commit ec74406cecccf4e7ac41d351ff635d8b835f61d4
parent 2efcf748fd620c05cbc2513e31119d3395a4c8bf
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 10 Aug 2022 11:00:55 -0400
Harmonize dictionary and linked lists
Dictionary entries are now a specialized form of linked lists.
Diffstat:
9 files changed, 67 insertions(+), 51 deletions(-)
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -206,7 +206,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
parentnode dup ast.func.locsize swap to ast.func.cursf ;
:w ( Ident ) dup identfind ?dup if ( inode dnode )
nip decl>op else ( inode )
- ast.ident.name current find ?dup _assert mem>op then ;
+ ast.ident.name sysdict find ?dup _assert mem>op then ;
:w ( UnaryOp )
_debug if ." unaryop: " dup printast nl> .ops then
dup genchildren
diff --git a/fs/doc/arch.txt b/fs/doc/arch.txt
@@ -6,21 +6,24 @@ This Forth is a Subroutine Thread Code (STC) Forth, that is, each reference to
words is a native call instead of being a reference. This means that we don't
have a "next" interpret loop. It's calls all the way down.
+# Linked lists
+
+The linked list is a data structure that is heavily used in Dusk: dictionaries
+are a specialized form of linked lists. A linked list is a structure where the
+first element is a 4 bytes pointer to the next element.
+
# Dictionary structure
Words in this Forth are embedded in a dictionary, which is a list of entries
each pointing to the previous entry. We keep that last added entry in "current".
+Dictionaries are a form of linked list.
The structure of each entry is:
Xb name
4b link to metadata
-4b link to previous entry
+4b link to previous entry --> this is where we link
1b name length + immediate
---> this is where we link
-
-When we refer to a word in Dusk OS, we always refer to its first executable
-byte, right after the name length field. This way, we can call it directly.
"previous entry" field in an entry refers to this same place.
@@ -29,6 +32,17 @@ The link to metadata is a linked list, initialized to 0. See doc/usage.
The length field is a 7 bit length with the 8th bit reserved for the "immediate"
flag (1=immediate).
+When we refer to a "word" in Dusk OS, we always refer to its first executable
+byte, right after the name length field. When what you have is a word, you can
+call it.
+
+When we refer to an "entry", we refer to the data structure. This means that an
+entry is a pointer to the "previous entry" field. To get a word from an entry,
+we add 5 bytes.
+
+Except for words specifically made for manipulating dictionary entries, we
+rarely deal with "entry" pointers. We most often deal with word pointers.
+
# Cross-compilation
When we use the word "cross-compiled" below, it means that the binary that is
diff --git a/fs/lib/xdict.fs b/fs/lib/xdict.fs
@@ -1,7 +1,7 @@
\ Extra dictionaries
\ Create and use dictionaries besides the system one. Such dictionaries use the
\ same words as words for the system dictionary. It does so by fiddling with
-\ "current".
+\ "sysdict".
\ Usage: You begin by allocating a new dict structure with "newxdict <name>".
\ Then, you just need to use "x" words like "xentry" and "x'". If you need
@@ -16,10 +16,10 @@
\ mydict x' foo execute 1+ c@ .x1 -> 02
\ mydict x' bar execute .x1 -> 2a
-0 value currentbkp
+0 value dictbkp
: newxdict create 4 allot0 ;
-: xdict[ ( 'dict -- ) current to currentbkp @ to current ;
-: ]xdict ( 'dict -- ) current swap ! currentbkp to current ;
+: xdict[ ( 'dict -- ) sysdict to dictbkp @ to sysdict ;
+: ]xdict ( 'dict -- ) sysdict swap ! dictbkp to sysdict ;
: xdictproxy ( w -- ) doer , does> ( 'dict 'w -- )
over xdict[ swap >r @ execute r> ]xdict ;
' ' xdictproxy x'
diff --git a/fs/tests/kernel.fs b/fs/tests/kernel.fs
@@ -66,7 +66,7 @@ current .x
\ preventry
: bar ;
: baz ;
-' baz preventry ' bar #eq
+' baz preventry e>w ' bar #eq
\ metadata and linked lists
' bar emeta 0 #eq
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -1,11 +1,15 @@
-," ;" 0 , current , $81 c, here to current
+," w>e" 0 , sysdict , 3 c, here 5 - to sysdict ]
+ 5 - [ exit,
+," ;" 0 , sysdict , $81 c, here w>e to sysdict
' [ execute, ' exit, execute, exit,
-," dict," 0 , current , 5 c, here to current ]
+," dict," 0 , sysdict , 5 c, here w>e to sysdict ]
dup 1+ swap c@ tuck move, rot> , , c, ;
-," entry" 0 , current , 5 c, here to current ]
- current nextmeta rot dict, here to current 0 to nextmeta ;
-," :" 0 , current , 1 c, here to current ]
+," entry" 0 , sysdict , 5 c, here w>e to sysdict ]
+ sysdict nextmeta rot dict, here w>e to sysdict 0 to nextmeta ;
+," :" 0 , sysdict , 1 c, here w>e to sysdict ]
word entry ] ;
+: e>w 5 + ;
+: current sysdict e>w ;
: immediate current 1- dup c@ $80 or swap c! ;
: ['] ' litn ; immediate
: to+ ['] +! [to] ;
@@ -112,6 +116,7 @@ alias else endof immediate
: llnext @ ;
: llend ( ll -- lastll ) begin dup @ ?dup while nip repeat ( ll ) ;
: lladd ( ll -- newll ) here swap llend ! here 0 , ;
+: llcnt ( ll -- count ) A>r 0 >A begin ?dup while A+ llnext repeat A> r>A ;
\ Emitting
$20 const SPC $0d const CR $0a const LF $08 const BS
@@ -140,8 +145,6 @@ alias noop [then]
dup wordlen swap 9 - over - ( sl sa ) swap ;
: .word ( w -- ) wordname[] rtype ;
: words ( -- ) current begin dup while dup .word spc> preventry repeat drop ;
-: dictcnt ( 'dict -- count )
- A>r 0 >A begin ?dup while A+ preventry repeat A> r>A ;
\ Entry metadata
4 &+@ emetatype
@@ -182,11 +185,11 @@ alias noop [then]
_getinst + to? ?dup if execute else @ execute then ;
: _parens ( 'struct off )
compiling if litn litn compile (struct()) else swap (struct()) then ;
-: 'structsz ( 'struct -- sz ) @ dictcnt CELLSZ * ;
+: 'structsz ( 'struct -- sz ) @ llcnt CELLSZ * ;
: structsz ( w -- sz ) does' 'structsz ;
: struct ( cnt -- )
doer >r here 0 , 0 , 0 0 begin ( 'dict off current )
- 0 ( meta ) word dict, here ( 'dict off current )
+ 0 ( meta ) word dict, here w>e ( 'dict off current )
swap dup , CELLSZ + swap next ( 'dict off current )
nip swap ! immediate
does> ( ??? 'struct -- ??? *to* )
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -25,7 +25,7 @@
0 to realmode
: values ( n -- ) >r begin 0 value next ;
25 values L1 L2 lblmainalias lbltoptr lbltoexec lblbootptr lblin< lblcurword
- lblnextmeta lblret lblcurrent lblemit lblparsec lblparseh lblparseud
+ lblnextmeta lblret lblsysdict lblemit lblparsec lblparseh lblparseud
lblerrmsg lblrtype lblhere lblmovewrite lblwrite lblcwrite lblfind
lblcompiling lblareg lblidt
$8000 const HERESTART \ TODO: find a better place
@@ -136,8 +136,8 @@ xcode heremax
xcode here
wcall, (val) pc to lblhere HERESTART ,
-xcode current
- wcall, (val) pc to lblcurrent 0 ,
+xcode sysdict
+ wcall, (val) pc to lblsysdict 0 ,
pc to lblcompiling 0 ,
xcode compiling
@@ -624,25 +624,24 @@ pc to lblfind
cl [esi] mov,
[ebp] inc,
pc ( loop )
- di dx mov,
- di dec,
- al di 0 d) mov,
+ di dx mov, \ entry
+ al di 4 d) mov, \ len
al $3f i) and, \ 3f instead of 7f? we reserve space for another flag.
al cl cmp,
forward jnz, to L1 ( skip1 )
\ same length
- di 8 i) sub,
- di cx sub,
+ di 4 i) sub,
+ di cx sub, \ beginning of name range
si [ebp] mov,
repz, cmpsb,
forward jnz, to L2 ( skip2 )
\ same contents
+ dx 5 i) add, \ word
[ebp] dx mov,
ret,
L2 forward! ( skip2 )
cl al mov,
L1 forward! ( skip1 )
- dx 5 i) sub,
dx dx 0 d) mov,
dx dx test,
( pc ) abs>rel jnz, ( loop )
@@ -662,7 +661,7 @@ xcode (wnf)
xcode ' ( "name" -- w )
wcall, word
- dx lblcurrent m) mov,
+ dx lblsysdict m) mov,
lblfind abs>rel call,
[ebp]z?
xwordlbl (wnf) abs>rel jz,
@@ -813,14 +812,14 @@ pc ( literal handling )
xwordlbl litn abs>rel jnz, \ compiling
ret, \ not compiling, nothing to do
-xcode runword ( str -- ) pc lblcurrent pc>addr !
+xcode runword ( str -- ) pc w>e lblsysdict pc>addr !
wcall, parse
AX pspop,
ax ax test,
( pc ) abs>rel jnz, \ is a literal
\ not a literal
lblcurword pspushN,
- dx lblcurrent m) mov,
+ dx lblsysdict m) mov,
lblfind abs>rel call,
[ebp]z?
xwordlbl (wnf) abs>rel jz,
diff --git a/fs/xcomp/pc/kernel.fs b/fs/xcomp/pc/kernel.fs
@@ -22,7 +22,7 @@ pc to L1 \ segment with ffff limits
0 L2 jmpfar,
0 to realmode
-xcode int13h ( drv head cyl sec dst -- ) pc lblcurrent pc>addr !
+xcode int13h ( drv head cyl sec dst -- ) pc w>e lblsysdict pc>addr !
BX pspop,
AX pspop, cl al mov, \ sec
AX pspop, ch al mov, \ cyl
diff --git a/fs/xcomp/tools.fs b/fs/xcomp/tools.fs
@@ -19,10 +19,10 @@ newxdict xbindict
\ to current org+binstart. Once this is done, the xdict can't be traversed
\ anymore and becomes opaque binary contents.
: orgifydict ( xdict -- )
- @ begin ( a )
- 5 - dup @ ( 'prev prev )
- ?dup while ( 'prev prev )
- dup xoffset + ( 'prev oldprev newprev ) rot ! ( prev ) repeat drop ;
+ @ begin ( entry )
+ dup @ ( entry next )
+ ?dup while ( entry next )
+ dup xoffset + ( entry old new ) rot ! ( entry ) repeat drop ;
LF value _last
0 value _incomment?
diff --git a/posix/vm.c b/posix/vm.c
@@ -22,8 +22,8 @@ The VM is little endian.
#define SYSVARSSZ 0x80
#define SYSVARS ((PSTOP-STACKSZ)-SYSVARSSZ)
#define HERE SYSVARS
-#define CURRENT (HERE+4)
-#define NEXTMETA (CURRENT+4)
+#define SYSDICT (HERE+4)
+#define NEXTMETA (SYSDICT+4)
#define INRD (NEXTMETA+4)
#define EMIT (INRD+4)
#define ABORT (EMIT+4)
@@ -75,21 +75,21 @@ static dword rpop() { dword n = rpeek(); vm.RSP += 4; return n; }
static void rpush(dword d) { vm.RSP -= 4; sd(vm.RSP, d); }
static dword here() { return gd(HERE); }
static void allot(dword n) { sd(HERE, here()+n); }
-static dword current() { return gd(CURRENT); }
+static dword sysdict() { return gd(SYSDICT); }
static dword _find(dword dict, byte *name, byte slen) {
dword a = dict;
byte len;
while (memchk(a)) {
- len = gb(a-1) & 0x3f;
- if ((len == slen) && (memcmp(name, &vm.mem[a-9-len], len)==0)) {
- return a;
+ len = gb(a+4) & 0x3f;
+ if ((len == slen) && (memcmp(name, &vm.mem[a-4-len], len)==0)) {
+ return a+5;
}
- a = gd(a-5);
+ a = gd(a);
}
return 0;
}
static dword find(char *name) {
- return _find(current(), (byte*)name, strlen(name));
+ return _find(sysdict(), (byte*)name, strlen(name));
}
static void cwrite(byte b) {
sb(here(), b);
@@ -114,9 +114,9 @@ static void _entry(byte *name, byte slen) {
memcpy(&vm.mem[here()], name, slen);
allot(slen);
dwrite(gd(NEXTMETA));
- dwrite(current());
+ dwrite(sysdict());
cwrite(slen);
- sd(CURRENT, here());
+ sd(SYSDICT, here()-5);
sd(NEXTMETA, 0);
}
static void entry(char *name) {
@@ -670,7 +670,7 @@ static void FIND() { // op: 55
static void APOS() { // op: 56
WORD();
- ppush(current());
+ ppush(sysdict());
FIND();
if (!ppeek()) WNF();
}
@@ -706,7 +706,7 @@ static void RUNWORD() { // op: 5b
if (vm.compiling) LITN();
} else {
ppush(CURWORD);
- ppush(current());
+ ppush(sysdict());
FIND();
if (!ppeek()) { WNF(); return; }
if (vm.compiling && !((gb(ppeek()-1) & 0x80) /* immediate */)) {
@@ -933,7 +933,7 @@ static void sysconst(char *name, dword val) {
static void buildsysdict() {
sd(HERE, 0);
- sd(CURRENT, 0);
+ sd(SYSDICT, 0);
entry("noop"); retwr();
for (int i=0x04; i<OPCNT; i++) {
if (ops[i] && opnames[i]) { opentry(i); retwr(); }
@@ -947,7 +947,7 @@ static void buildsysdict() {
sysalias("abort", ABORT);
sysalias("main", MAINLOOP);
sysval("here", HERE);
- sysval("current", CURRENT);
+ sysval("sysdict", SYSDICT);
sysval("nextmeta", NEXTMETA);
sysconst("heremax", HEREMAX);
sysconst("curword", CURWORD);
