diff options
| -rw-r--r-- | input.e | 50 | ||||
| -rw-r--r-- | interpret.e | 56 | ||||
| -rw-r--r-- | transform.e | 8 |
3 files changed, 90 insertions, 24 deletions
diff --git a/input.e b/input.e index 5cf2aeb..c7a1c02 100644 --- a/input.e +++ b/input.e @@ -166,7 +166,7 @@ buffer-logical-start @ 8@ ; -~ (metadata pointer) +~ (metadata pointer -- byte or 0) : key-from dup peek-from ~ (metadata pointer, result byte) @@ -175,6 +175,54 @@ swap consume-from ; +~ If the buffer is empty, make sure its logical position is at the +~ physical start. Otherwise, leave it alone. +~ +~ In: +~ pointer to buffer metadata +: normalize-buffer + dup buffer-logical-length @ 0 = + { dup buffer-physical-start @ swap + buffer-logical-start ! } { drop } if-else + ; + + +~ Find the next contiguous area of a buffer to write incoming data to. +~ This will begin at the logical end. Depending on the order things are in, +~ the available space might run from there to the physical end, or to the +~ logical start. Those are the only two possibilities. +~ +~ If the buffer is full, this will return as normal but the length will +~ be zero. The caller should make sure to respect that. +~ +~ In: +~ pointer to buffer metadata +~ Out: +~ destination start +~ destination length +: compute-next-buffer-free-block + dup buffer-physical-start @ swap dup buffer-physical-length @ + swap 3unroll + swap +~ (physical end, metadata pointer) + dup buffer-logical-start @ swap dup buffer-logical-length @ + swap 3unroll + swap 3unroll +~ (metadata pointer, physical end, logical end not yet wrapped) + + +~ (metadata pointer --) +: refill-input-buffer-from-stdin + dup normalize-buffer + dup compute-next-buffer-free-block + ~ Check whether the buffer is full. If not, do a read. If so, that's not + ~ an error, just clean up and take no action. + dup { swap sys-read + dup -2 = + { drop drop s" Read error." emitstring 0 sys-exit } + { swap dup buffer-logical-length @ 3roll + + swap buffer-logical-length ! } if-else } + { drop drop } if-else ; + + ~ Here we have some imperative code that runs immediately, to initialize ~ some runtime data structures. diff --git a/interpret.e b/interpret.e index ee0a52b..516c728 100644 --- a/interpret.e +++ b/interpret.e @@ -450,8 +450,28 @@ latest @ ; make-immediate +~ Though we only do it once, this is a bit involved so we provide it as a +~ word. Notionally there are situations in which it could come up again, so +~ it seems worth having around. +~ +~ It actually needs to run as a compiled word no matter what; if it were +~ run in interpret mode it would cut itself off from the rest of itself. +~ However, if we didn't want to keep it around we could have it forget +~ itself... +~ +~ It depends on ', so it's here in interpret.e. +: relink-main-input-buffer-to-stdin + 1024 allocate dup main-input-buffer buffer-physical-start ! + main-input-buffer buffer-logical-start ! + 1024 main-input-buffer buffer-physical-length ! + 0 main-input-buffer buffer-logical-length ! + ' refill-input-buffer-from-stdin entry-to-execution-token + main-input-buffer input-buffer-refill ! + ; + + -~ ~ Now the single most important word... +~ Now the single most important word... : interpret word @@ -493,7 +513,7 @@ latest @ ~ ourselves are compiled, hardcoded; doing a dynamic lookup would ~ require dealing with what happens if it's not found. dropstring-with-result - [ ' lit entry-to-execution-token literal ] + ' lit entry-to-execution-token , , exit } if @@ -507,24 +527,14 @@ latest @ ~ If it's neither in the dictionary nor a number, just print an error. s" No such word: " emitstring value@ emitstring dropstring ; -~ ~ TODO for ease of debugging, this isn't the full implementation, which lets -~ ~ us exit it to the outer "quit" -~ : quit { interpret } forever ; -~ -~ ~ Now we switch into the new interpreter, enabling the three words we'd been -~ ~ keeping hidden and then calling "quit". -~ dup entry-flags@ 0x80 invert & entry-flags! -~ dup entry-flags@ 0x80 invert & entry-flags! -~ dup entry-flags@ 0x80 invert & entry-flags! -~ quit -~ -~ ~ -0x10 newline . newline -~ compile ~ 4 5 + . : za 13 12 - . ; za -~ ~ ~ : ' word value@ find dropstring-with-result -~ ~ ~ interpreter-flags @ 1 & { literal } if ; make-immediate -~ ~ ' za . newline -~ ~ : piz ' za . newline ; piz -~ ~ ~ ' interpret forget quit 2 3 * . -~ ~ ' ' describe ' za describe ' piz describe -~ ~ bye -~ ~ +: quit r0 @ control! { interpret } forever ; + +~ Now we enable the three words we'd been keeping hidden. It would be a +~ good idea to call "quit" as soon as possible after this, but we leave it to +~ the user. +dup entry-flags@ 0x80 invert & entry-flags! +dup entry-flags@ 0x80 invert & entry-flags! +dup entry-flags@ 0x80 invert & entry-flags! + +relink-main-input-buffer-to-stdin quit + diff --git a/transform.e b/transform.e index 1502ee4..4d7c32c 100644 --- a/transform.e +++ b/transform.e @@ -740,6 +740,13 @@ allocate-transform-state s" transform-state" variable dup s" allocate-input-buffer-metadata" stringcmp 0 = { drop 1 exit } if dup s" allocate-input-buffer" stringcmp 0 = { drop 0 exit } if dup s" attach-string-to-input-buffer" stringcmp 0 = { drop -2 exit } if + dup s" consume-from" stringcmp 0 = { drop -1 exit } if + dup s" peek-from" stringcmp 0 = { drop 0 exit } if + dup s" key-from" stringcmp 0 = { drop 0 exit } if + dup s" normalize-buffer" stringcmp 0 = { drop -1 exit } if + dup s" compute-next-buffer-free-block" stringcmp 0 = { drop 1 exit } if + dup s" refill-input-buffer-from-stdin" stringcmp 0 = { drop -1 exit } if + dup s" main-input-buffer" stringcmp 0 = { drop 1 exit } if ~ From interpret.e. dup s" unroll-past-string" stringcmp 0 = { drop 0 exit } if @@ -759,6 +766,7 @@ allocate-transform-state s" transform-state" variable dup s" ;" stringcmp 0 = { drop 0 exit } if dup s" ;asm" stringcmp 0 = { drop 0 exit } if dup s" '" stringcmp 0 = { drop 1 exit } if + dup s" relink-main-input-buffer-to-stdin" stringcmp 0 = { drop 0 exit } if ~ The following is a deliberate omission: interpret. dup s" quit" stringcmp 0 = { drop 0 exit } if |