commit daf1246ca14dd25b3fdaacde68b0142b6d8fa87e
parent c61cf0798d1a9a26577370697ff80fafb69912a8
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 30 Sep 2022 07:19:44 -0400
cc: code consolidation
Diffstat:
4 files changed, 43 insertions(+), 56 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -93,15 +93,15 @@ extends ASTNode struct[ Unit
2 const STORAGE_MEM \ Fixed address in memory
extends NamedNode struct[ Declare
- sfield type
- sfield nbelem
+ sfield ctype
\ for variables and args, "address" is a frame offset
sfield address
sfield storage
- : :new ( type name -- node )
- AST_DECLARE NamedNode :new ( type name node )
- rot ( type ) , 0 ( nbelem ) , 0 ( address ) , STORAGE_SF , tuck :storename ;
+ : :new ( ctype -- node )
+ AST_DECLARE NamedNode :new ( ctype node )
+ swap ( ctype ) , 0 ( address ) , STORAGE_SF ,
+ dup ctype CType name over to name ;
: :isarg? ( dnode -- f ) storage STORAGE_PS = ;
: :isglobal? ( dnode -- f ) storage STORAGE_MEM = ;
@@ -109,17 +109,9 @@ extends NamedNode struct[ Declare
\ Number of bytes required to hold this variable declaration in memory.
: :totsize ( dnode -- size-in-bytes )
dup :isarg? if drop CELLSZ \ always 4b in params
- else
- dup type ( dnode type )
- typesize swap nbelem ( nbelem )
- 1 max * then ;
+ else ctype CType :size then ;
: :address! ( addr self -- addr+size ) 2dup to address :totsize + ;
- : :parseNbelem ( tok self -- )
- over S" [" s= if ( tok self )
- nip nextt parse _assert nextt ']' expectChar ( nbelem ) swap to nbelem
- else drop to nexttputback then ;
-
]struct
\ a node that contains Declare children (among others)
@@ -205,8 +197,7 @@ struct+[ ASTNode
\ Return the "pointer arithmetic size" of "node".
: :*arisz ( self -- n )
dup id AST_IDENT = if ( self )
- Ident :finddecl ?dup _assert dup Declare type ( dnode type )
- swap Declare nbelem if type*lvl+ then *ariunitsz ( n ) else
+ Ident :finddecl ?dup _assert Declare ctype CType :*arisz else
drop 1 then ;
]struct
@@ -258,9 +249,7 @@ ASTIDCNT stringlist astidnames
ASTIDCNT wordtbl astdatatbl ( node -- node )
:w ( Declare ) _[
- dup Declare type printtype spc>
- dup Declare name stype
- dup Declare nbelem dup 1 > if _[ .x _] else drop then spc>
+ dup Declare ctype CType :. spc>
dup Declare address .x1 _] ;
'w noop ( Unit )
:w ( function ) _[
@@ -439,9 +428,8 @@ current to parseExpression
\ Parse a variable declaration from within a function
: parseDeclare ( type parentnode -- dnode )
- swap parseType* ( pnode type tok ) expectIdent ( pnode type name )
- Declare :new ( pnode dnode ) dup rot Node :add ( dnode )
- nextt over Declare :parseNbelem ;
+ swap parseVariable ( pnode ctype )
+ Declare :new ( pnode dnode ) dup rot Node :add ( dnode ) ;
: parseDeclareInit ( dnode tok -- )
dup S" =" s= not if to nexttputback drop exit then
@@ -527,10 +515,8 @@ current to parseStatements
swap parseFuncArgs over Node :add ( unode fnode )
dup rot Node :add ( fnode ) parseStatements ;
-\ type and name have already been parsed, parse the rest
-: parseGlobalDecl ( unitnode type name tok -- )
- >r Declare :new ( unode dnode ) dup rot Node :add ( dnode )
- r> over Declare :parseNbelem
+: parseGlobalDecl ( unitnode ctype -- )
+ Declare :new ( unode dnode ) dup rot Node :add ( dnode )
STORAGE_MEM over to Declare storage
nextt parseDeclareInit read; ;
@@ -540,14 +526,13 @@ current to parseStatements
0 to curstatic
dup S" static" s= if drop nextt 1 to curstatic then
parseType _assert ( unode type )
- parseType* ( unode type tok )
- dup ';' isChar? if \ Only a type on a line is fine, carry on
+ nextt dup ';' isChar? if \ Only a type on a line is fine, carry on
2drop drop exit then
- expectIdent ( unode type name ) nextt dup S" (" s= if
- drop parseFuncDef else parseGlobalDecl then ;
+ to nexttputback parseVariable ( unode ctype ) nextt dup S" (" s= if
+ drop dup CType type swap CType name parseFuncDef
+ else to nexttputback parseGlobalDecl then ;
: newparseunit ( -- unit ) AST_UNIT ASTNode :new dup to curunit ;
: parseast ( -- )
newparseunit
begin ( unode ) nextt? ?dup while over swap parseUnit repeat drop ;
-
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -121,12 +121,12 @@ BOPSCNT wordtbl bopgentblpost ( -- )
\ Sometimes, we get a Function as dnode. In these cases, it's a global
\ address and its type is "void"
TYPE_VOID to vmop type Function address mem>op exit then
- dup Declare type to vmop type ( dnode )
+ dup Declare ctype CType type to vmop type ( dnode )
case
of Declare :isglobal? r@ Declare address mem>op endof
of Declare :isarg? r@ Declare address ps+>op endof
r@ Declare address sf+>op
- r@ Declare nbelem if vmop :&op then
+ r@ Declare ctype CType nbelem if vmop :&op then
endcase ;
ASTIDCNT wordtbl gentbl ( node -- )
diff --git a/fs/cc/type.fs b/fs/cc/type.fs
@@ -5,6 +5,10 @@
: _err ( -- ) abort" type error" ;
: _assert ( f -- ) not if _err then ;
+\ Forward declaration implemented below
+alias _err _typesize ( type -- size-in-bytes )
+alias _err _printtype ( type -- )
+
\ All information related to a basic type fits in 1b, so that's how "type" is
\ passed around. Structure:
\ b1:0 = *lvl. Indirection levels, from 0 to 3.
@@ -43,11 +47,16 @@ create _ 0 c, 1 c, 2 c, 4 c,
: ctype? ( type -- f ) $ff > ;
: ctype' ( type -- ctype ) $fffffffc and ;
-: printType* ( type -- ) type*lvl begin ?dup while '*' emit 1- repeat ;
-
-\ Forward declaration implemented below
-alias _err _typesize ( type -- size-in-bytes )
-alias _err _printtype ( type -- )
+\ Returns the "pointer arithmetics unit size" for type, that is, the size of
+\ a "single element" in pointer arithmetics. This allows, for example, "ptr + 1"
+\ to generate "ptr + 4" in native code if "ptr" is a "int*".
+\ Pointers to pointers always return 4. Non-pointers always return 1. 1st level
+\ pointers return the size of the data they point to.
+: *ariunitsz ( type -- n ) dup type*lvl case
+ 0 of = drop 1 endof
+ 1 of = type*lvl- _typesize endof
+ drop 4
+ endcase ;
struct[ CType
sfield nexttype \ a CType is a Linked List
@@ -69,17 +78,19 @@ struct[ CType
tuck dup type _typesize swap nbelem 1 max * +
swap llnext repeat ( res ) ;
+ : :*arisz ( self -- n )
+ dup type swap nbelem if type*lvl+ then *ariunitsz ;
+
\ 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 _ ;
: :. ( self -- ) >r
- r@ flags if
- ." struct" r@ name c@ if spc> r@ name stype then ." { "
- r@ nexttype ?dup if :. then ." }"
- else
- r@ type _printtype r@ name c@ if spc> r@ name stype then
- r@ nexttype ?dup if ." , " :. then
+ r@ :struct? if ." struct" else r@ type _printtype then
+ r@ name c@ if spc> r@ name stype then
+ r@ nbelem if '[' emit r@ nbelem . ']' emit then
+ r@ :struct? if ." { " r@ nexttype ?dup if :. then ." }"
+ else r@ nexttype ?dup if ." , " :. then
then rdrop ;
]struct
@@ -91,6 +102,8 @@ create typedefs 0 , 0 c, \ this is a dict link
: findTypedef ( name -- type-or-0 ) typedefs find dup if @ then ;
: cctypes$ 0 typedefs ! ;
+: printType* ( type -- ) type*lvl begin ?dup while '*' emit 1- repeat ;
+
: printtype ( type -- )
dup ctype? if ctype' CType :. else
dup typeunsigned? if ." unsigned " then
@@ -111,17 +124,6 @@ current to _typesize
4 of = TYPE_INT endof
_err endcase ;
-\ Returns the "pointer arithmetics unit size" for type, that is, the size of
-\ a "single element" in pointer arithmetics. This allows, for example, "ptr + 1"
-\ to generate "ptr + 4" in native code if "ptr" is a "int*".
-\ Pointers to pointers always return 4. Non-pointers always return 1. 1st level
-\ pointers return the size of the data they point to.
-: *ariunitsz ( type -- n ) dup type*lvl case
- 0 of = drop 1 endof
- 1 of = type*lvl- typesize endof
- drop 4
- endcase ;
-
: parseType* ( type -- type tok )
begin nextt dup '*' isChar? while drop type*lvl+ repeat ;
diff --git a/fs/tests/cc/type.fs b/fs/tests/cc/type.fs
@@ -32,7 +32,7 @@ S" bar" over CType :find
\ once defined, parseType will find the struct in typedefs
current with-stdin< Struct1 STOP over #eq
capture printtype
-S" struct Struct1 { unsigned int foo, short* bar, char baz }" #s=
+S" struct Struct1 { unsigned int foo, short* bar, char baz[2] }" #s=
\ Anonymous structs work too
current with-stdin< struct { int foo; } STOP typesize 4 #eq
