commit 0f555cd4805058e912297ef68f1f8173eedd3f32
parent 77943cd8af4aa37b5d0ead0fc63e5ad6c1414a16
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 14 Oct 2022 16:18:16 -0400
cc: fix opwidth bugs
Diffstat:
8 files changed, 31 insertions(+), 17 deletions(-)
diff --git a/fs/cc/vm/commonlo.fs b/fs/cc/vm/commonlo.fs
@@ -59,12 +59,9 @@ struct[ VMOp
: :push ( self -- 'copy ) dup >r :keep VM_NONE to r> loc ;
: :pop ( 'copy self -- ) dup :noop# 12 move ;
: :swap ( 'copy self -- 'copy ) dup :push rot> :pop ;
- \ if possible, transform current operand in its reference, f=1 means success.
- : :?&op ( -- f )
- dup :pointer? if
- dup :loclo over to loc dup type type*lvl+ swap to type 1
- else drop 0 then ;
- : :&op :?&op _assert ;
+ : :&op
+ dup :pointer? _assert
+ dup :loclo over to loc dup type type*lvl+ swap to type ;
: :*op dup loc case
VM_CONSTANT of = endof
VM_STACKFRAME of = endof
diff --git a/fs/cc/vm/forth.fs b/fs/cc/vm/forth.fs
@@ -45,7 +45,7 @@ struct+[ VMOp
: :compile ( -- ) >r
r@ :compile& r@ loc VM_*TOS = if r@ :typesz! compile @ r@ :>TOS then rdrop ;
: :>reg dup :loclo VM_REGISTER = if drop exit then >r
- r@ :hasop# r@ :?&op ( f ) r@ :compile& r@ 'arg litn compile ! PS- ( f )
+ r@ :hasop# r@ :pointer? ( f ) r@ :compile& r@ 'arg litn compile ! PS- ( f )
4 lshift VM_REGISTER or to r> loc ;
\ dereference current operand
: :*op dup :pointer? if dup :compile dup :>reg then VMOp :*op ;
@@ -201,10 +201,11 @@ binop= vm^=, xor
\ op2. In other words, perform a AST_ASSIGN with the right part as op2
\ and the left part as op1.
: _movarray, \ special case, we have a {1, 2, 3} assign
- vmop loc VM_STACKFRAME = _assert vmop :compile \ dst on PS
- vmop :forgetTOS vmop^ arg @+ ( a len ) >r begin ( a )
- @+ litn compile swap compile !+ next compile drop PS- ( a ) drop
- vmop^ :init ;
+ vmop loc VM_STACKFRAME = _assert
+ vmop type type*lvl- typesize vmop :compile ( sz ) \ dst on PS
+ vmop :forgetTOS vmop^ arg @+ ( sz a len ) >r begin ( sz a )
+ @+ litn compile swap over sz! compile !+ next compile drop PS- ( sz a )
+ 2drop vmop^ :init ;
: vm=,
vmop^ :hasop# vmop^ loc VM_CONSTARRAY = if _movarray, else
diff --git a/fs/cc/vm/i386.fs b/fs/cc/vm/i386.fs
@@ -181,7 +181,7 @@ binop= vm>>=, shr,
vmop loc VM_STACKFRAME = _assert
vmop :*op vmop^ arg @+ ( a len ) >r begin ( a )
vmop :dest# vmop :compilesz @+ i) mov, ( a+4 )
- CELLSZ to+ vmop arg next ( a )
+ vmop type typesize to+ vmop arg next ( a )
drop vmop^ :init
else _vm=, then ;
diff --git a/fs/tests/app/cos/cvm.fs b/fs/tests/app/cos/cvm.fs
@@ -8,10 +8,11 @@ vm structbind COSVM vm
vm mem f" /tests/app/cos/dummy.bin" File :readall
vm running #
\ The "dummy.bin" file is a test handcrafted binary with the equivalent of:
-\ 42 bye
+\ $1234 $2345 BYE
-2 COS_steps not #
+3 COS_steps not #
vm running not #
COS_printdbg
-COS_pop 42 #eq
+COS_pop $2345 #eq
+COS_pop $1234 #eq
testend
diff --git a/fs/tests/app/cos/dummy.bin b/fs/tests/app/cos/dummy.bin
Binary files differ.
diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs
@@ -76,6 +76,7 @@ structop2 45 #eq
opwidth1 42 #eq
opwidth2 42 #eq
opwidth3 $129 #eq
+opwidth4 14 #eq
\ and what about inline functions?
:c int myinline() { return 42; }
diff --git a/fs/tests/cc/test.c b/fs/tests/cc/test.c
@@ -329,3 +329,11 @@ int opwidth3() {
x += y;
return x;
}
+// The Forth VM lost track of opwidth through expressions
+// Forth VM and i386 VM mis-initialized the char array.
+char opwidth4() {
+ char x[2] = {1, 2};
+ int y = 0;
+ x[y] = 12;
+ return x[0] + x[1];
+}
diff --git a/posix/dis.c b/posix/dis.c
@@ -143,22 +143,28 @@ struct call {
int arg;
};
-#define CALLCNT 14
+#define CALLCNT 20
struct call calls[CALLCNT] = {
{0x9e, "(br)", ARGINT},
{0xae, "(?br)", ARGINT},
{0x11a, "dup", ARGNONE},
{0x138, "swap", ARGNONE},
+ {0x147, "over", ARGNONE},
{0x1c7, "@", ARGNONE},
{0x1cf, "16b @", ARGNONE},
{0x1d7, "8b @", ARGNONE},
{0x1e9, "!", ARGNONE},
{0x1f1, "16b !", ARGNONE},
{0x1f9, "8b !", ARGNONE},
+ {0x275, "!+", ARGNONE},
+ {0x27d, "16b !+", ARGNONE},
+ {0x285, "8b !+", ARGNONE},
{0x355, "1+", ARGNONE},
{0x36e, "+", ARGNONE},
{0x3a3, "and", ARGNONE},
- {0x3ec, "not", ARGNONE}
+ {0x3ec, "not", ARGNONE},
+ {0x436, "rshift", ARGNONE},
+ {0xc18, "drop", ARGNONE}
};
static int offset = 0;
