commit 30eb221dc5d83a0d0c2cd806169c1345c157d17c
parent e21b0d58a2a6318211eeab557712c62f58bc206e
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 17 Sep 2022 07:37:58 -0400
cc/vm: add "type" field
Its value is a cc/type. The replaces the "opsunsigned" flag and will help
having width-variable ops generation.
Diffstat:
6 files changed, 26 insertions(+), 20 deletions(-)
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -171,7 +171,7 @@ BOPSCNT wordtbl bopgentblpost ( -- )
'w vm>>=,
: decl>op ( dnode -- )
- dup Declare type typeunsigned? if opsunsigned! then ( dnode )
+ dup Declare type to vmop type ( dnode )
case
of Declare :isglobal? r@ Declare address mem>op endof
of Declare :isarg? r@ Declare address ps+>op endof
diff --git a/fs/cc/type.fs b/fs/cc/type.fs
@@ -4,18 +4,22 @@
\ All information related to a basic type fits in a 32b integer, so that's
\ how "type" is passed around. Structure:
-\ b2:0 = size. 0=0 1=8 2=16 3=32 4+=reserved for future use
-\ b3 = sign. 0=signed 1=unsigned
-\ b6:4 = *lvl. Indirection levels, from 0 to 7.
+\ b1:0 = size. 0=0 1=8 2=16 3=32
+\ b2 = sign. 0=signed 1=unsigned
+\ b5:3 = *lvl. Indirection levels, from 0 to 7.
-0 const TYPE_VOID
-4 const TYPE_UINT
+$0 const TYPE_VOID
+$3 const TYPE_INT
+$7 const TYPE_UINT
4 stringlist typenames "void" "char" "short" "int"
: typeunsigned? ( type -- flags ) 2 rshift 1 and ;
+: typesigned! ( type -- type ) $1b and ;
+: typeunsigned! ( type -- type ) $4 or ;
: type*lvl ( type -- lvl ) 3 rshift 3 and ;
-: type*lvl! ( lvl type -- type ) $f and swap 3 lshift or ;
-: type*lvl+ ( type -- type ) dup type*lvl 1+ swap type*lvl! ;
+: type*lvl! ( lvl type -- type ) $1f and swap 3 lshift or ;
+: type*lvl+ ( type -- type ) 8 + $1f and ;
+: type*lvl- ( type -- type ) 8 - $1f and ;
create _ 0 c, 1 c, 2 c, 4 c,
: typesize ( type -- size-in-bytes )
dup type*lvl if drop 4 else 3 and _ + c@ then ;
diff --git a/fs/cc/vm/commonhi.fs b/fs/cc/vm/commonhi.fs
@@ -1,3 +1,3 @@
\ Code common to all VM implementations (high part)
-: ops$ selop2 vmop :init selop1 vmop :init 0 to opsunsigned neutral# ;
+: ops$ selop2 vmop :init selop1 vmop :init neutral# ;
diff --git a/fs/cc/vm/commonlo.fs b/fs/cc/vm/commonlo.fs
@@ -4,6 +4,7 @@
\ Loading another VM impl will break the previous one. In Dusk, it's not a
\ problem because there is no CC cross-compiling. You'll always want to compile
\ with one VM: your CPU's.
+?f<< /cc/type.fs
: _err abort" vm error" ;
: _assert not if _err then ;
@@ -28,14 +29,16 @@ $13 const VM_*ARGSFRAME
$14 const VM_*REGISTER
struct[ VMOp
- sfield loc \ one of the VM_ constants
+ sfield loc \ one of the VM_ constants
sfield arg
+ sfield type \ from cc/type
sfield other \ link to the "other" op
4 &+ 'arg
\ Initialize op to VM_NONE, "freeing" any resource it held.
- : :init VM_NONE swap to loc ;
+ : :init VM_NONE over to loc TYPE_INT swap to type ;
: :loclo loc $f and ;
- : :deref? loc $10 and bool ;
+ \ Is op a pointer?
+ : :pointer? loc $10 and bool ;
: :noop# loc VM_NONE = _assert ;
: :keep ( self -- arg loc ) dup arg swap loc ;
: :push ( self -- arg loc ) dup >r :keep VM_NONE to r> loc ;
@@ -47,7 +50,6 @@ operands structbind VMOp vmop
operands VMOp SZ + structbind VMOp vmop^ \ the "other" op
vmop^ :self to vmop other
vmop :self to vmop^ other
-0 value opsunsigned \ when 1, ops are considered unsigned
: _sel ['] vmop rebind vmop other ['] vmop^ rebind ;
: selop1 ( -- ) operands _sel ;
@@ -55,7 +57,6 @@ vmop :self to vmop^ other
: selectedop ( -- n ) \ 0 == Op1 1 == Op2
vmop :self operands <> ;
: selop^ vmop other _sel ;
-: opsunsigned! 1 to opsunsigned ;
: .ops selectedop .x1 spc> 4 >r operands begin @+ .x spc> next drop nl> ;
diff --git a/fs/cc/vm/forth.fs b/fs/cc/vm/forth.fs
@@ -44,7 +44,7 @@ struct+[ VMOp
\ Resolve current operand and compile a push to PS as either VM_TOS or
\ VM_*TOS.
: :compile& >r
- r@ :deref? if r@ :loclo r@ _ r> :>*TOS else r@ loc r@ _ r> :>TOS then ;
+ r@ :pointer? if r@ :loclo r@ _ r> :>*TOS else r@ loc r@ _ r> :>TOS then ;
\ Resolve current operand and forces dereferencing. Always yields VM_TOS.
: :compile ( -- ) >r
r@ :compile& r@ loc VM_*TOS = if compile @ r@ :>TOS then rdrop ;
@@ -54,7 +54,7 @@ struct+[ VMOp
: neutral# psoff if abort" unbalanced PS" then ;
\ transform current operand in its reference
-: ?&op>op ( -- f ) vmop :deref? if vmop :loclo to vmop loc 1 else 0 then ;
+: ?&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
@@ -66,7 +66,7 @@ struct+[ VMOp
: ?tos>reg _ selop^ _ selop^ ;
\ dereference current operand
-: *op>op vmop :deref? if
+: *op>op vmop :pointer? if
vmop :compile vmop :>*TOS op>reg else
vmop loc $10 or to vmop loc then .ops ;
@@ -156,8 +156,9 @@ postop vmop--, 1-
: swapifTOS vmop :TOS? if compile swap then ;
\ 2 fields: signed op, unsigned op
-: binop doer ' , ' , does> opsunsigned if CELLSZ + then @ ( w )
- selop1 vmop :compile \ op1 is TOS
+: binop doer ' , ' , does> ( 'w )
+ selop1 vmop type typeunsigned? if CELLSZ + then @ ( w )
+ vmop :compile \ op1 is TOS
selop2 hasop# swapifTOS
vmop :compile vmop :forgetTOS
( w ) execute, PS- selop1 ; \ result in op1 as VM_TOS
diff --git a/fs/cc/vm/i386.fs b/fs/cc/vm/i386.fs
@@ -258,7 +258,7 @@ struct+[ VMOp
: _
selop1 op>reg opAsm selop2 opAsm cmp, vmop :init
selop1 opAsm 0 i) mov, ;
-: vm<, _ opAsm opsunsigned if setb, else setl, then ;
+: vm<, _ opAsm vmop type typeunsigned? if setb, else setl, then ;
: vm==, _ opAsm setz, ;
: _ ( 'w -- ) selop1 opAsm selop2 opAsm execute vmop :init selop1 vmboolify, ;
: vm&&, ['] and, _ ;
