~ ~~~~~~~~~~~~~~~~~~~ ~ ~~ 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 input buffer metadata -- pointer to input buffer "refill" field) : input-buffer-refill 4 8 * + ; ~ (pointer to input buffer metadata ~ -- pointer to input buffer "next-source" field) : input-buffer-next-source 5 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 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 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 6 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 6 8 * + allocate dup zero-input-buffer-metadata ~ (capacity in bytes, metadata pointer) dup dup 6 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) buffer-logical-length ! ; ~ (metadata pointer --) : consume-from ~ If the length is zero, exit without doing anything. dup buffer-logical-length @ 0 = { 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 ! ; ~ (metadata pointer -- byte or 0) : 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 null. ~ (metadata pointer, refill word) drop drop 0 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 null. ~ (metadata pointer) drop 0 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@ ; ~ (metadata pointer -- byte or 0) : 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-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. ~ ~ 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 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 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 ;