commit 68723241871601880b35701e8d07110f29575c44
parent 19a1cbf0c68457a66e420f3a42682278a90f1e19
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 25 Oct 2022 17:28:49 -0400
cc: fix a few bugs in the VMs
One of the bugs made Collapse OS' "AND" op buggy under i386 and made parsing
of decimal values mostly broken. This is fixed now. "LIST" still doesn't work
under i386 (but still works under the POSIX VM).
Diffstat:
6 files changed, 46 insertions(+), 38 deletions(-)
diff --git a/fs/cc/vm/forth.fs b/fs/cc/vm/forth.fs
@@ -95,18 +95,17 @@ struct+[ VMOp
locsz ?dup if r+, then
exit, ;
+0 value callsz \ length in bytes of the current call args
\ Write op to args
-: vmcallarg, ( -- ) vmop :compile vmop :forgetTOS ;
+: vmcallarg, ( -- ) vmop :compile vmop :forgetTOS CELLSZ to+ callsz ;
\ Call the address in current op. If the function has a result, you need to
\ pop it with vmpspop,
: vmcall, ( -- )
VM_CONSTANT vmop loc = if
vmop arg execute, vmop :init
- else vmop :compile vmop :forgetTOS compile execute then
- \ psoff is *not* supposed to be nonzero when we begin calling a function,
- \ which makes this line below work.
- 0 to psoff ;
+ else vmop :compile vmop :forgetTOS compile execute PS- then
+ 0 to@! callsz neg to+ psoff ;
\ Allocate a new register for active op and pop 4b from PS into it.
: vmpspop, vmop :noop# vmop :>TOS PS+ vmop :>reg ;
diff --git a/fs/cc/vm/i386.fs b/fs/cc/vm/i386.fs
@@ -1,36 +1,36 @@
\ C compiler virtual machine for i386
\ For usage example, see tests/cc/vm.fs
-?f<< asm/i386.fs
+?f<< /asm/i386.fs
+?f<< /lib/bit.fs
?f<< /cc/vm/commonlo.fs
-\ Register management
-\ When an operand needs to go to a register, we allocate one for it. when it
-\ doesn't need it anymore, we deallocate it. Registers have to be deallocated
-\ in the reverse order they were allocated.
-\ Allocation works by having a list of register to allocate, and a pointer,
-\ "reglvl" which indicate which register can be used next. When we run out of
-\ register, allocating a register pushes the first register to the stack and
-\ then allocates it.
-
-\ DX is not used in the regular allot stack so that it can be used "freely" is
-\ code generation.
-5 const REGCNT
-create registers REGCNT nc, AX BX CX SI DI
-0 value reglvl
-
-: curreg ( -- regid )
- reglvl REGCNT < if
- registers reglvl + c@ ( regid ) else
- ax push, AX ( regid ) then ;
-: regallot ( -- regid ) curreg 1 to+ reglvl ;
-: regfree ( -- )
- reglvl not if abort" too many regfree" then
- -1 to+ reglvl reglvl REGCNT >= if ax pop, then ;
+\ Mask of registers (by their ID in asm/i386) that can be allocated as
+\ VM_REGISTER. DX is not used in the regular allot stack so that it can be used
+\ "freely" in code generation.
+$cb const USABLEREGS \ 11001011 = di si bx cx ax
+0 value regused \ a bit mask of register used.
+
+: regusable? ( regid -- f ) USABLEREGS swap bit? ;
+: regused? ( regid -- f ) regused swap bit? ;
+\ Allocate a free register.
+: regallot ( -- regid )
+ 8 >r 0 begin ( regid )
+ dup regusable? if dup regused? not if ( regid )
+ rdrop regused over bit1! to regused ( regid ) ." allot " dup . nl> exit then then
+ 1+ next ( regid ) \ all used
+ abort" TODO: support deeper expressions" ;
+: regfree ( regid -- ) ." free " dup . nl>
+ regused over bit? not if abort" register allocation imbalance" then
+ regused swap bit0! to regused ;
+: pushregs
+ 8 >r begin r@ 1- dup regused? if r! push, else drop then next ;
+: popregs
+ 8 >r begin 8 r@ - dup regused? if r! pop, else drop then next ;
struct+[ VMOp
\ reinitialize selected op to VM_NONE and dealloc registers if needed
- : :init dup :loclo VM_REGISTER = if regfree then VMOp :init ;
+ : :init dup :loclo VM_REGISTER = if dup arg regfree then VMOp :init ;
: :dest# loc VM_CONSTANT <> _assert ;
: :isAX? dup :loclo VM_REGISTER = swap arg AX = and ;
@@ -108,7 +108,7 @@ struct+[ VMOp
]struct
\ Verify that we're in "neutral" position with regards to registers
-: neutral# reglvl if abort" unbalanced reg allot/free" then ;
+: neutral# regused if abort" unbalanced reg allot/free" then ;
\ If one op is larger than the other, copy the smaller one to a register and
\ copy the type of the larger op to the smaller.
@@ -143,9 +143,10 @@ struct+[ VMOp
\ pop it with vmpspop,
: vmcall, ( -- )
callsz ?dup if bp i) sub, 0 to callsz then
+ pushregs
VM_CONSTANT vmop loc = if
vmop arg VM_NONE to vmop loc abs>rel else vmop :compile then
- call, vmop :init ;
+ call, popregs vmop :init ;
\ Allocate a new register for active op and pop 4b from PS into it.
: vmpspop,
@@ -191,16 +192,18 @@ binop= vm>>=, shr,
\ 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).
+0 value _restoreAX
: _pre
+ 0 to _restoreAX
vmop :isAX? not if
- reglvl if ax push, then regallot drop ( reserve AX for vmop )
+ AX regused? if 1 to _restoreAX ax push, else regallot drop then
ax vmop :compilesz movclr, then
vmop^ :>reg ;
: _post
vmop^ :init
vmop :isAX? not if
- vmop :compilesz ax mov, regfree
- reglvl if ax pop, then then ;
+ vmop :compilesz ax mov,
+ _restoreAX if ax pop, else AX regfree then then ;
: vm*=, _pre vmop^ :compile mul, _post ;
: vm/=, _pre dx dx xor, vmop^ :compile div, _post ;
: vm%=, _pre dx dx xor, vmop^ :compile div, ax dx mov, _post ;
diff --git a/fs/tests/app/cos/cvm.fs b/fs/tests/app/cos/cvm.fs
@@ -23,9 +23,10 @@ vm running #
\ CODE >R $3e c, 07 c,
\ CODE (next) $09 c, $07 c,
\ CODE PC! $33 c, $07 c,
-\ : BOOT 42 3 >R BEGIN 1 + NEXT 0 PC! BYE ;
+\ CODE AND $27 c, $07 c,
+\ : BOOT 42 3 >R BEGIN 1 + NEXT 44 AND 0 PC! BYE ;
-50 COS_steps not #
+60 COS_steps not #
COS_printdbg
-myres 45 #eq
+myres 44 #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
@@ -72,6 +72,7 @@ binop3 $605 #eq
binop5 1 #eq
binop6 $1fe #eq
binop7 0 #eq
+binop8 $ffffffab #eq
structop1 44 #eq
structop2 45 #eq
structop3 42 #eq
diff --git a/fs/tests/cc/test.c b/fs/tests/cc/test.c
@@ -303,6 +303,10 @@ int binop7() {
int y = 0;
return x && y;
}
+// multiple function calls in an expression can do funky things
+int binop8() {
+ return bwnot() + neg();
+}
short structop1() {
globdata.bar += 2;
return globdata.bar;
