commit e5b057a5be58fcbcb99a4fd1329d428360040dac
parent 58642b848d97cf227d1811c8c7d4c9bdf2d7fa02
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 1 Oct 2022 09:15:29 -0400
cc: code consolidation
Diffstat:
7 files changed, 41 insertions(+), 46 deletions(-)
diff --git a/fs/app/cos/cvm.c b/fs/app/cos/cvm.c
@@ -1,5 +1,4 @@
// This doesn't compile. It's a prototype of what it will look like.
-// TODO: typedefs
// TODO: function pointer arrays (iord iowr).
// TODO: += -= &= |= %
// TODO: %s %x (4b hex) %w (2b hex) %b (1b hex) formatting
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -79,30 +79,16 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 3 c, 3 c, 3 c, 3 c,
extends Node struct[ ASTNode
]struct
-0 const STORAGE_SF \ Stack frame (or struct offset)
-1 const STORAGE_PS \ Parameter Stack
-2 const STORAGE_MEM \ Fixed address in memory
-
extends ASTNode struct[ Declare
sfield ctype
- \ for variables and args, "address" is a frame offset
- sfield address
- sfield storage
: :new ( ctype -- node )
- AST_DECLARE ASTNode :new ( ctype node )
- swap ( ctype ) , 0 ( address ) , STORAGE_SF , ;
+ AST_DECLARE ASTNode :new ( ctype node ) swap ( ctype ) , ;
: :name ctype CType name ;
- : :isarg? ( dnode -- f ) storage STORAGE_PS = ;
- : :isglobal? ( dnode -- f ) storage STORAGE_MEM = ;
-
\ 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 ctype CType :size then ;
-
- : :address! ( addr self -- addr+size ) 2dup to address :totsize + ;
+ ctype CType :size ;
]struct
\ a node that contains Declare children (among others)
@@ -117,7 +103,7 @@ extends ASTNode struct[ Declarations
0 swap :lastchild begin ( off node )
?dup while
dup id AST_DECLARE = if
- tuck Declare :address! ( node off ) swap
+ tuck Declare ctype CType :offset! ( node off ) swap
then ( off node ) prevsibling repeat ( off )
drop ;
]struct
@@ -242,9 +228,7 @@ ASTIDCNT stringlist astidnames
: _] ']' emit ;
ASTIDCNT wordtbl astdatatbl ( node -- node )
-:w ( Declare ) _[
- dup Declare ctype CType :. spc>
- dup Declare address .x1 _] ;
+:w ( Declare ) _[ dup Declare ctype CType :. _] ;
'w noop ( Unit )
:w ( function ) _[
dup Function name stype spc>
@@ -435,7 +419,8 @@ current to parseExpression
FuncSig :new nextt ( snode tok )
dup S" )" s= if drop exit then
begin ( snode tok )
- parseType _assert over parseDeclare STORAGE_PS swap to Declare storage
+ parseType _assert over parseDeclare
+ STORAGE_PS swap Declare ctype to CType storage
nextt dup S" )" s= not while
',' expectChar nextt repeat ( snode tok ) drop ;
@@ -513,7 +498,7 @@ current to parseStatement
: parseGlobalDecl ( unitnode ctype -- )
Declare :new ( unode dnode ) dup rot Node :add ( dnode )
dup dup Declare :name addSymbol
- STORAGE_MEM over to Declare storage
+ STORAGE_MEM over Declare ctype to CType storage
nextt parseDeclareInit read; ;
\\ Parse the next element in a Unit node
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -116,33 +116,20 @@ BOPSCNT wordtbl bopgentblpost ( -- )
'w vm<<=,
'w vm>>=,
-: decl>op ( dnode -- )
- dup Node id AST_FUNCTION = if
- \ 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 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 ctype CType nbelem if vmop :&op then
- endcase ;
-
ASTIDCNT wordtbl gentbl ( node -- )
-:w ( Declare ) dup Declare :isglobal? if
- here over to Declare address
+:w ( Declare ) dup Declare ctype CType :isglobal? if
+ here over Declare ctype to CType offset
dup Declare :totsize allot
dup Node firstchild ?dup if Node id case ( dnode )
AST_CONSTANT of =
dup Node firstchild Constant value
- over Declare address !
+ over Declare ctype CType offset !
endof
endcase then drop
else ( node )
Node firstchild ?dup if ( assignnode )
dup gennode selop^ ( value in op^ )
- Node parent decl>op ( dst in op ) vmmov,
+ Node parent Declare ctype ctype>op ( dst in op ) vmmov,
then
then ;
'w genchildren ( Unit )
@@ -166,8 +153,13 @@ ASTIDCNT wordtbl gentbl ( node -- )
Node firstchild begin
?dup while dup gennode ops$ Node nextsibling repeat ( snode ) ;
'w drop ( ArgSpecs )
-:w ( Ident ) dup Ident :finddecl ?dup if ( inode dnode )
- nip decl>op else ( inode )
+:w ( Ident ) dup Ident :finddecl ?dup if ( inode dnode-or-fnode )
+ nip dup Node id AST_FUNCTION = if
+ \ 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
+ else Declare ctype ctype>op then
+ else ( inode )
Ident name sysdict @ find ?dup _assert TYPE_VOID to vmop type mem>op then ;
:w ( UnaryOp )
_debug if ." unaryop: " dup printast nl> .ops then
diff --git a/fs/cc/ttr.fs b/fs/cc/ttr.fs
@@ -49,7 +49,7 @@ ASTIDCNT wordtbl trtbl ( node -- )
'w trchildren ( Return )
'w drop ( Constant )
:w ( Statements ) dup Declarations :computeDeclAddrs trchildren ;
-:w ( ArgSpecs ) Declarations :computeDeclAddrs ;
+:w ( FuncSig ) Declarations :computeDeclAddrs ;
'w drop ( Ident )
:w ( UnaryOp )
dup >r trchildren
diff --git a/fs/cc/type.fs b/fs/cc/type.fs
@@ -35,6 +35,10 @@ $d const TYPE_INT*
$1c const TYPE_UINT
$1d const TYPE_UINT*
+0 const STORAGE_SF \ Stack frame (or struct offset)
+1 const STORAGE_PS \ Parameter Stack
+2 const STORAGE_MEM \ Fixed address in memory
+
4 stringlist typenames "void" "char" "short" "int"
: typeunsigned? ( type -- flags ) 4 rshift 1 and ;
: typesigned! ( type -- type ) $f and ;
@@ -65,15 +69,19 @@ struct[ CType
\ of the struct. First field is nexttype.
sfield offset \ offset, in bytes, of this element within its list
sfield nbelem \ number of elements in array. 0 if not an array.
+ sfield storage \ one of the STORAGE_* consts
SZ &+ name \ name associated with this type within its list.
: :new ( name type -- ctype )
- 0 align4 here rot> 0 , , 0 , 0 , 0 , s, ;
+ 0 align4 here rot> 0 , , 0 , 0 , 0 , STORAGE_SF , s, ;
: :struct? flags 1 and ;
+ : :isarg? ( dnode -- f ) storage STORAGE_PS = ;
+ : :isglobal? ( dnode -- f ) storage STORAGE_MEM = ;
\ Combined size of all fields in the LL.
: :size ( self -- size )
+ dup :isarg? if drop CELLSZ exit then
0 swap begin ( res ctype ) ?dup while
tuck dup type _typesize swap nbelem 1 max * +
swap llnext repeat ( res ) ;
@@ -81,11 +89,14 @@ struct[ CType
: :*arisz ( self -- n )
dup type swap nbelem if type*lvl+ then *ariunitsz ;
+ : :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 _ ;
: :. ( self -- ) >r
+ r@ offset if '+' emit r@ offset .x? spc> 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
diff --git a/fs/cc/vm/commonlo.fs b/fs/cc/vm/commonlo.fs
@@ -12,7 +12,7 @@
\ stored in the location. If, for example, we have a int* stored in a
\ VM_REGISTER, it's the exact equivalent of having an int stored in a
\ VM_*REGISTER. The number is the same.
-?f<< /cc/ast.fs
+?f<< /cc/type.fs
: _err abort" vm error" ;
: _assert not if _err then ;
@@ -103,3 +103,11 @@ vmop :self to vmop^ other
: sf+>op ( off -- ) noop# VM_*STACKFRAME to vmop loc to vmop arg ;
: ps+>op ( off -- ) noop# VM_*ARGSFRAME to vmop loc to vmop arg ;
: mem>op ( n -- ) noop# VM_*CONSTANT to vmop loc to vmop arg ;
+: ctype>op ( ctype -- )
+ dup CType type to vmop type ( ctype )
+ case
+ of CType :isglobal? r@ CType offset mem>op endof
+ of CType :isarg? r@ CType offset ps+>op endof
+ r@ CType offset sf+>op
+ r@ CType nbelem if vmop :&op then
+ endcase ;
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[2] }" #s=
+S" struct Struct1 { unsigned int foo, +04 short* bar, +08 char baz[2] }" #s=
\ Anonymous structs work too
current with-stdin< struct { int foo; } STOP typesize 4 #eq
