~vdupras/duskos

9c8c7d2e25f0408809c4e01378fe6a5f0adcb3bb — Virgil Dupras 2 days ago a402716
cc/tree: make node fields into lib/struct's ufields
4 files changed, 24 insertions(+), 31 deletions(-)

M fs/cc/ast.fs
M fs/cc/gen.fs
M fs/cc/tree.fs
M fs/tests/cc/ast.fs
M fs/cc/ast.fs => fs/cc/ast.fs +3 -4
@@ 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" ;

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

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

M fs/tests/cc/ast.fs => fs/tests/cc/ast.fs +4 -4
@@ 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