commit ab47412710686cf4608a96559bfcdc7a1c9d75df
parent c387d55843c5ddacde83b66f718fb1161be31af9
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 21 Mar 2023 13:18:57 -0400
halcc: begin type reform
Since I'm rewriting the thing, I might as well fix CType at the same time.
My first design doesn't model the space well and ends up being unnecessarily
complex. Let's try something new.
Diffstat:
10 files changed, 135 insertions(+), 179 deletions(-)
diff --git a/fs/comp/c/cc.fs b/fs/comp/c/cc.fs
@@ -13,11 +13,7 @@
: :c cctok$ nextt cparse ;
: calias
- cctok$ ' nextt parseType _assert parseDeclarator ( w ctype )
- read; dup addSymbol to CType offset ;
+ cctok$ ' nextt parseType _assert parseDeclarator ( w cdecl )
+ read; dup addSymbol to CDecl offset ;
: cc<< ( -- ) ['] cc1, word with-stdin-file ;
-
-:c typedef unsigned char uchar ;
-:c typedef unsigned short ushort ;
-:c typedef unsigned int uint ;
diff --git a/fs/comp/c/egen.fs b/fs/comp/c/egen.fs
@@ -47,16 +47,16 @@ UOPSCNT wordtbl _tbl ( res -- res )
\ need to restore psoff to its initial level *without actually adjusting*
\ because it's the callee's responsibility to free its arguments.
: _funcall ( res -- res ) psoff dup >r >r \ V1=psinitlvl V2=pslvl
- dup Result :isctype? _assert ')' readChar? not if begin ( funcres tok )
+ dup Result :iscdecl? _assert ')' readChar? not if begin ( funcres tok )
parseExpression Result :?>W
psoff V2 - ?dup if dup ps+, neg to+ psoff then CELLSZ to+ V2
',' readChar? while nextt repeat ')' expectChar then ( funcres )
- dup Result :ctype# dup CType :funcsig? if
- nip dup CType offset execute,
- else abort" TODO: dynamic calls" then ( ctype )
+ dup Result :cdecl# dup CDecl :funcsig? if
+ nip dup CDecl offset execute,
+ else abort" TODO: dynamic calls" then ( cdecl )
rdrop r> ( psinitlvl ) to psoff
Result currentW ?dup if PS- Result :release then
- CType type if PS+ Result :W else Result :none then ;
+ CDecl type typesize if PS+ Result :W else Result :none then ;
: _incdec, ( res incsz -- res )
swap bi+ Result :hal# | Result :?>W ( incsz res halop ) rot swap [+n], ;
@@ -110,7 +110,7 @@ UOPSCNT wordtbl _tbl ( res -- res )
of uopid ( opid )
nextt parseFactor ( opid res ) _tbl rot wexec endof
of isIdent? \ lvalue, FunCall or macro
- r@ findIdent ?dup _assert Result :ctype parsePostfixOp endof
+ r@ findIdent ?dup _assert Result :cdecl parsePostfixOp endof
r@ parse if Result :const else _err then
endcase ;
current ' parseFactor realias
diff --git a/fs/comp/c/expr.fs b/fs/comp/c/expr.fs
@@ -10,7 +10,7 @@ struct[ Result
0 const NONE \ Nothing (probably a released W)
1 const CONST \ Is a constant (value in arg)
2 const W \ Value in W register
- 3 const CTYPE \ CType pointer is in arg.
+ 3 const CDECL \ CDecl pointer is in arg.
4 const PS \ Result pushed to PS, offset in arg
sfield type
sfield arg
@@ -25,13 +25,13 @@ struct[ Result
: :none ( -- res ) 0 NONE :new ;
: :const ( n -- res ) CONST :new ;
: :W ( -- res ) :Wfree# 0 W :new dup to currentW ;
- : :ctype ( ctype -- res ) CTYPE :new ;
+ : :cdecl ( cdecl -- res ) CDECL :new ;
: :isW? ( self -- f ) type W = ;
: :release ( self -- ) dup :isW? if 0 to currentW then NONE swap to type ;
: :hal# ( self -- halop ) dup type case ( self )
CONST of = arg i) endof
- CTYPE of = arg CType :halop endof
+ CDECL of = arg CDecl :halop endof
PS of = arg PSP+) endof
abort" :hal# error" endcase ;
: :>W ( self -- )
@@ -44,8 +44,8 @@ struct[ Result
: :iszero? bi arg 0 = | :isconst? and ;
: :isone? bi arg 1 = | :isconst? and ;
: :const# dup :isconst? _assert arg ;
- : :isctype? ( self -- f ) type CTYPE = ;
- : :ctype# dup :isctype? _assert arg ;
+ : :iscdecl? ( self -- f ) type CDECL = ;
+ : :cdecl# dup :iscdecl? _assert arg ;
: :>PS dup :>W$ dup, PS+ PS over to type psoff neg swap to arg ;
: :?freeCurrentW ( -- ) currentW ?dup if :>PS then ;
: :?>W dup :isW? if drop else :?freeCurrentW :>W then ;
@@ -56,7 +56,7 @@ struct[ Result
: :* ( self -- ) 1 swap to+ lvl ;
: :& ( self -- )
dup lvl if -1 swap to+ lvl else
- :?freeCurrentW dup :ctype# CType :halop lea, W swap to type then ;
+ :?freeCurrentW dup :cdecl# CDecl :halop lea, W swap to type then ;
]struct
BOPSCNT wordtbl _tbl ( a b -- n )
diff --git a/fs/comp/c/fgen.fs b/fs/comp/c/fgen.fs
@@ -8,8 +8,8 @@
: _assert ( f -- ) not if _err then ;
: _postlude
- _curfunc CType :argssize ?dup if ps+, then
- _locvars CType :size ?dup if rs+, then ;
+ _curfunc CDecl :argssize ?dup if ps+, then
+ _locvars CDecl :size ?dup if rs+, then ;
alias noop parseStatement ( tok -- ) \ forward declaration
@@ -52,49 +52,49 @@ current ' parseStatement realias
0 value _initcode
: parseDeclLine ( type -- )
- parseDeclarator ( ctype )
- dup _locvars ?dup if CType :append else to _locvars then begin ( ctype )
- '=' readChar? if ( ctype )
+ parseDeclarator ( cdecl )
+ dup _locvars ?dup if CDecl :append else to _locvars then begin ( cdecl )
+ '=' readChar? if ( cdecl )
_initcode not if here to _initcode then
- nextt parseExpression ( ctype res )
- Result :>W$ dup CType :halop !, psneutral nextt then ( ctype tok )
- dup ';' isChar? not while ( ctype tok )
- ',' expectChar CType type parseDeclarator ( ctype )
- dup _locvars CType :append repeat ( ctype tok ) 2drop ;
+ nextt parseExpression ( cdecl res )
+ Result :>W$ dup CDecl :halop !, psneutral nextt then ( cdecl tok )
+ dup ';' isChar? not while ( cdecl tok )
+ ',' expectChar CDecl type parseDeclarator ( cdecl )
+ dup _locvars CDecl :append repeat ( cdecl tok ) 2drop ;
-\ Given a ctype for a function body that has a proper offset field, but that
+\ Given a cdecl for a function body that has a proper offset field, but that
\ hasn't been added to the symbol list yet, check if we have a prototype in the
\ symbols that correspond to this function. If yes, update the jump of that
\ prototype.
-: ?updateFunctionPrototype ( ctype -- )
- dup CType name findSymbol ?dup if
- dup CType :funcsig? over CType :incomplete? and if ( ctype found )
- CType offset to@! here >r ( ctype )
- dup CType offset branch, drop r> to here ( ctype )
- else drop then then ( ctype ) drop ;
+: ?updateFunctionPrototype ( cdecl -- )
+ dup CDecl name findSymbol ?dup if
+ dup CDecl :funcsig? over CDecl :incomplete? and if ( cdecl found )
+ CDecl offset to@! here >r ( cdecl )
+ dup CDecl offset branch, drop r> to here ( cdecl )
+ else drop then then ( cdecl ) drop ;
\ '{' is already parsed
-: parseFunctionBody ( ctype -- )
+: parseFunctionBody ( cdecl -- )
0 to _locvars 0 to _initcode to _curfunc _litarena :reserve ( )
STORAGE_SF to@! curstorage >r
begin nextt dup parseType while ( tok type ) nip parseDeclLine repeat ( tok )
to nexttputback r> to curstorage
_initcode if [compile] ahead >r then
- _curfunc CType :static? not if sysdict _curfunc CType name entry then ( )
- here _curfunc to CType offset ( )
+ _curfunc CDecl :static? not if sysdict _curfunc CDecl name entry then ( )
+ here _curfunc to CDecl offset ( )
_curfunc ?updateFunctionPrototype _curfunc addSymbol
\ prelude: space for stack frame. "dup," is wiggle room for W
- dup, _locvars CType :size ?dup if neg rs+, then
+ dup, _locvars CDecl :size ?dup if neg rs+, then
_initcode ?dup if [compile] again r> [compile] then then
0 to _laststmtid parseStatements
_laststmtid 1 <> if emitNullRet then \ emit implicit return if needed
0 to _curfunc ;
-: parseFunctionProto ( ctype tok -- )
+: parseFunctionProto ( cdecl tok -- )
';' expectChar dup addSymbol curstatic if
- dup CType :incomplete! here ['] _err branch, drop
+ dup CDecl :incomplete! here ['] _err branch, drop
\ allot a little extra space in case the replacement jump is wider
CELLSZ allot
- else dup CType name sysdict @ find ?dup not if
- CType name stype abort" not found" then then ( ctype addr )
- swap to CType offset ;
+ else dup CDecl name sysdict @ find ?dup not if
+ CDecl name stype abort" not found" then then ( cdecl addr )
+ swap to CDecl offset ;
diff --git a/fs/comp/c/func.fs b/fs/comp/c/func.fs
@@ -1,10 +1,10 @@
\ Function metadata
?f<< /comp/c/type.fs
-0 value _curfunc \ ctype of the current function (includes arguments)
-0 value _locvars \ the root ctype of local variables for current function
+0 value _curfunc \ cdecl of the current function (includes arguments)
+0 value _locvars \ the root cdecl of local variables for current function
-: findIdent ( name -- ctype-or-0 )
- _curfunc if dup _curfunc CType :find ?dup if nip exit then then ( name )
- dup _locvars if to' _locvars CType :find else drop 0 then ( name ctype-or-0 )
+: findIdent ( name -- cdecl-or-0 )
+ _curfunc if dup _curfunc CDecl :find ?dup if nip exit then then ( name )
+ dup _locvars if to' _locvars CDecl :find else drop 0 then ( name cdecl-or-0 )
?dup if nip else findSymbol then ;
diff --git a/fs/comp/c/gen.fs b/fs/comp/c/gen.fs
@@ -19,13 +19,13 @@ require /sys/scratch.fs
: parseGlobalDecl ( ctype -- )
dup addSymbol
- dup CType :static? not if \ not static
- dup CType name NEXTWORD ! create then ( ctype )
- here over to CType offset ( ctype )
+ dup CDecl :static? not if \ not static
+ dup CDecl name NEXTWORD ! create then ( ctype )
+ here over to CDecl offset ( ctype )
'=' readChar? if ( ctype ) abort" TODO"
- else to nexttputback dup CType :size allot then ( ctype )
+ else to nexttputback dup CDecl :size allot then ( ctype )
',' readChar? if
- CType type parseDeclarator parseGlobalDecl
+ CDecl type parseDeclarator parseGlobalDecl
else ';' expectChar drop then ;
\ Begin parsing incoming tokens for a new "element" (a function or a
@@ -38,12 +38,12 @@ require /sys/scratch.fs
';' readChar? if \ Only a type on a line is fine, carry on
drop exit then to nexttputback
parseDeclarator ( ctype )
- curstatic if dup CType :static! then
+ curstatic if dup CDecl :static! then
_ccdebug if ." parsing: " dup printtype nl> then
- dup CType :funcsig? if ( ctype )
+ dup CDecl :funcsig? if ( ctype )
'{' readChar? if dup parseFunctionBody
_ccdebug if
- ." complete: " dup printtype nl> CType offset here over - spit nl>
+ ." complete: " dup printtype nl> CDecl offset here over - spit nl>
else drop then
else parseFunctionProto then
else parseGlobalDecl then ( ) ;
diff --git a/fs/comp/c/ptype.fs b/fs/comp/c/ptype.fs
@@ -6,7 +6,7 @@
: _assert ( f -- ) not if _err then ;
alias _err parseType ( tok -- type? f ) \ forward declaration
-alias _err parseDeclarator ( type -- ctype ) \ forward declaration
+alias _err parseDeclarator ( type -- cdecl ) \ forward declaration
\ Parsing strategy: we dig down recursively through nextt until we get to our
\ identifier. Before that identifier, we can hit chars like ( and *.
@@ -14,74 +14,60 @@ alias _err parseDeclarator ( type -- ctype ) \ forward declaration
\ recursion.
\ After we hit the identifier, we continue parsing forward, where
\ we can hit chars like [, an array specifier and (, a function specifier. We
-\ process them, amending our ctype structure as we go. If we hit a ), we go up
+\ process them, amending our cdecl structure as we go. If we hit a ), we go up
\ one level in recursion and apply previously recorded indirection levels to the
\ returned type.
-: _arg ( parent-ctype tok -- offset )
- parseType _assert parseDeclarator ( ctype newtype )
- tuck swap to CType nexttype ( newtype )
- ')' readChar? if 0 swap CType :offset! else
- ',' expectChar dup nextt _arg ( ctype offset )
- swap CType :offset! then ( offset ) ;
+: _arg ( parent-cdecl tok -- offset )
+ parseType _assert parseDeclarator ( cdecl newtype )
+ tuck swap to CDecl nexttype ( newtype )
+ ')' readChar? if 0 swap CDecl :offset! else
+ ',' expectChar dup nextt _arg ( cdecl offset )
+ swap CDecl :offset! then ( offset ) ;
\ parsing after the identifier
-: _post ( ctype -- ctype )
- begin ( ctype ) nextt case
+: _post ( cdecl -- cdecl )
+ begin ( cdecl ) nextt case
'[' of isChar?^ abort" TODO" endof
'(' of isChar?^
- dup CType :funcsig! STORAGE_PS to@! curstorage >r
- ')' readChar? not if ( ctype tok )
- over swap _arg ( ctype offset ) drop then
+ dup CDecl :funcsig! STORAGE_PS to@! curstorage >r
+ ')' readChar? not if ( cdecl tok )
+ over swap _arg ( cdecl offset ) drop then
r> to curstorage endof
r> to nexttputback exit
endcase again ;
-: _addlvl ( lvl type -- type ) tuck type*lvl + dup 4 < _assert swap type*lvl! ;
-
-: _parseDeclarator ( type -- ctype )
+: _parseDeclarator ( type -- cdecl )
0 begin ( type lvl )
'*' readChar? while ( type lvl tok ) 1+ repeat ( type lvl tok )
dup '(' isChar? if ( type lvl tok )
- drop swap parseDeclarator read)
- >r >r \ V1=outer-ctype v2=inner-lvl
- \ type recursion in C is "inside out". The ctype we have now is the outer
- \ type. We'll forward its current "type" field to the ctype we're about to
- \ finish parsing, and that new ctype will be placed in our outer type's
- \ "type" field. One thing we have to be careful about is to keep our *lvl
- \ where it belongs.
- V1 CType type dup type*lvl ( inner-type outer-lvl )
- swap r> ( inner-lvl ) swap type*lvl! ( outer-lvl inner-type )
- NULLSTR swap CType :new _post ( outer-lvl inner-type )
- _addlvl ( inner-type ) r@ ( outer-type ) to CType type r> ( ctype )
+ abort" TODO: declarator recursion"
else ( type lvl tok )
dup isIdent? not if to nexttputback NULLSTR then ( type lvl name )
- rot CType :new ( lvl ctype )
- _post tuck CType type ( ctype lvl type )
- _addlvl ( ctype type )
- over to CType type ( ctype ) then ;
+ rot CDecl :new ( lvl cdecl ) tuck to CDecl lvl _post then ;
current ' parseDeclarator realias
-: _parseStruct ( -- ctype )
+: _parseStruct ( -- cdecl )
nextt dup isIdent? if nextt else NULLSTR swap then
- '{' expectChar ( name ) TYPE_VOID CType :new ( res )
- dup CType :struct! dup addTypedef
+ '{' expectChar ( name ) TYPE_VOID CDecl :new ( res )
+ dup CDecl :struct! dup addTypedef
0 >r dup begin ( res prev ) \ V1=offset
'}' readChar? not while ( res prev tok )
parseType _assert parseDeclarator begin ( res prev new )
- tuck swap to CType nexttype ( res new )
- V1 over to CType offset
+ tuck swap to CDecl nexttype ( res new )
+ V1 over to CDecl offset
dup typesize to+ V1
';' readChar? not while ( res prev tok )
- ',' expectChar dup CType type parseDeclarator repeat ( res prev )
+ ',' expectChar dup CDecl type parseDeclarator repeat ( res prev )
repeat ( res prev ) rdrop drop ;
\ parse a type from stream, starting with "tok". This only parses the "type"
\ part without the "*" part or the name part. The result can be a "base" type
-\ (type < $100) or a CType if the type is a struct, union or enum.
-: _parseType ( tok -- type? f )
+\ (type < $100) or a CDecl if the type is a struct, union or enum.
+create _ubuf $10 allot
+: _parseType ( tok -- type? f ) \ ." parseType " dup stype nl>
dup S" typedef" s= if
- drop nextt parseType _assert parseDeclarator ( ctype )
+ drop nextt parseType _assert parseDeclarator ( cdecl )
dup addTypedef 1 exit then
dup S" struct" s= if drop _parseStruct 1 else
dup S" unsigned" s= if drop $10 nextt else $00 swap then ( type tok )
diff --git a/fs/comp/c/type.fs b/fs/comp/c/type.fs
@@ -24,72 +24,54 @@ Arena :new const _tarena \ Temporary
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.
-\ b3:2 = size. 0=0 1=8 2=16 3=32
-\ b4 = sign. 0=signed 1=unsigned
-\ b7:5 = reserved
-
-\ When a type is higher than $ff, it means that it's a pointer to a CType,
+\ When a type is higher than $ff, it means that it's a pointer to a CDecl,
\ which contains extra information needed for arrays (nbelem) and structs/sig
-\ (offset and nexttype). All CType are aligned to 4 bytes, which allows our
+\ (offset and nexttype). All CDecl are aligned to 4 bytes, which allows our
\ pointers to use the lower 2 bits to be used for the "*lvl" field.
-\ In the nomenclature below, "type" can be either a basic type or a CType,
-\ but "ctype" is always a CType (which is also a type).
+\ In the nomenclature below, "type" can be either a basic type or a CDecl,
+\ but "cdecl" is always a CDecl (which is also a type).
$0 const TYPE_VOID
-$1 const TYPE_VOID*
$4 const TYPE_CHAR
-$5 const TYPE_CHAR*
$8 const TYPE_SHORT
-$9 const TYPE_SHORT*
$c const TYPE_INT
-$d const TYPE_INT*
$1c const TYPE_UINT
-$1d const TYPE_UINT*
0 const STORAGE_SF \ Stack frame
1 const STORAGE_PS \ Parameter Stack
2 const STORAGE_MEM \ Fixed address in memory
-\ Set by pgen and determines the storage type of new created CTypes
+\ Set by pgen and determines the storage type of new created CDecls
STORAGE_MEM value curstorage
0 value curstatic \ is current definition "static"?
: _arena curstorage STORAGE_MEM <> curstatic or if _tarena else _parena then ;
4 stringlist typenames "void" "char" "short" "int"
-: type*lvl ( type -- lvl ) 3 and ;
-\ TODO: have the _assert in type*lvl! it's not possible now because it breaks
-\ the CC vms.
-: type*lvl! ( lvl type -- type ) $fffffffc and or ;
-: type*lvl+ ( type -- type ) dup type*lvl 1+ dup 4 < _assert swap type*lvl! ;
-: type*lvl- ( type -- type ) dup type*lvl 1- dup 0>= _assert swap type*lvl! ;
-create _ 0 c, 1 c, 2 c, 4 c,
-: ctype? ( type -- f ) $ff > ;
-: ctype' ( type -- ctype ) $fffffffc and ;
-
-\ CType flags
-\ b0=is a struct? if 1, this is an "empty" ctype with the name of the struct.
+
+: cdecl? ( type -- f ) $ff > ;
+
+\ CDecl flags
+\ b0=is a struct? if 1, this is an "empty" CDecl with the name of the struct.
\ First field is nexttype.
\ b1=is a funcsig? if 1, type is func return type and name is the name of the
\ sig. arguments follow in nexttype.
\ b2=has static storage?
\ b3=incomplete? If 1, this is an incomplete definition.
-struct[ CType
- sfield nexttype \ a CType is a Linked List
- sfield type \ a basic type. Can be a link to a CType
+struct[ CDecl
+ sfield nexttype \ a CDecl is a Linked List
+ sfield type \ a basic type. Can be a link to a CDecl
+ sfield lvl \ indirection levels (*)
sfield flags
sfield offset \ offset, in bytes, of this element within its list
- \ if this ctype is a function, offset contains its address.
+ \ if this cdecl is a function, offset contains its address.
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 )
+ : :new ( name type -- cdecl )
$100 SZ + _arena Arena :[
- 0 align4 here rot> 0 , , 0 , 0 , 0 , curstorage , s,
+ 0 align4 here rot> 0 , , 0 , 0 , 0 , 0 , curstorage , s,
_arena Arena :] drop ;
: _f? doer , does> ( self 'w ) @ swap flags and bool ;
@@ -98,10 +80,6 @@ struct[ CType
2 _f? :funcsig? 2 _f! :funcsig!
4 _f? :static? 4 _f! :static!
8 _f? :incomplete? 8 _f! :incomplete!
- : :funcptr?
- type dup ctype? if
- dup type*lvl 1 = swap ctype' :funcsig? and
- else drop 0 then ;
: :isarg? ( dnode -- f ) storage STORAGE_PS = ;
: :isglobal? ( dnode -- f ) storage STORAGE_MEM = ;
@@ -114,23 +92,23 @@ struct[ CType
\ Combined size of all fields in the LL.
: :size ( self -- size )
dup :isarg? over :funcsig? or if drop CELLSZ exit then
- 0 swap begin ( res ctype ) ?dup while
+ 0 swap begin ( res cdecl ) ?dup while
tuck dup type _typesize swap nbelem 1 max * +
swap llnext repeat ( res ) ;
: :argssize ( self -- size ) dup :funcsig? _assert llcnt 1- CELLSZ * ;
- : :type ( self -- type ) bi type | nbelem if type*lvl+ then ;
: :offset! ( off self -- off+size ) 2dup to offset :size + ;
- \ Find "name" in CType's LL. return 0 if not found
+ \ Find "name" in CDecl'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 ( name self -- cdecl ) llnext dup if _ then nip ;
: :find# :find dup _assert ;
: _.children begin nexttype ?dup while dup _printtype ." , " repeat ;
: :. ( self -- ) >r \ print without children
r@ offset if '+' emit r@ offset .x? spc> then
- r@ :struct? if ." struct" else r@ type _printtype then
+ r@ :struct? if ." struct" else
+ r@ type _printtype r@ lvl for '*' emit next then
r@ name c@ if spc> r@ name stype then
r@ nbelem if '[' emit r@ nbelem . ']' emit then
r@ :funcsig? if '(' emit r@ _.children ')' emit then rdrop ;
@@ -140,70 +118,50 @@ struct[ CType
: :export ( self -- )
dup :struct? _assert \ we can only export structs
- dup name NEXTWORD ! struct[ llnext begin ( ctype )
+ dup name NEXTWORD ! struct[ llnext begin ( cdecl )
?dup while
- dup name NEXTWORD ! dup nbelem if ( ctype )
+ dup name NEXTWORD ! dup nbelem if ( cdecl )
dup type _typesize over nbelem * sfield'
- else ( ctype )
+ else ( cdecl )
dup type _typesize case
1 of = sfieldb endof
2 of = sfieldw endof
- sfield endcase then ( ctype )
+ sfield endcase then ( cdecl )
llnext repeat ]struct ;
: :append ( other self -- ) 2dup :size swap to offset llappend ;
]struct
-: ensurebasetype ( type -- type )
- dup ctype? if ctype' CType type ensurebasetype then ;
-: typeunsigned? ( type -- flags ) ensurebasetype 4 rshift 1 and ;
-
\ Typedefs are dictionary entries in the "typedefs" dicts, which contain a 4b
\ value representing the type it aliases.
create typedefs 0 , 0 c, \ this is a dict link
-: addTypedef ( ctype -- ) typedefs over CType name entry , ;
+: addTypedef ( cdecl -- ) typedefs over CDecl name entry , ;
: findTypedef ( name -- type-or-0 ) typedefs find dup if @ then ;
create _symbols 0 , 0 c, \ non-static
create _ssymbols 0 , 0 c, \ static
-: addSymbol ( ctype -- )
+: addSymbol ( cdecl -- )
curstatic if _ssymbols else _symbols then
- over CType name dup c@ ( ctype 'dict name len )
+ over CDecl name dup c@ ( cdecl 'dict name len )
ENTRYSZ + 8 + _arena Arena :[ entry , _arena Arena :] drop ;
-: findSymbol ( name -- ctype-or-0 )
+: findSymbol ( name -- cdecl-or-0 )
dup _ssymbols find ?dup if nip @ else _symbols find dup if @ then then ;
: cctypes$ 0 _ssymbols ! _tarena Arena :reset ;
+: ensurebasetype ( type -- type )
+ dup cdecl? if CDecl type ensurebasetype then ;
+: typeunsigned? ( type -- flags ) ensurebasetype 4 rshift 1 and ;
+
: printtype ( type -- )
- dup ctype? if dup ctype' CType :. else
+ dup cdecl? if CDecl :. else
dup typeunsigned? if ." unsigned " then
- dup >> >> 3 and typenames slistiter stype then
- type*lvl begin ?dup while '*' emit 1- repeat ;
+ >> >> 3 and typenames slistiter stype then ;
current ' _printtype realias
: typesize ( type -- size-in-bytes )
- dup type*lvl if drop 4 else
- dup ctype? if
- ctype' CType :size
- else >> >> 3 and _ + c@ then then ;
+ dup cdecl? if
+ dup CDecl lvl if drop 4 else CDecl :size then
+ else >> >> 3 and _ + c@ then ;
current ' _typesize realias
-
-: inttypeofsize ( size -- type ) case
- 0 of = TYPE_VOID endof
- 1 of = TYPE_CHAR endof
- 2 of = TYPE_SHORT endof
- 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 ;
diff --git a/fs/tests/comp/c/cc.fs b/fs/tests/comp/c/cc.fs
@@ -30,9 +30,9 @@ ptrset 54 #eq
42 condif 142 #eq
42 incdec 43 #eq
54 incdecp 54 #eq
-testend \s
exprparens 9 #eq
cnoop ( no result! ) scnt 0 #eq
+testend \s
42 ptrari 50 #eq
42 50 ptrari2 2 #eq
array 52 #eq
diff --git a/fs/tests/comp/c/test2.c b/fs/tests/comp/c/test2.c
@@ -119,3 +119,19 @@ int incdecp(int x) {
x--;
return x--;
}
+// test that parens override precedence
+int exprparens() {
+ return (1 + 2) * 3;
+}
+// test that a void function doesn't add anything to PS
+void cnoop() {}
+// test that pointer arithmetics properly multiply operands by 2 or 4.
+int* ptrari(int *x) {
+ cnoop(); // this doesn't mess up PS
+ x++; ++x; x--;
+ return x + 1;
+}
+// subtracting two pointers yield a number divided by the type size.
+int ptrari2(int *lo, int *hi) {
+ return hi-lo;
+}
