feat(v4): the ROM's symbol table

(FIND) ( -- rec | 0 ), (DEFINE) ( value kind -- ) and (OPCODE) ( -- op | -1 ),
entries 3-5.  Names are refused as text.c's define refuses them, compared
case by case with text.c; a set variable may be set again.  256 hash heads,
records growing up and names growing down in dictionary space, used only
while the ROM assembles.  text.c gains the data directives #, and ", (the
ROM's language; its mnemonic and reserved-word tables are data); the
nucleus image is byte-identical.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

capsules/v4/rom/main.f18

@@ -10,3 +10,6 @@
   jump (KEY)                    \ 0   ( -- c )
   jump (TOKEN)                  \ 1   ( -- len )
   jump (NUMBER)                 \ 2   ( -- n flag )
+  jump (FIND)                   \ 3   ( -- rec | 0 )
+  jump (DEFINE)                 \ 4   ( value kind -- )
+  jump (OPCODE)                 \ 5   ( -- op | -1 )

capsules/v4/rom/sym.f18

@@ -0,0 +1,110 @@
+\ 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.  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.
+\
+\ 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, as counted strings, 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
+\ compared as the token is held, a counted string, a cell at a time.
+\ (REC) (CNT) (PTR) (I) (WI) are working cells.  Every routine uses A; some B.
+
+\ ( addr -- f )   1 if the counted string at addr is the token
+: (SAME?)
+  (PTR) a! !  (TOK) (I) a! !
+  (TOKN) a! @ 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 ;
+
+\ ( 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)
+
+\ ( -- h )   the token's hash, 0 .. 255, from its first two cells
+: (HASH)
+  (TOK) a! @+ @ xor
+  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 ;
+
+\ ( -- rec | 0 )   the newest record whose name is the token
+: (FIND)
+  (HASH) (SYMH) + a! @
+  L: if NONE
+    dup (REC) a! !  1 + a! @  (SAME?) if NO
+    drop  (REC) a! @ ;
+    NO: drop  (REC) a! @ a! @  jump L
+  NONE: ;
+
+\ ( -- f )   1 if the token cannot be a name
+: (BADNAME?)
+  (OPCODE) -if BAD
+  drop  &(RESERVED) (WALK) -if BAD
+  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
+: (DEFINE)
+  (BADNAME?) if OKNAME  drop drop drop  ERR-BAD-NAME jump (FAIL)
+  OKNAME: drop
+  (FIND) if NEW
+  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! ! ;
+  NEW: drop
+    (TOKN) a! @ 4 + 2/ 2/  (CNT) a! !
+    POOLTOP  (POOLN) a! @ inv 1 + +  (CNT) a! @ inv 1 + +
+    dup  SYMREC (RECN) a! @ + 4 +  inv 1 + +
+    -if ROOM  drop drop drop drop  ERR-NAMES jump (FAIL)
+  ROOM: drop
+    dup (PTR) a! !  (TOK) (I) a! !  (CNT) a! @
+    C: (I) a! @ a! @  (PTR) a! @ b! !b
+      (PTR) a! @ 1 + !  (I) a! @ 1 + !
+      -1 + if CD  jump C
+    CD: drop
+    (POOLN) a! @  (CNT) a! @ +  (POOLN) a! !
+    SYMREC (RECN) a! @ +  (REC) a! !
+    (REC) a! @ 1 + a! !
+    (REC) a! @ 2 + a! !
+    (REC) a! @ 3 + a! !
+    (HASH) (SYMH) +  dup a! @  (REC) a! @ a! !
+    (REC) a! @  over a! !  drop
+    (RECN) a! @ 4 + ! ;