Files
LithosAnanake/v4/capsule/input.v4
T
rajamesandClaude Opus 5.5 7b42a9b6c1 fix(v4.0.0): EXPECT, QUERY and WORD follow FORTH-79
Ruled 2026-10-04: standard words follow the standard where v3 did not.

EXPECT takes up to n characters (v3 took n-1) and does nothing for
n <= 0.  QUERY takes up to 80 (v3: 1024).  WORD stores the delimiter it
met, or a zero at the end of the text, after the word, and leaves >IN
just past that one delimiter (v3 skipped them all and stored a zero);
the word may be up to 255 characters (v3: 62).

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-04 08:37:44 -04:00

149 lines
6.6 KiB
Plaintext

\ 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 six 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
: 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.
: 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.
: QUERY TIB 80 EXPECT 0 >IN a! ! ;
\ ---- WORD ------------------------------------------------------------------
\ (P)+0 the delimiter, (P)+1 the length of the text in TIB.
macro (WDELIM) (P) endmacro
macro (WLEN) (P) 1 + endmacro
: (LEFT) ( i -- i d ) dup (WLEN) a! @ - ; \ d < 0 while i is inside the text
: (CH) ( i -- i x ) dup TIB + C@ (WDELIM) a! @ xor ; \ x = 0 at a delimiter
: (SKIP) ( i -- i' ) \ past delimiters
L: (LEFT) -if E drop (CH) if S drop ;
S: drop 1 + jump L
E: drop ;
: (SCAN) ( i -- i' ) \ up to a delimiter
L: (LEFT) -if E drop (CH) if E drop 1 + jump L
E: drop ;
\ ( 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.
: WORD
255 and (WDELIM) a! !
SPAN a! @ -if A drop 0 A: (WLEN) a! !
>IN a! @ -if B drop 0 B:
(SKIP) dup push (SCAN) \ end R: start
pop over over - \ end start len
dup -256 + -if CAP drop jump FITS CAP: drop drop 255 FITS:
dup WBUF C!
dup push push TIB + WBUF 1 + pop CMOVE \ end R: len
(LEFT) -if RANOUT
drop (WDELIM) a! @ pop WBUF + 1 + C! \ the delimiter after the text
1 + >IN a! ! WBUF ;
RANOUT: drop 0 pop WBUF + 1 + C!
>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 (WLEN) a! @ + C@ if END (WDELIM) 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.
: ENCLOSE
255 and (WDELIM) a! ! dup (WLEN) 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.
: 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 ) FORTH-79: the counted string at baddr as a signed double in
\ the current BASE; it may begin with a minus sign. If it is empty, is only
\ a sign, or holds anything that is not a digit, the result is 0 and
\ NODE-ERROR is set. 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 jump DNEGATE
POS: drop ;
ERR2: drop drop
ERR0: NODE-ERROR b! -1 !b 0 0 ;
\ ---- comments (5.15) -------------------------------------------------------
\ PAREN skips to the closing parenthesis; BACKSLASH skips the rest of the line.
: PAREN 41 WORD drop ;
: BACKSLASH SPAN a! @ >IN a! ! ;