\ system.v4 -- words about the dictionary as a whole: WORDS, FORGET, FENCE.
\
\ DECOMPOSITION.md 5.13 and 5.15.  Part of the compiler capsule; rests on
\ dict.v4, quit.v4 and forth.v4.
\
\ Constants the loader supplies:
\   FENCE   word address of the variable: FORGET will not remove an entry
\           that starts below the address it holds
\   VOC-LINK   word address of the variable: the newest vocabulary, or 0

header FENCE inline     : FENCE'  FENCE ;

\ ---- vocabularies (FORTH-79) ----------------------------------------------------
\ A vocabulary is two cells: its head -- the xt of its newest entry, or 0 --
\ and the address of the vocabulary defined before it, or 0.  VOC-LINK holds
\ the newest one's address.  FORTH's head is (LATEST) and it is in no chain.
header CONTEXT inline   : CONTEXT'  CONTEXT ;
header CURRENT inline   : CURRENT'  CURRENT ;

\ FORTH-79: the primary vocabulary; it becomes the CONTEXT vocabulary.
header FORTH immediate
: FORTH         (LATEST) CONTEXT a! ! ;
\ FORTH-79: new definitions go into the CONTEXT vocabulary from now on.
header DEFINITIONS
: DEFINITIONS   CONTEXT a! @ CURRENT a! ! ;

\ VOCABULARY xxx   FORTH-79: xxx is a new, empty list of words; executing
\ xxx makes it the CONTEXT vocabulary.  When a search of it finds nothing,
\ FORTH is searched.
: (DOVOC)   pop CONTEXT a! ! ;
header VOCABULARY
: VOCABULARY
  &(DOVOC) (C)+3 a! !  (DATA)  (C)+8 a! @ if NONE  drop
  0 ,  VOC-LINK a! @ ,  HERE -2 + VOC-LINK a! ! ;
  NONE: drop ;

\ ( cell -- )   print the name of the vocabulary whose head cell this is
: (.VOC)
  dup (LATEST) xor if F  drop  -1 + -2 + a! @ 4*  COUNT 31 and  jump TYPE
  F: drop drop  $54524F46 (EMIT4) $48 (EMIT4) ;

\ ( -- )   as v3's, but true: where names are looked for, and where new ones go
header ORDER
: ORDER
  $72616553 (EMIT4) $6F206863 (EMIT4) $72656472 (EMIT4) $203A (EMIT4)
  CONTEXT a! @  dup (.VOC) SPACE
  (LATEST) xor if ONLY  drop  (LATEST) (.VOC)  jump TWO
  ONLY: drop
  TWO: CR
  $72727543 (EMIT4) $3A746E65 (EMIT4) $20 (EMIT4)
  CURRENT a! @ (.VOC)  jump CR

\ ( -- )   the names in the CONTEXT vocabulary, the newest first, a blank after
\ each, a new line whenever one has passed column 64.  Hidden entries -- a
\ definition under way -- are not shown.  (Q)+0 is the column.
header WORDS
: WORDS
  0 (Q) a! !
  CONTEXT a! @ a! @
  L: if DONE
     dup -3 + a! @ 2 and if SHOW  drop jump NXT
     SHOW: drop
       dup -2 + a! @ 4*  COUNT 31 and        \ xt baddr u
       dup (Q) a! @ + 1 + !
       TYPE SPACE
       (Q) a! @ -64 + -if WRAP  drop jump NXT
       WRAP: drop  CR  0 (Q) a! !
     NXT: -1 + a! @  jump L
  DONE: drop  jump CR
header VLIST
: VLIST   jump WORDS

\ ( cell -- )   take off a vocabulary's list every entry at or above the
\ address in (Q)+0.  The newest are first, so it stops at the first one below.
: (PRUNE)
  (Q)+1 a! !
  L: (Q)+1 a! @ a! @  if DONE
     dup (Q) a! @ inv + 1 + -if CUT  drop drop ;
     CUT: drop  -1 + a! @  (Q)+1 a! @ a! !  jump L
  DONE: drop ;

\ FORGET xxx   FORTH-79: remove xxx and every word defined after it, in
\ whatever vocabulary; the space they took is free again.  A vocabulary that
\ goes is no longer CONTEXT or CURRENT: FORTH is.  A word that is not there
\ is an error, and so is one below FENCE, which is where the capsule's own
\ words are (code 10, "Protected word").
header FORGET
: FORGET
  32 WORD (LOOKUP) if MISSING
  -2 + a! @                                  \ where its name starts
  dup FENCE a! @ inv + 1 + -if OK            \ name - fence
    drop drop  NODE-ERROR b! 10 !b ;
  OK: drop
  dup (Q) a! !  4* DP a! !                   \ the space from its name on
  (LATEST) (PRUNE)
  V: VOC-LINK a! @ if PRUNED                 \ vocabularies that go
     dup (Q) a! @ inv + 1 + -if GONE  drop jump KEPT
     GONE: drop  1 + a! @  VOC-LINK a! !  jump V
  KEPT: P: if PRUNED                         \ the lists of those that stay
     dup (PRUNE)  1 + a! @  jump P
  PRUNED: drop
  CONTEXT a! @ (Q) a! @ inv + 1 + -if C1  drop jump C2
  C1: drop  (LATEST) CONTEXT a! !
  C2: CURRENT a! @ (Q) a! @ inv + 1 + -if C3  drop ;
  C3: drop  (LATEST) CURRENT a! ! ;
  MISSING: drop  (UNKNOWN) drop ;