rajamesandClaude Opus 5.5
084c520a54
word.f18: (NEXT-TOKEN) reads the console or a macro being expanded; labels, branches by name (a label of the word, or a word, now or later), the table of branches waiting, end of word, FOR/NEXT/UNEXT, macros, &NAME, CONST+N, and (ONE), which dispatches a token. A forward branch to a name not yet defined waits on a placeholder symbol, filled in by (DEFINE). dir.f18: constant set here #, ", store, and start, which resolves, clears the tables the ROM used and runs the word it names. main.f18: the ROM itself, entry 12; on an error it stops at (ROM-FAILED) with the code and line in its state, for the loader to report. sym.f18 generalized: any counted string, placeholders, a hash of only a name's own cells. test_host_rom_asm.c gives test_text.c's own texts (accepted and refused), its four real definitions and the ROM's directives to text.c and to the ROM: the same words, the same errors on the same lines, at both widths. The ROM is 2036 words. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
159 lines
5.5 KiB
Plaintext
159 lines
5.5 KiB
Plaintext
\ sym.f18 -- the ROM's symbol table.
|
|
\
|
|
\ A name the ROM assembles is given a kind and a value: 1 a word (its
|
|
\ address), 2 a constant, 3 a macro, 4 a set variable. Kind 0 is a name
|
|
\ only branched to so far: a placeholder that the forward branches to it
|
|
\ wait on (word.f18), which (DEFINE) fills in. The rules are
|
|
\ v4/src/text.c's define: a name may not be an opcode, a reserved word, a
|
|
\ label (NAME:), a number or start with &; nothing is defined twice, except
|
|
\ that a set variable may be set again and a placeholder be defined.
|
|
\
|
|
\ The table is used only while the ROM assembles, and lives in dictionary
|
|
\ space: 256 hash heads at (SYMH); records of four cells -- link, name,
|
|
\ kind, value -- growing up from SYMREC; names and macro bodies, growing
|
|
\ down from POOLTOP. When the two would meet, "too many names". (RECN) and
|
|
\ (POOLN) count the cells used, so an empty table is all zeroes. Names are
|
|
\ counted strings, the form the token is held in, compared a cell at a time.
|
|
\ (REC) (CNT) (PTR) (I) (WI) are working cells. Every routine uses A; some B.
|
|
|
|
\ ( p q -- f ) 1 if the counted strings at p and q are the same
|
|
: (SAME2?)
|
|
(I) a! ! (PTR) a! !
|
|
(PTR) a! @ a! @ 255 and 4 + 2/ 2/
|
|
L: (PTR) a! @ b! @b (I) a! @ a! @ xor if EQ drop drop 0 ;
|
|
EQ: drop (PTR) a! @ 1 + ! (I) a! @ 1 + !
|
|
-1 + if DONE jump L
|
|
DONE: drop 1 ;
|
|
|
|
\ ( addr -- f ) 1 if the counted string at addr is the token
|
|
: (SAME?) (TOK) jump (SAME2?)
|
|
|
|
\ ( table -- i | -1 ) which counted string of a table the token is; the
|
|
\ table ends with a zero cell
|
|
: (WALK)
|
|
0 (WI) a! !
|
|
L: dup a! @ if END
|
|
drop dup (SAME?) if NO
|
|
drop drop (WI) a! @ ;
|
|
NO: drop dup a! @ 255 and 4 + 2/ 2/ +
|
|
(WI) a! @ 1 + ! jump L
|
|
END: drop drop -1 ;
|
|
|
|
\ the opcodes' names, in the order of their numbers
|
|
: (MNEMONICS)
|
|
", ; ", ex ", jump ", call ", unext ", next ", if ", -if
|
|
", @p ", @+ ", @b ", @ ", !p ", !+ ", !b ", !
|
|
", +* ", 2* ", 2/ ", inv ", + ", and ", xor ", drop
|
|
", dup ", pop ", over ", a ", nop ", push ", b! ", a!
|
|
#, 0
|
|
|
|
\ the ROM's reserved words: its notation and its directives
|
|
: (RESERVED)
|
|
", : ", macro ", endmacro ", FOR ", NEXT ", UNEXT
|
|
", constant ", set ", here ", #, ", ", ", store
|
|
", start
|
|
#, 0
|
|
|
|
\ ( -- op | -1 ) which opcode the token names
|
|
: (OPCODE) &(MNEMONICS) jump (WALK)
|
|
|
|
\ ( -- f ) 1 if the token is a reserved word
|
|
: (RESERVED?) &(RESERVED) (WALK) -if Y drop 0 ;
|
|
Y: drop 1 ;
|
|
|
|
\ ( p -- h ) the hash, 0 .. 255, of the counted string at p, from its
|
|
\ first cell, and its second if the name runs into it (4 characters or more:
|
|
\ the cell after a shorter name is not its own)
|
|
: (HASH-AT)
|
|
a! @+ dup 255 and -4 + -if TWO drop jump MIX
|
|
TWO: drop @ xor
|
|
MIX: dup 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ +
|
|
dup 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ +
|
|
255 and ;
|
|
|
|
\ ( p -- rec | 0 ) the newest record whose name is the counted string at p,
|
|
\ placeholders included
|
|
: (FIND-AT)
|
|
dup (T3) a! ! (HASH-AT) (SYMH) + a! @
|
|
L: if NONE
|
|
dup (REC) a! ! 1 + a! @ (T3) a! @ (SAME2?) if NO
|
|
drop (REC) a! @ ;
|
|
NO: drop (REC) a! @ a! @ jump L
|
|
NONE: ;
|
|
|
|
\ ( -- rec | 0 ) the token's record, placeholders included
|
|
: (FIND0) (TOK) jump (FIND-AT)
|
|
|
|
\ ( -- rec | 0 ) the token's record, if it has been defined
|
|
: (FIND)
|
|
(FIND0) if NONE
|
|
dup 2 + a! @ if PH drop ;
|
|
PH: drop drop 0 ;
|
|
NONE: ;
|
|
|
|
\ ( n -- addr | 0 ) n cells of the pool, below what it holds; 0 if they
|
|
\ would meet the records ("too many names")
|
|
: (ALLOC)
|
|
dup (CNT) a! !
|
|
POOLTOP (POOLN) a! @ inv 1 + + (CNT) a! @ inv 1 + +
|
|
dup SYMREC (RECN) a! @ + 4 + inv 1 + +
|
|
-if ROOM drop drop drop ERR-NAMES (FAIL) 0 ;
|
|
ROOM: drop push drop
|
|
(POOLN) a! @ (CNT) a! @ + (POOLN) a! !
|
|
pop ;
|
|
|
|
\ ( from to n -- ) copy n cells, n at least 1
|
|
: (COPY)
|
|
(CN) a! ! (CTO) a! ! (CFROM) a! !
|
|
L: (CN) a! @ if D drop
|
|
(CFROM) a! @ a! @ (CTO) a! @ b! !b
|
|
(CFROM) a! @ 1 + ! (CTO) a! @ 1 + ! (CN) a! @ -1 + ! jump L
|
|
D: drop ;
|
|
|
|
\ ( value kind p -- rec | 0 ) a new record for the counted string at p,
|
|
\ the name copied into the pool; 0 if there is no room
|
|
: (NEW-REC)
|
|
dup (T3) a! !
|
|
a! @ 255 and 4 + 2/ 2/ (ALLOC)
|
|
if FULL
|
|
dup (T4) a! !
|
|
push (T3) a! @ pop (T3) a! @ a! @ 255 and 4 + 2/ 2/ (COPY)
|
|
SYMREC (RECN) a! @ + (REC) a! !
|
|
(T4) a! @ (REC) a! @ 1 + a! !
|
|
(REC) a! @ 2 + a! !
|
|
(REC) a! @ 3 + a! !
|
|
(T4) a! @ (HASH-AT) (SYMH) + dup a! @ (REC) a! @ a! !
|
|
(REC) a! @ over a! ! drop
|
|
(RECN) a! @ 4 + !
|
|
(REC) a! @ ;
|
|
FULL: drop drop drop 0 ;
|
|
|
|
\ ( -- f ) 1 if the token cannot be a name
|
|
: (BADNAME?)
|
|
(OPCODE) -if BAD
|
|
drop (RESERVED?) if NOTRES drop 1 ;
|
|
NOTRES: drop (NUMBER) push drop pop if NOTNUM drop 1 ;
|
|
NOTNUM: drop 0 (CHAR@) 38 xor if AMP
|
|
drop (TOKN) a! @ -1 + if ONE
|
|
(CHAR@) 58 xor if COLON drop 0 ;
|
|
COLON: drop 1 ;
|
|
ONE: drop 0 ;
|
|
AMP: drop 1 ;
|
|
BAD: drop 1 ;
|
|
|
|
\ ( value kind -- ) give the token a kind and a value. A placeholder is
|
|
\ filled in, and the branches waiting on it are told (word.f18, (DEFINED)).
|
|
: (DEFINE)
|
|
(BADNAME?) if OKNAME drop drop drop ERR-BAD-NAME jump (FAIL)
|
|
OKNAME: drop
|
|
(FIND0) if NEW
|
|
dup 2 + a! @ if FILL drop
|
|
over 4 xor if K4 drop drop drop drop ERR-DEFINED jump (FAIL)
|
|
K4: drop 2 + a! @ 4 xor if BOTH drop drop drop ERR-DEFINED jump (FAIL)
|
|
BOTH: drop drop (REC) a! @ 3 + a! ! ;
|
|
FILL: drop dup (REC) a! !
|
|
2 + a! !
|
|
(REC) a! @ 3 + a! !
|
|
(REC) a! @ jump (DEFINED)
|
|
NEW: drop (TOK) (NEW-REC) drop ;
|