289 lines
10 KiB
Text
289 lines
10 KiB
Text
~ ~~~~~~~~~~~~~~~~~~~
|
|
~ ~~ 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 -EINTR =
|
|
{
|
|
~ 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 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 ;
|
|
|