duskos

commit 3fbb95310a2d46eb0f623cd411ba299fcc2da313
parent 7f2ac4036a96529a1ab643bd6b25ec71cff3ac3a
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Mon,  5 Dec 2022 20:20:16 -0500

comp/c/vm/forth: fix PS corruption during switch()

Diffstat:
M
fs/comp/c/vm/forth.fs
 | 
14
++++++++------
M
fs/tests/comp/c/cc.fs
 | 
2
++
M
fs/tests/comp/c/test.c
 | 
9
+++++++++

3 files changed, 19 insertions(+), 6 deletions(-)
diff --git a/fs/comp/c/vm/forth.fs b/fs/comp/c/vm/forth.fs
@@ -86,12 +86,14 @@ struct+[ VMOp
 \ However, because we don't track "psoff" across branches, we *have* to have a
 \ neutral level before the jump, which means that this flag that we're pushing
 \ on PS *has* to be right after the last argument of the args frame.
-: _ vmop^ :noop# vmop :compile$ PS- 0 to@! psoff ?dup if
+\ The same logic applies to vmswitch,.
+: _compileFinal
+  vmop^ :noop# vmop :compile$ PS- 0 to@! psoff ?dup if
     dup p', compile ! CELLSZ - ?dup if p+, then then ;
-: vmjz, ( a -- ) _ [compile] until ;
-: vmjz[, ( -- a ) _ [compile] if ;
-: vmjnz, ( a -- ) _ compile not [compile] until ;
-: vmjnz[, ( -- a ) _ compile not [compile] if ;
+: vmjz, ( a -- ) _compileFinal [compile] until ;
+: vmjz[, ( -- a ) _compileFinal [compile] if ;
+: vmjnz, ( a -- ) _compileFinal compile not [compile] until ;
+: vmjnz[, ( -- a ) _compileFinal compile not [compile] if ;
 
 UNOPCNT wordtbl unop
 'w neg             'w ^                'w bool             'w not
@@ -177,4 +179,4 @@ LOGOPCNT wordtbl _tblunsigned
       rdrop ( nref ) rdrop ( oldaddr ) >r exit then
     next ( a ) drop rdrop rdrop else ( nref lookup ) 2drop then ;
 : vmswitch, ( 'lookup -- )
-  vmop :compile$ litn compile @ compile _lookup PS- PS- ;
+  _compileFinal litn compile @ compile _lookup ;
diff --git a/fs/tests/comp/c/cc.fs b/fs/tests/comp/c/cc.fs
@@ -115,6 +115,8 @@ myval 42 #eq
 ptrari5 6 + @ 42 #eq
 funcall1 138 #eq
 42 funcall2 85 #eq
+41 switch1 41 #eq
+42 switch1 43 #eq
 
 \ and what about inline functions?
 :c int myinline() { return 42; }
diff --git a/fs/tests/comp/c/test.c b/fs/tests/comp/c/test.c
@@ -496,3 +496,12 @@ int funcall1() {
 int funcall2(int x) {
     return adder(++x, 42);
 }
+// There used to be a bug in the forth VM where an expression (something that
+// isn't a simple reference, but the result of a computation) with an arg on PS
+// would mess PS up.
+int switch1(char *x) {
+	switch (x+1) {
+		case 43: return 43;
+	}
+	return x;
+}