LithosAnanake/v4/capsule/input.v4

\ input.v4 -- reading a line and splitting it into words and numbers.
\
\ DECOMPOSITION.md 5.9: TIB >IN SPAN SOURCE BL EXPECT QUERY WORD ENCLOSE
\ CONVERT NUMBER, and the comment words ( and \ of 5.15 (named PAREN and
\ BACKSLASH here, since the text assembler reads those two characters as its
\ own comments; the dictionary will give them their names).  Part of the compiler
\ capsule: it runs on the host node.  Rests on core.v4.
\
\ Constants the loader supplies:
\   TIB      byte address of the text input buffer; QUERY fills at most 81 bytes
\   >IN      word address of the variable: offset in TIB of the next character
\   SPAN     word address of the variable: how many characters the last
\            EXPECT or QUERY read
\   WBUF     byte address of WORD's buffer, 257 bytes
\   (P)      word address of eight cells of scratch for this file
\ TIB >IN SPAN and BL are in-line: written in a definition they are literals.

macro BL  32  endmacro

\ ( -- baddr u )   the input buffer and how much of it is in use
header SOURCE
: SOURCE   TIB  SPAN a! @  -if P  drop 0  P: ;

\ ( baddr n -- )   FORTH-79: characters from the terminal are stored from
\ baddr upward until a new-line or until n have been received; the new-line
\ is taken but not stored.  A zero is added after the text, so the buffer
\ must hold n + 1 bytes.  No action for n <= 0.  SPAN is how many characters
\ were stored (SPAN is not FORTH-79; v3 has it).  A line longer than n leaves
\ the rest, its new-line included, to be read next.
header EXPECT
: EXPECT
  -if NN  drop drop ;                        \ n < 0
  NN: if ZERO
  over push                                  \ p n        R: start
  L: if END
     push  KEY  dup -10 + if NL              \ p c x      R: start n
     drop over C!  1 +  pop -1 +  jump L
     NL: drop drop pop
  END: drop  0 over C!                       \ p
       pop -  SPAN a! ! ;
  ZERO: drop drop ;

\ ( -- )   FORTH-79: up to 80 characters, or a line, into TIB; >IN to 0.
header QUERY
: QUERY   TIB 80 EXPECT  0 >IN a! ! ;

\ ---- WORD ------------------------------------------------------------------
\ WORD is called from deep inside the interpreter and compiler, with whatever
\ the user has on the stacks beneath it, and the stacks are ten and nine deep
\ (D-2).  So everything it works on is in (P), and it never has more than
\ three cells of its own on the data stack:
\   (P)+0 the delimiter         (P)+1 the length of the text in TIB
\   (P)+2 the word's length     (P)+3 how much of it is still to be copied
\   (P)+6 where it is in TIB    (P)+7 where the word starts
\ (CONVERT and NUMBER use (P)+2 .. (P)+5; they and WORD never run inside
\ each other.)

\ In line, not called: WORD may have only a few return entries to spare.
macro (LEFT)   (P)+6 a! @  (P)+1 a! @  -            endmacro   \ ( -- d )  d < 0 while inside the text
macro (CH)     (P)+6 a! @ TIB + C@  (P) a! @  xor   endmacro   \ ( -- x )  x = 0 at a delimiter
macro (STEP)   (P)+6 a! @ 1 + !                     endmacro

\ ( c -- baddr )   FORTH-79: characters are taken from TIB until the
\ delimiter c or the end of the text, leading delimiters ignored, and stored
\ in WBUF as a counted string.  The delimiter met -- c, or a zero if the text
\ ran out -- is stored after them and is not counted.  >IN is left just past
\ that delimiter.  With nothing left the count is 0.  The count is a byte,
\ so a word longer than 255 characters is cut to 255.
header WORD
: WORD
  255 and (P) a! !
  SPAN a! @  -if A drop 0 A:  (P)+1 a! !
  >IN a! @   -if B drop 0 B:  (P)+6 a! !
  SK: (LEFT) -if SKE  drop (CH) if SKS  drop jump SKIPPED      \ past delimiters
  SKS: drop (STEP) jump SK
  SKE: drop
  SKIPPED:
  (P)+6 a! @ (P)+7 a! !                      \ where it starts
  SC: (LEFT) -if SCE  drop (CH) if SCE  drop (STEP) jump SC    \ up to a delimiter
  SCE: drop
  (P)+6 a! @  (P)+7 a! @  -                  \ its length
  dup -256 + -if CAP  drop jump FITS   CAP: drop drop 255   FITS:
  dup (P)+2 a! !  (P)+3 a! !
  (P)+2 a! @ WBUF C!
  \ copy it, last character first
  CP: (P)+3 a! @ if COPIED  -1 + dup !       \ k
      dup (P)+7 a! @ + TIB + C@              \ k c
      SWAP WBUF+1 + C!
      jump CP
  COPIED: drop
  (LEFT) -if RANOUT
    drop  (P) a! @  (P)+2 a! @ WBUF+1 + C!   \ the delimiter after the text
    (P)+6 a! @ 1 +  >IN a! !  WBUF ;
  RANOUT: drop  0  (P)+2 a! @ WBUF+1 + C!
    (P)+6 a! @  >IN a! !  WBUF ;

\ ---- ENCLOSE ---------------------------------------------------------------
\ (P)+0 the delimiter, (P)+1 the string's address.
: (E?) ( i -- i k )     \ k: 0 at the end of the string, 1 at a delimiter, else 2
  dup (P)+1 a! @ + C@  if END  (P) a! @ xor if DEL  drop 2 ;
  DEL: drop 1 ;
  END: drop 0 ;
: (ESKIP) ( i -- i' )   L: (E?) -1 + if S  drop ;   S: drop 1 + jump L
: (ESCAN) ( i -- i' )   L: (E?) -2 + if S  drop ;   S: drop 1 + jump L

\ ( baddr c -- baddr n1 n2 n3 )   in the zero-terminated string at baddr:
\ n1 the offset of the first character that is not c, n2 the offset of the
\ first c after it, n3 the offset of the first character after that run of c.
header ENCLOSE
: ENCLOSE
  255 and (P) a! !  dup (P)+1 a! !
  0 (ESKIP)  dup (ESCAN)  dup (ESKIP) ;

\ ---- CONVERT and NUMBER ----------------------------------------------------
\ ( c -- n )   the value of the digit c, 0 .. 35, in either case; -1 if none
: (DIGIT)
  dup -48 + -if GE0  drop drop -1 ;
  GE0: drop dup -58 + -if GT9  drop -48 + ;
  GT9: drop dup -65 + -if GEA  drop drop -1 ;
  GEA: drop dup -91 + -if GTZ  drop -55 + ;
  GTZ: drop dup -97 + -if GEa  drop drop -1 ;
  GEa: drop dup -123 + -if GTz  drop -87 + ;
  GTz: drop drop -1 ;

\ ( d1 baddr1 -- d2 baddr2 )   FORTH-79: the characters from baddr1 + 1 on are
\ taken as digits in the current BASE, each accumulated into the double after
\ it is multiplied by BASE, until one is not a digit; baddr2 is its address.
\ (P)+2 holds the digit while the double is multiplied and (P)+5 the address,
\ so nothing waits on the return stack across the calls.
header CONVERT
: CONVERT
  L: 1 + dup (P)+5 a! !  C@ (DIGIT)        \ lo hi n
     -if DIG  drop  (P)+5 a! @ ;
     DIG: dup (BASE) - -if BIG
          drop  (P)+2 a! !                 \ lo hi
          (BASE) UM* drop                    \ lo hi*base
          SWAP (BASE) UM*                    \ hi*base plo phi
          push SWAP pop +                    \ plo hi'
          (P)+2 a! @ 0 D+
          (P)+5 a! @  jump L
     BIG: drop drop  (P)+5 a! @ ;

\ ( baddr -- d flag )   the counted string at baddr as a signed double in the
\ current BASE, and -1; it may begin with a minus sign.  If it is empty, is
\ only a sign, or holds anything that is not a digit: 0 0 and 0.  The character after the string must not be a digit
\ (WORD puts the delimiter or a zero there); if it is, that too is reported
\ as an error.  (P)+3 the address of its last character, (P)+4 the sign.
: (NUMBER?)
  dup C@ if ERR2
  over + (P)+3 a! !                        \ baddr
  dup 1 + C@ -45 + if NEG
    drop  0 (P)+4 a! !  jump GO
  NEG: drop  -1 (P)+4 a! !  1 +
       dup (P)+3 a! @ xor if ERR2  drop
  GO: push 0 0 pop CONVERT                   \ lo hi baddr2
      (P)+3 a! @ 1 + xor if FINE
      drop drop drop jump ERR0
  FINE: drop  (P)+4 a! @ if POS  drop DNEGATE -1 ;
  POS: drop  -1 ;
  ERR2: drop drop
  ERR0: 0 0 0 ;

\ ( baddr -- d )   FORTH-79.  What is not a number gives 0 and sets NODE-ERROR.
header NUMBER
: NUMBER
  (NUMBER?) if BAD  drop ;
  BAD: drop  NODE-ERROR b! -1 !b ;

\ ---- comments (5.15) -------------------------------------------------------
\ PAREN skips to the closing parenthesis; BACKSLASH skips the rest of the line.
header ( immediate
: PAREN      41 WORD drop ;
header \ immediate
: BACKSLASH  SPAN a! @  >IN a! ! ;