\ 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