commit a442db3cd24d490a0afb5946250b3b040aa05020
parent d140833201f383389c4f802113748baff60ee0d8
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 24 Sep 2022 14:30:46 -0400
cc: add the ability to declare structs in C code
I've temporarily removed the ability to use system struct, but that's coming
back...
Diffstat:
6 files changed, 80 insertions(+), 43 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -42,7 +42,7 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 3 c, 3 c, 3 c, 3 c,
: boptoken ( opid -- tok ) BOPTlist slistiter ;
\ AST node types
-22 const ASTIDCNT
+23 const ASTIDCNT
0 const AST_DECLARE
1 const AST_UNIT
2 const AST_FUNCTION
@@ -65,6 +65,7 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 3 c, 3 c, 3 c, 3 c,
19 const AST_WHILE
20 const AST_DO
21 const AST_ARROW
+22 const AST_STRUCT
extends Node struct[ ASTNode
]struct
@@ -125,8 +126,17 @@ extends Declarations struct[ Statements
: :funcbody? ( snode -- f ) Node parent Node id AST_FUNCTION = ;
]struct
-0 value curextern \ is current definition "extern"?
+\ Find, in a node that contains AST_DECLARE nodes, the first one with a matching
+\ name, or 0 if none is found.
+: findDecl ( name node -- dnode-or-0 )
+ Node firstchild begin ( name node )
+ ?dup while ( name node )
+ dup Node id AST_DECLARE = if
+ over over Declare name s= if ( name node )
+ nip exit then then
+ Node nextsibling repeat ( name ) drop 0 ;
+0 value curextern \ is current definition "extern"?
extends NamedNode struct[ Function
sfield type \ type of return value
sfield address
@@ -138,17 +148,9 @@ extends NamedNode struct[ Function
rot ( type ) , 0 ( address ) , 0 ( cursf ) ,
curextern ( flags ) , tuck :storename ;
- : _ ( name args-or-stmts -- dnode-or-0 )
- firstchild begin ( name node )
- ?dup while ( name node )
- dup id AST_DECLARE = if
- over over Declare name s= if ( name node )
- nip exit then then
- nextsibling repeat ( name ) drop 0 ;
-
: :finddecl ( name fnode -- dnode-or-0 )
- firstchild ( args ) 2dup _ ?dup if
- nip nip else nextsibling ( stmts ) _ then ;
+ firstchild ( args ) 2dup findDecl ?dup if
+ nip nip else nextsibling ( stmts ) findDecl then ;
: :args ( fnode -- anode )
firstchild dup id AST_ARGSPECS = _assert ;
@@ -194,6 +196,19 @@ struct+[ ASTNode
Ident :finddecl ?dup _assert dup Declare type ( dnode type )
swap Declare nbelem ( nbelem ) 1 > if type*lvl+ then *ariunitsz ( n ) else
drop 1 then ;
+
+ \ Given a "node" which is a container for Declare nodes, go through each of
+ \ them and set their respective "address" field to their proper offset in
+ \ their context
+ \ TODO: use this with Function too, not only for Struct
+ : :computeDeclAddrs ( node -- )
+ 0 swap firstchild begin ( off node )
+ ?dup while
+ dup id AST_DECLARE = if
+ 2dup to Declare address
+ tuck Declare :totsize + ( node off ) swap
+ then ( off node ) nextsibling repeat ( off )
+ drop ;
]struct
extends Op struct[ UnaryOp
@@ -222,7 +237,7 @@ extends Op struct[ BinaryOp
]struct
extends ASTNode struct[ StrLit
- ASTNode SZ &+ value
+ SZ &+ value
: :new AST_STRLIT ASTNode :new ;
]struct
@@ -232,10 +247,14 @@ extends NamedNode struct[ Arrow
: :parse ( -- node ) :new nextt over :storename ;
]struct
+extends NamedNode struct[ CStruct \ "Struct" clashes with bootlo
+ : :new 0 align4 AST_STRUCT NamedNode :new ;
+]struct
+
ASTIDCNT stringlist astidnames
"declare" "unit" "function" "return" "constant" "stmts" "args" "ident"
"unaryop" "postop" "binop" "list" "if" "str" "call" "for" "push" "pop" "break"
-"while" "do" "arrow"
+"while" "do" "arrow" "struct"
: idname ( id -- str ) astidnames slistiter ;
@@ -272,6 +291,7 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
'w noop ( While )
'w noop ( Do )
:w ( Arrow ) _[ dup Arrow name stype _] ;
+:w ( Struct ) _[ dup CStruct name stype _] ;
: printast ( node -- )
?dup not if ." null" exit then
@@ -286,7 +306,6 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
: newnode ( parent nodeid -- newnode )
ASTNode :new ( parent node ) dup rot Node :add ( node ) ;
-: expectType ( tok -- type ) parseType not if _err then ( type ) ;
: expectConst ( tok -- n ) dup parse if nip else _err then ;
: isIdent? ( tok -- f )
dup 1+ c@ identifier1st? not if drop 0 exit then
@@ -434,6 +453,15 @@ current to parseFactor
( node tok ) to nexttputback ;
current to parseExpression
+: parseType ( tok -- type? f )
+ dup S" struct" s= if
+ drop nextt dup Unit :find ?dup if
+ dup Node id AST_STRUCT = _assert nip
+ else abort" TODO" then ( struct' )
+ dup type*lvl not _assert 1
+ else parseIntType then ;
+
+: expectType ( tok -- type ) parseType not if _err then ( type ) ;
: parseType* ( type -- type tok )
begin nextt dup S" *" s= while drop type*lvl+ repeat ;
@@ -526,21 +554,29 @@ alias noop parseStatements ( funcnode -- ) \ forward declaration
nextt repeat ( snode tok ) 2drop ;
current to parseStatements
+: parseStruct ( unitnode -- )
+ CStruct :new dup rot Node :add ( snode )
+ nextt expectIdent over CStruct :storename nextt '{' expectChar
+ begin ( snode ) nextt dup '}' isChar? not while ( snode tok )
+ expectType over parseDeclareStatement repeat ( snode tok )
+ 2drop read; ;
+
\\ Parse the next element in a Unit node
: parseUnit ( unitnode tok -- )
dup S" #[" s= if drop #[0 drop exit then
0 to curextern
dup S" extern" s= if drop nextt 1 to curextern then
- parseType _assert ( unode type ) parseType* ( unode type tok )
- expectIdent ( unode type name ) nextt case ( unode type name )
- S" (" of s=
- Function :new ( unode fnode ) dup rot Node :add ( fnode )
- dup parseArgSpecs parseStatements
- endof
- Declare :new ( unode dnode ) dup rot Node :add ( dnode )
- r@ parseNbelem over to Declare nbelem
- nextt parseDeclareInit read;
- endcase ( ) ;
+ dup S" struct" s= if drop parseStruct else
+ parseType _assert ( unode type ) parseType* ( unode type tok )
+ expectIdent ( unode type name ) nextt case ( unode type name )
+ S" (" of s=
+ Function :new ( unode fnode ) dup rot Node :add ( fnode )
+ dup parseArgSpecs parseStatements
+ endof
+ Declare :new ( unode dnode ) dup rot Node :add ( dnode )
+ r@ parseNbelem over to Declare nbelem
+ nextt parseDeclareInit read;
+ endcase then ( ) ;
: newparseunit ( -- unit ) AST_UNIT ASTNode :new dup to curunit ;
: parseast ( -- )
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -259,9 +259,10 @@ ASTIDCNT wordtbl gentbl ( node -- )
:w ( Arrow )
dup Node firstchild dup _assert gennode
vmop type dup typestruct? _assert type*lvl 1 = _assert ( arrownode )
- Arrow name vmop type typestruct' structdict' find dup _assert
- does' ( sfield' ) dup Field offset vmop^ :>const vmadd, vmop :*op ( sfield' )
- Field size inttypeofsize to vmop type ;
+ Arrow name vmop type typestruct' findDecl ( dnode )
+ dup Declare address vmop^ :>const vmadd, vmop :*op ( dnode )
+ Declare type to vmop type ;
+'w drop ( Struct )
: _ ( node -- ) gentbl over Node id wexec ;
current to gennode
diff --git a/fs/cc/ttr.fs b/fs/cc/ttr.fs
@@ -79,6 +79,7 @@ ASTIDCNT wordtbl trtbl ( node -- )
'w trchildren ( While )
'w trchildren ( Do )
'w drop ( Arrow )
+:w ( Struct ) CStruct :computeDeclAddrs ;
: _ ( node -- ) trtbl over Node id wexec ;
current to trnode
diff --git a/fs/cc/type.fs b/fs/cc/type.fs
@@ -1,6 +1,5 @@
\ C compiler types
?f<< lib/str.fs
-?f<< lib/meta.fs
?f<< cc/tok.fs
: _err ( -- ) abort" type error" ;
@@ -66,18 +65,12 @@ create _ 0 c, 1 c, 2 c, 4 c,
\ Unlike ANSI C, "signed" doesn't exist and "unsigned" needs to be before the
\ type name. '*' are not parsed because they are sometimes attached to the
\ variable rather than the type specifier.
-: parseType ( tok -- type? f )
- dup S" struct" s= if
- drop nextt sysdict @ find ?dup _assert dup type*lvl not _assert 1
- else
- dup S" unsigned" s= if drop $10 nextt else $00 swap then ( type tok )
- typenames sfind dup 0>= if
- ( type idx ) << << or 1 else 2drop 0 then then ;
+: parseIntType ( tok -- type? f )
+ dup S" unsigned" s= if drop $10 nextt else $00 swap then ( type tok )
+ typenames sfind dup 0>= if ( type idx ) << << or 1 else 2drop 0 then ;
: printtype ( type -- )
- dup typestruct? if
- ." struct " dup $fffffffc and wordname[] rtype
- else
+ dup typestruct? if ." struct" else
dup typeunsigned? if ." unsigned " then
dup >> >> 3 and typenames slistiter stype then
type*lvl ?dup if >r begin '*' emit next then ;
diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs
@@ -55,8 +55,8 @@ S" foobar" dup 6 'X' set8b S" foobaX" #s=
5 whilesum 15 #eq
5 dowhilesum 15 #eq
42 unaryopmut 42 #eq
-create mydata 12 , 42 ,
-mydata structget 42 #eq
+create mydata 42 , $12345678 , $23456789 ,
+mydata structget $5678 #eq
2 3 binop1 1 #eq
'2' binop2 44 #eq
diff --git a/fs/tests/cc/test.c b/fs/tests/cc/test.c
@@ -207,8 +207,14 @@ extern int unaryopmut(int n) {
return n;
}
-extern int structget(struct Field *f) {
- return f->size;
+struct MyStruct {
+ int foo;
+ short bar;
+ char baz;
+};
+
+extern short structget(struct MyStruct *s) {
+ return s->bar;
}
// Below this comment are simple construct that were buggy before
extern int binop1(int a, int b) {
