rajamesandClaude Opus 5.5
c1bbcaaba4
- Each entry's flags cell also holds v3's four fields: denied, pinned, mode and a 16-bit TTL. - compile.v4: INTERPRET checks every word it is about to execute or compile -- recheck at TTL 0, else count down; a denied word is refused with v3's line, the stack emptied and the line ended. - capsule/acl.v4: ACL-MODE@ ACL-MODE! ACL-TTL@ ACL-TTL! ACL-ALLOW@ ACL-ALLOW! ACL-PINNED? ACL-PIN ACL-INHERIT ACL-INIT-PRIMITIVES ACL-HEAT@ ACL-WORD-ID, and ACL-HOOK. - capsule/ACL.fth: v3's ACL.4th as FORTH source the node compiles; loading it switches access control on. - v3 checks every execution, inside definitions too. v4's code is native, so it checks a word when it is compiled as well as when interpreted; a call compiled while the word was allowed is not checked again. DECOMPOSITION.md 5.20 says so. - ACL-HEAT@ is 0 until heat is readable (D-6). - tests/test_host_quit.c: seven transcripts of the v3 binary; the policy file loaded and exercised; COLD. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
169 lines
6.6 KiB
Plaintext
169 lines
6.6 KiB
Plaintext
\ 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 ;
|
|
C3: drop (LATEST) CURRENT a! ! ;
|
|
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
|
|
$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@)
|
|
|