commit f3d3cf2505e0eee11f05b6eb6eaa1b0a54b3f26b
parent 8194bdf05578dc66b765369179a59acc5ca62477
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 23 Mar 2023 17:23:16 -0400
halcc: consolidate
The upcoming part, array and advanced pointer arithmetics, is hairy and there's
lots of little things to get right. Among those was fixing a bug with 16b) and
8b) lea, which was broken in the POSIX vm.
Diffstat:
3 files changed, 35 insertions(+), 27 deletions(-)
diff --git a/fs/comp/c/egen.fs b/fs/comp/c/egen.fs
@@ -131,7 +131,7 @@ current ' parseFactor realias
_prep +, ;
\ ops that can't freely swap their operands
-: _prep ( left right -- left halop ) Result :?>PS over Result :?>W ;
+: _prep ( left right -- left halop ) Result :?>A over Result :?>W ;
: _/, _prep /, ; : _%, _prep %, ;
: _<<, _prep <<, ; : _>>, _prep >>, ;
@@ -147,7 +147,7 @@ assign _&=, _&, assign _^=, _^, assign _|=, _|,
assign _-=, _-, assign _/=, _/, assign _%=, _%,
assign _<<=, _<<, assign _>>=, _>>,
-: _=, swap dup Result :& Result :?>W$ W>A, dup Result :?>W A) !, ;
+: _=, tuck Result :?>W Result :hal# !, ;
\ To avoid W juggling, we check if our right operand is W. If it is, no need
\ for juggling, all we need is to invert the condition we use.
@@ -164,7 +164,7 @@ Z) Z) cmpop _==, NZ) NZ) cmpop _!=,
\ the "true" hand, push it to PS, then generate the "cond", keep it in W. When
\ we encounter the "false" hand, *then* we generate conditional code which
\ cleans up PS.
-: _?, ( left right -- res ) Result :>PS ;
+: _?, ( left right -- res ) Result :?>W Result :?freeCurrentW ;
: _:, ( left right -- res )
swap Result :>W$ PS- W=0>Z, 0 Z) branchC,
drop, [compile] else nip, over Result :>W [compile] then ;
diff --git a/fs/comp/c/expr.fs b/fs/comp/c/expr.fs
@@ -6,6 +6,14 @@
: _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 ;
+
struct[ Result
0 const NONE \ Nothing (probably a released W)
1 const CONST \ Is a constant (value in arg)
@@ -14,10 +22,9 @@ struct[ Result
4 const PS \ Result pushed to PS, offset in arg
sfield type
sfield arg
- sfield lvl \ indirection levels (*). This is different from CDecl lvl
- \ because it track indirections at the *location* level.
- \ Sometimes, when we need to know whether we're dealing with a
- \ pointer or an actual value, we want to add these 2 levels.
+ sfield lvl \ indirection levels (*) that have been applied within the
+ \ expression (not at declaration). This is only used with CDECL
+ \ type. On the W type, * indirections are applied directly.
\ 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.
@@ -34,14 +41,13 @@ struct[ Result
: :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
- CDECL of = arg CDecl :halop endof
+ CDECL of = bi arg CDecl :halop | lvl applylvl endof
PS of = arg PSP+) endof
abort" :hal# error" endcase ;
: :>W ( self -- )
- dup lvl over type W = if
- W) else 1+ :Wfree# over :hal# then ( self lvl halop )
- begin swap ?dup while 1- dup if 1- swap [@], else swap @, then W) repeat
- drop dup to currentW W swap to type ;
+ dup :isW? if drop else
+ :Wfree# dup :hal# @,
+ dup to currentW W swap to type then ;
: :>W$ ( self -- ) dup :>W :release ;
: :isconst? ( self -- f ) type CONST = ;
: :iszero? bi arg 0 = | :isconst? and ;
@@ -49,29 +55,30 @@ struct[ Result
: :const# dup :isconst? _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 ;
+ : :>PS
+ dup :isW? _assert dup :release
+ 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 ;
: :?>W$ dup :?>W :release ;
- \ Free up W by sending it to PS (if needed).
- : :?>PS ( self -- halop )
- dup :isW? if dup :release dup :>PS then :hal# ;
- : :* ( self -- ) 1 swap to+ lvl ;
- : :& ( self -- )
- dup lvl if -1 swap to+ lvl else
- :?freeCurrentW dup :cdecl# CDecl :halop lea, W swap to type then ;
+ \ Free up W by sending it to A if needed.
+ : :?>A ( self -- halop )
+ dup :isW? if dup :release W>A, A*) else :hal# then ;
+ : :* ( self -- )
+ dup :isW? if W) @, else 1 swap to+ lvl then ;
+ : :& ( self -- ) -1 swap to+ lvl ;
: :<<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 ;
- : :totlvl bi :cdecl# CDecl lvl | lvl + ;
+ : :arilvl bi :cdecl# CDecl lvl | lvl - ;
\ Return the "pointer arithmetics" multiplier to apply to the "other" operand.
\ If we're a lvl 1 pointer, return the size of the underlying type, otherwise
\ return 1.
: :*arisz ( self -- n )
- dup :iscdecl? if dup :totlvl case
+ dup :iscdecl? if dup :arilvl case
0 of = drop 1 endof
1 of = :cdecl# CDecl type typesize endof
drop 4 endcase else drop 1 then ;
diff --git a/posix/vm.c b/posix/vm.c
@@ -297,7 +297,7 @@ static void WIFETCH8() { GETA; *vm.dst = gb(gdr(a)); }
static void WISTORE8() { GETA; sb(gdr(a), *vm.dst); }
static void WADD8() { GETA; *vm.dst += gb(a); vm.Z = *vm.dst == 0; }
-static void WLEA() { GETA; *vm.dst = a; } // 0x28
+// 0x28
static void BOOTRD() { ppush(fgetc(fp)); }
static void STDOUT() { dword c = ppop(); write(STDOUT_FILENO, &c, 1); }
// ( -- c? f )
@@ -526,6 +526,7 @@ static void WDIV() { GETA; *vm.dst /= gdr(a); }
static void WMOD() { GETA; *vm.dst %= gdr(a); }
static void WSHL() { GETA; *vm.dst <<= gdr(a); }
static void WSHR() { GETA; *vm.dst >>= gdr(a); }
+static void WLEA() { GETA; *vm.dst = a; }
static void WSUB16() { GETA; *vm.dst -= gw(a); } // 0x70
static void WMUL16() { GETA; *vm.dst *= gw(a); }
@@ -845,9 +846,9 @@ static void (*ops[OPCNT])() = {
BYE, BYEFAIL, QUIT, ABORT_, DBG, USLEEP, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, WCHECKZ, STOREC, ACHECKZ,
- WSUB, WMUL, WDIV, WMOD, WSHL, WSHR, NULL, NULL,
- WSUB16, WMUL16, WDIV16, WMOD16, WSHL16, WSHR16, NULL, NULL,
- WSUB8, WMUL8, WDIV8, WMOD8, WSHL8, WSHR8, NULL, NULL,
+ WSUB, WMUL, WDIV, WMOD, WSHL, WSHR, WLEA, NULL,
+ WSUB16, WMUL16, WDIV16, WMOD16, WSHL16, WSHR16, WLEA, NULL,
+ WSUB8, WMUL8, WDIV8, WMOD8, WSHL8, WSHR8, WLEA, NULL,
WAND, WOR, WXOR, NULL, NULL, NULL, NULL, NULL,
WAND16, WOR16, WXOR16, NULL, NULL, NULL, NULL, NULL,
WAND8, WOR8, WXOR8, NULL, NULL, NULL, NULL, NULL,
@@ -957,10 +958,10 @@ static void buildsysdict() {
entry("%,"); compopwr(0x6b); retwr();
entry("<<,"); compopwr(0x6c); retwr();
entry(">>,"); compopwr(0x6d); retwr();
+ entry("lea,"); compopwr(0x6e); retwr();
entry("and,"); compopwr(0x80); retwr();
entry("or,"); compopwr(0x81); retwr();
entry("xor,"); compopwr(0x82); retwr();
- entry("lea,"); compopwr(0x28); retwr();
entry("neg,"); compileop(0x4e); retwr();
entry("W=0>Z,"); compileop(0x65); retwr();
entry("C>W,"); compileop(0x66); cwritewr(); retwr();
