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