commit 31290e5566ca67e9415a39c10e315047385b1ed3
parent ea6c69886642d5c8794702485900a222ef769736
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 3 Nov 2022 12:37:42 -0400
cc: code consolidation
Diffstat:
5 files changed, 26 insertions(+), 27 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -73,7 +73,7 @@ create bopsprectbl BOPSCNT nc,
3 const AST_RETURN
4 const AST_CONSTANT
5 const AST_STATEMENTS
-6 const AST_FUNCSIG \ function signature. each child is an argument
+\ 6 is unused
7 const AST_IDENT
8 const AST_UNARYOP
9 const AST_POSTFIXOP
@@ -140,10 +140,6 @@ extends ASTNode struct[ Declarations
nip Declare ctype exit then then
Node nextsibling repeat ( name ) drop 0 ;
-extends ASTNode struct[ FuncSig
- : :new ( -- node ) AST_FUNCSIG ASTNode :new ;
-]struct
-
extends ASTNode struct[ Function
sfield ctype \ the signature of the function.
sfield flags \ b0=static
@@ -156,12 +152,11 @@ extends ASTNode struct[ Function
( ctype ) _arena :, curstatic ( flags ) _arena :, ;
: name ctype CType name ;
- : :sig ( self -- anode ) firstchild dup id AST_FUNCSIG = _assert ;
- : :stmts ( self -- snode ) :sig nextsibling dup id AST_STATEMENTS = _assert ;
+ : :stmts ( self -- snode ) firstchild dup id AST_STATEMENTS = _assert ;
: :rettype ctype CType type ;
: :finddecl ( name self -- ctype-or-0 )
- 2dup :sig findDecl ?dup if nip nip else :stmts findDecl then ;
- : :argssize ( self -- size-in-bytes ) :sig Declarations :totsize ;
+ 2dup ctype CType :find ?dup if nip nip else :stmts findDecl then ;
+ : :argssize ( self -- size-in-bytes ) ctype CType :argssize ;
: :locsize ( self -- size-in-bytes ) :stmts Declarations :totsize ;
]struct
@@ -213,7 +208,7 @@ struct+[ ASTNode
dup Arrow name swap firstchild :type ( name type )
dup type*lvl 1 = _assert ( name type )
ctype' dup CType :struct? _assert ( name ctype )
- CType :find ( field-ctype ) CType :type endof
+ CType :find# ( field-ctype ) CType :type endof
drop TYPE_INT endcase ;
\ Return the "pointer arithmetic size" of "node".
@@ -275,7 +270,7 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
'w noop ( Return )
:w ( Constant ) _[ dup Constant value .x _] ;
'w noop ( Statements )
-'w noop ( FuncSig )
+'w noop ( unused )
:w ( Ident ) _[ dup Ident name stype _] ;
:w ( UnaryOp ) _[ dup Op opid uoptoken stype _] ;
:w ( PostfixOp ) _[ dup Op opid poptoken stype _] ;
@@ -438,15 +433,17 @@ current to parseExpression
parseExpression then
( dnode expr-or-list ) swap Node :add ;
-: parseFuncArgs ( -- signode )
+: _ ( parent-ctype tok -- offset )
+ parseType _assert parseVariable ( ctype newtype )
+ STORAGE_PS over to CType storage
+ tuck swap to CType nexttype ( newtype )
+ nextt dup S" )" s= if drop 0 swap CType :offset! else
+ ',' expectChar dup nextt _ ( ctype offset )
+ swap CType :offset! then ( offset ) ;
+
+: parseFuncArgs ( func-ctype -- )
\ First '(' is already parsed
- FuncSig :new nextt ( snode tok )
- dup S" )" s= if drop exit then
- begin ( snode tok )
- parseType _assert over parseDeclare
- STORAGE_PS swap Declare ctype to CType storage
- nextt dup S" )" s= not while
- ',' expectChar nextt repeat ( snode tok ) drop ;
+ nextt dup S" )" s= if 2drop exit then ( ctype tok ) _ drop ;
: parseDeclareStatement ( type parentnode -- )
2dup parseDeclare nextt parseDeclareInit ( type parentnode )
@@ -516,7 +513,7 @@ current to parseStatement
: parseFuncDef ( unitnode type name -- fnode )
Function :new ( unode fnode )
dup Function ctype over Function name addSymbol ( unode fnode )
- parseFuncArgs over Node :add ( unode fnode )
+ dup Function ctype parseFuncArgs ( unode fnode )
dup rot Node :add ( fnode ) dup parseStatement ;
: parseGlobalDecl ( unitnode ctype -- dnode )
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -167,7 +167,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
\ we run ops$ between each statement to discard any unused Result
Node firstchild begin
?dup while dup gennode$ Node nextsibling repeat ( snode ) ;
-'w drop ( ArgSpecs )
+'w _err ( unused )
:w ( Ident )
_ccdebug if ." ident: " dup printast nl> then
dup Ident :finddecl ?dup if ( inode ctype )
@@ -263,7 +263,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
dup Node firstchild dup _assert gennode Arrow name ( fieldname )
vmop type dup ctype? _assert dup type*lvl 1 = _assert ( name type )
ctype' dup CType :struct? _assert ( name ctype )
- CType :find ( field-ctype )
+ CType :find# ( field-ctype )
dup CType offset vm+n, vmop :*op ( field-ctype )
dup CType type to vmop type
CType nbelem if vmop :&op then ;
diff --git a/fs/cc/ttr.fs b/fs/cc/ttr.fs
@@ -62,7 +62,7 @@ ASTIDCNT wordtbl trtbl ( node -- )
'w trchildren ( Return )
'w drop ( Constant )
:w ( Statements ) dup Declarations :computeDeclAddrs trchildren ;
-:w ( FuncSig ) Declarations :computeDeclAddrs ;
+'w _err ( unused )
'w drop ( Ident )
:w ( UnaryOp )
dup >r trchildren
diff --git a/fs/cc/type.fs b/fs/cc/type.fs
@@ -87,12 +87,14 @@ struct[ CType
tuck dup type _typesize swap nbelem 1 max * +
swap llnext repeat ( res ) ;
+ : :argssize ( self -- size ) dup :funcsig? _assert llcnt 1- CELLSZ * ;
: :type ( self -- type ) dup type swap nbelem if type*lvl+ then ;
: :offset! ( off self -- off+size ) 2dup to offset :size + ;
- \ Find "name" in CType's LL. Error out if not found.
- : _ 2dup name s= if nip else llnext ?dup if _ else _err then then ;
- : :find ( name self -- ctype ) llnext _ ;
+ \ Find "name" in CType's LL. return 0 if not found
+ : _ 2dup name s= not if llnext dup if _ then then ;
+ : :find ( name self -- ctype-or-0 ) llnext dup if _ then nip ;
+ : :find# :find dup _assert ;
: _( case of :struct? ." {" endof
of :funcsig? ." (" endof
diff --git a/fs/tests/cc/ast.fs b/fs/tests/cc/ast.fs
@@ -6,7 +6,7 @@ testbegin
curunit Node firstchild dup Node id AST_FUNCTION #eq ( fnode )
dup Function name S" retconst" #s=
-Node firstchild Node nextsibling dup Node id AST_STATEMENTS #eq ( snode )
+Node firstchild dup Node id AST_STATEMENTS #eq ( snode )
Node firstchild dup Node id AST_RETURN #eq ( rnode )
Node firstchild dup Node id AST_CONSTANT #eq ( cnode )
Constant value 42 #eq
