rajamesandClaude Opus 5.5
a28b5f2230
- Text after start is refused, as text.c refuses it: before it jumps, the ROM reads on to the end of the source; blanks, comments and the ends of blobs may follow, a token is ERR-AFTER (26), "text after start". - A token too long where a name, a target or a value is wanted is "name too long", as text.c says: (MISSING) reports "missing" only when no error came first. `", keeps "missing", which is text.c's word for both. - text.c's "address out of range" names the address, not the value. - The system's source files are one list, v4/sys_files.h: boot.c, the harness and the nucleus test are made from it. - The ROM's error codes and words are one list, v4/rom_errors.h: boot.c's messages, host_map.h's ROM_ERR_* and mkmap's ERR-* are made from it. - node.h says what v4_node_store does with a ROM address (nothing, as for any address outside RAM, D-14); test_host_rom_range pins it. ROM: 2095 words, rom_hash 0x06d0dcb7a0cb41a1. dict_hash unchanged, 0xe5a57f3eb72ff94a. make -C v4 test test-32 hosted-check pass. QEMU: amd64, aarch64, riscv64 to ok>, POST 538/538, POST: PASSED. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
391 lines
13 KiB
Plaintext
391 lines
13 KiB
Plaintext
\ word.f18 -- the ROM assembles words: names, labels, branches, macros, FOR.
|
|
\
|
|
\ The rules are v4/src/text.c's one_token, end_word and branch:
|
|
\ : NAME a word begins at the next instruction word
|
|
\ NAME: a label of the word being assembled
|
|
\ jump X call X if X -if X next X
|
|
\ a branch to X: a label of this word, before or after the
|
|
\ branch, if it has one of that name; otherwise a word
|
|
\ X a call to the word X, defined already or later
|
|
\ &X the address of the word X, already defined, as a literal
|
|
\ 123 $FF CONST CONST+N a literal
|
|
\ a macro its tokens, read in its place
|
|
\ FOR ... NEXT FOR ... UNEXT
|
|
\ A branch to a label not yet seen waits, local to its word, in the table
|
|
\ of branches (REFS); when the word ends, a name that is not a label of it
|
|
\ must be a word, and the branch then waits on that name's symbol -- a
|
|
\ placeholder if it has none yet (sym.f18) -- until it is defined.
|
|
\
|
|
\ State, in the ROM's area: (NREF) (NLAB) (WNP) (NFOR) (FORS) (RDEPTH)
|
|
\ (RPTRS). Tables, used only while assembling: (REFS) four cells an entry
|
|
\ -- the word, the line, a symbol record (or, while local, a name), 1 if
|
|
\ local; (LABELS) a name and an address; (WNAMES) the word's names. Uses
|
|
\ A and B, and the working cells (T1) .. (T6), (MLEN).
|
|
|
|
\ ---- reading: the console, or a macro being expanded ----------------------
|
|
|
|
\ ( -- len ) the next token, from the innermost macro being expanded, or
|
|
\ from the console. A macro's body is its tokens as counted strings, then
|
|
\ a zero cell.
|
|
: (NEXT-TOKEN)
|
|
L: (RDEPTH) a! @ if SRC
|
|
-1 + (RPTRS) + dup (T1) a! ! a! @
|
|
dup a! @ if EOM
|
|
255 and dup (TOKN) a! !
|
|
4 + 2/ 2/ dup (T2) a! !
|
|
push (TOK) pop (COPY)
|
|
(T1) a! @ a! @ (T2) a! @ + (T1) a! @ a! !
|
|
(TOKN) a! @ ;
|
|
EOM: drop drop (RDEPTH) a! @ -1 + ! jump L
|
|
SRC: drop jump (TOKEN)
|
|
|
|
\ ---- the token, taken apart ------------------------------------------------
|
|
|
|
\ ( -- ) save the token's characters, a character to a cell, in (MTEMP)
|
|
: (TOK-SAVE)
|
|
(TOKN) a! @ (MLEN) a! ! 0 (T5) a! !
|
|
L: (T5) a! @ (MLEN) a! @ xor if D drop
|
|
(T5) a! @ (CHAR@) (T5) a! @ (MTEMP) + b! !b
|
|
(T5) a! @ 1 + ! jump L
|
|
D: drop ;
|
|
|
|
\ ( start len -- ) the token becomes characters start .. start+len-1 of
|
|
\ the one saved by (TOK-SAVE)
|
|
: (TOK-SUB)
|
|
(T6) a! ! (T5) a! !
|
|
(TOK) a! 15 FOR 0 !+ NEXT
|
|
0 (TOKN) a! !
|
|
L: (T6) a! @ if D drop
|
|
(T5) a! @ (MTEMP) + a! @ (PUT)
|
|
(T5) a! @ 1 + ! (T6) a! @ -1 + ! jump L
|
|
D: drop (TOKN) a! @ (TOK) a! @ xor ! ;
|
|
|
|
\ ( -- f ) 1 if the token is a label's definition: NAME:
|
|
: (LABELFORM?)
|
|
(TOKN) a! @ -1 + if NO
|
|
(CHAR@) 58 xor if YES drop 0 ;
|
|
YES: drop 1 ;
|
|
NO: drop 0 ;
|
|
|
|
\ ---- the word's names: labels, and names branched to before they are seen --
|
|
|
|
\ ( -- p | 0 ) the token, copied into the word's name area
|
|
: (WNAME)
|
|
(TOKN) a! @ 4 + 2/ 2/ (T6) a! !
|
|
(WNP) a! @ (T6) a! @ + WN-SIZE inv 1 + + -1 + -if FULL drop
|
|
(WNAMES) (WNP) a! @ +
|
|
(TOK) over (T6) a! @ (COPY)
|
|
(WNP) a! @ (T6) a! @ + (WNP) a! ! ;
|
|
FULL: drop ERR-NAMES (FAIL) 0 ;
|
|
|
|
\ ( -- addr | -1 ) the address of the word's label named by the token
|
|
: (LAB-FIND)
|
|
0 (T5) a! !
|
|
L: (T5) a! @ (NLAB) a! @ xor if NONE drop
|
|
(T5) a! @ 2* (LABELS) + a! @ (SAME?) if NO
|
|
drop (T5) a! @ 2* (LABELS) + 1 + a! @ ;
|
|
NO: drop (T5) a! @ 1 + ! jump L
|
|
NONE: drop -1 ;
|
|
|
|
\ ---- the branches waiting for a target -------------------------------------
|
|
|
|
\ ( word sym local -- ) one more branch waiting
|
|
: (REF-ADD)
|
|
(NREF) a! @ REFS-MAX inv 1 + + -if FULL drop
|
|
(NREF) a! @ 2* 2* (REFS) + (T5) a! !
|
|
(T5) a! @ 3 + a! !
|
|
(T5) a! @ 2 + a! !
|
|
(T5) a! @ a! !
|
|
(LINE) a! @ (T5) a! @ 1 + a! !
|
|
(NREF) a! @ 1 + ! ;
|
|
FULL: drop drop drop drop ERR-REFS jump (FAIL)
|
|
|
|
\ ( i target -- ) the waiting branch i gets its target, and stops waiting:
|
|
\ the last entry takes its place. A branch that cannot reach is reported
|
|
\ at the line it was written on.
|
|
: (REF-RESOLVE)
|
|
(T4) a! !
|
|
2* 2* (REFS) + dup (T3) a! !
|
|
a! @ (T4) a! @ (RESOLVE)
|
|
(FAILED) a! @ if OK drop
|
|
(T3) a! @ 1 + a! @ (ERRLINE) a! ! ;
|
|
OK: drop
|
|
(NREF) a! @ -1 + dup (NREF) a! !
|
|
2* 2* (REFS) + (T3) a! @ 4 (COPY) ;
|
|
|
|
\ ( addr -- ) a label has been defined at addr: the branches in this word
|
|
\ waiting on its name, the token, get it
|
|
: (LOCAL-RESOLVE)
|
|
(T1) a! ! 0 (T2) a! !
|
|
L: (T2) a! @ (NREF) a! @ xor if DONE drop
|
|
(FAILED) a! @ if GO drop ;
|
|
GO: drop
|
|
(T2) a! @ 2* 2* (REFS) +
|
|
dup 3 + a! @ if SKIP drop
|
|
2 + a! @ (SAME?) if NX
|
|
drop (T2) a! @ (T1) a! @ (REF-RESOLVE) jump L
|
|
SKIP: drop drop jump NX1
|
|
NX: drop
|
|
NX1: (T2) a! @ 1 + ! jump L
|
|
DONE: drop ;
|
|
|
|
\ ( rec -- ) the symbol rec has been defined (sym.f18, (DEFINE)): if it is
|
|
\ a word, the branches waiting on it get its address
|
|
: (DEFINED)
|
|
dup 2 + a! @ 1 xor if W drop drop ;
|
|
W: drop (T1) a! ! 0 (T2) a! !
|
|
L: (T2) a! @ (NREF) a! @ xor if DONE drop
|
|
(FAILED) a! @ if GO drop ;
|
|
GO: drop
|
|
(T2) a! @ 2* 2* (REFS) +
|
|
dup 3 + a! @ if NL drop drop jump NX
|
|
NL: drop 2 + a! @ (T1) a! @ xor if MATCH drop jump NX
|
|
MATCH: drop (T2) a! @ (T1) a! @ 3 + a! @ (REF-RESOLVE) jump L
|
|
NX: (T2) a! @ 1 + ! jump L
|
|
DONE: drop ;
|
|
|
|
\ ( -- ) the word being assembled ends: a FOR left open is an error; the
|
|
\ branches still local to it wait on their names' symbols, unless the name
|
|
\ is a word, which they then get; its labels and names go.
|
|
: (END-WORD)
|
|
(NFOR) a! @ if F0 drop 0 (NFOR) a! ! ERR-FOR jump (FAIL)
|
|
F0: drop
|
|
0 (T1) a! !
|
|
L: (T1) a! @ (NREF) a! @ xor if DONE drop
|
|
(FAILED) a! @ if GO drop ;
|
|
GO: drop
|
|
(T1) a! @ 2* 2* (REFS) +
|
|
dup 3 + a! @ if SKIP drop
|
|
0 over 3 + a! !
|
|
dup 2 + a! @ (FIND-AT)
|
|
if MK
|
|
dup 2 + a! @ 1 xor if RES drop
|
|
over 2 + a! ! drop jump NX
|
|
RES: drop push drop (T1) a! @ pop 3 + a! @ (REF-RESOLVE) jump L
|
|
MK: drop dup 2 + a! @ push 0 0 pop (NEW-REC)
|
|
over 2 + a! ! drop jump NX
|
|
SKIP: drop drop
|
|
NX: (T1) a! @ 1 + ! jump L
|
|
DONE: drop
|
|
0 (NLAB) a! ! 0 (WNP) a! ! ;
|
|
|
|
\ ---- branches by name ------------------------------------------------------
|
|
|
|
\ ( op local -- ) a branch to the name in the token. local: written after
|
|
\ a branch mnemonic, so it may be a label of this word, before or after.
|
|
: (BRANCH-NAME)
|
|
(T6) a! !
|
|
(T6) a! @ if CHK
|
|
drop (LAB-FIND) -if TOLAB drop jump CHK1
|
|
TOLAB: jump (BRANCH)
|
|
CHK: drop
|
|
(FIND) if CHK0
|
|
dup 2 + a! @ 1 xor if NOW drop drop jump BAD
|
|
NOW: drop 3 + a! @ jump (BRANCH)
|
|
CHK0: drop
|
|
CHK1:
|
|
(FIND) if C2
|
|
2 + a! @ 1 xor if C3 drop jump BAD
|
|
C3: drop jump C4
|
|
C2: drop
|
|
C4: (OPCODE) -if BAD1 drop
|
|
(RESERVED?) if C5 drop jump BAD
|
|
C5: drop (LABELFORM?) if C6 drop jump BAD
|
|
C6: drop (NUMBER) push drop pop if C7 drop jump BAD
|
|
C7: drop
|
|
(T6) a! @ if GLOBAL drop
|
|
(BRANCH>) (WNAME) 1 jump (REF-ADD)
|
|
GLOBAL: drop
|
|
(BRANCH>) (FIND0) if NEWPH
|
|
0 jump (REF-ADD)
|
|
NEWPH: drop 0 0 (TOK) (NEW-REC) 0 jump (REF-ADD)
|
|
BAD1: drop
|
|
BAD: drop ERR-TARGET jump (FAIL)
|
|
|
|
\ ---- labels ----------------------------------------------------------------
|
|
|
|
\ ( addr -- ) a label of this word, named by the token, at addr; the
|
|
\ branches already waiting on it get it
|
|
: (LAB-ADD)
|
|
(LAB-FIND) -if DUP drop
|
|
(NLAB) a! @ -64 + -if FULL drop
|
|
(WNAME) if FAILP
|
|
(NLAB) a! @ 2* (LABELS) + a! !
|
|
dup (NLAB) a! @ 2* (LABELS) + 1 + a! !
|
|
(NLAB) a! @ 1 + !
|
|
jump (LOCAL-RESOLVE)
|
|
DUP: drop drop ERR-LABEL-DUP jump (FAIL)
|
|
FULL: drop drop ERR-LABELS jump (FAIL)
|
|
FAILP: drop drop ;
|
|
|
|
\ ( -- ) NAME: -- a label at the next instruction word
|
|
: (LABEL-DEF)
|
|
(TOK-SAVE) 0 (MLEN) a! @ -1 + (TOK-SUB)
|
|
(LABEL) jump (LAB-ADD)
|
|
|
|
\ ---- FOR ... NEXT, FOR ... UNEXT --------------------------------------------
|
|
|
|
: (H-FOR)
|
|
(NFOR) a! @ -8 + -if DEEP drop
|
|
29 (OP) (LABEL) (NFOR) a! @ (FORS) + a! !
|
|
(NFOR) a! @ 1 + ! ;
|
|
DEEP: drop ERR-FOR jump (FAIL)
|
|
|
|
: (H-NEXT)
|
|
(NFOR) a! @ if NONE
|
|
-1 + dup (NFOR) a! ! (FORS) + a! @
|
|
push 5 pop jump (BRANCH)
|
|
NONE: drop ERR-FOR jump (FAIL)
|
|
|
|
\ unext repeats the word it is in: it must still be the word the body
|
|
\ began, with a slot left, owing no literal
|
|
: (H-UNEXT)
|
|
(NFOR) a! @ if NONE
|
|
-1 + dup (NFOR) a! ! (FORS) + a! @
|
|
(HERE) a! @ xor if SAMEW drop jump BAD
|
|
SAMEW: drop
|
|
(SLOT) a! @ if BAD0
|
|
-6 + -if BAD0 drop
|
|
(NLIT) a! @ if OK drop jump BAD
|
|
OK: drop 4 jump (OP)
|
|
BAD0: drop
|
|
BAD: ERR-UNEXT jump (FAIL)
|
|
NONE: drop ERR-FOR jump (FAIL)
|
|
|
|
\ ---- macros ----------------------------------------------------------------
|
|
|
|
\ ( -- ) restore the name (TSAVE) holds into the token
|
|
: (NAME-BACK) (TSAVE) (TOK) 16 (COPY) (TOK) a! @ 255 and (TOKN) a! ! ;
|
|
|
|
\ ( -- f ) 0 if not in a macro; else "not allowed in a macro", and 1
|
|
: (IN-MACRO?)
|
|
(RDEPTH) a! @ if NO drop ERR-IN-MACRO (FAIL) 1 ;
|
|
NO: ;
|
|
|
|
\ macro NAME ... endmacro: the tokens between, as counted strings, then a
|
|
\ zero cell, into the pool; NAME the macro, its value where they are. One
|
|
\ left open is reported at the line it began on, as text.c reports it.
|
|
: (H-MACRO)
|
|
(IN-MACRO?) if OK drop ;
|
|
OK: drop
|
|
(LINE) a! @ (T4) a! !
|
|
(NEXT-TOKEN) if NONAME drop
|
|
(TOK) (TSAVE) 16 (COPY)
|
|
0 (T1) a! !
|
|
L: (NEXT-TOKEN) if EOF drop
|
|
&(RESERVED) (WALK)
|
|
dup -2 + if END drop
|
|
dup if BAD2 drop
|
|
-1 + if BAD1 drop
|
|
(LABELFORM?) if APP drop jump BAD
|
|
APP: drop
|
|
(TOKN) a! @ 4 + 2/ 2/ dup (T2) a! !
|
|
(T1) a! @ + 1 + MBODY-SIZE inv 1 + + -1 + -if FULLM drop
|
|
(TOK) (MBODY) (T1) a! @ + (T2) a! @ (COPY)
|
|
(T1) a! @ (T2) a! @ + (T1) a! !
|
|
jump L
|
|
END: drop drop
|
|
0 (MBODY) (T1) a! @ + b! !b
|
|
(T1) a! @ 1 + (ALLOC) if FAILP
|
|
(MBODY) over (T1) a! @ 1 + (COPY)
|
|
(NAME-BACK)
|
|
3 jump (DEFINE)
|
|
FAILP: drop ;
|
|
BAD2: drop
|
|
BAD1: drop
|
|
BAD: ERR-IN-MACRO jump (FAIL)
|
|
FULLM: drop ERR-NAMES jump (FAIL)
|
|
EOF: drop ERR-MACRO (FAIL) (T4) a! @ (ERRLINE) a! ! ;
|
|
NONAME: drop ERR-MACRO jump (FAIL)
|
|
|
|
: (H-ENDMACRO) ERR-MACRO jump (FAIL)
|
|
|
|
\ ( body -- ) read a macro's tokens in its place
|
|
: (USE-MACRO)
|
|
(RDEPTH) a! @ -8 + -if DEEP drop
|
|
(RDEPTH) a! @ (RPTRS) + a! !
|
|
(RDEPTH) a! @ 1 + ! ;
|
|
DEEP: drop drop ERR-DEEP jump (FAIL)
|
|
|
|
\ ---- CONST+N ---------------------------------------------------------------
|
|
|
|
\ ( -- v 1 | 0 0 ) the token as a constant and a number after its last +;
|
|
\ if it is not one, the token is left as it was
|
|
: (CONST+N)
|
|
(TOK-SAVE)
|
|
(MLEN) a! @ -1 + (T1) a! !
|
|
L: (T1) a! @ -if GO drop jump NOPE
|
|
GO: (MTEMP) + a! @ 43 xor if FOUND drop
|
|
(T1) a! @ -1 + ! jump L
|
|
FOUND: drop
|
|
(T1) a! @ if NOPE0 drop
|
|
(T1) a! @ (MLEN) a! @ -1 + xor if NOPE0 drop
|
|
0 (T1) a! @ (TOK-SUB)
|
|
(FIND) if NOPE0
|
|
dup 2 + a! @ 2 xor if ISC drop drop jump NOPE
|
|
ISC: drop 3 + a! @ (T2) a! !
|
|
(T1) a! @ 1 + (MLEN) a! @ (T1) a! @ inv 1 + + -1 + (TOK-SUB)
|
|
(NUMBER) 1 xor if OKN drop drop jump NOPE
|
|
OKN: drop (T2) a! @ + 1 ;
|
|
NOPE0: drop
|
|
NOPE: 0 (MLEN) a! @ (TOK-SUB) 0 0 ;
|
|
|
|
\ ---- one token -------------------------------------------------------------
|
|
|
|
\ the reserved words' handlers, in (RESERVED)'s order
|
|
: (DISPATCH)
|
|
jump (H-COLON) jump (H-MACRO) jump (H-ENDMACRO)
|
|
jump (H-FOR) jump (H-NEXT) jump (H-UNEXT)
|
|
jump (H-CONSTANT) jump (H-SET) jump (H-HERE)
|
|
jump (H-CELL) jump (H-STRING) jump (H-STORE)
|
|
jump (H-START)
|
|
|
|
\ : NAME end the word before, and begin NAME at the next instruction word
|
|
: (H-COLON)
|
|
(IN-MACRO?) if OK drop ;
|
|
OK: drop
|
|
(NEXT-TOKEN) if NONAME drop
|
|
(END-WORD) (LABEL) 1 jump (DEFINE)
|
|
NONAME: drop jump (MISSING)
|
|
|
|
\ ( -- ) assemble the token
|
|
: (ONE)
|
|
&(RESERVED) (WALK) -if RES drop
|
|
(LABELFORM?) if NLD drop jump (LABEL-DEF)
|
|
NLD: drop
|
|
(OPCODE) -if OPC drop
|
|
0 (CHAR@) 38 xor if AMP drop
|
|
AFTERAMP:
|
|
(NUMBER) if NN
|
|
-if NUMOK drop drop ERR-BIG jump (FAIL)
|
|
NUMOK: drop jump (LIT)
|
|
NN: drop drop
|
|
(FIND) if NOSYM
|
|
dup 2 + a! @
|
|
dup 3 xor if MAC drop
|
|
dup 2 xor if CV drop
|
|
4 xor if CV0
|
|
drop drop 3 0 jump (BRANCH-NAME)
|
|
MAC: drop drop 3 + a! @ jump (USE-MACRO)
|
|
CV: drop drop 3 + a! @ jump (LIT)
|
|
CV0: drop 3 + a! @ jump (LIT)
|
|
NOSYM: drop
|
|
(CONST+N) if CALL drop jump (LIT)
|
|
CALL: drop drop 3 0 jump (BRANCH-NAME)
|
|
RES: &(DISPATCH) + push ;
|
|
OPC: dup 8 xor if FP drop
|
|
dup (BRANCH-OP?) if PLAIN drop
|
|
(NEXT-TOKEN) if NOTGT drop
|
|
1 jump (BRANCH-NAME)
|
|
PLAIN: drop jump (OP)
|
|
FP: drop drop ERR-FETCH-P jump (FAIL)
|
|
NOTGT: drop drop jump (MISSING)
|
|
AMP: drop (TOKN) a! @ -1 + if ONECH drop
|
|
(TOK-SAVE) 1 (MLEN) a! @ -1 + (TOK-SUB)
|
|
(FIND) if BADA
|
|
dup 2 + a! @ 1 xor if OKA drop drop jump BADA0
|
|
OKA: drop 3 + a! @ jump (LIT)
|
|
BADA: drop
|
|
BADA0: ERR-AMP jump (FAIL)
|
|
ONECH: drop jump AFTERAMP
|