feat(v4.0.0): the dictionary: its space, its entries, and FIND
The second layer of the compiler capsule, v4/capsule/dict.v4: HERE ALIGN ALLOT , C, 2, PAD LATEST; an entry layout reached entirely from the xt, with >LINK LFA LINK> >NAME NFA NAME> CFA PFA >BODY TRAVERSE SMUDGE HIDDEN on it; and FIND and ' . FIND is FORTH-79's and v3's. ' is FORTH-79's: the parameter field address, which for a code word is what FIND gives. ALLOT counts cells (D-1). 31 characters of a name are significant. Executed at both cell widths against a list of 300 entries kept in C. WORD no longer holds its length on the return stack. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
01b5bbb23f
commit
c10d3a9cca
@@ -0,0 +1,139 @@
|
||||
\ 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, or 0
|
||||
\ 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 two cells of scratch for this file
|
||||
\ 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) ------------------------------------------------------
|
||||
|
||||
: (DERR) ( -- 0 ) NODE-ERROR b! -1 !b 0 ;
|
||||
|
||||
\ ( 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.
|
||||
: (DP+)
|
||||
DP a! @ +
|
||||
dup DBASE - -if LOW drop drop jump (DERR)
|
||||
LOW: drop DLIMIT over - -if HIGH drop drop jump (DERR)
|
||||
HIGH: drop DP a! ! -1 ;
|
||||
|
||||
: HERE ( -- addr ) DP a! @ 3 + 4/ ;
|
||||
: ALIGN ( -- ) DP a! @ 3 + -4 and DP a! ! ;
|
||||
: ALLOT ( n -- ) ALIGN 4* (DP+) drop ;
|
||||
|
||||
: , ( x -- )
|
||||
ALIGN HERE push 4 (DP+) if FULL drop pop a! ! ;
|
||||
FULL: drop pop drop drop ;
|
||||
: C, ( c -- )
|
||||
DP a! @ push 1 (DP+) if FULL drop pop C! ;
|
||||
FULL: drop pop drop drop ;
|
||||
: 2, ( lo hi -- ) SWAP , , ; \ the low cell first, as v3
|
||||
|
||||
: LATEST ( -- xt ) (LATEST) a! @ ;
|
||||
|
||||
\ ---- the fields of an entry (5.13) -----------------------------------------
|
||||
|
||||
: (FLAGS) ( xt -- addr ) -3 + ;
|
||||
: >LINK ( xt -- addr ) -1 + ;
|
||||
: LFA ( xt -- addr ) jump >LINK
|
||||
: LINK> ( addr -- xt ) a! @ ;
|
||||
: >NAME ( xt -- baddr ) -2 + a! @ 4* ;
|
||||
: NFA ( xt -- baddr ) jump >NAME
|
||||
: NAME> ( baddr -- xt ) dup C@ 31 and 4 + 4/ push 4/ pop + 3 + ;
|
||||
: CFA ( xt -- xt ) ;
|
||||
: PFA ( xt -- addr ) dup (FLAGS) a! @ 4 and if CODE drop 1 + ; CODE: drop ;
|
||||
: >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.
|
||||
: TRAVERSE
|
||||
-if NN drop ;
|
||||
NN: if ZERO drop dup C@ 31 and + 1 + ;
|
||||
ZERO: drop ;
|
||||
|
||||
: SMUDGE ( -- ) LATEST if NONE (FLAGS) a! @ 2 xor ! ; NONE: drop ;
|
||||
: HIDDEN ( -- ) LATEST if NONE (FLAGS) a! @ 2 OR ! ; NONE: drop ;
|
||||
|
||||
\ ---- making an entry -------------------------------------------------------
|
||||
|
||||
\ ( baddr -- baddr ) cut the counted string to 31 characters, in place
|
||||
: (CLIP) dup C@ -32 + -if LONG drop ; LONG: drop 31 over C! ;
|
||||
|
||||
\ ( 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)
|
||||
(CLIP) dup C@ if EMPTY \ baddr len
|
||||
ALIGN
|
||||
dup 4 + -4 and 12 + \ baddr len need bytes: name cells and three more
|
||||
dup (DP+) if FULL drop NEGATE (DP+) drop \ there is room; DP back where it was
|
||||
HERE (D) a! ! \ where the name starts
|
||||
dup C, \ baddr len
|
||||
L: if DONE SWAP 1 + dup C@ C, SWAP -1 + jump L \ nothing on R across C,
|
||||
DONE: drop drop
|
||||
P: DP a! @ 3 and if ALIGNED drop 0 C, jump P
|
||||
ALIGNED: drop
|
||||
0 , (D) a! @ , LATEST ,
|
||||
HERE (LATEST) a! ! ;
|
||||
FULL: drop drop
|
||||
EMPTY: drop drop NODE-ERROR b! -1 !b ;
|
||||
|
||||
\ ---- looking a name up -----------------------------------------------------
|
||||
|
||||
\ ( baddr1 baddr2 -- flag ) two counted strings are the same
|
||||
: (NAME=)
|
||||
over C@ 1 + \ b1 b2 n the count byte and the characters
|
||||
L: if SAME push
|
||||
over C@ over C@ xor if EQ drop drop drop pop drop 0 ;
|
||||
EQ: drop 1 + push 1 + pop pop -1 + jump L
|
||||
SAME: drop drop drop -1 ;
|
||||
|
||||
\ ( baddr -- xt | 0 ) the newest visible entry named by the counted string
|
||||
: (LOOKUP)
|
||||
(CLIP) (D) 1 + a! !
|
||||
LATEST
|
||||
L: if END
|
||||
dup (FLAGS) a! @ 2 and if VISIBLE jump OLDER
|
||||
VISIBLE: drop dup >NAME (D) 1 + a! @ (NAME=) if OLDER drop ;
|
||||
OLDER: drop >LINK a! @ jump L
|
||||
END: ;
|
||||
|
||||
\ ( -- xt | 0 ) FORTH-79: the compilation address of the next word in the
|
||||
\ input stream, or 0 if it is not in the dictionary.
|
||||
: 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.
|
||||
: ' 32 WORD (LOOKUP) if MISSING jump PFA
|
||||
MISSING: drop jump (DERR)
|
||||
+6
-4
@@ -42,7 +42,8 @@ macro BL 32 endmacro
|
||||
: QUERY TIB 80 EXPECT 0 >IN a! ! ;
|
||||
|
||||
\ ---- WORD ------------------------------------------------------------------
|
||||
\ (P)+0 the delimiter, (P)+1 the length of the text in TIB.
|
||||
\ (P)+0 the delimiter, (P)+1 the length of the text in TIB, (P)+2 the length
|
||||
\ of the word (CONVERT uses (P)+2 too; the two never run inside each other).
|
||||
macro (WDELIM) (P) endmacro
|
||||
macro (WLEN) (P) 1 + endmacro
|
||||
|
||||
@@ -70,11 +71,12 @@ macro (WLEN) (P) 1 + endmacro
|
||||
pop over over - \ end start len
|
||||
dup -256 + -if CAP drop jump FITS CAP: drop drop 255 FITS:
|
||||
dup WBUF C!
|
||||
dup push push TIB + WBUF 1 + pop CMOVE \ end R: len
|
||||
dup (P) 2 + a! ! \ the length waits in (P)+2, not on a stack
|
||||
push TIB + WBUF 1 + pop CMOVE \ end
|
||||
(LEFT) -if RANOUT
|
||||
drop (WDELIM) a! @ pop WBUF + 1 + C! \ the delimiter after the text
|
||||
drop (WDELIM) a! @ (P) 2 + a! @ WBUF + 1 + C! \ the delimiter after the text
|
||||
1 + >IN a! ! WBUF ;
|
||||
RANOUT: drop 0 pop WBUF + 1 + C!
|
||||
RANOUT: drop 0 (P) 2 + a! @ WBUF + 1 + C!
|
||||
>IN a! ! WBUF ;
|
||||
|
||||
\ ---- ENCLOSE ---------------------------------------------------------------
|
||||
|
||||
Reference in New Issue
Block a user