admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
1bf19d62240fcb3c4cf6abfa5c02764e385b2d62
LithosAnanake/capsules/v4/sys/system.f18
T
rajamesandClaude Opus 5.5 1bf19d6224 feat(v4): the ROM assembles the system's .f18 to the nucleus, word for word 
capsules/v4/sys: the nucleus's fourteen sources as .f18 blobs (made once by
v4/tools/v4tof18.py: header becomes the ROM's directives, every other token
and line kept), the memory map as map-<width>.f18 (mkmap sys, from one
table in host_map.h that host_load reads too), and end.f18, the switch-on
state mkimage.c set in C, the image record, and start (IDLE).

test_host_rom_nucleus.c: the ROM, fed those blobs through the console,
builds RAM identical word for word to mkimage.c's, outside its own state
and the image record, and starts at (IDLE), at both widths.  The cost:
60.7 million instructions, 1.5 s on the C model.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-15 12:27:50 -04:00

171 lines
7.9 KiB
Plaintext
Raw Blame History

\ 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
set HDR-NFA here ", FENCE #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : 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.
set HDR-NFA here ", CONTEXT #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : CONTEXT' CONTEXT ;
set HDR-NFA here ", CURRENT #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : CURRENT' CURRENT ;
\ FORTH-79: the primary vocabulary; it becomes the CONTEXT vocabulary.
set HDR-NFA here ", FORTH #, 1 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: FORTH (LATEST) CONTEXT a! ! ;
\ FORTH-79: new definitions go into the CONTEXT vocabulary from now on.
set HDR-NFA here ", DEFINITIONS #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: 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! ! ;
set HDR-NFA here ", VOCABULARY #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: 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
set HDR-NFA here ", ORDER #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: 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.
set HDR-NFA here ", WORDS #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: 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
set HDR-NFA here ", VLIST #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: 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").
set HDR-NFA here ", FORGET #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: 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.)
set HDR-NFA here ", 79-STANDARD #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: 79-STANDARD ;
\ ( -- ) which system this is, and its cell width
set HDR-NFA here ", VERSION #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: 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
set HDR-NFA here ", PAGE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: 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
set HDR-NFA here ", WARM #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: 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.
set HDR-NFA here ", COLD #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: 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 ;
set HDR-NFA here ", DEFER #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: DEFER &(DODEFER) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop 0 jump , NONE: drop ;
: (is!) a! ! ;
: (defer@) a! @ ;
set HDR-NFA here ", IS #, 1 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: IS
(') STATE a! @ if NOW drop (LIT,) &(is!) jump (CALL,)
NOW: drop jump (is!)
set HDR-NFA here ", DEFER@ #, 1 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: DEFER@
(') STATE a! @ if NOW drop (LIT,) &(defer@) jump (CALL,)
NOW: drop jump (defer@)
Reference in New Issue View Git Blame Copy Permalink