duskos

commit d15f3d5b34d43f255136f897ee0cde301c9dc30f
parent 26f013b36eca9d5084b10c2af0298aa3ff893c6b
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Sun, 13 Nov 2022 12:43:40 -0500

cc: fix pointer arithmetics on ++ and -- ops

Diffstat:
M
fs/cc/vm/forth.fs
 | 
34
+++++++++++++++-------------------
M
fs/cc/vm/i386.fs
 | 
21
++++++++++++---------
M
fs/tests/cc/cc.fs
 | 
2
+-
M
fs/tests/cc/test.c
 | 
1
+

4 files changed, 29 insertions(+), 29 deletions(-)
diff --git a/fs/cc/vm/forth.fs b/fs/cc/vm/forth.fs
@@ -122,29 +122,25 @@ UNOPCNT wordtbl unop
 'w neg             'w ^                'w bool             'w not
 : unop, ( opid -- ) vmop :compile unop swap wexec, ;
 
-\ Signature: a -- n
-UNOPMUTCNT wordtbl _tbl32
-:w ( ++op ) 1 over +! @ ;
-:w ( --op ) -1 over +! @ ;
-:w ( op++ ) dup @ dup 1+ rot ! ;
-:w ( op-- ) dup @ dup 1- rot ! ;
-
-UNOPMUTCNT wordtbl _tbl16
-:w ( ++op ) 1 over 16b +! 16b @ ;
-:w ( --op ) -1 over 16b +! 16b @ ;
-:w ( op++ ) dup 16b @ dup 1+ rot 16b ! ;
-:w ( op-- ) dup 16b @ dup 1- rot 16b ! ;
-
-UNOPMUTCNT wordtbl _tbl8
-:w ( ++op ) 1 over 8b +! 8b @ ;
-:w ( --op ) -1 over 8b +! 8b @ ;
-:w ( op++ ) dup 8b @ dup 1+ rot 8b ! ;
-:w ( op-- ) dup 8b @ dup 1- rot 8b ! ;
+\ Signature: a incsz -- n
+UNOPMUTCNT >> wordtbl _tbl32
+:w ( ++op/--op ) over +! @ ;
+:w ( op++/op-- ) over @ tuck + rot ! ;
+
+UNOPMUTCNT >> wordtbl _tbl16
+:w ( ++op/--op ) over 16b +! 16b @ ;
+:w ( op++/op-- ) over 16b @ tuck + rot 16b ! ;
+
+UNOPMUTCNT >> wordtbl _tbl8
+:w ( ++op/--op ) over 8b +! 8b @ ;
+:w ( op++/op-- ) over 8b @ tuck + rot 8b ! ;
 
 : unopmut, ( opid -- )
   vmop type typesize
   case 1 of = _tbl8 endof 2 of = _tbl16 endof _tbl32 endcase ( opid tbl )
-  vmop :&loc vmop :compile swap wexec, ;
+  over >> wtbl@ ( opid w )
+  vmop :&loc vmop :compile
+  vmop :*arisz rot 1 and if ( -- ) neg then litn ( w ) execute, ;
 
 ARIOPCNT wordtbl _tbl
 'w +               'w -                'w *                'w /
diff --git a/fs/cc/vm/i386.fs b/fs/cc/vm/i386.fs
@@ -215,19 +215,22 @@ UNOPCNT wordtbl _tbl
 
 : unop, ( opid -- ) vmop :>reg vmop :compilesz _tbl swap wexec ;
 
-: _pre ( w -- ) vmop :dest# vmop :compilesz execute ;
+: _doit vmop :compilesz ( n ) case
+  1 of = inc, endof
+  -1 of = dec, endof
+  r@ i) add, endcase ;
+: _pre ( n -- ) vmop :dest# _doit ;
 \ It's a bit complicated here. Before we inc/dec, we need a copy of the current
 \ value in a new register, which will be our result.
-: _post ( w -- )
-  vmop :keep vmop :>reg vmop :swap vmop :dest# vmop :compilesz swap execute
-  vmop :init vmop :pop ;
+: _post ( n -- )
+  vmop :keep vmop :>reg vmop :swap vmop :dest# swap _doit vmop :init vmop :pop ;
 UNOPMUTCNT wordtbl _tbl
-:w ( ++op ) ['] inc, _pre ;
-:w ( --op ) ['] dec, _pre ;
-:w ( op++ ) ['] inc, _post ;
-:w ( op-- ) ['] dec, _post ;
+:w ( ++op ) _pre ;
+:w ( --op ) neg _pre ;
+:w ( op++ ) _post ;
+:w ( op-- ) neg _post ;
 
-: unopmut, ( opid -- ) _tbl swap wexec ;
+: unopmut, ( opid -- ) vmop :*arisz swap _tbl swap wexec ;
 
 : _
   vmop :>reg vmop :compilesz vmop^ :compile cmp, vmop^ :init
diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs
@@ -30,7 +30,7 @@ ptrset 54 #eq
 54 incdecp 54 #eq
 exprparens 9 #eq
 cnoop ( no result! ) scnt 0 #eq
-42 ptrari 46 #eq
+42 ptrari 50 #eq
 42 50 ptrari2 2 #eq
 array 52 #eq
 global 1234 #eq
diff --git a/fs/tests/cc/test.c b/fs/tests/cc/test.c
@@ -120,6 +120,7 @@ void cnoop() {}
 // test that pointer arithmetics properly multiply operands by 2 or 4.
 int* ptrari(int *x) {
     cnoop(); // this doesn't mess up PS
+    x++; ++x; x--;
     return x + 1;
 }
 // subtracting two pointers yield a number divided by the type size.