commit 5d96fd4248507486fa78b0eac5b9c6fd53d96648
parent a7589021be2e66e858d3fae49b0718b170802724
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 24 Mar 2023 10:24:57 -0400
halcc: globalshort()
Diffstat:
3 files changed, 58 insertions(+), 44 deletions(-)
diff --git a/fs/comp/c/egen.fs b/fs/comp/c/egen.fs
@@ -52,8 +52,9 @@ UOPSCNT wordtbl uoptbl ( res -- res )
: _+, ( left right -- res )
over Result :*arisz over Result :*arisz <> if
over Result :*arisz 1 = if swap then \ left has mutiplier
- over Result :*arisz log2 over Result :<<n then
- _prep +, ;
+ over Result :*arisz log2 over Result :<<n ( left right*arisz )
+ over >r _prep +, r> over Result :copymeta
+ else _prep +, then ;
\ ops that can't freely swap their operands
: _prep ( left right -- left halop ) Result :?>A over Result :?>W ;
@@ -62,7 +63,7 @@ UOPSCNT wordtbl uoptbl ( res -- res )
: _-, ( left right -- res )
over Result :*arisz over Result :*arisz over = _assert ( left right arisz )
- >r _prep -, r> log2 ?dup if over Result :>>n then ;
+ >r _prep -, r> log2 ?dup if over Result :>>n then dup Result :toint ;
: assign doer ' , does> @ ( left right w ) >r
over Result :hal# rot> r> execute ( lefthal res ) swap !, ;
diff --git a/fs/comp/c/expr.fs b/fs/comp/c/expr.fs
@@ -6,33 +6,19 @@
: _err ( -- ) tokdbg abort" expr error" ;
: _assert ( f -- ) not if _err then ;
-\ Apply indirection level to halop. If necessary, use the A register to get to
-\ the right place.
-: applylvl ( halop lvl -- halop ) case ( halop )
- 0 of = endof
- -1 of = A>) lea, A*) endof
- of 0>= r@ for A>) @, A) next drop A) endof
- _err endcase ;
-
-\ Operation levels vs Arithmetic levels
-\ We track two types of indirection levels here. First, there's the "operations"
-\ level, that is, where to get the damn value at the end. This is independent of
-\ indirection levels in the declarations. It is only affected by & and *
-\ operators applied within expressions. Therefore, Results begin their lives
-\ at "oplvl" 0. There's one exception: Arrays living in the stack frame start
-\ at lvl -1 because the pointer is RSP+offset without indirection.
-\ When comes the time to resolve the oplvl, we first check if it's -1, in which
-\ case we resolve it with a "lea,". This only works on CDECL results. Less than
-\ -1 is an error. For positive oplvl, we move to W and repeatedly call @,. For
-\ more efficiency, we bundle oplvl in 2s and use [@], when possible.
-\ Arithmetic levels serve a different purpose: to know when we need to apply
-\ pointer arithmetics. For this, we take CDecl's base lvl (if it's an array,
-\ this adds 1 to this level) subtract Result's lvl from it.
-\ This is the "arilvl". If that level is 0, then its "pointer arithmetics
-\ multiplier" is 1. If the level is 1, then the multiplier is the size of the
-\ base type. Otherwise, the multiplier is 4 (size of a pointer). Negative is an
-\ error. The arilvl has no effect on how the fetching of the actual value
-\ occurs.
+\ Indirection levels
+\ We track two types of indirection levels here. First, there's the "regular"
+\ level, that is, where the result presently points to, with all & and *
+\ applied, relative to the current location of the result. For example, if the
+\ Result presently points to RS+4 and has "**" applied to it (lvl=2), we know
+\ that when push comes to shove, we'll have two "@," to apply before we can
+\ consider that we holw the value we're looking for.
+\ When the base type is 32-bit, then it's easy. All "@," ops can be made in
+\ 32-bit mode. When the base type is 16-bit or 8-bit, however, it's trickier and
+\ we need a second indirection information: whether the final value we're about
+\ to get is a direct value or a pointer. For this reason, we have the "blvl"
+\ (Bottom Level), that is, the indirection level at which the final value lies.
+\ That value has a size "basesz". All other levels have a 4b size.
struct[ Result
0 const NONE \ Nothing (probably a released W)
1 const CONST \ Is a constant (value in arg)
@@ -40,17 +26,19 @@ struct[ Result
3 const CDECL \ CDecl pointer is in arg.
4 const PS \ Result pushed to PS, offset in arg
5 const ARRAY \ Result is a constant array in a Stack. arg is a pointer to it.
+
sfield type
sfield arg
+ sfield basesz \ size, in bytes of the base type
sfield lvl \ lvl changed applied within the expression
- sfield arilvl \ offset to apply to lvl to get the arithmetic level
+ sfield blvl \ Bottom Level
\ There can only be one result using W at once. Whenever a W result is
\ created, it takes the lock. If it's already taken, there's an error.
0 value currentW \ link to Result
: :Wfree# currentW if abort" W is already taken!" then ;
- : :new ( arg type -- res ) SZ syspad :[ , , 0 , 0 , syspad :] ;
+ : :new ( arg type -- res ) SZ syspad :[ , , CELLSZ , 0 , 0 , syspad :] ;
: :none ( -- res ) 0 NONE :new ;
: :const ( n -- res ) CONST :new ;
: :W ( -- res ) :Wfree# 0 W :new dup to currentW ;
@@ -62,22 +50,40 @@ struct[ Result
: :?freeCurrentW ( -- ) currentW ?dup if :>PS then ;
: :iscdecl? ( self -- f ) type CDECL = ;
: :isarray? ( self -- f ) type ARRAY = ;
+ create _ ," NIWCPA"
+ : :. ( self -- )
+ dup type _ + c@ emit spc>
+ dup arg over :iscdecl? if CDecl :. else .x then spc>
+ dup basesz . spc> dup lvl . spc> blvl . spc>
+ ." W=" currentW bool . nl> ;
: :W! ( self -- ) dup to currentW W swap to type ;
: :& ( self -- ) -1 swap to+ lvl ;
: :cdecl ( cdecl -- res )
dup CDECL :new ( cdecl res )
- over bi CDecl lvl | CDecl nbelem bool + over to arilvl ( cdecl res )
- swap CDecl nbelem if dup :& -1 over to+ arilvl then ;
+ over CDecl type typesize over to basesz
+ over bi CDecl lvl | CDecl nbelem bool + over to blvl ( cdecl res )
+ swap CDecl nbelem if dup :& -1 over to+ blvl then ;
: :cdecl# dup :iscdecl? _assert arg ;
+ : :opsz ( halop self -- halop ) dup :.
+ bi+ lvl | blvl = if 'B' emit
+ basesz case 1 of = 8b) endof 2 of = 16b) endof endcase
+ else drop then ;
: :hal# ( self -- halop ) dup type case ( self )
CONST of = arg i) endof
- CDECL of = bi arg CDecl :halop | lvl applylvl endof
+ CDECL of = 'C' emit
+ bi+ arg CDecl :halop | lvl case ( self halop )
+ 0 of = endof
+ -1 of = A>) lea, A*) endof
+ of 0>= r@ for A>) @, A) next drop A) endof
+ _err endcase ( self halop )
+ swap :opsz endof
PS of = arg PSP+) endof
abort" :hal# error" endcase ;
: :>W ( self -- )
- dup :isW? if drop else
+ dup :isW? if drop else 'W' emit
:Wfree# dup :hal# @,
+ 0 over to@! lvl neg over to+ blvl
dup to currentW W swap to type then ;
: :>W$ ( self -- ) dup :>W :release ;
: :isconst? ( self -- f ) type CONST = ;
@@ -89,22 +95,29 @@ struct[ Result
\ Free up W by sending it to A if needed.
: :?>A ( self -- halop )
dup :isW? if :release W>A, A*) else :hal# then ;
- : :* ( self -- )
- dup :isW? if W) @, then 1 swap to+ lvl ;
+ : :* ( self -- ) '*' emit
+ 1 over to+ lvl dup :isW? if '!' emit W) swap :opsz @, else drop then 'X' emit ;
: :<<n ( n self -- )
dup :isconst? if
dup arg rot lshift swap to arg else :?>W i) <<, then ;
: :>>n ( n self -- )
dup :isconst? if
dup arg rot rshift swap to arg else :?>W i) >>, then ;
- : :arilvl bi arilvl | lvl - ;
+ \ For pointer arithmetics, we apply the "bottom level" logic one level higher.
+ \ That is, when lvl=blvl, our "arisz" is 1 (regular arithmetics), when
+ \ lvl=blvl+1, our arisz is "basesz" (we add and subtract by chunks of the
+ \ base type), otherwise it's 4 (we deal with pointers).
: :*arisz ( self -- n ) \ pointer arithmetics multiplier
- dup :arilvl case
+ dup bi blvl | lvl - case
0 of = drop 1 endof
- \ TODO: make cdecl typesize follow when a :& converts the result.
- \ Hardcoding to 4 is bad...
- 1 of = dup :iscdecl? if :cdecl# CDecl type typesize else drop 4 then endof
+ 1 of = basesz endof
drop 4 endcase ;
+ \ Copy meta information (basesz, lvl, blvl) from "other" result
+ : :copymeta ( other self -- )
+ over basesz over to basesz
+ over lvl over to lvl
+ swap blvl swap to blvl ;
+ : :toint ( self -- ) 4 over to basesz 0 over to lvl 0 swap to blvl ;
]struct
BOPSCNT wordtbl _tbl ( a b -- n )
diff --git a/fs/tests/comp/c/cc.fs b/fs/tests/comp/c/cc.fs
@@ -38,8 +38,8 @@ array 52 #eq
global 1234 #eq
globalinc 1236 #eq
globalinc 1238 #eq
-testend \s
1 globalshort 2 #eq
+testend \s
42 142 funcsig 184 #eq
capture helloworld S" Hello World!" #s=
create expected ," Null terminated\0"
