path: root/input.e

~ ~~~~~~~~~~~~~~~~~~~
~ ~~ 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 = 0branch [ 2 8 * , ] exit

  ~ 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)
  0branch [ 5 8 * , ]

  ~ 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 @

  ~ 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 @ 0 = 0branch [ 28 8 * , ]

  ~ 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 0branch [ 17 8 * , ]

  ~ 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 @ 0 = 0branch [ 10 8 * , ]

  ~ The length is zero even after calling the refill word, so return null.
  ~ (metadata pointer)
  drop 0 exit

  ~ If the refill word is zero, we can't help, just return null.
  ~ (metadata pointer, refill word)
  drop drop 0 exit

  ~   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 ;