diff options
Diffstat (limited to 'language/dynamic/input.e')
| -rw-r--r-- | language/dynamic/input.e | 289 |
1 files changed, 289 insertions, 0 deletions
diff --git a/language/dynamic/input.e b/language/dynamic/input.e new file mode 100644 index 0000000..9d73c16 --- /dev/null +++ b/language/dynamic/input.e @@ -0,0 +1,289 @@ +~ ~~~~~~~~~~~~~~~~~~~ +~ ~~ Input streams ~~ +~ ~~~~~~~~~~~~~~~~~~~ + +~ (pointer to buffer metadata -- pointer to buffer "physical-start" field) +: buffer-physical-start ; + ~ The physical-start field happens to be the first thing in the metadata, so + ~ this is an nop, but it still exists as a word because having it reduces + ~ confusion. +~ (pointer to buffer metadata -- pointer to buffer "physical-length" field) +: buffer-physical-length 8 + ; +~ (pointer to buffer metadata -- pointer to buffer "logical-start" field) +: buffer-logical-start 2 8 * + ; +~ (pointer to buffer metadata -- pointer to buffer "logical-length" field) +: buffer-logical-length 3 8 * + ; +~ (pointer to buffer metadata -- pointer to buffer "file-descriptor" field) +: buffer-file-descriptor 4 8 * + ; +~ (pointer to input buffer metadata -- pointer to input buffer "refill" field) +: input-buffer-refill 5 8 * + ; +~ (pointer to input buffer metadata +~ -- pointer to input buffer "next-source" field) +: input-buffer-next-source 6 8 * + ; + + +~ Given an initialized buffer (input or otherwise), sets its logical-start +~ and logical-length fields to indicate the buffer is empty. This relies on +~ the buffer having a backing store attached, but does not alter the backing +~ store or its contents. +~ +~ (pointer to buffer metadata --) +: clear-buffer + dup buffer-physical-start @ swap + ~ (address of backing store, metadata pointer) + dup 3unroll + ~ (metadata pointer, address of backing store, metadata pointer) + buffer-logical-start ! + buffer-logical-length 0 swap ! ; + + +~ Sets all fields in an input buffer metadata structure to their default +~ values, mostly zero, effectively detaching and leaking any backing store +~ that had been attached to it. Suitable for use during initialization. +~ +~ (pointer to input buffer metadata --) +: zero-input-buffer-metadata + dup buffer-physical-start 0 swap ! + dup buffer-physical-length 0 swap ! + dup buffer-logical-start 0 swap ! + dup buffer-logical-length 0 swap ! + dup buffer-file-descriptor -1 swap ! + dup input-buffer-refill 0 swap ! + ~ Notice the absence of a dup this time. + input-buffer-next-source 0 swap ! ; + + +~ Allocates input-buffer metadata, with no backing store attached. +~ Initializes the metadata to all zeroes. +~ +~ (-- pointer to input buffer metadata) +: allocate-input-buffer-metadata + 7 8 * allocate + dup zero-input-buffer-metadata ; + + +~ Allocates input buffer metadata and a backing store, in one operation. +~ Points the metadata to the backing store. +~ +~ (buffer capacity in bytes -- pointer to input buffer metadata) +: allocate-input-buffer + dup 7 8 * + allocate + dup zero-input-buffer-metadata + ~ (capacity in bytes, metadata pointer) + dup dup 7 8 * + + ~ (capacity in bytes, metadata pointer, metadata pointer, physical start) + swap buffer-physical-start ! + ~ (capacity in bytes, metadata pointer) + dup 3unroll buffer-physical-length ! + ~ (metadata pointer) + dup clear-buffer ; + + +~ Sets the backing store of an input buffer to point at a null-teriminated +~ string and read from it. +~ +~ (buffer metadata pointer, string pointer --) +: attach-string-to-input-buffer + swap + ~ (string pointer, metadata pointer) + 2dup buffer-physical-start ! + ~ (string pointer, metadata pointer) + 2dup buffer-logical-start ! + ~ (string pointer, metadata pointer) + swap stringlen swap + ~ (string length, metadata pointer) + 2dup buffer-physical-length ! + ~ (string length, metadata pointer) + dup 3unroll buffer-logical-length ! + ~ (metadata pointer) + -1 swap buffer-file-descriptor ! ; + + +~ (metadata pointer --) +: consume-from + ~ If the length is zero, exit without doing anything. + dup buffer-logical-length @ 0 = { drop exit } if + + ~ Decrement the logical length. We do this now to get it over with, since + ~ adjusting the start pointer is more complex. + dup buffer-logical-length dup @ 1 - swap ! + ~ (metadata pointer) + + ~ We compute the physical end. We'll need it in adjusting the logical start, + ~ and doing it now means less stack juggling later. + dup dup buffer-physical-start @ swap buffer-physical-length @ + swap + ~ (physical end, metadata pointer) + + ~ Compute the incremented logical start. + dup buffer-logical-start @ 1 + + ~ (physical end, metadata pointer, updated start pointer) + + ~ Check whether the updated start is equal to the physical end. + dup 4 roll = + ~ (metadata pointer, updated start, updated start, physical end) + { + ~ If the logical start pointer is now equal to the physical end pointer, + ~ we want to wrap to the physical start. That's what makes it a circular + ~ buffer. + ~ (metadata pointer, updated start) + drop dup buffer-physical-start @ + } if + + ~ However we got here, save the updated logical start pointer. + ~ (metadata pointer, updated start) + swap buffer-logical-start ! ; + + +~ We use -1 as a return value to indicate end-of-file. This can be +~ distinguished from valid data, because it's a full 64 bits, whereas a byte +~ of 0xFF wouldn't be. +~ +~ (metadata pointer -- byte or -1) +: peek-from + dup buffer-logical-length @ { + ~ If the length is zero, there is no input, but we can still try calling + ~ the "refill" word. + ~ (metadata pointer) + dup input-buffer-refill @ dup { + ~ If the refill word is zero, we can't help, just return EOF. + ~ (metadata pointer, refill word) + drop drop -1 exit + } unless + + ~ If the refill word is nonzero, call it. It expects a copy of the metadata + ~ pointer as its parameter, so set that up. + ~ (metadata pointer, refill word) + swap dup 3roll execute + ~ (metadata pointer) + ~ Now we check if the length is still zero. + dup buffer-logical-length @ { + ~ The length is zero even after calling the refill word, so return EOF. + ~ (metadata pointer) + drop -1 exit + } unless + } unless + + ~ The buffer is non-empty, so read a byte from it. We might have reached + ~ this point either from the original check, or from the second check after + ~ calling the refill word. + ~ + ~ While it might be more extensible to call an "unpack" word here, such as + ~ unpack8, we actually just want to get the value, and delegate the pointer + ~ adjustments to "consume". + ~ + ~ (metadata pointer) + buffer-logical-start @ 8@ ; + + +~ Just as with peek-from, we use -1 for EOF. +~ +~ (metadata pointer -- byte or -1) +: key-from + dup peek-from + ~ (metadata pointer, result byte) + ~ We unconditionally consume, because we have no way to distinguish between + ~ reading a zero byte and having nothing left to read. + swap consume-from ; + + +~ If the buffer is empty, make sure its logical position is at the +~ physical start. Otherwise, leave it alone. +~ +~ (metadata pointer --) +: 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. +~ +~ (metadata pointer -- 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) + + 2dup >= { + ~ If the logical end is greater than or equal to the physical end, find + ~ where it wraps to and start from there. + swap - swap dup buffer-physical-start @ swap 3unroll + + ~ (metadata pointer, destination start) + ~ In this scenario, the logical start is the end of the free space, so + ~ compute how far away it is. + dup 3roll + ~ (destination start, destination start, metadata pointer) + buffer-logical-start @ swap - + } { + 3roll drop + dup 3roll swap - + ~ If the logical end is less than the physical end, it is the destination; + ~ the physical end is also the end of the free space, so compute how far + ~ away it is. + } if-else ; + + +~ (metadata pointer --) +: refill-input-buffer-from-stream + dup normalize-buffer + dup compute-next-buffer-free-block + ~ (metadata pointer, destination start, destination length) + ~ 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 + ~ (metadata pointer, destination length, destination start) + { 3 ndup 3roll buffer-file-descriptor @ 3unroll swap sys-read + ~ (metadata pointer, destination length, destination start, + ~ read result) + dup 0 > { + dup -4 = + { + ~ This is the EINTR case, so we're supposed to try the same + ~ read again. To that end, this whole thing is running in a + ~ loop, and all the other paths exit. + drop + ~ (metadata pointer, destination length, destination start) + } + { drop drop drop drop + ." Read error." 0 sys-exit } if-else } + { 3unroll drop drop + ~ (metadata pointer, read result) + swap dup buffer-logical-length @ 3roll + + ~ (metadata pointer, adjusted logical length) + swap buffer-logical-length ! exit } if-else } forever } + { drop drop drop } if-else ; + + + +~ Here we have some imperative code that runs immediately, to initialize +~ some runtime data structures. +~ +~ First, we insert a metadata word header to delimit the space. Otherwise +~ "describe" would crash when attempting to describe +~ "attach-string-to-input-buffer". + +s" main-input-buffer-metadata" create +s" main-input-buffer-metadata" find 0x01 swap entry-flags! + +~ Having done that, now we do the runtime allocation. Then we also define +~ the variable "main-input-buffer" so we can find it again. +allocate-input-buffer-metadata +s" main-input-buffer" variable + +~ We'll leave it to warm-start, in compilation/execution.e, to attach the +~ buffer. It's easier that way. + +: peek main-input-buffer peek-from ; +: consume main-input-buffer consume-from ; +: key main-input-buffer key-from ; + |