commit 52d7037d9bfbbefa08fac1575affe07232ae7e78
parent f68c6b8222cfe8a02d2f5192c54492bba7674a44
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 6 Aug 2022 08:59:12 -0400
Replace entry-based annotations with linked lists based metadata
Both systems are more or less equivalent, simplicity-wise, but because I intend
to use linked lists in many places, we have an advantage with using linked lists
for entry metadata.
And, to be fair, this feels cleaner to me...
Diffstat:
13 files changed, 85 insertions(+), 71 deletions(-)
diff --git a/Makefile b/Makefile
@@ -21,7 +21,7 @@ pc.bin: dusk buildpc.fs
pc.img: mbr.bin pc.bin $(ALLSRCS)
dd if=/dev/zero of=$@ bs=1M count=1
# We need to reserve (-R) enough sectors for MBR + pc.bin
- mformat -M 512 -d 1 -R 40 -i $@ ::
+ mformat -M 512 -d 1 -R 48 -i $@ ::
dd if=mbr.bin of=$@ bs=1 seek=62 conv=notrunc
dd if=pc.bin of=$@ bs=1 seek=512 conv=notrunc
mcopy -sQ -i $@ fs/* ::
diff --git a/fs/doc/arch.txt b/fs/doc/arch.txt
@@ -14,6 +14,7 @@ each pointing to the previous entry. We keep that last added entry in "current".
The structure of each entry is:
Xb name
+4b link to metadata
4b link to previous entry
1b name length + immediate
--> this is where we link
@@ -23,6 +24,8 @@ 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.
+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).
diff --git a/fs/doc/usage.txt b/fs/doc/usage.txt
@@ -56,3 +56,29 @@ This word works both in compiling mode and outside of it. For example, this
would work too:
: moduleinit chain emit myemitroutine ;
+
+# Linked lists
+
+Linked lists are a fundamental data structure in Dusk. They are simply addresses
+in memory pointing to each other, with the last element of the list pointing to
+0. The first element of a LL (linked list) element is always the pointer
+element.
+
+Iterating a LL is easy, it's as simple as reading next with @ ("llnext" makes
+the intent clearer).
+
+When you want to add a new element to the list, you can call "lladd", which
+makes the list's last element point to "here". You can then write your new
+element.
+
+# Dictionary entry metadata
+
+Each entry in the dictionary can have metadata linked to it in the form of a
+linked list. The pointer to the first element (or 0 if none) for an entry is
+given by the word "emeta".
+
+Each metadata element has this structure:
+
+4b link to next
+4b type ID
+( any other type-specific data )
diff --git a/fs/lib/annotate.fs b/fs/lib/annotate.fs
@@ -1,15 +0,0 @@
-\ Annotations
-?f<< lib/dict.fs
-
-: (annotate) ( w -- w' )
- current dup preventry to current >r
- dup preventry r@ preventry!
- r@ swap preventry! r> ;
-
-: annotate (annotate) drop ;
-
-: [][]= ( a u a u -- f )
- rot over = if []= else 2drop drop 0 then ;
-
-: has-name? ( w str -- f )
- c@+ rot wordname[] [][]= ;
diff --git a/fs/lib/btrace.fs b/fs/lib/btrace.fs
@@ -1,6 +1,5 @@
-?f<< lib/dict.fs
?f<< lib/nfmt.fs
-: raddr>entry ( a -- w ) current begin 2dup < while prevword repeat nip ;
+: raddr>entry ( a -- w ) current begin 2dup < while preventry repeat nip ;
: .raddr ( a -- ) dup .x raddr>entry ?dup if spc> .word then ;
: _abort ( 'oldabort -- ) nl> begin rcnt while r> .raddr nl> repeat execute ;
: btrace$ chain abort _abort ;
diff --git a/fs/lib/dict.fs b/fs/lib/dict.fs
@@ -1,14 +0,0 @@
-\ Dictionary
-: preventry ( w -- w ) 5 - @ ;
-: preventry! ( w w -- ) 5 - ! ;
-: wordlen ( w -- len ) 1- c@ $3f and ;
-: wordname[] ( w -- sa sl )
- dup wordlen swap 5 - over - ( sl sa ) swap ;
-
-: word? ( w -- f ) ?dup if wordname[] if c@ 127 = not else 0 then then ;
-: (prevword) ( w -- w ) begin dup while dup word? not while preventry repeat then ;
-: prevword ( w -- w ) preventry (prevword) ;
-: lastword ( -- w ) current (prevword) ;
-: .word ( w -- ) wordname[] rtype ;
-: words ( -- )
- lastword begin dup while dup .word spc> prevword repeat drop ;
diff --git a/fs/sys/doc.fs b/fs/sys/doc.fs
@@ -1,22 +0,0 @@
-?f<< lib/annotate.fs
-
-create doc-magic 2 c, 127 c, 'D' c,
-
-: _ doc-magic entry begin in< dup c, LF = until ;
-' _ to \\
-
-: add-doc ( w -- )
- begin current word? not while (annotate) repeat drop ;
-
-: .doc ( w -- )
- preventry dup word? not if dup .doc then
- dup doc-magic has-name? if
- begin c@+ dup emit LF = until
- then drop ;
-
-: doc ' .doc ;
-
-\\ create a new constant
-' const add-doc
-
-
diff --git a/fs/tests/kernel.fs b/fs/tests/kernel.fs
@@ -61,10 +61,10 @@ current .x
6 foo 209 #eq
20 foo 220 #eq
-\ prevword
+\ preventry
: bar ;
: baz ;
-' baz prevword ' bar #eq
+' baz preventry ' bar #eq
\ autoloading
floaded #
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -88,6 +88,11 @@ alias else endof immediate
: endcase ( then-stopgap jump1? jump2? ... jumpn? -- )
?dup if begin [compile] then ?dup not until then compile rdrop ; immediate
+\ Linked lists. See doc/usage.
+alias @ llnext
+: llend ( ll -- lastll ) begin dup @ ?dup while nip repeat ( ll ) ;
+: lladd ( ll -- newll ) here swap llend ! here 0 , ;
+
\ Emitting
$20 const SPC $0d const CR $0a const LF $08 const BS
: nl> CR emit LF emit ; : spc> SPC emit ;
@@ -107,6 +112,30 @@ $20 const SPC $0d const CR $0a const LF $08 const BS
: [if] not if S" [then]" begin word over s= until drop then ;
alias noop [then]
+\ Dictionary
+-5 &+@ preventry
+-9 &+@ emeta
+: wordlen ( w -- len ) 1- c@ $3f and ;
+: wordname[] ( w -- sa sl )
+ dup wordlen swap 9 - over - ( sl sa ) swap ;
+: .word ( w -- ) wordname[] rtype ;
+: words ( -- ) current begin dup while dup .word spc> preventry repeat drop ;
+
+\ Entry metadata
+4 &+@ emetatype
+8 &+ 'emeta
+: findemeta ( typeid ll -- ll-or-0 ) begin ( typeid ll )
+ dup while 2dup emetatype = not while llnext repeat
+ ( success ) then ( typeid ll-or-0 ) nip ;
+
+\ Docstrings
+1 const EMETA_DOCLINE \ a doc strings that ends with LF
+\ a \\ comment goes before the creation of the word it comments
+: \\ nextmeta lladd drop EMETA_DOCLINE , begin in< dup c, LF = until ;
+: .doc ( w -- ) emeta begin ( ll )
+ EMETA_DOCLINE swap findemeta ?dup while ( ll )
+ dup 'emeta begin c@+ dup emit LF = until drop llnext repeat ;
+
\ Alias chaining. See doc/usage.
: _ ( 'target 'alias -- )
here swap to@! execute ( 'tgt 'prevtgt )
@@ -125,6 +154,3 @@ alias noop [then]
\ Autoloading
0 value floaded \ address of the current "loaded file" structure
: floaded, ( id -- ) floaded here to floaded , ( id ) , ;
-
-\ doc comment placeholder
-alias \ \\
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -24,10 +24,10 @@
\ Constants and labels
0 to realmode
: values ( n -- ) >r begin 0 value next ;
-23 values L1 L2 lblmainalias lbltoptr lbltoexec lblbootptr lblin< lblcurword
- lblret lblcurrent lblemit lblparsec lblparseh lblparseud lblerrmsg
- lblrtype lblhere lblmovewrite lblwrite lblcwrite lblcompiling lblareg
- lblidt
+24 values L1 L2 lblmainalias lbltoptr lbltoexec lblbootptr lblin< lblcurword
+ lblnextmeta lblret lblcurrent lblemit lblparsec lblparseh lblparseud
+ lblerrmsg lblrtype lblhere lblmovewrite lblwrite lblcwrite
+ lblcompiling lblareg lblidt
$a000 const HERESTART \ TODO: find a better place
$80000 const HEREMAX
$8000 to binstart \ This code lives at $8000.
@@ -626,7 +626,7 @@ pc ( loop )
al cl cmp,
forward jnz, to L1 ( skip1 )
\ same length
- di 4 i) sub,
+ di 8 i) sub,
di cx sub,
si [ebp] mov,
repz, cmpsb,
@@ -745,17 +745,25 @@ xcode parse ( str -- n? f )
bp CELLSZ d) neg,
ret,
+pc to lblnextmeta 4 allot0
+xcode nextmeta
+ lblnextmeta pspushN,
+ ret,
+
xcode entry ( str -- )
SI pspop,
cx cx xor,
cl [esi] mov,
si inc,
dx cx mov, \ save len
- lblmovewrite abs>rel call,
+ lblmovewrite abs>rel call, \ name
+ ax lblnextmeta m) mov,
+ lblwrite abs>rel call, \ meta
+ lblnextmeta m) 0 i) mov,
ax lblcurrent m) mov,
- lblwrite abs>rel call,
+ lblwrite abs>rel call, \ prev
ax dx mov,
- lblcwrite abs>rel call,
+ lblcwrite abs>rel call, \ len
ax lblhere m) mov,
lblcurrent m) ax mov,
ret,
diff --git a/fs/xcomp/pc/init.fs b/fs/xcomp/pc/init.fs
@@ -3,7 +3,6 @@
herestart to here
0 S" sys" fchild S" file.fs" fchild fload
\ We now have f<<
-f<< /sys/doc.fs
f<< /drv/pc/acpi.fs
f<< /drv/pc/com.fs
f<< /drv/pc/vga.fs
diff --git a/posix/init.fs b/posix/init.fs
@@ -2,4 +2,3 @@
: ARCH S" none" ;
0 S" sys" fchild S" file.fs" fchild fload
\ We now have f<<
-f<< sys/doc.fs
diff --git a/posix/vm.c b/posix/vm.c
@@ -23,7 +23,8 @@ The VM is little endian.
#define HERE SYSVARS
#define CURRENT (HERE+4)
#define COMPILING (CURRENT+4)
-#define INRD (COMPILING+4)
+#define NEXTMETA (COMPILING+4)
+#define INRD (NEXTMETA+4)
#define EMIT (INRD+4)
#define ABORT (EMIT+4)
#define MAINLOOP (ABORT+4)
@@ -71,7 +72,7 @@ static dword _find(byte *name, byte slen) {
byte len;
while (a) {
len = gb(a-1) & 0x3f;
- if ((len == slen) && (memcmp(name, &vm.mem[a-5-len], len)==0)) {
+ if ((len == slen) && (memcmp(name, &vm.mem[a-9-len], len)==0)) {
return a;
}
a = gd(a-5);
@@ -103,9 +104,11 @@ static void callword(dword addr); // forward declaration
static void _entry(byte *name, byte slen) {
memcpy(&vm.mem[here()], name, slen);
allot(slen);
+ dwrite(gd(NEXTMETA));
dwrite(current());
cwrite(slen);
sd(CURRENT, here());
+ sd(NEXTMETA, 0);
}
static void entry(char *name) {
_entry((byte*)name, strlen(name));
@@ -157,6 +160,7 @@ static void QUIT() { // op: 06
static void ABORT_() { // op: 07
vm.PSP = PSTOP;
sd(COMPILING, 0);
+ sd(NEXTMETA, 0);
QUIT();
}
@@ -925,6 +929,7 @@ static void buildsysdict() {
sysval("compiling", COMPILING);
sysconst("heremax", HEREMAX);
sysconst("curword", CURWORD);
+ sysconst("nextmeta", NEXTMETA);
entry("mainloop");
sd(MAINLOOP, here());
callwr(find("word"));
