~vdupras/duskos

f68c6b8222cfe8a02d2f5192c54492bba7674a44 — Virgil Dupras 4 days ago 1ec00f2
Move ufields from lib/struct to bootlo, as "field"

Rename "field" in "lib/struct" to "bfield" (for "bounded field"). Add &+ &+@
and &+!.
M fs/cc/ast.fs => fs/cc/ast.fs +16 -16
@@ 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"

M fs/cc/tree.fs => fs/cc/tree.fs +5 -5
@@ 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

M fs/doc/code.txt => fs/doc/code.txt +6 -0
@@ 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".

M fs/fs/fatlo.fs => fs/fs/fatlo.fs +6 -11
@@ 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 ;

M fs/lib/scratch.fs => fs/lib/scratch.fs +3 -3
@@ 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


M fs/lib/struct.fs => fs/lib/struct.fs +6 -19
@@ 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 ) @ + ;

M fs/tests/lib/struct.fs => fs/tests/lib/struct.fs +1 -1
@@ 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

M fs/xcomp/bootlo.fs => fs/xcomp/bootlo.fs +4 -0
@@ 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