duskos

commit d67a41ba37e859772d87aed8530fcb555428d03c
parent 4dd01a4ec6df8f5562a0e1de2a9331e1a31494cb
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Sat,  1 Apr 2023 14:50:25 -0400

halcc: protect binops against PS sliding bugs

A tricky bug would previously occur when W is taken at the time the binop begins
resolving. :hal# is called, refering PS elements, and then :>W is called,
pushing to PS. The HAL op previously generated becomes invalid because it refers
to the wrong PS slot.

Diffstat:
M
fs/comp/c/egen.fs
 | 
12
+++++++++---

1 file changed, 9 insertions(+), 3 deletions(-)
diff --git a/fs/comp/c/egen.fs b/fs/comp/c/egen.fs
@@ -44,6 +44,10 @@ unaryop _!, _ not
 UOPSCNT wordtbl uoptbl ( res -- res )
 'w _neg, 'w _not,   'w _!,   'w _&,   'w _*,   'w _++,    'w _--,
 
+\ For binops to resolve without problems, we want both operands to solve without
+\ affecting PS so that HAL ops generated for one operand isn't invalidated when
+\ the second pushes to PS. Hence the :?freeCurrentW prelude.
+
 \ ops that can freely swap their operands
 : _prep ( left right -- left halop )
   dup Result :hasW? if swap then over Result :?>W Result :hal$ ;
@@ -58,7 +62,8 @@ UOPSCNT wordtbl uoptbl ( res -- res )
   _prep +, r> over Result :copymeta ;
 
 \ ops that can't freely swap their operands
-: _prep ( left right -- left halop ) Result :?>W dup Result :?>W PSP) ;
+: _prep ( left right -- left halop )
+  Result :?freeCurrentW Result :hal$ over Result :?>W ;
 : _/, _prep /, ; : _%, _prep %, ;
 : _<<, _prep <<, ; : _>>, _prep >>, ;
 
@@ -66,7 +71,8 @@ UOPSCNT wordtbl uoptbl ( res -- res )
   over Result :*arisz over Result :*arisz over = _assert ( left right arisz )
   >r _prep -, r> ?dup if over Result :/n then dup Result :toint ;
 
-: _prep ( left right -- res halop ) over Result :hal# swap Result :?>W$ <>) ;
+: _prep ( left right -- res halop )
+  Result :?freeCurrentW over Result :hal# swap Result :?>W$ <>) ;
 : _=, _prep @, ;    : _-=, _prep -, ;
 : _*=, _prep *, ;   : _/=, _prep /, ;   : _%=, _prep %, ;
 : _&=, _prep and, ; : _^=, _prep xor, ; :  _|=, _prep or, ;
@@ -82,7 +88,7 @@ UOPSCNT wordtbl uoptbl ( res -- res )
 : cmpop doer 4 for ' execute , next does> ( left right 'conds )
   over Result :unsigned? not if CELLSZ << + then
   over Result :isW? if CELLSZ + @ >r swap else @ >r then ( left right )
-  Result :hal$ over Result :?>W cmp, r> C>W, ;
+  Result :?freeCurrentW Result :hal$ over Result :?>W cmp, r> C>W, ;
 cmpop _==, Z) Z) Z) Z)       cmpop _!=, NZ) NZ) NZ) NZ)
 cmpop _<, <) >=) s<) s>=)    cmpop _<=, <=) >) s<=) s>)
 cmpop _>, >) <=) s>) s<=)   cmpop _>=, >=) <) s>=) s<)