rajamesandClaude Opus 5.5
5d6043e37e
capsules/v4/post79.4th: 537 of v3's POST cases for the FORTH-79 Required Word Set, each carrying what the hosted v3 binary did with the same line (error or not, the stack, the length and checksum of what it printed). Written by v4/tools/mkpost.py. The harness is FORTH-79 plus the two nucleus hooks. docs/v4.0.0/NUCLEUS.md section 6. - NODE-ERROR has a FORTH name: how a definition in FORTH raises an error - the boot passes POST only on seeing its tally line with fail=0 - POST is not in the boot yet (V4_POST_AT_BOOT=0); make -C v4 post runs it Result: tests=537 pass=439 fail=98. The 98 are not yet sorted into v4 defects and differences needing a ruling; v4/README.md has a first reading. Verified: make -C v4 test passes; hosted-check passes on three ISAs; clean qemu with STARFORTH_V4=1 on amd64, aarch64 and riscv64 reaches ok> with the same hashes as hosted (logs/20261005-1601xx..1604xx). Nothing was typed at a bare-metal prompt. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
225 lines
11 KiB
Plaintext
225 lines
11 KiB
Plaintext
\ 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 four cells of scratch, which system.v4 and
|
|
\ blocks.v4 use too
|
|
\ 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! ! ;
|
|
|
|
\ CATCHING A LINE'S ERROR. While the variable (CATCH) is not zero, a line
|
|
\ that ends in an error -- a fault, or a code in NODE-ERROR -- does not say
|
|
\ ERROR: (CATCH) is set to -1 and the line ends " ok". Whatever message the
|
|
\ error printed has gone wherever EMIT was sending it. POST uses this to
|
|
\ go on to its next case, and to check the cases that must fail
|
|
\ (docs/v4.0.0/NUCLEUS.md 6.3). (EMIT-HOOK), core.v4, is set to 0 here at
|
|
\ the end of every line, caught or not.
|
|
\
|
|
\ ( 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)
|
|
(EMIT-HOOK) b! 0 !b \ the console is the console again
|
|
if GO -1 + if OK
|
|
drop (RESET)
|
|
(CATCH) b! @b if LOUD drop -1 !b 1 jump (REPL) \ caught: the line ends " ok"
|
|
LOUD: drop $52524520 (EMIT4) $524F (EMIT4) CR jump READ \ " ERROR"
|
|
OK: drop $6B6F20 (EMIT4) CR jump READ \ " ok"
|
|
GO: drop
|
|
READ:
|
|
$203E6B6F (EMIT4) \ "ok> "
|
|
0 BLK a! ! \ the terminal, whatever was being loaded
|
|
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.
|
|
\ NODE-ERROR, by name: how a definition written in FORTH raises an error.
|
|
\ A store of a code that is not zero is the trap of D-18 -- the word goes no
|
|
\ further, the message for the code is printed (-1: the word has printed
|
|
\ its own) and the line ends with ERROR. The codes are listed in core.v4.
|
|
header NODE-ERROR inline : NODE-ERROR' NODE-ERROR ;
|
|
header (CATCH) inline : (CATCH)' (CATCH) ;
|
|
header (EMIT-HOOK) inline : (EMIT-HOOK)' (EMIT-HOOK) ;
|
|
|
|
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 -1 + if M9
|
|
-1 + if M10 -1 + if M11 -1 + if M12 -1 + if M13 -1 + if M14
|
|
-1 + if M15 -1 + if M16
|
|
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)
|
|
M9: drop $66696853 (EMIT4) $6F632074 (EMIT4) $20746E75 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR 2 jump (REPL)
|
|
M10: drop $746F7250 (EMIT4) $65746365 (EMIT4) $6F772064 (EMIT4) $6472 (EMIT4) CR 2 jump (REPL)
|
|
M11: drop $69766944 (EMIT4) $6E6F6973 (EMIT4) $20796220 (EMIT4) $6F72657A (EMIT4) CR 2 jump (REPL)
|
|
M12: drop $75677241 (EMIT4) $746E656D (EMIT4) $74756F20 (EMIT4) $20666F20 (EMIT4) $676E6172 (EMIT4) $65 (EMIT4) CR 2 jump (REPL)
|
|
M13: drop $636F6C42 (EMIT4) $756F206B (EMIT4) $666F2074 (EMIT4) $6E617220 (EMIT4) $6567 (EMIT4) CR 2 jump (REPL)
|
|
M14: drop $62206F4E (EMIT4) $6B636F6C (EMIT4) $20736920 (EMIT4) $6E696562 (EMIT4) $6F6C2067 (EMIT4) $64656461 (EMIT4) CR 2 jump (REPL)
|
|
M15: drop $65666544 (EMIT4) $64657272 (EMIT4) $726F7720 (EMIT4) $6F6E2064 (EMIT4) $65732074 (EMIT4) $74 (EMIT4) CR 2 jump (REPL)
|
|
M16: drop $20746F4E (EMIT4) $6F772061 (EMIT4) $6472 (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 ---------------------------------------------------------
|
|
\ The three run-time words have names, as v3's have, so that SEE can tell a
|
|
\ string in a definition from code; they cannot be used from the prompt.
|
|
\ ." 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.
|
|
header (.") compile-only
|
|
: (.")
|
|
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.
|
|
header (ABORT") compile-only
|
|
: (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 ;
|
|
|
|
\ The run time of S" : leave the address and length of the string after the
|
|
\ call, and go on after it.
|
|
header (S") compile-only
|
|
: (S")
|
|
pop 4* dup C@ \ baddr n
|
|
over over + 4/ 1 + push \ the cell after the last character
|
|
push 1 + pop ; \ baddr+1 n
|
|
|
|
\ ( -- baddr u ) S" text" as v3. In a definition the text is compiled
|
|
\ into it. At the prompt it is copied to PAD, where it stays until PAD is
|
|
\ used again: WORD's buffer is overwritten by the very next word of the line.
|
|
header S" immediate
|
|
: S-QUOTE
|
|
34 (PARSE) drop
|
|
STATE a! @ if NOW
|
|
drop &(S") (CALL,) jump (STRING,)
|
|
NOW: drop WBUF+1 PAD WBUF C@ CMOVE PAD WBUF jump C@
|