Claude
dd6c393a89
#189 -- Captain Bob, 2026-11-12: "Add HEAT-OP. If it's a huge performance hit, we'll revert it. If not ... it stands"; a full 33-cell array, as DECOMPOSITION.md section 7 draws it; the Stadium feed is Phase 1's. - node.h/node.c: v4_node_heat_regs_attach; a data fetch from base+k gives opcode k's count, base+32 the anti-clock (the low cell at 32 bits); a store changes nothing. Reset detaches them. - host_map.h: HEAT_REG at word 13824, in what was free between the dictionary space and SEND_TEXT; the compile-time check covers it. Nothing moved. map-*.f18: HEAT-OP 13824, ANTICLOCK 13856. - image.h/image.c/mkmap.c: the image carries the address; v4_image_born attaches the node's own counts. - system.f18: HEAT-OP@ ( op -- n ), op mod 32; ANTICLOCK@ ( -- n ). word_count 318 -> 320 (hosted 317 -> 319): dict_hash changes. - v4-dictionary.tsv: both words; DECOMPOSITION.md 7 records the build. Also in this batch: - Makefile: make init installs qemu-user -- hosted-check needs it (Captain Bob: "Add to make init now"). - .claude/memory/rules.md, rule 5: stop and ask when something comes up (Captain Bob: "you are supposed to stop and ask"). Tests first (logs/20261113-005047/heat-op): test_node did not compile; test_host_quit 3 of 1337 failed. Suite: 199 programs, 7448554 checks, 0 failures; hosted-check, the three alike. Timing: no measurable cost. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_017RzZgrf7V7Zk2iczBXDRbm
183 lines
8.7 KiB
Plaintext
183 lines
8.7 KiB
Plaintext
\ system.f18 -- 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.f18, quit.f18 and forth.f18.
|
|
\
|
|
\ 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
|
|
\ HEAT-OP ANTICLOCK word addresses of HEAT-OP[0] and ANTICLOCK, the heat
|
|
\ registers (DECOMPOSITION.md section 7): read-only
|
|
|
|
set HDR-NFA here ", FENCE #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : FENCE' FENCE ;
|
|
|
|
\ ---- the heat registers (DECOMPOSITION.md section 7; #189) -----------------------
|
|
\ Captain Bob, 2026-11-12: "Add HEAT-OP". The node counts every instruction it
|
|
\ retires, by opcode, and the anti-clock ticks once for each; these read them.
|
|
\ ( op -- n ) how many times opcode op has retired; op is taken mod 32
|
|
set HDR-NFA here ", HEAT-OP@ #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: HEAT-OP@ 31 and HEAT-OP + b! @b ;
|
|
\ ( -- n ) the anti-clock: one tick per instruction retired
|
|
set HDR-NFA here ", ANTICLOCK@ #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ANTICLOCK@ ANTICLOCK b! @b ;
|
|
|
|
\ ---- 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.f18)
|
|
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.f18)
|
|
$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@)
|
|
|