\ 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 \ (SRC) word address of the variable: the byte address of the text being \ interpreted. QUERY makes it TIB; LOAD (blocks.v4) makes it a \ block buffer. >IN is an offset from it and SPAN its length. \ (SRC-HOOK) word address of a variable: 0, or the address of a word \ that WORD calls before it looks at the text, to make sure (SRC) \ is right. LOAD puts one there: a block buffer can be given to \ another block between one word of the text and the next. \ BLK word address of the variable: the block being interpreted, or \ 0 for the terminal (FORTH-79) \ 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 (SRC) a! @ 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. \ It is what the prompt reads every line with, with whatever the user has left \ on the stack beneath it, so it works in (P) -- (P)+0 where the next \ character goes, (P)+1 how many more may come, (P)+2 where the first went -- \ and has at most three cells of its own on the data stack (D-2). header EXPECT : EXPECT -if NN drop drop ; \ n < 0 NN: if ZERO (P)+1 a! ! dup (P)+2 a! ! (P) a! ! L: (P)+1 a! @ if END drop KEY dup -10 + if NL drop \ c (P) a! @ C! (P) a! @ 1 + ! (P)+1 a! @ -1 + ! jump L NL: drop drop jump FIN END: drop FIN: 0 (P) a! @ C! (P) a! @ (P)+2 a! @ - SPAN a! ! ; ZERO: drop drop ; \ ( -- ) FORTH-79: up to 80 characters, or a line, into TIB; >IN to 0. header QUERY : QUERY TIB (SRC) a! ! 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.) \ ( -- c ) the character WORD is at. A zero reads as a blank when words \ are being split at blanks: a block that has never been written is all \ zeros, and so is the end of one whose lines were put there one at a time. : (SRC@) (P)+6 a! @ (SRC) a! @ + C@ if Z ; Z: drop (P) a! @ -32 + if B drop 0 ; B: drop 32 ; \ 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) (SRC@) (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. \ The three parts of WORD. The first is called and returns before anything \ else is; the last is jumped to; so WORD's calls of C@ and C! are no deeper \ than if it were written in one piece. : (WORD-SET) ( c -- ) 255 and (P) a! ! (SRC-HOOK) a! @ if NONE push ex \ call it: ex comes back to the next word jump HOOKED NONE: drop HOOKED: SPAN a! @ -if A drop 0 A: (P)+1 a! ! >IN a! @ -if B drop 0 B: (P)+6 a! ! ; : (WORD-TAKE) ( -- baddr ) (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! @ + (SRC) a! @ + 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 ; header WORD : WORD (WORD-SET) SK: (LEFT) -if SKE drop (CH) if SKS drop jump (WORD-TAKE) \ past delimiters SKS: drop (STEP) jump SK SKE: drop jump (WORD-TAKE) \ ( c -- baddr ) as WORD, but leading delimiters are not ignored: the text \ starts at >IN, and may be empty. This is what ." needs: ." " is an \ empty string, where WORD would step over its closing quote. : (PARSE) (WORD-SET) jump (WORD-TAKE) \ ---- 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! 2 !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 \ In a block a line is 64 characters: skip to the start of the next. : BACKSLASH BLK a! @ if TERM drop >IN a! @ -64 and 64 + ! ; TERM: drop SPAN a! @ >IN a! ! ;