duskos

commit 32309ece8784c15a39c81da314140e099b3d2c82
parent 7c0b174a519c6889fd6ace55e4839a6e0ad9c573
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Tue,  4 Oct 2022 09:25:42 -0400

cc/vm/forth: fix :push/:pop bugs

A bug in the loc check in VMOp :pop override hid the fact that there was another
bug in binop= and vmmov,: it doesn't make sense, in those cases, to have this
override because there will always be, right before a "compile !", 2 TOS
operands (something that the override ensures never happens).

Straighten all of this out.

Diffstat:
M
fs/cc/vm/forth.fs
 | 
12
+++++++-----

1 file changed, 7 insertions(+), 5 deletions(-)
diff --git a/fs/cc/vm/forth.fs b/fs/cc/vm/forth.fs
@@ -71,10 +71,12 @@ struct+[ VMOp
 \ 3. When popping, if oploc=TOS, we need to ensure that the "other op" is not
 \    a TOS. If it is, change it into a REGISTER.
 struct+[ VMOp
-  : :push ( self -- arg loc )
+  : :push ( self -- arg loc&type )
     dup :loclo VM_REGISTER = if vmop :compile& then VMOp :push ;
-  : :pop ( arg loc self -- )
-    over $f and VM_TOS = if ?tos>reg then VMOp :pop ;
+  \ In vmmov, and binop= we need to pop without the ?tos>reg check
+  : :popNoChk ( arg loc&type self -- ) VMOp :pop ;
+  : :pop ( arg loc&type self -- )
+    over 8 rshift $f and VM_TOS = if .ops ?tos>reg .ops then VMOp :pop .ops ;
 ]struct
 
 \ generate function prelude code by allocating "locsz" bytes on RS.
@@ -181,7 +183,7 @@ binop vm||, or and
   vmop^ :hasop# vmop^ :compile \ op2 is TOS
   ( w ) execute, PS- \ result on TOS
   vmop :forgetTOS
-  vmop :pop vmop :&op vmop :compile
+  vmop :popNoChk vmop :&op vmop :compile
   vmop :forgetTOS vmop^ :forgetTOS compile ! PS- PS- ;
 
 binop= vm<<=, lshift
@@ -208,7 +210,7 @@ binop= vm^=, xor
   vmop^ :hasop# vmop^ loc VM_CONSTARRAY = if _movarray, else
     vmop^ :compile \ op2 is TOS
     vmop :TOS? if compile over PS+ then
-    vmop :keep vmop :&op vmop :compile vmop :forgetTOS vmop :pop
+    vmop :keep vmop :&op vmop :compile vmop :forgetTOS vmop :popNoChk
     vmop^ :typesz! vmop^ :forgetTOS compile ! PS- PS- then ;
 
 \ Jumping