rajamesandClaude Opus 5.5
1bf19d6224
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>
234 lines
11 KiB
Plaintext
234 lines
11 KiB
Plaintext
\ dict.v4 -- the dictionary: its space, its entries, and looking a name up.
|
|
\
|
|
\ DECOMPOSITION.md 5.12 and 5.13: HERE ALIGN ALLOT , C, 2, PAD LATEST, FIND ' ,
|
|
\ and the entry-field words >LINK LFA LINK> >NAME NFA NAME> CFA PFA >BODY
|
|
\ TRAVERSE SMUDGE HIDDEN. Part of the compiler capsule: it runs on the host
|
|
\ node. Rests on core.v4 and input.v4.
|
|
\
|
|
\ AN ENTRY. A word's execution address (xt) is the address of its code, and
|
|
\ everything else is found from it:
|
|
\
|
|
\ name the count byte, then the characters, four bytes to a cell,
|
|
\ padded with zeros to a whole cell
|
|
\ xt - 3 flags: 1 immediate, 2 hidden, 4 data
|
|
\ xt - 2 the word address of the name
|
|
\ xt - 1 the link: the xt of the entry before this one, 0 for the first
|
|
\ xt the code
|
|
\
|
|
\ A name holds at most 31 characters; longer ones are cut to 31 both when
|
|
\ defined and when looked up, so 31 characters are significant (FORTH-79).
|
|
\ A "data" word is one whose code is a single call to its run-time routine,
|
|
\ with its parameter field in the cell after it: xt + 1. For any other word
|
|
\ the parameter field is the code itself.
|
|
\
|
|
\ THE SPACE. DP is a byte address, so that C, can pack characters; HERE is
|
|
\ the next whole cell. An address unit is a cell (D-1): ALLOT counts cells.
|
|
\
|
|
\ Constants the loader supplies:
|
|
\ DP word address of the variable: the next free byte
|
|
\ (LATEST) word address of the variable: the xt of the newest entry of the
|
|
\ FORTH vocabulary, or 0
|
|
\ CONTEXT CURRENT word addresses of the variables: each holds the address
|
|
\ of a vocabulary's head cell -- the cell that holds the xt of
|
|
\ that vocabulary's newest entry. FORTH's head cell is (LATEST).
|
|
\
|
|
\ VOCABULARIES (FORTH-79). A name is looked up in the CONTEXT vocabulary and
|
|
\ then, if that is not FORTH, in FORTH. A new entry goes into the CURRENT
|
|
\ vocabulary: it is linked to that vocabulary's newest entry and becomes it.
|
|
\ DBASE DLIMIT byte addresses of the start and end of dictionary space
|
|
\ PAD byte address of the scratch area for strings, 84 bytes or more
|
|
\ (D) word address of five cells of scratch for this file
|
|
\ (WORD-DEFINED) (WORD-FORGOTTEN) word addresses of two variables: see
|
|
\ "telling the kernel" below
|
|
\ PAD is in line.
|
|
|
|
macro 4* 2* 2* endmacro
|
|
macro 4/ 2/ 2/ endmacro
|
|
macro OR over inv and xor endmacro
|
|
|
|
\ ---- the space (5.12) ------------------------------------------------------
|
|
\ These reach DP through B and leave A alone, so that , and C, can keep what
|
|
\ they are storing in A while the space is taken: nothing of theirs is then
|
|
\ on the data stack under (DP+), which itself needs three cells (D-2).
|
|
|
|
: (DERR) ( -- 0 ) NODE-ERROR b! 5 !b 0 ; \ dictionary full
|
|
|
|
\ ( n -- flag ) move DP by n bytes if it stays inside the dictionary space
|
|
\ and say -1; otherwise leave it, set NODE-ERROR and say 0. The two
|
|
\ subtractions are x + ~y + 1, which unlike the in-line - needs no return
|
|
\ entry: these words are called at the bottom of long chains of calls.
|
|
: (DP+)
|
|
DP b! @b +
|
|
dup DBASE inv + 1 + -if LOW drop drop jump (DERR) \ new - DBASE
|
|
LOW: drop dup inv DLIMIT + 1 + -if HIGH drop drop jump (DERR) \ DLIMIT - new
|
|
HIGH: drop DP b! !b -1 ;
|
|
|
|
set HDR-NFA here ", HERE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: HERE ( -- addr ) DP b! @b 3 + 4/ ;
|
|
set HDR-NFA here ", ALIGN #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ALIGN ( -- ) DP b! @b 3 + -4 and !b ;
|
|
set HDR-NFA here ", ALLOT #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ALLOT ( n -- ) ALIGN 4* (DP+) drop ;
|
|
|
|
\ , calls nothing: the code generator calls it from as deep as anything goes.
|
|
set HDR-NFA here ", , #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: , ( x -- )
|
|
a!
|
|
DP b! @b 3 + -4 and \ the next whole cell, as a byte address
|
|
dup inv DLIMIT + -3 + -if ROOM \ DLIMIT - (it + 4)
|
|
drop drop NODE-ERROR b! 5 !b ;
|
|
ROOM: drop dup 4 + !b \ DP is past it
|
|
4/ b! a !b ;
|
|
set HDR-NFA here ", C, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: C, ( c -- )
|
|
a! 1 (DP+) if FULL
|
|
drop a DP b! @b -1 + jump C!
|
|
FULL: drop ;
|
|
set HDR-NFA here ", 2, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: 2, ( lo hi -- ) SWAP , , ; \ the low cell first, as v3
|
|
|
|
set HDR-NFA here ", LATEST #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: LATEST ( -- xt ) CURRENT a! @ a! @ ; \ the newest entry of the CURRENT vocabulary
|
|
|
|
\ ---- the fields of an entry (5.13) -----------------------------------------
|
|
|
|
: (FLAGS) ( xt -- addr ) -3 + ;
|
|
set HDR-NFA here ", >LINK #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: >LINK ( xt -- addr ) -1 + ;
|
|
set HDR-NFA here ", LFA #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: LFA ( xt -- addr ) jump >LINK
|
|
set HDR-NFA here ", LINK> #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: LINK> ( addr -- xt ) a! @ ;
|
|
set HDR-NFA here ", >NAME #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: >NAME ( xt -- baddr ) -2 + a! @ 4* ;
|
|
set HDR-NFA here ", NFA #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: NFA ( xt -- baddr ) jump >NAME
|
|
set HDR-NFA here ", NAME> #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: NAME> ( baddr -- xt ) dup C@ 31 and 4 + 4/ push 4/ pop + 3 + ;
|
|
set HDR-NFA here ", CFA #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: CFA ( xt -- xt ) ;
|
|
set HDR-NFA here ", PFA #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: PFA ( xt -- addr ) dup (FLAGS) a! @ 4 and if CODE drop 1 + ; CODE: drop ;
|
|
set HDR-NFA here ", >BODY #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: >BODY ( xt -- addr ) jump PFA
|
|
|
|
\ ( baddr n -- baddr' ) as v3: for n > 0, from a name's count byte to the
|
|
\ byte after its last character; otherwise the address unchanged.
|
|
set HDR-NFA here ", TRAVERSE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: TRAVERSE
|
|
-if NN drop ;
|
|
NN: if ZERO drop dup C@ 31 and + 1 + ;
|
|
ZERO: drop ;
|
|
|
|
set HDR-NFA here ", SMUDGE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: SMUDGE ( -- ) LATEST if NONE (FLAGS) a! @ 2 xor ! ; NONE: drop ;
|
|
set HDR-NFA here ", HIDDEN #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: HIDDEN ( -- ) LATEST if NONE (FLAGS) a! @ 2 OR ! ; NONE: drop ;
|
|
|
|
\ ---- telling the kernel (docs/v4.0.0/ENGINE.md 3b) ------------------------------
|
|
\ A word's code is here on the node; its accounts are a record its kernel
|
|
\ keeps. So the kernel has to be told of every entry that is made and of
|
|
\ every entry that goes. An entry is made in one place, (HEADER); entries go
|
|
\ in two, FORGET and COLD (system.v4). Each tells through a variable that
|
|
\ holds the xt of a word to run, or 0 for a node whose host keeps no records:
|
|
\ (WORD-DEFINED) ( xt -- ) an entry has been made; its code will be at xt
|
|
\ (WORD-FORGOTTEN) ( w -- ) every entry at word address w or above is gone
|
|
\ On the bare-metal system the kernel puts words of its own there.
|
|
|
|
\ ( -- ) tell of the entry just made, whose code starts at HERE
|
|
: (DEFINED)
|
|
(WORD-DEFINED) b! @b if NONE HERE SWAP push ;
|
|
NONE: drop ;
|
|
|
|
\ ( w -- ) tell that the entries from word address w up have gone
|
|
: (FORGOTTEN)
|
|
(WORD-FORGOTTEN) b! @b if NONE push ;
|
|
NONE: drop drop ;
|
|
|
|
\ ---- making an entry -------------------------------------------------------
|
|
\ (D)+0 where the name starts (D)+1 the name being looked up
|
|
\ (D)+2 the name being copied, or the entry being looked at
|
|
\ (D)+3 a count (D)+4 whether a lookup has gone on to FORTH
|
|
|
|
\ ( -- bytes ) what an entry for a name of (D)+3 characters takes: its name
|
|
\ cells and three more
|
|
: (NEED) (D)+3 a! @ 4 + -4 and 12 + ;
|
|
|
|
\ ( baddr -- ) an entry for the counted string at baddr; its code starts at
|
|
\ HERE afterwards. An empty name, or no room, makes nothing and sets
|
|
\ NODE-ERROR.
|
|
: (HEADER)
|
|
dup (D)+2 a! ! \ (CLIP), in line
|
|
C@ -32 + -if LONG drop jump CLIPPED
|
|
LONG: drop 31 (D)+2 a! @ C!
|
|
CLIPPED:
|
|
(D)+2 a! @ C@ if EMPTY \ len
|
|
(D)+3 a! !
|
|
ALIGN
|
|
(NEED) (DP+) if FULL drop \ there is room;
|
|
(NEED) NEGATE (DP+) drop \ DP back where it was
|
|
HERE (D) a! ! \ where the name starts
|
|
(D)+3 a! @ C,
|
|
L: (D)+3 a! @ if DONE -1 + !
|
|
(D)+2 a! @ 1 + dup ! C@ C,
|
|
jump L
|
|
DONE: drop
|
|
P: DP b! @b 3 and if ALIGNED drop 0 C, jump P
|
|
ALIGNED: drop
|
|
0 , (D) a! @ , LATEST ,
|
|
HERE CURRENT a! @ a! !
|
|
jump (DEFINED)
|
|
FULL: drop ; \ (DP+) has set NODE-ERROR
|
|
EMPTY: drop NODE-ERROR b! 6 !b ; \ name missing
|
|
|
|
\ ---- looking a name up -----------------------------------------------------
|
|
|
|
\ ( baddr -- xt | 0 ) the newest visible entry named by the counted string.
|
|
\ Written out in one piece -- the string cut to 31, each entry's flags and
|
|
\ name fetched, the two names compared byte by byte -- so that the only call
|
|
\ it makes is C@: it is called from the interpreter for every word of every
|
|
\ line, with the user's return stack beneath it.
|
|
: (LOOKUP)
|
|
dup (D)+1 a! ! \ cut the string to 31 characters
|
|
C@ -32 + -if LONG drop jump CUT
|
|
LONG: drop 31 (D)+1 a! @ C!
|
|
CUT:
|
|
0 (D)+4 a! ! \ not yet on to FORTH
|
|
CONTEXT a! @ a! @
|
|
L: if END
|
|
(D)+2 a! !
|
|
(D)+2 a! @ -3 + a! @ 2 and if VISIBLE drop jump OLDER
|
|
VISIBLE: drop
|
|
(D)+2 a! @ -2 + a! @ 4* (D) a! ! \ its name
|
|
(D)+1 a! @ C@ 1 + (D)+3 a! ! \ the count byte and the characters
|
|
C: (D)+3 a! @ if SAME -1 + dup ! \ k
|
|
dup (D) a! @ + C@ \ k c1
|
|
SWAP (D)+1 a! @ + C@ \ c1 c2
|
|
xor if EQ drop jump OLDER
|
|
EQ: drop jump C
|
|
SAME: drop (D)+2 a! @ ;
|
|
OLDER: (D)+2 a! @ -1 + a! @ jump L
|
|
END: (D)+4 a! @ if FIRST drop ; \ FORTH has been searched: not found
|
|
FIRST: drop -1 (D)+4 a! !
|
|
CONTEXT a! @ (LATEST) xor if ISFORTH \ CONTEXT is FORTH: that was it
|
|
drop drop (LATEST) a! @ jump L
|
|
ISFORTH: drop ;
|
|
|
|
\ ( -- xt | 0 ) FORTH-79: the compilation address of the next word in the
|
|
\ input stream, or 0 if it is not in the dictionary.
|
|
set HDR-NFA here ", FIND #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: FIND 32 WORD jump (LOOKUP)
|
|
|
|
\ ( -- addr ) FORTH-79: the parameter field address of the next word in the
|
|
\ input stream. Not found is an error: 0, and NODE-ERROR is set. This is '
|
|
\ when interpreting; compile.v4 adds what ' does when compiling.
|
|
\ ( -- 0 ) say that the word WORD has just left is not known, as v3 does:
|
|
\ UNKNOWN WORD: 'xxx'
|
|
: (UNKNOWN)
|
|
$4E4B4E55 (EMIT4) $204E574F (EMIT4) $44524F57 (EMIT4) $27203A (EMIT4)
|
|
WBUF COUNT TYPE 39 EMIT CR
|
|
NODE-ERROR b! -1 !b 0 ;
|
|
|
|
: (') 32 WORD (LOOKUP) if MISSING jump PFA
|
|
MISSING: drop jump (UNKNOWN)
|