\ 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 + ! ;