\ quit.v4 -- the prompt: lines read from the console and interpreted, one \ after another, for as long as the node runs; and the words that print text \ written in the source. \ \ DECOMPOSITION.md 5.15 and 5.10: QUIT ABORT ABORT" (ABORT") ." (."). Part of \ the compiler capsule. Rests on all the files before it. \ \ WHAT THE CONSOLE SHOWS, as v3: \ ok> 65 EMIT the prompt, then the line as it is typed \ A ok what the line printed, then " ok" \ ok> NOSUCH \ UNKNOWN WORD: 'NOSUCH' \ ERROR any line that sets NODE-ERROR ends so \ ok> -1 @ \ Address out of range an address fault (D-14), from any depth \ ERROR \ The line itself is not sent back: the terminal shows what is typed. \ \ THE STACKS are guarded (D-16): each counts what it holds, and a push onto \ a full one or a pop from an empty one is a fault. So QUIT and ABORT, which \ never return to whatever ran them, must empty the return stack, and ABORT \ the data stack too. A store to RSTACK-DEPTH or DSTACK-DEPTH does that. \ \ Constants the loader supplies: \ (Q) word address of two cells of scratch for this file \ DSTACK-DEPTH RSTACK-DEPTH word addresses of the stack registers \ ( -- ) empty the return stack. `a` is only something to store: any \ store to the register empties the stack, and `a` needs nothing to be on \ the data stack. One cell of the data stack is used for a moment. macro R-CLEAR RSTACK-DEPTH b! a !b endmacro \ ( -- ) stop compiling; forget the word being built and any open control \ structures. A definition that was under way stays hidden. : (RESET) 0 STATE a! ! (CG-RESET) CFBASE (CFP) a! ! ; \ ( k -- ) the loop. It is entered with what to say first -- 0 nothing, \ 1 " ok", anything else " ERROR" -- and never returns. It is always jumped \ to, never called, by something that has emptied the return stack (or by a \ fault, which empties it). Each line is then interpreted with one return \ entry under it, this word's call of INTERPRET. : (REPL) if GO -1 + if OK drop (RESET) $52524520 (EMIT4) $524F (EMIT4) CR jump READ \ " ERROR" OK: drop $6B6F20 (EMIT4) CR jump READ \ " ok" GO: drop READ: $203E6B6F (EMIT4) \ "ok> " QUERY 0 NODE-ERROR b! !b INTERPRET NODE-ERROR b! @b if GOOD drop 2 jump (REPL) GOOD: drop 1 jump (REPL) \ FORTH-79: clear the return stack, set execution mode, return control to \ the terminal; no message is given. The data stack is left as it is. header QUIT : QUIT R-CLEAR (RESET) CR 0 jump (REPL) \ FORTH-79: clear the data and return stacks, set execution mode, return \ control to the terminal. As v3, the line it stops ends with " ok". \ Both are emptied before anything is called: ABORT may be run with the \ return stack full. header ABORT : ABORT R-CLEAR DSTACK-DEPTH b! a !b (RESET) 1 jump (REPL) \ ---- faults (D-14, D-16) ------------------------------------------------------- \ Where the node goes when a programme uses an address outside its memory, \ pushes onto a full stack or pops an empty one. The opcode that faulted did \ nothing, and both stacks have been emptied. Each handler says what happened; \ whatever was running is abandoned, as by ABORT, and the line ends with \ ERROR. : (FAULT) \ "Address out of range" $72646441 (EMIT4) $20737365 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR 2 jump (REPL) : (D-OVER) \ "Stack overflow" $63617453 (EMIT4) $766F206B (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR 2 jump (REPL) : (D-UNDER) \ "Stack underflow" $63617453 (EMIT4) $6E75206B (EMIT4) $66726564 (EMIT4) $776F6C (EMIT4) CR 2 jump (REPL) : (R-OVER) \ "Return stack overflow" $75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $65766F20 (EMIT4) $6F6C6672 (EMIT4) $77 (EMIT4) CR 2 jump (REPL) : (R-UNDER) \ "Return stack underflow" $75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $646E7520 (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR 2 jump (REPL) \ A word has stored an error code in NODE-ERROR (D-18; the codes are listed \ in core.v4). Print its message -- a negative code means the word printed \ its own -- and end the line with ERROR. The return stack has been \ emptied; the data stack is as the word left it. : (RAISED) NODE-ERROR b! @b -if POS drop 2 jump (REPL) POS: -1 + if M1 -1 + if M2 -1 + if M3 -1 + if M4 -1 + if M5 -1 + if M6 -1 + if M7 -1 + if M8 drop 2 jump (REPL) M1: drop $6167654E (EMIT4) $65766974 (EMIT4) $756F6320 (EMIT4) $746E (EMIT4) CR 2 jump (REPL) M2: drop $20746F4E (EMIT4) $756E2061 (EMIT4) $7265626D (EMIT4) CR 2 jump (REPL) M3: drop $626D754E (EMIT4) $74207265 (EMIT4) $6C206F6F (EMIT4) $676E6F (EMIT4) CR 2 jump (REPL) M4: drop $20746F4E (EMIT4) $68632061 (EMIT4) $63617261 (EMIT4) $726574 (EMIT4) CR 2 jump (REPL) M5: drop $74636944 (EMIT4) $616E6F69 (EMIT4) $66207972 (EMIT4) $6C6C75 (EMIT4) CR 2 jump (REPL) M6: drop $656D614E (EMIT4) $73696D20 (EMIT4) $676E6973 (EMIT4) CR 2 jump (REPL) M7: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $696D2065 (EMIT4) $74616D73 (EMIT4) $6863 (EMIT4) CR 2 jump (REPL) M8: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $74207365 (EMIT4) $64206F6F (EMIT4) $706565 (EMIT4) CR 2 jump (REPL) \ The table the loader gives the node: six words, one for each kind of \ fault in the node's order, each a jump. A jump fills its word, so they \ are one after another. : (FAULTS) jump (FAULT) jump (D-OVER) jump (D-UNDER) jump (R-OVER) jump (R-UNDER) jump (RAISED) \ ---- text in the source --------------------------------------------------------- \ ." and ABORT" take the text up to the next " , which may be none at all \ (input.v4's (PARSE)); with no closing " it is the rest of the line. Inside a definition they lay \ down a call to their run-time word and, after it, the text as a counted \ string: the count byte and the characters, four to a cell, the last cell \ filled with zeros. The run-time word finds the string by the return \ address the call left, and returns to the cell after the string. \ ( -- ) lay the counted string in WBUF into the dictionary, as above. \ (Q)+0 how many bytes are still to go, (Q)+1 which is next. : (STRING,) (FLUSH) WBUF C@ 1 + (Q) a! ! 0 (Q)+1 a! ! L: (Q) a! @ if DONE -1 + ! (Q)+1 a! @ dup 1 + ! WBUF + C@ C, jump L DONE: drop P: DP b! @b 3 and if ALIGNED drop 0 C, jump P ALIGNED: drop ; \ The run time of ." : print the string after the call, go on after it. \ It takes the return address off before it calls anything and keeps the \ count there instead, so a word that prints text goes no deeper than one \ that calls any other word. : (.") pop 4* dup C@ \ baddr n L: if DONE push 1 + dup C@ EMIT pop -1 + jump L DONE: drop 4/ 1 + push ; \ the cell after the last character \ FORTH-79: ." text" prints the text -- now, if interpreting; when the word \ it is compiled into runs, if compiling. header ." immediate : DOT-QUOTE 34 (PARSE) drop STATE a! @ if NOW drop &(.") (CALL,) jump (STRING,) NOW: drop WBUF COUNT jump TYPE \ ( flag -- ) the run time of ABORT" : if the flag is not zero print the \ string after the call, start a new line and ABORT; otherwise go on after \ the string. : (ABORT") if NO drop pop 4* R-CLEAR COUNT TYPE CR jump ABORT NO: drop pop 4* dup C@ + 4/ 1 + push ; \ ( flag -- ) ABORT" text" as v3 (it is FORTH-83's, not FORTH-79's): if \ the flag is not zero, print the text and ABORT. header ABORT" immediate : ABORT-QUOTE 34 (PARSE) drop STATE a! @ if NOW drop &(ABORT") (CALL,) jump (STRING,) NOW: drop if NO drop WBUF COUNT TYPE CR jump ABORT NO: drop ;