commit c2be425ebda1badb3999ccfa7863c35e18bc7bca
parent 1bf8676f8ce01243bbc49368f1918f46c8aaa56a
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 22 Sep 2022 15:43:39 -0400
Add ability for structs to have 8b and 16b fields
Diffstat:
7 files changed, 89 insertions(+), 43 deletions(-)
diff --git a/fs/fs/fat.fs b/fs/fs/fat.fs
@@ -117,20 +117,20 @@ $e5 const DIRFREE
: fatnewfile ( dirid name self -- id ) >r
r@ _newentry ( dirent ) r@ writecursector r> :getid ;
-: _makedir ( dirent -- dirent ) $10 over DirEntry attr! ;
+: _makedir ( dirent -- dirent ) $10 over to DirEntry attr ;
0 value _self 0 value _cluster 0 value _parentcl
: fatnewdir ( dirid name self -- id ) to _self
_self allocatecluster0 to _cluster ( dirid name )
_self _newentry ( dirent ) _makedir ( dirent )
- _cluster over DirEntry cluster! _self writecursector ( dirent )
+ _cluster over to DirEntry cluster _self writecursector ( dirent )
_self :getid ( id ) _self bufcluster to _parentcl
\ Cluster allocated, now let's initialize it with "." and ".."
_cluster _self :FirstSectorOfCluster 1 _self :readsector
_self :buf( dup DirEntry NAMESZ SPC fill '.' over c! _makedir ( id buf )
- _cluster over DirEntry cluster! ( id buf ) DirEntry SZ +
+ _cluster over to DirEntry cluster ( id buf ) DirEntry SZ +
dup DirEntry NAMESZ SPC fill '.' over c!+ '.' swap c! ( id buf )
- _makedir ( id buf ) _parentcl swap DirEntry cluster!
+ _makedir ( id buf ) _parentcl swap to DirEntry cluster
_self writecursector ( id ) ;
0 value self
@@ -163,7 +163,7 @@ $e5 const DIRFREE
\ special case: if :cluster0 is zero, we have an empty file. We need to
\ update its direntry to record the file's first cluster.
?dup not if self fat allocatecluster then ( cluster0 )
- self :dirent 2dup DirEntry cluster! ( custer0 dirent )
+ self :dirent 2dup to DirEntry cluster ( custer0 dirent )
self size swap to DirEntry filesize self fat writecursector ( cluster0 )
self size self fat :ClusterSize / ?dup if
>r begin ( cluster ) self fat FAT@+ next then ( cluster ) drop ;
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -14,16 +14,15 @@
$ffff const EOC
struct[ DirEntry
- 32 const SZ
11 const NAMESZ
8 const EXTIDX
3 const EXTSZ
: :name[] ( self -- sa sl ) NAMESZ ;
- 11 &+c@ attr
- : attr! ( n self -- ) 11 + c! ;
- 26 &+w@ cluster
- : cluster! ( n self -- ) 26 + w! ;
- 28 field filesize
+ 11 sallot
+ sfieldb attr
+ 14 sallot
+ sfieldw cluster
+ sfield filesize
: :lastentry? ( self -- f ) c@ not ;
: :valid? ( self -- f ) dup :lastentry? not swap c@ $e5 <> and ;
: :iterable? ( self -- f ) dup :valid? swap c@ '.' <> and ;
diff --git a/fs/tests/kernel.fs b/fs/tests/kernel.fs
@@ -89,20 +89,20 @@ foo 5 #eq 4 #eq
\ Structures
struct[ Foo
sfield bar
- sfield baz
+ sfieldb baz
smethod :bleh
]struct
\ ' Foo structsize 12 #eq
: mybleh ( 'data -- n ) dup Foo bar swap Foo baz + ;
-create data1 1 , 2 , ' mybleh ,
-create data2 3 , 4 , ' mybleh ,
+create data1 1 , 2 c, ' mybleh ,
+create data2 3 , 4 c, ' mybleh ,
data1 Foo bar 1 #eq
data2 Foo baz 4 #eq
data1 Foo :bleh 3 #eq
42 to+ data1 Foo baz
data1 Foo baz 44 #eq
-: myword data2 Foo bar ;
-myword 3 #eq
+: myword data2 Foo baz ;
+myword 4 #eq
data1 Foo :bleh 45 #eq
: myword data2 Foo :bleh ;
myword 7 #eq
@@ -114,14 +114,14 @@ data2 ' MyData1 rebind
myword 7 #eq
data1 ' MyData1 rebind
: bleh2 dup Foo bar swap Foo baz + 1+ ;
-' bleh2 data1 8 + !
+' bleh2 data1 5 + !
data1 Foo :bleh 46 #eq
myword 46 #eq
extends Foo struct[ Bazooka
sfield bling
]struct
-create data3 7 , 9 , ' mybleh , 999 ,
+create data3 7 , 9 c, ' mybleh , 999 ,
data3 Bazooka bling 999 #eq
data3 Bazooka baz 9 #eq
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -208,9 +208,8 @@ HERE ivalue here
0 value _bkp \ backup of sysdict to restore at ]struct
0 value _cur \ current struct entry
0 value _curroot \ root entry of the current struct hierarchy
-: _structsz' ( struct -- a ) does' 5 + ;
-: _struct+ ( struct ) CELLSZ swap _structsz' +! ;
-: structsz ( struct -- sz ) _structsz' @ ;
+: structsz' ( struct -- a ) does' 5 + ;
+: structsz ( struct -- sz ) structsz' @ ;
: structdict' does' ;
: _curroot! ( struct -- )
@@ -220,18 +219,15 @@ HERE ivalue here
sysdict @ to _bkp ' dup w>e to _cur dup _curroot! ( struct )
structdict' @ sysdict ! ;
-\ 4b dict
-\ 1b zero len size. See doc/impl
-\ 4b data size
: struct[
- doer immediate 0 , 0 c, _extends dup if _structsz' @ then ,
+ doer immediate 0 , 0 c, _extends dup if structsz' @ then ,
sysdict @ dup to _cur to _bkp
_extends ?dup if
_curroot! 0 to@! _extends structdict' sysdict !
else
sysdict S" :self" entry exit, \ :self is our root
sysdict @ to _curroot then
- sysdict S" SZ" entry _cur e>w _structsz' litn compile @ exit,
+ sysdict S" SZ" entry _cur e>w structsz' litn compile @ exit,
does> ( 'struct )
@ ( 'dict ) word swap ( str 'dict ) find ( 'word )
?dup not if curword stype abort" not in namespace!" then
@@ -243,12 +239,32 @@ does> ( 'struct )
\ Rewind the sysdict to our struct
_bkp sysdict @! _cur e>w structdict' ! ;
-: field ( off -- ) doer , immediate does> @ ( off ) compiling if ( off )
- litn compile + 0 toptr @! ?dup if execute, else compile @ then else
- + 0 toptr @! ?dup if execute else @ then then ;
+: sallot ( n -- ) _cur e>w structsz' +! ;
+: field ( sz off -- ) doer immediate , ,
+ does> @+ swap @ swap ( a? sz off )
+ compiling if ( sz off )
+ litn compile + 0 toptr @! ( sz toptr )
+ ?dup if swap ?b execute, else ?b compile @ then
+ else ( a sz off )
+ rot + 0 toptr @! ( sz a toptr )
+ ?dup not if ['] @ then rot ?b (woff) + execute then ;
: method ( off -- ) doer , does> @ over + @ execute ;
-: sfield _cur e>w structsz field _cur e>w _struct+ ;
-: smethod _cur e>w structsz method _cur e>w _struct+ ;
+: _sfield dup _cur e>w structsz field sallot ;
+: sfield CELLSZ _sfield ;
+: sfieldw 2 _sfield ;
+: sfieldb 1 _sfield ;
+: smethod _cur e>w structsz method CELLSZ sallot ;
+
+struct[ Struct
+ sfield dict
+ 1 sallot \ 1b that is always zero after dict link. See doc/impl
+ sfield size
+]struct
+
+struct[ Field
+ sfield offset
+ sfield size \ 1, 2 or 4
+]struct
\ 4b link to struct
\ 4b link to data
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -609,6 +609,12 @@ xcode p', ( n -- )
si ( pc ) i) mov,
L2 abs>rel jmp,
+xcode (woff)
+ ax lblwoff m) mov,
+ lblwoff m) 0 i) mov,
+ AX pspush,
+ ret,
+
xcode 16b ximm
lblwoff m) $20 i) mov,
ret,
@@ -617,6 +623,14 @@ xcode 8b ximm
lblwoff m) $40 i) mov,
ret,
+xcode ?b
+ AX pspop,
+ ax dec,
+ xwordlbl 8b abs>rel jz,
+ ax dec,
+ xwordlbl 16b abs>rel jz,
+ ret,
+
pc to lblemit xwordlbl drop ,
xcode EMIT
lblemit pspushN,
diff --git a/fs/xcomp/pc/init.fs b/fs/xcomp/pc/init.fs
@@ -1,6 +1,10 @@
\ Initialization for PC
: ARCH S" i386" ;
+\ we pre-load driver dependencies as much as possible here to keep file cursor
+\ to a minimum until the alternate Drive driver is active. Otherwise, we hit the
+\ BIOS 64k limit and all hell breaks loose.
+?f<< /asm/i386.fs
f<< /drv/pc/acpi.fs
f<< /drv/pc/com.fs
f<< /drv/pc/vga.fs
diff --git a/posix/vm.c b/posix/vm.c
@@ -350,14 +350,6 @@ static void RCNT() { // op: 25
ppush(((RSTOP-vm.RSP)>>2)-1);
}
-static void SET16B() { // op: 26
- vm.woff = 8;
-}
-
-static void SET8B() { // op: 27
- vm.woff = 16;
-}
-
static void FETCH() { // op: 28
ppush(gv(ppop()));
vm.bwidth = 0;
@@ -449,10 +441,31 @@ static void SWR() { // op: 32
}
}
+static void WOFF() { // op: 33
+ ppush(woff());
+}
+
static void SETBW() { // op: 34
vm.bwidth = ppop();
}
+static void SET16B() { // op: 35
+ vm.woff = 8;
+}
+
+static void SET8B() { // op: 36
+ vm.woff = 16;
+}
+
+static void SETNB() { // op: 37
+ dword n = ppop();
+ if (n==1) {
+ SET8B();
+ } else if (n==2) {
+ SET16B();
+ }
+}
+
static void INC() { // op: 38
ppush(ppop()+1);
}
@@ -966,9 +979,9 @@ static void (*ops[OPCNT])() = {
EXECUTE, CELL, DOES, SLIT, BR, CBR, NEXT, NULL,
PSADD, PSADDWR, PSADDR, PSADDRWR, BOOTRD, STDOUT, KEY, NULL,
DUP, CDUP, SWAP, OVER, ROT, ROTR, NIP, TUCK,
- RSADD, RSADDWR, RSADDR, RSADDRWR, SCNT, RCNT, SET16B, SET8B,
+ RSADD, RSADDWR, RSADDR, RSADDRWR, SCNT, RCNT, NULL, NULL,
FETCH, STORE, ADDSTORE, FETCHSTORE, FETCHADD, STOREADD, IFETCHADD, ISTOREADD,
- WRITE, SRD, SWR, NULL, SETBW, NULL, NULL, NULL,
+ WRITE, SRD, SWR, WOFF, SETBW, SET16B, SET8B, SETNB,
INC, DEC, ADD, SUB, MUL, DIVMOD, AND, NULL,
OR, XOR, BOOL, NOT, LT, SHLC, SHRC, LSHIFT,
RSHIFT, LITN, EXECUTEWR, EXITWR, MOVE, MOVEWR, RTYPE, WNF,
@@ -982,9 +995,9 @@ static char *opnames[OPCNT] = {
"execute", "(cell)", "(does)", "(s)", "(br)", "(?br)", "(next)", NULL,
NULL, "p+,", NULL, "p',", "boot<", "(emit)", "(key)", "drop",
"dup", "?dup", "swap", "over", "rot", "rot>", "nip", "tuck",
- NULL, "r+,", NULL, "r',", "scnt", "rcnt", "16b", "8b",
+ NULL, "r+,", NULL, "r',", "scnt", "rcnt", NULL, NULL,
"@", "!", "+!", "@!", "@+", "!+", "@@+", "@!+",
- ",", "\"<", ",\"", NULL, NULL, NULL, NULL, NULL,
+ ",", "\"<", ",\"", "(woff)", NULL, "16b", "8b", "?b",
"1+", "1-", "+", "-", "*", "/mod", "and", NULL,
"or", "xor", "bool", "not", "<", "<<c", ">>c", "lshift",
"rshift", "litn", "execute,", "exit,", "move", "move,", "rtype", "(wnf)",
