commit f68c6b8222cfe8a02d2f5192c54492bba7674a44
parent 1ec00f29a8ab99b3effe1dc5cb84b91d8d96e72e
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 5 Aug 2022 20:50:23 -0400
Move ufields from lib/struct to bootlo, as "field"
Rename "field" in "lib/struct" to "bfield" (for "bounded field"). Add &+ &+@
and &+!.
Diffstat:
8 files changed, 47 insertions(+), 55 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -64,23 +64,23 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 3 c, 3 c, 3 c, 3 c,
\ It's important that decl.name and func.name have the same offset. Poor man's
\ polymorphism...
-NODESZ ufield ast.decl.name
-NODESZ 4 + ufield ast.decl.type
-NODESZ 8 + ufield ast.decl.nbelem
+NODESZ field ast.decl.name
+NODESZ 4 + field ast.decl.type
+NODESZ 8 + field ast.decl.nbelem
\ for variables and args, "address" is a frame offset
-NODESZ 12 + ufield ast.decl.address
-NODESZ ufield ast.func.name
-NODESZ 4 + ufield ast.func.sfsize
-NODESZ 8 + ufield ast.func.type
-NODESZ 12 + ufield ast.func.address
-NODESZ 16 + ufield ast.func.cursf \ last SF offset computed
-NODESZ 20 + ufield ast.func.flags
-NODESZ ufield ast.const.value
-NODESZ ufield ast.ident.name
-NODESZ ufield ast.uop.opid
-NODESZ ufield ast.pop.opid
-NODESZ ufield ast.bop.opid
-NODESZ 'ufield ast.strlit.value
+NODESZ 12 + field ast.decl.address
+NODESZ field ast.func.name
+NODESZ 4 + field ast.func.sfsize
+NODESZ 8 + field ast.func.type
+NODESZ 12 + field ast.func.address
+NODESZ 16 + field ast.func.cursf \ last SF offset computed
+NODESZ 20 + field ast.func.flags
+NODESZ field ast.const.value
+NODESZ field ast.ident.name
+NODESZ field ast.uop.opid
+NODESZ field ast.pop.opid
+NODESZ field ast.bop.opid
+NODESZ &+ ast.strlit.value
ASTIDCNT stringlist astidnames
"declare" "unit" "function" "return" "constant" "stmts" "args" "ident"
"unaryop" "postop" "binop" "list" "if" "str" "call" "for" "push" "pop"
diff --git a/fs/cc/tree.fs b/fs/cc/tree.fs
@@ -10,11 +10,11 @@
\ ... maybe data
20 const NODESZ
-0 ufield nodeid
-4 ufield parentnode
-8 ufield firstchild
-12 ufield nextsibling
-16 ufield prevsibling
+0 field nodeid
+4 field parentnode
+8 field firstchild
+12 field nextsibling
+16 field prevsibling
: rootnode ( n -- n ) dup parentnode if parentnode rootnode then ;
\ iterate to the next node, descending into children before continuing to
diff --git a/fs/doc/code.txt b/fs/doc/code.txt
@@ -29,6 +29,9 @@ example, "?dup" is meant as "maybe dup".
? at the end of a word indicate a yes/no answer. For example, "ws?" means "is
it a whitespace?".
+# means "assert", meaning that an abort will take place in case of failure. For
+example, "findpath#" means "try to find specified path and abort if not found".
+
^ means "opposite order". For now, it's only used in "-^" as a shortcut to
"swap -". Maybe we'll drop this...
@@ -54,3 +57,6 @@ is an out- of bounds fetch. ")in 1- c@" fetches the last char of the buffer.
you aren't expected to call directly, but rather to compile in a special
context. For example, calling "(?br)" makes no sense. "(?br)" is compiled by
"if".
+
+& means "create doer" and is given to "does words" compilers. For example,
+"42 &+" means "create an adder with a 42 constant".
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -153,20 +153,15 @@ here const )fnbuf
\ Xb current cluster X=ClusterSize
10 const FCURSORCNT \ maximum number of opened files
: FCursorSize ClusterSize 44 + ;
-: FCUR_flags ( fcur -- n ) 20 + @ ;
+20 &+@ FCUR_flags 20 &+! FCUR_flags!
+24 &+@ FCUR_cluster 24 &+! FCUR_cluster!
+28 &+@ FCUR_clusteridx 28 &+! FCUR_clusteridx!
+36 &+@ FCUR_pos 36 &+! FCUR_pos!
+40 &+@ FCUR_size 40 &+! FCUR_size!
+44 &+ FCUR_buf(
: FCUR_free? ( fcur -- f ) FCUR_flags not ;
: FCUR_dirty? ( fcur -- f ) FCUR_flags 2 and ;
-: FCUR_flags! ( n fcur -- ) 20 + ! ;
-: FCUR_cluster ( fcur -- n ) 24 + @ ;
-: FCUR_cluster! ( n fcur -- ) 24 + ! ;
-: FCUR_clusteridx ( fcur -- n ) 28 + @ ;
-: FCUR_clusteridx! ( n fcur -- n ) 28 + ! ;
-: FCUR_pos ( fcur -- n ) 36 + @ ;
-: FCUR_pos! ( n fcur -- n ) 36 + ! ;
: FCUR_pos+ ( n fcur -- ) 36 + +! ;
-: FCUR_size ( fcur -- n ) 40 + @ ;
-: FCUR_size! ( n fcur -- ) 40 + ! ;
-: FCUR_buf( ( fcur -- a ) 44 + ;
: FCUR_)buf ( fcur -- a ) FCUR_buf( ClusterSize + ;
: FCUR_bufpos ( fcur -- a ) dup FCUR_pos ClusterSize mod swap FCUR_buf( + ;
: FCUR_dirent ( fcur -- dirent ) 32 + @ getdirentry ;
diff --git a/fs/lib/scratch.fs b/fs/lib/scratch.fs
@@ -10,9 +10,9 @@
\ The system scratchpad lives at sys/scratch.
struct Scratchpad
- field scratchsize
- field scratch>
- 'field scratch(
+ bfield scratchsize
+ bfield scratch>
+ 'bfield scratch(
0 value _here
diff --git a/fs/lib/struct.fs b/fs/lib/struct.fs
@@ -4,7 +4,7 @@
\ address in memory where offsets compared to this address are mapped to names.
\ Here's an example:
-\ struct Pos field pos.x field pos.y
+\ struct Pos bfield pos.x bfield pos.y
\ This structure will be 8 bytes in size, x maps to Pos+0, y maps to Pos+4.
\ But up until now, our Pos exists nowhere. This unit doesn't manage structure
@@ -21,31 +21,18 @@
\ Struct fields support the "to" semantics:
\ 54 to pos.x
+\ The "b" in "bfield" is for "bound".
+
0 value laststruct
0 value lastoffset
: struct 0 value current to laststruct 0 to lastoffset ;
-: field doer laststruct to' execute , lastoffset , 4 to+ lastoffset does>
+: bfield doer laststruct to' execute , lastoffset , 4 to+ lastoffset does>
dup @ @ swap 4 + @ + to? ?dup if execute else @ then ;
-\ A 'field returns the address of the field instead of the value. It doesn't
+\ A 'bfield returns the address of the field instead of the value. It doesn't
\ follow "to" semantics and does not increase struct size.
-: 'field doer laststruct to' execute , lastoffset , does>
+: 'bfield doer laststruct to' execute , lastoffset , does>
dup @ @ swap 4 + @ + ;
-
-\ Unbounded fields
-\ These works a bit like struct fields, but without an associated struct. In
-\ some cases, it makes more sense to have them instead of a full struct. Each
-\ invocation of them require the struct's address on the top of PS. They also
-\ support "to" semantics, but they are a bit awkward. Example:
-
-\ 4 ( offset ) ufield foo
-\ $1234 foo ( equivalent to $1238 @ )
-\ 42 $1234 to+ foo ( equivalent to 42 $1238 +! )
-
-: ufield ( off -- ) doer , does> ( a 'w )
- @ + to? ?dup if execute else @ then ;
-
-: 'ufield ( off -- ) doer , does> ( a 'w ) @ + ;
diff --git a/fs/tests/lib/struct.fs b/fs/tests/lib/struct.fs
@@ -3,7 +3,7 @@
testbegin
\ Testing lib/struct.fs
-struct Pos field pos.x field pos.y
+struct Pos bfield pos.x bfield pos.y
here to Pos 42 , 12 ,
pos.x 42 #eq
pos.y 12 #eq
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -63,6 +63,10 @@
: alias ' code compile (alias) , ;
: doer code compile (does) CELLSZ allot ;
: does> r> ( exit current definition ) current 5 + ! ;
+: &+ ( n -- ) doer , does> @ + ;
+: &+@ ( n -- ) doer , does> @ + @ ;
+: &+! ( n -- ) doer , does> @ + ! ;
+: field ( off -- ) doer , does> ( a 'w ) @ + to? ?dup if execute else @ then ;
\ while..repeat
: while [compile] if swap ; immediate
