commit a0ae72ca1634cf37e5e14ddb4e6dbfedbd037b4b
parent b1a35c900a35aa84b4238949f40a62aa07c8d3f4
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 18 Sep 2022 09:06:39 -0400
cc/vm: move &op>op and *op>op to VMOp struct
Diffstat:
5 files changed, 41 insertions(+), 52 deletions(-)
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -117,8 +117,8 @@ UOPSCNT wordtbl uopgentbl ( -- )
:w ( - ) vmneg, ;
:w ( ~ ) vmnot, ;
:w ( ! ) vmboolnot, ;
-'w &op>op ( & )
-'w *op>op ( * )
+:w ( & ) vmop :&op ;
+:w ( * ) vmop :*op ;
:w ( ++ ) vm++op, ;
:w ( -- ) vm--op, ;
@@ -176,7 +176,7 @@ BOPSCNT wordtbl bopgentblpost ( -- )
of Declare :isglobal? r@ Declare address mem>op endof
of Declare :isarg? r@ Declare address ps+>op endof
r@ Declare address sf+>op
- r@ Declare nbelem ( nbelem ) 1 > if &op>op then
+ r@ Declare nbelem ( nbelem ) 1 > if vmop :&op then
endcase ;
ASTIDCNT wordtbl gentbl ( node -- )
diff --git a/fs/cc/vm/commonlo.fs b/fs/cc/vm/commonlo.fs
@@ -22,11 +22,13 @@ $02 const VM_STACKFRAME \ on RS at RSP+arg
$03 const VM_ARGSFRAME \ on PS at PSP+arg
$04 const VM_REGISTER \ in an implementation-specific register of id "arg"
$05 const VM_CONSTARRAY \ pointer to an array with the 1st elem being length
+$06 const VM_TOS \ top of PS
\ Below, references to a location (points to X)
$11 const VM_*CONSTANT
$12 const VM_*STACKFRAME
$13 const VM_*ARGSFRAME
$14 const VM_*REGISTER
+$16 const VM_*TOS
struct[ VMOp
sfield loc \ one of the VM_ constants
@@ -50,6 +52,16 @@ struct[ VMOp
: :swap ( arg loc&type self -- arg loc&type )
>r >r >r \ V1=self V2=loc&type V3=arg
V1 :push r> r> ( arg loc&type ) r> :pop ;
+ \ if possible, transform current operand in its reference, f=1 means success.
+ : :?&op ( -- f ) dup :pointer? if dup :loclo swap to loc 1 else drop 0 then ;
+ : :&op :?&op _assert ;
+ : :*op dup loc case
+ VM_CONSTANT of = endof
+ VM_STACKFRAME of = endof
+ VM_ARGSFRAME of = endof
+ VM_REGISTER of = endof
+ VM_TOS of = endof
+ _err endcase dup loc $10 or swap to loc ;
]struct
create operands VMOp SZ 2 * allot
diff --git a/fs/cc/vm/forth.fs b/fs/cc/vm/forth.fs
@@ -13,13 +13,6 @@
\ and op2. Those memory areas correspond to "oparg", which is the area itself
\ directly.
-\ VM_TOS is a special type of location which indicates that the op lives on PS
-\ directly. This location is set after an operation and has limited uses: it is
-\ used to return a value during vmret, and it is used as a staging area to be
-\ pushed to a register.
-$06 const VM_TOS
-$16 const VM_*TOS
-
\ When accumulating call arguments, we need to keep track of how many we have
\ and apply the corresponding offset to VM_ARGSFRAME.
0 value psoff
@@ -48,28 +41,22 @@ struct+[ VMOp
\ Resolve current operand and forces dereferencing. Always yields VM_TOS.
: :compile ( -- ) >r
r@ :compile& r@ loc VM_*TOS = if 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 )
+ 4 lshift VM_REGISTER or to r> loc ;
+ \ dereference current operand
+ : :*op dup >r :pointer? if
+ r@ :compile r@ :>*TOS r> :>reg else
+ r> VMOp :*op then ;
]struct
\ Verify that we're in "neutral" position with regards to PS
: neutral# psoff if abort" unbalanced PS" then ;
-\ transform current operand in its reference
-: ?&op>op ( -- f ) vmop :pointer? if vmop :loclo to vmop loc 1 else 0 then ;
-: &op>op ?&op>op _assert ;
-
-: op>reg vmop :loclo VM_REGISTER = if exit then
- hasop# ?&op>op ( f ) vmop :compile& vmop 'arg litn compile ! PS- ( f )
- 4 lshift VM_REGISTER or to vmop loc ;
-
\ If any of the op is VM_TOS, push it to a register.
-: _ vmop :TOS? if op>reg then ;
+: _ vmop :TOS? if vmop :>reg then ;
: ?tos>reg _ selop^ _ selop^ ;
-\ dereference current operand
-: *op>op vmop :pointer? if
- vmop :compile vmop :>*TOS op>reg else
- vmop loc $10 or to vmop loc then .ops ;
-
\ We override the common :push/:pop mechanism to adjust to the weirness of
\ the forth backend. We use :push/:pop when 2 ops aren't enough to store all
\ variables needed to resolve the expression. This happens in nested binops.
@@ -119,7 +106,7 @@ struct+[ VMOp
0 to psoff ;
\ Allocate a new register for active op and pop 4b from PS into it.
-: vmpspop, noop# vmop :>TOS PS+ op>reg ;
+: vmpspop, noop# vmop :>TOS PS+ vmop :>reg ;
\ Push active op to PS.
: vmpspush, vmop :compile vmop :forgetTOS PS- ;
@@ -131,7 +118,7 @@ struct+[ VMOp
: unop doer ' , does> @ ( w )
isconst? if vmop arg swap execute to vmop arg else
litn PS+
- vmop :keep &op>op vmop :compile vmop :forgetTOS vmop :pop compile apply
+ vmop :keep vmop :&op vmop :compile vmop :forgetTOS vmop :pop compile apply
PS- PS- then ;
unop vmneg, neg
@@ -146,7 +133,7 @@ unop vm--op, 1-
: apply ( w a -- n ) \ Same as unop's apply, but yield old value
tuck @ ( a w old ) dup rot execute ( a old new ) rot ! ;
: postop doer ' , does> @ ( w ) litn PS+
- &op>op vmop :compile vmop :forgetTOS compile apply PS- vmop :>TOS ;
+ vmop :&op vmop :compile vmop :forgetTOS compile apply PS- vmop :>TOS ;
postop vmop++, 1+
postop vmop--, 1-
@@ -181,7 +168,7 @@ binop vm||, or and
vmop^ :hasop# vmop^ :compile \ op2 is TOS
( w ) execute, PS- \ result on TOS
vmop :forgetTOS
- vmop :pop &op>op vmop :compile
+ vmop :pop vmop :&op vmop :compile
vmop :forgetTOS vmop^ :forgetTOS compile ! PS- PS- ;
binop= vm<<=, lshift
@@ -199,7 +186,7 @@ binop= vm>>=, rshift
: vmmov,
vmop^ :hasop# vmop^ loc VM_CONSTARRAY = if _movarray, else
vmop^ :compile \ op2 is TOS
- vmop :TOS? if compile swap then &op>op vmop :compile
+ vmop :TOS? if compile swap then vmop :&op vmop :compile
vmop :forgetTOS vmop^ :forgetTOS compile ! PS- PS- then ;
\ Jumping
diff --git a/fs/cc/vm/i386.fs b/fs/cc/vm/i386.fs
@@ -108,6 +108,14 @@ struct+[ VMOp
VM_*REGISTER of =
V1 arg r! V1 arg r! 0 d) mov, VM_REGISTER V1 to loc endof
endcase rdrop ;
+
+ \ if possible, dereference current operand
+ : :*op dup loc case
+ VM_*CONSTANT of = dup :>reg endof
+ VM_*STACKFRAME of = dup :>reg endof
+ VM_*ARGSFRAME of = dup :>reg endof
+ VM_*REGISTER of = dup :deref endof
+ endcase VMOp :*op ;
]struct
\ Verify that we're in "neutral" position with regards to registers
@@ -120,24 +128,6 @@ struct+[ VMOp
vmop loc VM_*REGISTER = vmop :loclo VM_STACKFRAME = or
vmop loc VM_*ARGSFRAME = or if vmop^ :deref then ;
-\ if possible, transform current operand in its reference
-: &op>op vmop loc case
- VM_*STACKFRAME of = VM_STACKFRAME to vmop loc endof
- VM_*CONSTANT of = VM_CONSTANT to vmop loc endof
- VM_*REGISTER of = VM_REGISTER to vmop loc endof
- _err endcase ;
-
-\ if possible, dereference current operand
-: *op>op vmop loc case
- VM_CONSTANT of = VM_*CONSTANT to vmop loc endof
- VM_*CONSTANT of = vmop :>reg *op>op endof
- VM_STACKFRAME of = VM_*STACKFRAME to vmop loc endof
- VM_*STACKFRAME of = vmop :>reg *op>op endof
- VM_*ARGSFRAME of = vmop :>reg *op>op endof
- VM_REGISTER of = VM_*REGISTER to vmop loc endof
- VM_*REGISTER of = vmop :deref VM_*REGISTER to vmop loc endof
- _err endcase ;
-
\ Code generation - Functions, calls, ret, pspush, pspop
\ generate function prelude code by allocating "locsz" bytes on RS.
@@ -210,7 +200,7 @@ struct+[ VMOp
: vmmov,
vmop^ loc VM_CONSTARRAY = if \ special case, we have a {1, 2, 3} assign
vmop loc VM_STACKFRAME = _assert
- *op>op vmop^ arg dup @ ( a len ) >r begin ( a )
+ vmop :*op vmop^ arg dup @ ( a len ) >r begin ( a )
vmop :compile 4 + dup @ i) mov, ( a+4 )
vmop arg 4 + to vmop arg next ( a )
drop
diff --git a/fs/tests/cc/vm.fs b/fs/tests/cc/vm.fs
@@ -72,13 +72,13 @@ code test5
ops$
\ bar = &foo
selop2 4 sf+>op
- &op>op
+ vmop :&op
selop1 0 sf+>op
vmmov,
ops$
\ return *bar
selop1 0 sf+>op
- *op>op
+ vmop :*op
vmret,
test5 42 #eq
@@ -93,14 +93,14 @@ code test6
ops$
\ bar = &foo
selop2 4 sf+>op
- &op>op
+ vmop :&op
selop1 0 sf+>op
vmmov,
ops$
\ *bar = 54
selop2 54 const>op
selop1 0 sf+>op
- *op>op
+ vmop :*op
vmmov,
ops$
\ return foo
