commit bde754e4c3e25956b7c7afe5e2dc59cec31e8065
parent a0ae72ca1634cf37e5e14ddb4e6dbfedbd037b4b
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 18 Sep 2022 10:46:51 -0400
cc/vm: make VMOp :compile's width dependent on type
Diffstat:
7 files changed, 50 insertions(+), 8 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -101,9 +101,9 @@ extends Node struct[ Statements
extends DeclOrFunc struct[ Function
sfield sfsize
- sfield type
+ sfield type \ type of return value
sfield address
- sfield cursf \ last SF offset computed
+ sfield cursf \ last SF offset computed
sfield flags
: _ ( name args-or-stmts -- dnode-or-0 )
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -171,7 +171,10 @@ BOPSCNT wordtbl bopgentblpost ( -- )
'w vm>>=,
: decl>op ( dnode -- )
- dup Declare type to vmop type ( dnode )
+ \ if our node is a func, op type is TYPE_VOID, *not* func return type.
+ dup Node id AST_FUNCTION = if
+ TYPE_VOID else dup Declare type then
+ to vmop type ( dnode )
case
of Declare :isglobal? r@ Declare address mem>op endof
of Declare :isarg? r@ Declare address ps+>op endof
@@ -228,7 +231,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
Node parent dup Function :locsize swap to Function cursf ;
:w ( Ident ) dup identfind ?dup if ( inode dnode )
nip decl>op else ( inode )
- Ident name sysdict @ find ?dup _assert mem>op then ;
+ Ident name sysdict @ find ?dup _assert TYPE_VOID to vmop type mem>op then ;
:w ( UnaryOp )
_debug if ." unaryop: " dup printast nl> .ops then
dup genchildren
diff --git a/fs/cc/type.fs b/fs/cc/type.fs
@@ -9,8 +9,15 @@
\ b5:3 = *lvl. Indirection levels, from 0 to 7.
$0 const TYPE_VOID
+$8 const TYPE_VOID*
+$1 const TYPE_CHAR
+$9 const TYPE_CHAR*
+$2 const TYPE_SHORT
+$a const TYPE_SHORT*
$3 const TYPE_INT
+$b const TYPE_INT*
$7 const TYPE_UINT
+$f const TYPE_UINT*
4 stringlist typenames "void" "char" "short" "int"
: typeunsigned? ( type -- flags ) 2 rshift 1 and ;
diff --git a/fs/cc/vm/commonlo.fs b/fs/cc/vm/commonlo.fs
@@ -4,6 +4,14 @@
\ 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.
+
+\ Relation between "loc" and type:
+\ Location is where the value is stored. We track a level of indirection here
+\ for performance reasons: CPUs generally can access locations with a level of
+\ indirection. The type contains the "logical" level of indirection of the value
+\ stored in the location. If, for example, we have a int* stored in a
+\ VM_REGISTER, it's the exact equivalent of having an int stored in a
+\ VM_*REGISTER. The number is the same.
?f<< /cc/type.fs
: _err abort" vm error" ;
@@ -53,7 +61,10 @@ struct[ VMOp
>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 ( -- f )
+ dup :pointer? if
+ dup :loclo over to loc dup type type*lvl+ swap to type 1
+ else drop 0 then ;
: :&op :?&op _assert ;
: :*op dup loc case
VM_CONSTANT of = endof
@@ -61,7 +72,8 @@ struct[ VMOp
VM_ARGSFRAME of = endof
VM_REGISTER of = endof
VM_TOS of = endof
- _err endcase dup loc $10 or swap to loc ;
+ _err endcase
+ dup loc $10 or over to loc dup type type*lvl- swap to type ;
]struct
create operands VMOp SZ 2 * allot
diff --git a/fs/cc/vm/forth.fs b/fs/cc/vm/forth.fs
@@ -38,9 +38,12 @@ struct+[ VMOp
\ VM_*TOS.
: :compile& >r
r@ :pointer? if r@ :loclo r@ _ r> :>*TOS else r@ loc r@ _ r> :>TOS then ;
+ : :typesz!
+ type typesize case
+ 1 of = [compile] 8b endof 2 of = [compile] 16b endof endcase ;
\ Resolve current operand and forces dereferencing. Always yields VM_TOS.
: :compile ( -- ) >r
- r@ :compile& r@ loc VM_*TOS = if compile @ r@ :>TOS then rdrop ;
+ r@ :compile& r@ loc VM_*TOS = if r@ :typesz! 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 ;
diff --git a/fs/cc/vm/i386.fs b/fs/cc/vm/i386.fs
@@ -69,9 +69,12 @@ struct+[ VMOp
\ reinitialize selected op to VM_NONE and dealloc registers if needed
: :init dup :loclo VM_REGISTER = if regfree then VMOp :init ;
+ : :typesz!
+ type typesize case
+ 1 of = 8b! endof 2 of = 16b! endof endcase ;
\ Resolve current operand as an assembler "src" argument.
: :compile
- dup arg swap loc case
+ dup :typesz! 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
diff --git a/fs/tests/cc/vm.fs b/fs/tests/cc/vm.fs
@@ -177,9 +177,23 @@ code test11 ( n -- n-42 )
42 const>op
vmcallarg,
' test3 mem>op ( a b -- a-b )
+ TYPE_VOID to vmop type
vmcall,
vmpspop,
vmret,
54 test11 12 #eq
+\ variable op width
+ops$
+here ," hello" ( a )
+code test12 ( n -- c )
+ 4 0 vmprelude,
+ selop1 ( a ) const>op
+ TYPE_CHAR* to vmop type
+ selop2 0 ps+>op
+ selop1 vmadd,
+ vmop :*op
+ vmret,
+0 test12 'h' #eq
+1 test12 'e' #eq
testend
