\ 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 \ (BOOT) word address of two cells: DP and (LATEST) as the loader left them 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 jump TOLD C3: drop (LATEST) CURRENT a! ! TOLD: (Q) a! @ jump (FORGOTTEN) \ the kernel's records of them go too (dict.v4) MISSING: drop (UNKNOWN) drop ; \ ---- the system as a whole ------------------------------------------------------- \ (BOOT) is two cells the loader fills when the capsule is in place: DP and \ the newest FORTH entry as they then are. COLD goes back to them. \ FORTH-79: execute to be sure a FORTH-79 system is there. It is: nothing \ happens. (v3's prints two lines and leaves a flag.) header 79-STANDARD : 79-STANDARD ; \ ( -- ) which system this is, and its cell width header VERSION : VERSION $72617453 (EMIT4) $74726F46 (EMIT4) $34762068 (EMIT4) $302E302E (EMIT4) $38314620 (EMIT4) $20 (EMIT4) N-1 1 + 0 U-DOT-R $7469622D (EMIT4) CR ; \ ( -- ) clear the screen and put the cursor at the top, as v3: ESC [2J ESC [H header PAGE : PAGE 27 EMIT 91 EMIT 50 EMIT 74 EMIT 27 EMIT 91 EMIT 72 jump EMIT \ ( -- ) as v3's message, and then ABORT: both stacks emptied, the prompt header WARM : WARM $54524F46 (EMIT4) $39372D48 (EMIT4) $72615720 (EMIT4) $7453206D (EMIT4) $747261 (EMIT4) CR $74737953 (EMIT4) $72206D65 (EMIT4) $61747365 (EMIT4) $64657472 (EMIT4) $2E (EMIT4) CR jump ABORT \ ( -- ) the system as it was when the capsule had just been loaded: \ everything defined since is gone, there is one vocabulary, numbers are \ decimal, the block buffers are empty. Then as WARM. header COLD : COLD (BOOT) a! @ DP a! ! (BOOT)+1 a! @ (LATEST) a! ! (BOOT) a! @ 2/ 2/ FENCE a! ! (LATEST) CONTEXT a! ! (LATEST) CURRENT a! ! 0 VOC-LINK a! ! 10 BASE a! ! 0 SCR a! ! 2 (LOG-LEVEL) a! ! 0 (ACL-HOOK) a! ! EMPTY-BUFFERS (BOOT) a! @ 2/ 2/ (FORGOTTEN) \ the kernel's records of what has gone go too (dict.v4) $54524F46 (EMIT4) $39372D48 (EMIT4) $6C6F4320 (EMIT4) $74532064 (EMIT4) $747261 (EMIT4) CR $74737953 (EMIT4) $69206D65 (EMIT4) $6974696E (EMIT4) $7A696C61 (EMIT4) $2E6465 (EMIT4) CR jump ABORT \ ---- deferred words (as v3) ------------------------------------------------------- \ DEFER xxx makes xxx, which does whatever word it has been given: \ ' yyy IS xxx gives it one; DEFER@ xxx leaves the one it has. A deferred \ word with none is an error (code 15, "Deferred word not set"). : (DODEFER) pop a! @ if UNSET push ; \ go to it: it returns to xxx's caller UNSET: drop NODE-ERROR b! 15 !b ; header DEFER : DEFER &(DODEFER) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop 0 jump , NONE: drop ; : (is!) a! ! ; : (defer@) a! @ ; header IS immediate : IS (') STATE a! @ if NOW drop (LIT,) &(is!) jump (CALL,) NOW: drop jump (is!) header DEFER@ immediate : DEFER@ (') STATE a! @ if NOW drop (LIT,) &(defer@) jump (CALL,) NOW: drop jump (defer@)