commit 6773cb4f81c347a691e24131c6c0985fa0c59849
parent f864277bceaddc0154fcd09902cf8d7034242e18
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 17 Sep 2022 08:07:29 -0400
cc/vm/i386: move opAsm to VMOp :compile
Diffstat:
| M | fs/cc/vm/i386.fs | | | 89 | ++++++++++++++++++++++++++++++++++++++++++------------------------------------- |
1 file changed, 47 insertions(+), 42 deletions(-)
diff --git a/fs/cc/vm/i386.fs b/fs/cc/vm/i386.fs
@@ -68,25 +68,25 @@ create registers AX c, BX c, CX c, DX c, SI c, DI c,
struct+[ VMOp
\ reinitialize selected op to VM_NONE and dealloc registers if needed
: :init dup :loclo VM_REGISTER = if regfree then VMOp :init ;
+
+ \ Resolve current operand as an assembler "src" argument.
+ : :compile
+ 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
+ VM_*CONSTANT of = m) endof
+ VM_*STACKFRAME of = sp d) endof
+ VM_*ARGSFRAME of = bp d) endof
+ VM_*REGISTER of = r! 0 d) endof
+ _err endcase ;
]struct
\ Verify that we're in "neutral" position with regards to registers
: neutral# reglvl if abort" unbalanced reg allot/free" then ;
-\ Resolve current operand as an assembler "src" argument.
-: opAsm ( -- )
- vmop loc case
- VM_CONSTANT of = vmop arg i) endof
- VM_STACKFRAME of = abort" can't address VM_STACKFRAME directly" endof
- VM_REGISTER of = vmop arg r! endof
- VM_*CONSTANT of = vmop arg m) endof
- VM_*STACKFRAME of = sp vmop arg d) endof
- VM_*ARGSFRAME of = bp vmop arg d) endof
- VM_*REGISTER of = vmop arg r! 0 d) endof
- _err endcase ;
-
\ Force current operand to be copied to a register
-: _ regallot dup r! ( regid ) opAsm mov, to vmop arg ;
+: _ regallot dup r! ( regid ) vmop :compile mov, to vmop arg ;
: op>reg vmop loc case
VM_CONSTANT of = _ VM_REGISTER to vmop loc endof
VM_*CONSTANT of = _ VM_REGISTER to vmop loc endof
@@ -152,20 +152,21 @@ struct+[ VMOp
opderef \ 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 bp 0 d) opAsm 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
\ Write op to args
: vmcallarg, ( -- )
- opderef 4 to+ callsz callsz neg bp d) opAsm mov, vmop :init ;
+ opderef 4 to+ callsz callsz neg bp d) vmop :compile mov, vmop :init ;
\ Call the address in current op. If the function has a result, you need to
\ pop it with vmpspop,
: vmcall, ( -- )
callsz ?dup if bp i) sub, 0 to callsz then
- VM_*CONSTANT vmop loc = if vmop arg VM_NONE to vmop loc else opAsm then
+ VM_*CONSTANT vmop loc = if
+ vmop arg VM_NONE to vmop loc else vmop :compile then
abs>rel call, vmop :init ;
\ TODO: copy forth VM's TOS argtype and logic to all VMs. This could save quite
@@ -177,12 +178,12 @@ struct+[ VMOp
bp CELLSZ i) add, ;
\ Push active op to PS.
-: vmpspush, opderef bp CELLSZ i) sub, bp 0 d) opAsm mov, vmop :init ;
+: vmpspush, opderef bp CELLSZ i) sub, bp 0 d) vmop :compile mov, vmop :init ;
\ Code generation - Binary ops
: binopprep ( -- ) \ prepare ops for the binop
- selop1 op>reg opAsm
- selop2 hasop# opAsm ;
+ selop1 op>reg vmop :compile
+ selop2 hasop# vmop :compile ;
: vmadd, binopprep add, vmop :init ;
: vmsub, binopprep sub, vmop :init ;
: vm&, binopprep and, vmop :init ;
@@ -199,9 +200,9 @@ struct+[ VMOp
reglvl 4 >= if dx push, then
\ if op1 is not EAX, we need to push EAX, perform the mul, copy EAX to op1's
\ reg, then pop eax back.
- selop1 op>reg vmop arg AX = not if ax push, ax opAsm mov, then
- selop2 op>reg hasop# opAsm mul, vmop :init
- selop1 vmop arg AX = not if opAsm ax mov, ax pop, then
+ selop1 op>reg vmop arg AX = not if ax push, ax vmop :compile mov, then
+ selop2 op>reg hasop# vmop :compile mul, vmop :init
+ selop1 vmop arg AX = not if vmop :compile ax mov, ax pop, then
reglvl 4 >= if dx pop, then ;
\ Copy the contents of op2 in the memory address pointed out by op1 and deinit
\ op2. In other words, perform a AST_ASSIGN with the right part as op2
@@ -210,35 +211,36 @@ struct+[ VMOp
selop2 vmop loc VM_CONSTARRAY = if \ special case, we have a {1, 2, 3} assign
selop1 vmop loc VM_STACKFRAME = _assert
*op>op selop2 vmop arg selop1 dup @ ( a len ) >r begin ( a )
- opAsm 4 + dup @ i) mov, ( a+4 ) vmop arg 4 + to vmop arg next ( a )
+ vmop :compile 4 + dup @ i) mov, ( a+4 )
+ vmop arg 4 + to vmop arg next ( a )
drop selop2
else
- maybederef selop1 opAsm selop2 opAsm mov, then
+ maybederef selop1 vmop :compile selop2 vmop :compile mov, then
vmop :init ;
: binop=prep ( -- ) \ prepare ops a binop of the "assign" loc
- selop1 opAsm selop2 hasop# opAsm ;
+ selop1 vmop :compile selop2 hasop# vmop :compile ;
: vm<<=, binop=prep isconst# shl, vmop :init ;
: vm>>=, binop=prep isconst# shr, vmop :init ;
\ Code generation - Unary ops
\ Unary operations are performed on the selected op, which can be either op1 or
\ op2.
-: unaryopprep op>reg opAsm ;
+: unaryopprep op>reg vmop :compile ;
: vmneg, unaryopprep neg, ;
: vmnot, ( ~ ) unaryopprep not, ;
: vmboolify, unaryopprep
- opAsm test,
- opAsm 0 i) mov,
- opAsm setnz, ;
+ vmop :compile test,
+ vmop :compile 0 i) mov,
+ vmop :compile setnz, ;
: vmboolnot, unaryopprep
- opAsm test,
- opAsm 0 i) mov,
- opAsm setz, ;
+ vmop :compile test,
+ vmop :compile 0 i) mov,
+ vmop :compile setz, ;
\ pre-inc/dec op1
-: vm++op, opAsm inc, ;
-: vm--op, opAsm dec, ;
+: vm++op, vmop :compile inc, ;
+: vm--op, vmop :compile dec, ;
\ post-inc/dec op1
\ It's a bit complicated here. Before we inc/dec, we need a copy of the current
@@ -249,18 +251,20 @@ struct+[ VMOp
: _ ( 'w -- )
selop1 vmop loc VM_*STACKFRAME = vmop loc VM_*ARGSFRAME = or _assert
selop2 noop# selop1 vmop loc vmop arg selop2 to vmop arg to vmop loc
- selop1 op>reg selop2 opAsm execute vmop :init selop1 ;
+ selop1 op>reg selop2 vmop :compile execute vmop :init selop1 ;
: vmop++, ['] inc, _ ;
: vmop--, ['] dec, _ ;
\ Code generation - Logic
: _
- selop1 op>reg opAsm selop2 opAsm cmp, vmop :init
- selop1 opAsm 0 i) mov, ;
-: vm<, _ opAsm vmop type typeunsigned? if setb, else setl, then ;
-: vm==, _ opAsm setz, ;
-: _ ( 'w -- ) selop1 opAsm selop2 opAsm execute vmop :init selop1 vmboolify, ;
+ selop1 op>reg vmop :compile selop2 vmop :compile cmp, vmop :init
+ selop1 vmop :compile 0 i) mov, ;
+: vm<, _ vmop :compile vmop type typeunsigned? if setb, else setl, then ;
+: vm==, _ vmop :compile setz, ;
+: _ ( 'w -- )
+ selop1 vmop :compile selop2 vmop :compile execute
+ vmop :init selop1 vmboolify, ;
: vm&&, ['] and, _ ;
: vm||, ['] or, _ ;
@@ -286,8 +290,9 @@ struct+[ VMOp
\ simple register, the "test eax, eax" form is more compact. Otherwise, use
\ test ..., -1.
: vmtest,
- opAsm vmop loc $f and VM_REGISTER = if opAsm else -1 i) then test, ( sets Z )
- vmop :init ;
+ vmop :compile vmop loc $f and VM_REGISTER = if
+ vmop :compile else -1 i) then
+ test, ( sets Z ) vmop :init ;
: vmjz, ( a -- ) selop1 vmtest, jz, ;
: vmjz[, ( -- a ) 0 vmjz, _ ;
: vmjnz, ( a -- ) selop1 vmtest, jnz, ;
