commit 285b196071ed76ffbeae8d7b936c90d4cb2a9f1d
parent a0bf382be10b3cda1210a826543c88a2f683839c
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 10 Jun 2022 13:44:37 -0400
cc: remove the "child slots" concept from tree.fs
It's not needed any more.
Diffstat:
4 files changed, 31 insertions(+), 42 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -101,12 +101,12 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
: newnode ( parent astid -- newnode )
- -1 swap createnode ( parent node ) dup rot addnode ( node ) ;
+ createnode ( parent node ) dup rot addnode ( node ) ;
\ AST nodes
: Declare ( parent name -- node )
swap AST_DECLARE newnode swap , ;
-: Unit ( -- node ) -1 AST_UNIT createnode dup to curunit ;
+: Unit ( -- node ) AST_UNIT createnode dup to curunit ;
: Function ( unitnode name -- node )
swap AST_FUNCTION newnode swap , 0 , ;
: Statements ( funcnode -- node ) AST_STATEMENTS newnode ;
@@ -135,11 +135,11 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
: parseFactor ( tok -- node nexttok )
dup isIdent? if \ Variable or FunCall
_nextt ( prevtok newtok ) dup S" (" s= if \ FunCall
- drop 0 AST_FUNCALL createnode swap , _nextt ')' expectChar _nextt
+ drop AST_FUNCALL createnode swap , _nextt ')' expectChar _nextt
else \ Variable
- swap ( newtok prevtok ) 0 AST_VARIABLE createnode swap , swap then
+ swap ( newtok prevtok ) AST_VARIABLE createnode swap , swap then
else \ Constant
- expectConst 0 AST_CONSTANT createnode swap , _nextt then ;
+ expectConst AST_CONSTANT createnode swap , _nextt then ;
\ An expression can be 3 things:
\ 1. a factor
@@ -147,19 +147,19 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
\ 3. A binaryop containing two expressions.
: parseExpression ( tok -- exprnode nexttok )
dup uopid if ( tok uopid )
- nip -1 AST_UNARYOP createnode ( uopid node ) swap , ( node )
+ nip AST_UNARYOP createnode ( uopid node ) swap , ( node )
_nextt parseExpression ( uopnode expr tok )
rot> over addnode swap ( node tok )
else ( tok ) \ binaryop or factor
\ tok is expected to be a factor
parseFactor ( factor nexttok )
dup bopid if ( factor tok binop )
- nip ( factor binop ) -1 AST_BINARYOP createnode swap , ( factor node )
+ nip ( factor binop ) AST_BINARYOP createnode swap , ( factor node )
tuck addnode _nextt ( binnode tok )
\ now, let's consume tokens as long as we have binops coming.
begin ( bn tok )
parseFactor ( bn factor tok ) dup bopid if ( bn fn tok bopid )
- nip -1 AST_BINARYOP createnode swap , ( bn1 fn bn2 )
+ nip AST_BINARYOP createnode swap , ( bn1 fn bn2 )
\ another binop! who will get fn? bn1 or bn2? the one that has the
\ best precedence!
rot ( fn bn2 bn1 ) over data1 bopprec over data1 bopprec < if
@@ -180,7 +180,7 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
: parseDeclare ( parentnode tok -- )
'=' expectChar
- -1 AST_ASSIGN createnode ( pnode anode ) over data1 ( name ) ,
+ AST_ASSIGN createnode ( pnode anode ) over data1 ( name ) ,
dup rot addnode ( anode )
_nextt parseExpression ';' expectChar ( anode expr ) swap addnode ;
@@ -200,7 +200,7 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
begin ( snode tok )
dup S" }" s= if 2drop exit then
dup S" return" s= if
- drop -1 AST_RETURN createnode ( snode rnode ) 2dup swap addnode
+ drop AST_RETURN createnode ( snode rnode ) 2dup swap addnode
_nextt parseExpression ';' expectChar ( snode rnode expr )
swap addnode ( snode )
else
diff --git a/fs/cc/map.fs b/fs/cc/map.fs
@@ -19,12 +19,12 @@ create mapidnames 4 c, ," unit" 8 c, ," function" 3 c, ," var"
: _err ( -- ) abort" mapping error" ;
: newnode
- createnode dup activenode addnode ( node )
- dup nodeclosed? not if to activenode else drop then ;
+ createnode dup activenode addnode ( node ) to activenode ;
-: Unit ( -- ) -1 MAP_UNIT createnode dup to curmap to activenode ;
-: Function ( name -- ) -1 MAP_FUNCTION newnode , 0 , 0 , 0 , ;
-: Variable ( offset name -- ) 0 MAP_VARIABLE newnode , , ;
+: Unit ( -- ) MAP_UNIT createnode dup to curmap to activenode ;
+: Function ( name -- ) MAP_FUNCTION newnode , 0 , 0 , 0 , ;
+: Variable ( offset name -- )
+ MAP_VARIABLE createnode activenode addnode , , ;
: _[ '[' emit ;
: _] ']' emit ;
diff --git a/fs/cc/tree.fs b/fs/cc/tree.fs
@@ -3,8 +3,7 @@
\ same memory layout, which is a series of nodes linked to each other:
\ 1b type id
-\ 1b reserved
-\ 1b child slots
+\ 3b padding/reserved
\ 4b addr of parent node (0 if root)
\ 4b addr of child node (0 if none)
\ 4b addr of next sibling (0 if none)
@@ -18,21 +17,15 @@
: nodeid ( node -- id ) c@ ;
: nodeid! ( id node -- ) c! ;
-: cslots ( node -- slots ) 1+ 1+ c@ ;
-: cslots! ( slots node -- ) 1+ 1+ c! ;
-: cslots- ( node -- ) dup cslots 1- swap cslots! ;
-: cslots+ ( node -- ) dup cslots 1+ swap cslots! ;
-: closenode ( node -- ) 0 swap cslots! ;
-: nodeclosed? ( node -- f ) cslots not ;
-: parentnode ( node -- parent ) 3 + @ ;
-: parentnode! ( parent node -- ) 3 + ! ;
-: firstchild ( node -- child ) 7 + @ ;
-: firstchild! ( child node -- ) 7 + ! ;
-: nextsibling ( node -- next ) 11 + @ ;
-: nextsibling! ( next node -- ) 11 + ! ;
-: prevsibling ( node -- prev ) 15 + @ ;
-: prevsibling! ( prev node -- ) 15 + ! ;
-: 'data ( node -- 'data ) 19 + ;
+: parentnode ( node -- parent ) 4 + @ ;
+: parentnode! ( parent node -- ) 4 + ! ;
+: firstchild ( node -- child ) 8 + @ ;
+: firstchild! ( child node -- ) 8 + ! ;
+: nextsibling ( node -- next ) 12 + @ ;
+: nextsibling! ( next node -- ) 12 + ! ;
+: prevsibling ( node -- prev ) 16 + @ ;
+: prevsibling! ( prev node -- ) 16 + ! ;
+: 'data ( node -- 'data ) 20 + ;
: data1 ( node -- n ) 'data @ ;
: data1! ( n node -- ) 'data ! ;
: data2 ( node -- n ) 'data 4 + @ ;
@@ -61,16 +54,14 @@
: nodedepth ( node -- n ) firstchild ?dup if nodedepth 1+ else 0 then ;
: childcount ( node -- n )
0 swap firstchild ?dup if begin swap 1+ swap nextsibling ?dup not until then ;
-: createnode ( slots id -- node ) here >r c, 0 c, c, 16 allot0 r> ;
+: createnode ( id -- node ) here >r c, 19 allot0 r> ;
: addnode ( node parent -- )
- dup nodeclosed? if abort" node is closed" then
- 2dup swap parentnode! dup cslots- ( node parent )
+ 2dup swap parentnode! ( node parent )
dup lastchild ?dup if ( n p lc ) \ add next to last child
nip ( n lc ) 2dup nextsibling! swap prevsibling!
else \ add node as first child
( n p ) firstchild! then ;
: removenode ( node -- )
- dup parentnode cslots+
dup parentnode firstchild over = if
dup nextsibling over parentnode firstchild!
else
diff --git a/fs/tests/cctree.fs b/fs/tests/cctree.fs
@@ -3,11 +3,10 @@ f<< cc/tree.fs
testbegin
\ C compiler tree unit
-2 1 createnode value n1
+1 createnode value n1
n1 nodeid 1 #eq
-n1 nodeclosed? not #
--1 2 createnode value n2
+2 createnode value n2
n2 n1 addnode
n2 nodeid 2 #eq
n2 parentnode n1 #eq
@@ -16,7 +15,7 @@ n2 prevsibling 0 #eq
n2 firstchild 0 #eq
n1 firstchild n2 #eq
-0 3 createnode 42 , value n3
+3 createnode 42 , value n3
n3 n1 addnode
n3 nodeid 3 #eq
n3 'data @ 42 #eq
@@ -25,10 +24,9 @@ n3 nextsibling 0 #eq
n3 prevsibling n2 #eq
n3 firstchild 0 #eq
n1 firstchild n2 #eq
-n1 nodeclosed? #
n1 lastchild n3 #eq
-0 4 createnode value n4
+4 createnode value n4
n4 n2 addnode
n4 nodeid 4 #eq
n4 parentnode n2 #eq
