commit 911b67320ce3c8c61103b91a9b6f5714026478e9
parent 8f6bdeded1bb580d98408d823d39da293f4fdd31
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 14 Oct 2022 08:18:33 -0400
cc/vm/i386: make opwidth a bit more surgical
Using :typesz! on every :compile induced many problems. We now use it only when
relevant.
Diffstat:
3 files changed, 41 insertions(+), 40 deletions(-)
diff --git a/fs/cc/vm/i386.fs b/fs/cc/vm/i386.fs
@@ -32,13 +32,14 @@ struct+[ VMOp
\ reinitialize selected op to VM_NONE and dealloc registers if needed
: :init dup :loclo VM_REGISTER = if regfree then VMOp :init ;
+ : :dest# loc VM_CONSTANT <> _assert ;
: :isAX? dup :loclo VM_REGISTER = swap arg AX = and ;
: :typesz!
type typesize case
1 of = 8b! endof 2 of = 16b! endof endcase ;
\ Resolve current operand as an assembler "src" argument.
: :compile
- dup :typesz! dup arg swap loc case
+ dup arg swap loc case
VM_CONSTANT of = i) endof
VM_STACKFRAME of = abort" can't address VM_STACKFRAME directly" endof
VM_REGISTER of = r! endof
@@ -47,11 +48,10 @@ struct+[ VMOp
VM_*ARGSFRAME of = bp d) endof
VM_*REGISTER of = r! 0 d) endof
_err endcase ;
-
- : :compileDest dup loc VM_CONSTANT <> _assert :compile ;
+ : :compilesz dup :typesz! :compile ;
\ Force current operand to be copied to a register
- : _ regallot dup r! ( self regid ) over :compile movclr, swap to arg ;
+ : _ regallot dup r! ( self regid ) over :compilesz movclr, swap to arg ;
: :>reg dup >r loc case \ V1=self
VM_CONSTANT of = V1 _ VM_REGISTER V1 to loc endof
VM_*CONSTANT of = V1 _ VM_REGISTER V1 to loc endof
@@ -127,9 +127,7 @@ struct+[ VMOp
vmop :>simple \ for bp 0 d) src mov, to work, "src" has to be "simple"
locsz if sp locsz i) add, then
?dup if bp i) add, then
- vmop loc if
- vmop type typesize 4 <> if bp 0 d) 0 i) mov, then
- bp 0 d) vmop :compile mov, then
+ vmop loc if bp 0 d) vmop :compile mov, then
ret, ;
0 value callsz \ size in bytes of args added to current call
@@ -157,7 +155,7 @@ struct+[ VMOp
\ Code generation - Binary ops
: binop doer ' , does> ( 'w ) @
- vmop :>res harmonizeops vmop :compile vmop^ :compile execute vmop^ :init ;
+ vmop :>res harmonizeops vmop :compilesz vmop^ :compile execute vmop^ :init ;
binop vm+, add,
binop vm-, sub,
binop vm&, and,
@@ -166,23 +164,10 @@ binop vm^, xor,
binop vm<<, shl,
binop vm>>, shr,
-\ Copy the contents of vmop^ in the memory address pointed out by vmop and
-\ deinit vmop^. In other words, perform a "=" binop with the right part as
-\ vmop^ and the left part as vmop.
-: vm=,
- vmop^ loc VM_CONSTARRAY = if \ special case, we have a {1, 2, 3} assign
- vmop loc VM_STACKFRAME = _assert
- vmop :*op vmop^ arg dup @ ( a len ) >r begin ( a )
- vmop :compileDest 4 + dup @ i) mov, ( a+4 )
- vmop arg 4 + to vmop arg next ( a )
- drop
- else
- vmop :?>simple vmop :compileDest vmop^ :compile mov, then
- vmop^ :init ;
-
: binop= doer ' , does> ( 'w ) @
- vmop :?>simple vmop :compileDest vmop^ :hasop# vmop^ :compile
+ vmop :?>simple vmop :compilesz vmop^ :hasop# vmop^ :compile
execute vmop^ :init ;
+binop= _vm=, mov,
binop= vm+=, add,
binop= vm-=, sub,
binop= vm&=, and,
@@ -191,18 +176,27 @@ binop= vm^=, xor,
binop= vm<<=, shl,
binop= vm>>=, shr,
+: vm=,
+ vmop^ loc VM_CONSTARRAY = if \ special case, we have a {1, 2, 3} assign
+ 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 )
+ drop vmop^ :init
+ else _vm=, then ;
+
\ mul and div are special and cannot use binopprep for two reasons: their target
\ operand is hardcoded to EAX, the other operand needs to be a register and EDX
\ gets overwritten by the operation (and, for div, it needs to be set to 0).
: _pre
vmop :isAX? not if
reglvl if ax push, then regallot drop ( reserve AX for vmop )
- ax vmop :compile mov, then
+ ax vmop :compilesz movclr, then
vmop^ :>reg ;
: _post
vmop^ :init
vmop :isAX? not if
- vmop :compileDest ax mov, regfree
+ vmop :compilesz ax mov, regfree
reglvl if ax pop, then then ;
: vm*=, _pre vmop^ :compile mul, _post ;
: vm/=, _pre dx dx xor, vmop^ :compile div, _post ;
@@ -215,15 +209,15 @@ binop= vm>>=, shr,
\ Unary operations are performed on the selected op, which can be either op1 or
\ op2.
-: unaryop doer ' , does> ( 'w ) @ vmop :>reg vmop :compileDest execute ;
+: unaryop doer ' , does> ( 'w ) @ vmop :>reg vmop :compile execute ;
unaryop vmneg, neg,
unaryop vmnot, not, ( ~ )
: vmboolify, vmneg, vmop :compile 0 i) mov, vmop :compile setnz, ;
: vmboolnot, vmneg, vmop :compile 0 i) mov, vmop :compile setz, ;
\ pre-inc/dec op1
-: vm++op, vmop :compileDest inc, ;
-: vm--op, vmop :compileDest dec, ;
+: vm++op, vmop :dest# vmop :compilesz inc, ;
+: vm--op, vmop :dest# vmop :compilesz dec, ;
: vm+n, ( n -- ) vmop :loclo VM_CONSTANT = if
to+ vmop arg
@@ -233,7 +227,7 @@ unaryop vmnot, not, ( ~ )
\ 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.
: _ ( 'w -- )
- vmop :keep vmop :>reg vmop :swap vmop :compileDest swap execute
+ vmop :keep vmop :>reg vmop :swap vmop :dest# vmop :compilesz swap execute
vmop :init vmop :pop ;
: vmop++, ['] inc, _ ;
: vmop--, ['] dec, _ ;
@@ -241,7 +235,7 @@ unaryop vmnot, not, ( ~ )
\ Code generation - Logic
: _
- vmop :>reg vmop :compile vmop^ :compile cmp, vmop^ :init
+ vmop :>reg vmop :compilesz vmop^ :compile cmp, vmop^ :init
vmop :compile 0 i) mov, ;
: vm<, _ vmop :compile vmop type typeunsigned? if setb, else setl, then ;
: vm>, _ vmop :compile vmop type typeunsigned? if seta, else setg, then ;
@@ -249,7 +243,7 @@ unaryop vmnot, not, ( ~ )
: vm>=, _ vmop :compile vmop type typeunsigned? if setae, else setge, then ;
: vm==, _ vmop :compile setz, ;
: vm!=, _ vmop :compile setnz, ;
-: vm&&, vmop :>reg vmop :compile vmop :compile test, nop, forward8 jz,
+: vm&&, vmop :>reg vmop :compile vmop :compile test, forward8 jz,
vmop :compile vmop^ :compile or, vmop^ :init vmboolify, forward! ;
: vm||, vmop :>reg vmop :compile vmop^ :compile or, vmop^ :init vmboolify, ;
@@ -274,7 +268,7 @@ unaryop vmnot, not, ( ~ )
\ simple register, the "test eax, eax" form is more compact. Otherwise, use
\ test ..., -1.
: vmtest,
- vmop :compileDest vmop :loclo VM_REGISTER = if
+ vmop :dest# vmop :compile vmop :loclo VM_REGISTER = if
vmop :compile else -1 i) then
test, ( sets Z ) vmop :init ;
: vmjz, ( a -- ) vmtest, abs>rel jz, ;
diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs
@@ -64,7 +64,7 @@ mydata $42 structset mydata 4 + @ $42345678 #eq
42 globstructset globstructget 42 #eq
globdata 4 + 16b @ 42 #eq
0 callfuncidx 42 #eq
-2 callfuncidx -42 #eq
+2 callfuncidx 82 #eq
2 3 binop1 1 #eq
'2' binop2 44 #eq
@@ -75,6 +75,7 @@ structop1 44 #eq
structop2 45 #eq
opwidth1 42 #eq
opwidth2 42 #eq
+opwidth3 $129 #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
@@ -6,14 +6,13 @@
short retconst() {
return #[ MYCONST c]# ;
}
-int variables() {
- unsigned int foo = 40, _bar = 2;
+short variables() {
+ short foo = 40, _bar = 2;
_bar = foo + _bar;
return foo + _bar;
}
// test unary op and that we don't require whitespace around symbols
-// TODO: if I change "int a" below to "short a", I get a PS leak during tests.
-short neg() {int a=$2a; return -a;}
+int neg() {int a=$2a; return -a;}
int bwnot() {
int a='*';
return ~a;
@@ -256,7 +255,7 @@ void globstructset(short val) {
// support funcsig ident in global arrays and don't mess up thing when the
// function's return type isn't 4b
typedef short (*ShortRet)();
-static ShortRet globfuncs[3] = {retconst, NULL, neg};
+static ShortRet globfuncs[3] = {retconst, NULL, variables};
int callfuncidx(int idx) {
if (idx != 1) {
@@ -312,14 +311,21 @@ void cond1() {
if (x==0) x++; else x--;
}
// The forth VM used to assign to the SF in the wrong width
-int opwidth1() {
+short opwidth1() {
short x = 42;
short y = $12345678;
return x;
}
-int opwidth2() {
+short opwidth2() {
short x = 42;
short y = 12;
y += $12345678;
return x;
}
+// The i386 VM didn't carry the $100
+int opwidth3() {
+ int x = 42;
+ unsigned char y = $ff;
+ x += y;
+ return x;
+}
