\ 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)