commit 9c8c7d2e25f0408809c4e01378fe6a5f0adcb3bb
parent a402716aa8db071e87f6af900a2dc35ad75ecbf7
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 23 Jun 2022 15:17:06 -0400
cc/tree: make node fields into lib/struct's ufields
Diffstat:
4 files changed, 24 insertions(+), 31 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -70,7 +70,6 @@ ASTIDCNT stringlist astidnames
0 value curunit \ points to current Unit, the beginning of the AST
-: astid ( node -- id ) nodeid $3f and ;
: idname ( id -- str ) astidnames slistiter ;
: _[ '[' emit ;
@@ -100,15 +99,15 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
: printast ( node -- )
?dup not if ." null" exit then
- dup astid dup AST_FUNCTION = if nl> then idname stype
- astdatatbl over astid wexec
+ dup nodeid dup AST_FUNCTION = if nl> then idname stype
+ astdatatbl over nodeid wexec
firstchild ?dup if
'(' emit begin
dup printast nextsibling dup if ',' emit then ?dup not until
')' emit then ;
-: newnode ( parent astid -- newnode )
+: newnode ( parent nodeid -- newnode )
createnode ( parent node ) dup rot addnode ( node ) ;
: _err ( -- ) abort" parsing error" ;
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -62,14 +62,14 @@ alias noop gennode ( node -- ) \ forward declaration
\ Multiply the value of "node" by a factor of "n"
\ TODO: support lvalues and expressions
: node*=n ( n node -- )
- dup astid case ( n node )
+ dup nodeid case ( n node )
AST_CONSTANT of = tuck ast.const.value * swap to ast.const.value endof
_err
endcase ;
\ Return the "pointer arithmetic size" of "node".
: node*arisz ( node -- n )
- dup astid AST_LVALUE = if ( node )
+ dup nodeid AST_LVALUE = if ( node )
lvvar vmap.decl ( dnode ) dup ast.decl.type ( dnode type )
swap ast.decl.nbelem ( nbelem ) 1 > if type*lvl+ then *ariunitsz ( n ) else
drop 1 then ;
@@ -86,7 +86,7 @@ alias noop gennode ( node -- ) \ forward declaration
\ Does node need 2 VM operands?
: needs2ops? ( node -- f )
- dup astid dup AST_BINARYOP = swap AST_FUNCALL = or if drop 1 exit then
+ dup nodeid dup AST_BINARYOP = swap AST_FUNCALL = or if drop 1 exit then
firstchild begin ?dup while dup needs2ops? not while nextsibling repeat
( needs2ops? == true ) drop 1 else ( end of children ) 0 then ;
@@ -203,5 +203,5 @@ ASTIDCNT wordtbl gentbl ( node -- )
( node ) ast.funcall.funcname ( name ) findfuncinmap ( mapfunc )
fmap.address vmcall>op1, ;
-: _ ( node -- ) gentbl over astid wexec ;
+: _ ( node -- ) gentbl over nodeid wexec ;
current to gennode
diff --git a/fs/cc/tree.fs b/fs/cc/tree.fs
@@ -2,8 +2,7 @@
\ The different parts of the C compiler that need a tree structure all use the
\ same memory layout, which is a series of nodes linked to each other:
-\ 1b type id
-\ 3b padding/reserved
+\ 4b type id
\ 4b addr of parent node (0 if root)
\ 4b addr of child node (0 if none)
\ 4b addr of next sibling (0 if none)
@@ -11,17 +10,12 @@
\ ... maybe data
20 const NODESZ
+0 ufield nodeid
+4 ufield parentnode
+8 ufield firstchild
+12 ufield nextsibling
+16 ufield prevsibling
-: nodeid ( node -- id ) c@ ;
-: nodeid! ( id node -- ) c! ;
-: 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 + ! ;
: rootnode ( n -- n ) dup parentnode if parentnode rootnode then ;
\ iterate to the next node, descending into children before continuing to
\ siblings. we stop when we reach the last child of "ref"
@@ -42,18 +36,18 @@
: 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 ( id -- node ) here >r c, 19 allot0 r> ;
+: createnode ( id -- node ) here >r , 16 allot0 r> ;
: addnode ( node parent -- )
- 2dup swap parentnode! ( node parent )
+ 2dup swap to parentnode ( node parent )
dup lastchild ?dup if ( n p lc ) \ add next to last child
- nip ( n lc ) 2dup nextsibling! swap prevsibling!
+ nip ( n lc ) 2dup to nextsibling swap to prevsibling
else \ add node as first child
- ( n p ) firstchild! then ;
+ ( n p ) to firstchild then ;
: removenode ( node -- )
dup parentnode firstchild over = if
- dup nextsibling over parentnode firstchild!
+ dup nextsibling over parentnode to firstchild
else
- dup nextsibling over prevsibling nextsibling! then
+ dup nextsibling over prevsibling to nextsibling then
dup nextsibling if
- dup prevsibling swap nextsibling prevsibling!
+ dup prevsibling swap nextsibling to prevsibling
else drop then ;
diff --git a/fs/tests/cc/ast.fs b/fs/tests/cc/ast.fs
@@ -5,10 +5,10 @@ testbegin
: _parse S" tests/cc/test.c" fopen >fd ['] f< to cc< parseast ;
_parse
-curunit firstchild dup astid AST_FUNCTION #eq ( fnode )
+curunit firstchild dup nodeid AST_FUNCTION #eq ( fnode )
dup ast.func.name S" retconst" s= #
-firstchild nextsibling dup astid AST_STATEMENTS #eq ( snode )
-firstchild dup astid AST_RETURN #eq ( rnode )
-firstchild dup astid AST_CONSTANT #eq ( cnode )
+firstchild nextsibling dup nodeid AST_STATEMENTS #eq ( snode )
+firstchild dup nodeid AST_RETURN #eq ( rnode )
+firstchild dup nodeid AST_CONSTANT #eq ( cnode )
ast.const.value 42 #eq
testend