commit d53a7652bfbb94f9296649cd514dbb2478d67102
parent a34fd780e9c40b9c1444893ef069de1e567de42c
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 15 Jun 2022 12:51:09 -0400
cc: make some more of cc/gen use cc/vm
Diffstat:
| M | fs/asm.fs | | | 1 | + |
| M | fs/cc/gen.fs | | | 96 | +++++++++++++++++++++++++++---------------------------------------------------- |
| M | fs/cc/vm.fs | | | 91 | +++++++++++++++++++++++++++++++++++++++++++++++++------------------------------ |
| M | fs/tests/cc/vm.fs | | | 73 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- |
4 files changed, 163 insertions(+), 98 deletions(-)
diff --git a/fs/asm.fs b/fs/asm.fs
@@ -47,6 +47,7 @@
: ebp BP r! ;
: edi DI r! ;
: [eax] AX [r]! ;
+: [ebx] BX [r]! ;
: [ebp] BP [r]+8b! 0 to disp ;
: [edi] DI [r]! ;
: [ebp]+ ( disp -- ) BP [r]+8b! to disp ;
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -7,17 +7,6 @@
\ Code generation
-\ lvallvl indicates the current indirection level. The next time a LValue is
-\ resolved, it will apply this indirection level and reset it to 0.
-\ a negative level means "&" level. only "-1" is possible. Positive levels means
-\ "*". These dereferences can happen multiple times.
-0 value lvallvl
-
-\ When a AST_LVALUE is on the left side of an assign, we want to set it. When
-\ "lvalset" is set, the LVALUE handler sets the effective address of the LVALUE
-\ to the value in EAX and resets the "lvalset" flag.
-0 value lvalset
-
: _err ( node -- ) printast abort" unexpected node" ;
UOPSCNT wordtbl uopgentbl ( -- )
@@ -29,8 +18,8 @@ UOPSCNT wordtbl uopgentbl ( -- )
al setz, ;
LOPSCNT wordtbl lopgentbl ( -- )
-:w ( & ) -1 to+ lvallvl ;
-:w ( * ) 1 to+ lvallvl ;
+'w operand>&operand ( & )
+'w operand>[operand] ( * )
\ In binary Ops, the result is in EAX and the source operand is EBX.
BOPSCNT wordtbl bopgentblmiddle ( node -- node )
@@ -45,28 +34,22 @@ BOPSCNT wordtbl bopgentblmiddle ( node -- node )
'w noop ( == )
'w noop ( != )
:w ( && ) ( node -- jump_addr node )
- eax eax test,
+ eax eax test, 0 to resultset?
0 jz, here 4 - swap ;
:w ( || ) ( node -- jump_addr node )
- eax eax test,
+ eax eax test, 0 to resultset?
0 jnz, here 4 - swap ;
BOPSCNT wordtbl bopgentblpost ( -- )
-:w ( + ) eax ebx add, ;
-:w ( - ) eax ebx sub, ;
-:w ( * ) ebx mul, ;
+'w vmadd, ( + )
+'w vmsub, ( - )
+'w vmmul, ( * )
:w ( / ) abort" TODO" ;
-:w ( < )
- eax ebx cmp,
- eax 0 i32 mov,
- al setg, ;
+'w vm<, ( < )
:w ( > ) abort" TODO" ;
:w ( <= ) abort" TODO" ;
:w ( >= ) abort" TODO" ;
-:w ( == )
- eax ebx cmp,
- eax 0 i32 mov,
- al setz, ;
+'w vm==, ( == )
:w ( != ) abort" TODO" ;
:w ( && ) ( jump_addr -- ) here over - 4 - swap ! ;
:w ( || ) ( jump_addr -- ) here over - 4 - swap ! ;
@@ -88,71 +71,58 @@ ASTIDCNT wordtbl gentbl ( node -- )
'w genchildren ( Unit )
:w ( Function )
_debug if ." debugging: " dup data1 stype nl> then
+ vm$
dup data1 entry
dup data2 ( astfunc mapfunc )
here over fmap.address! \ set address
dup fmap.argsize swap fmap.sfsize over - ( argsz locsz ) vmprelude,
genchildren
_debug if current here current - spit nl> then ;
-:w ( Return ) genchildren ( node )
+:w ( Return )
+ genchildren operand?>result
1 to resultset? vmret, ;
-:w ( Constant ) eax data1 i32 mov, ;
+:w ( Constant ) data1 const>operand ;
:w ( Statements ) genchildren ;
'w genchildren ( ArgSpecs )
-:w ( LValue )
- _debug if ." lvalue: " dup printast spc> lvallvl .x1 spc> lvalset .x1 nl> then
- lvalset if ( node )
- 0 to lvalset
- lvallvl 0< if _err then
- lvallvl if ( node )
- edi ebp mov,
- edi lvsfoff i32 add,
- begin edi [edi] mov, -1 to+ lvallvl lvallvl not until
- [edi] eax mov,
- else ( node )
- lvsfoff [ebp]+ eax mov, then
- else ( node )
- lvallvl 0< if ( node )
- 1 to+ lvallvl
- lvallvl if _err then
- eax ebp mov,
- eax lvsfoff i32 add,
- else ( node )
- eax lvsfoff [ebp]+ mov,
- then
- lvallvl if
- begin eax [eax] mov, -1 to+ lvallvl lvallvl not until then
- then ;
-:w ( UnaryOp ) dup genchildren data1 uopgentbl swap wexec ;
+:w ( LValue ) lvsfoff sf+>operand ;
+:w ( UnaryOp )
+ dup genchildren
+ operand?>result
+ data1 uopgentbl swap wexec ;
:w ( Assign )
firstchild ?dup not if _err then ( lvnode )
dup nextsibling ?dup not if _err then ( lvnode exprnode )
- gennode \ result in EAX
- 1 to lvalset gennode ;
+ gennode operand?>result \ result=set
+ gennode \ operand=set
+ result>operand ;
:w ( BinaryOp )
( node ) >r
r@ childcount 2 = not if abort" binop node with more than 2 children!" then
- r@ firstchild dup nextsibling swap ( n1 n2 )
- gennode bopgentblmiddle r@ data1 wexec eax push,
- gennode ebx pop, bopgentblpost r> data1 wexec ;
+ r@ firstchild dup nextsibling swap ( n2 n1 )
+ gennode bopgentblmiddle r@ data1 wexec
+ operand?>result
+ resultset? if
+ pushresult, gennode operand?>result popresult, else
+ gennode operand?>result then
+ bopgentblpost r> data1 wexec ;
:w ( LValueOp )
- dup data1 lopgentbl swap wexec
- firstchild ?dup not if _err then gennode ;
+ dup firstchild ?dup not if _err then gennode
+ data1 lopgentbl swap wexec ;
'w _err ( unused )
'w _err ( unused )
:w ( FunCall )
\ pass arguments
dup firstchild ?dup if begin ( argnode )
- dup gennode
+ dup gennode operand?>result
ebp 4 i32 sub,
- [ebp] eax mov,
+ [ebp] eax mov, 0 to resultset?
nextsibling ?dup not until then
\ find in map
data1 ( name ) findfuncinmap ( mapfunc )
\ call!
fmap.address call,
\ get result
- eax [ebp] mov,
+ eax [ebp] mov, 1 to resultset?
ebp 4 i32 add, ;
: _ ( node -- ) gentbl over astid wexec ;
diff --git a/fs/cc/vm.fs b/fs/cc/vm.fs
@@ -29,57 +29,36 @@
\ To avoid errors, moving an operand to a non-empty and non-pushed Result is an
\ error. To set the operand when it's not None is also an error.
-\ For example, let's solve this:
-\ binop[+](binop[*](const[2],const[3]),const[1])
-
-\ 2 const>operand --> operand = const(2)
-\ operand>result --> operand = None, result=set
-\ 3 const>operand --> operand = const(3)
-\ vmmul, --> operand = None, result=set
-\ 1 const>operand --> operand = const(1)
-\ vmadd, --> operand = None, result=set
-
-\ Another example involving push/popping:
-\ binop[+](binop[-](const[2], const[1]),binop[*](const[2],const[3]))
-
-\ 2 const>operand --> operand = const(2)
-\ operand>result --> operand = None, result=set
-\ 1 const>operand --> operand = const(1)
-\ vmsub, --> operand = None, result = set
-\ pushresult --> result = none
-\ 2 const>operand --> operand = const(2)
-\ operand>result --> operand = None, result=set
-\ 3 const>operand --> operand = const(3)
-\ vmmul, --> operand = None, result = set
-\ popresult --> operand = register
-\ vmadd, --> operand = none, result = set
-
-0 const VM_NONE
-1 const VM_CONSTANT
-2 const VM_STACKFRAME
-3 const VM_REGISTER
+\ For usage example, see tests/cc/vm.fs
+
+$00 const VM_NONE
+$01 const VM_CONSTANT
+$02 const VM_STACKFRAME
+$03 const VM_REGISTER
0 value resultset? \ 0 = no result, 1=result set
VM_NONE value operand
\ For VM_CONSTANT, this contains the actual value
\ For VM_STACKFRAME, this contains the SF offset
0 value operandarg
+0 value operandlvl \ -1 means "&", 1 means "*", 2 means "**" etc.
0 value argsz \ size of the argument portion of the SF.
0 value locsz \ size of the "local vars" portion of the SF.
-: vm$ 0 to resultset? VM_NONE to operand ;
+: vm$ 0 to resultset? VM_NONE to operand 0 to operandlvl ;
: _err abort" vm error" ;
: _assert not if _err then ;
-\ Resolve current operand as an assembler "src" argument
+\ Resolve current operand as an assembler "src" argument.
: operandAsm ( -- )
operand VM_CONSTANT = if
operandarg i32
else operand VM_REGISTER = if
ebx
- else operand VM_STACKFRAME = if
- operandarg [ebp]+ else _err then then then
+ else operand VM_STACKFRAME = if
+ operandarg [ebp]+
+ else _err then then then
VM_NONE to operand ;
: result! 1 to resultset? ;
@@ -89,6 +68,17 @@ VM_NONE value operand
operand VM_REGISTER = not if
ebx operandAsm mov, VM_REGISTER to operand then ;
+\ emit, if necessary, the code necessary to resolve "positive" operandlvl
+: resolvederef
+ operandlvl if
+ operandlvl 0< if
+ 0 to operandlvl
+ VM_REGISTER to operand
+ ebx ebp mov,
+ operandarg if ebx operandarg i32 add, then
+ else operand>reg begin
+ ebx [ebx] mov, -1 to+ operandlvl operandlvl not until then then ;
+
: const>operand ( n -- )
VM_NONE operand = _assert
VM_CONSTANT to operand to operandarg ;
@@ -99,7 +89,32 @@ VM_NONE value operand
: operand>result ( -- )
resultset? not _assert
- eax operandAsm mov, ;
+ resolvederef
+ eax operandAsm mov, result! ;
+
+: operand?>result operand VM_NONE = not if operand>result then ;
+
+: operand>&operand
+ operand VM_STACKFRAME = _assert
+ operandlvl 0>= _assert
+ -1 to operandlvl ;
+
+: operand>[operand]
+ operand VM_STACKFRAME = operand VM_REGISTER = or _assert
+ 1 to+ operandlvl ;
+
+: result>operand
+ resultset? _assert
+ operand VM_STACKFRAME = if
+ operandlvl if
+ -1 to+ operandlvl operand>reg resolvederef
+ [ebx] eax mov,
+ else operandAsm eax mov, then
+ else operand VM_REGISTER = if
+ -1 to+ operandlvl resolvederef
+ [ebx] eax mov,
+ else _err then then
+ 0 to resultset? VM_NONE to operand ;
\ generate function prelude code by allocating "locsz" bytes on PS.
: vmprelude, ( argsz locsz -- )
@@ -120,3 +135,11 @@ VM_NONE value operand
: vmadd, eax operandAsm add, result! ;
: vmsub, eax operandAsm sub, result! ;
: vmmul, operand>reg operandAsm mul, result! ;
+: vm<,
+ eax operandAsm cmp,
+ eax 0 i32 mov,
+ al setg, ;
+: vm==,
+ eax operandAsm cmp,
+ eax 0 i32 mov,
+ al setz, ;
diff --git a/fs/tests/cc/vm.fs b/fs/tests/cc/vm.fs
@@ -35,8 +35,9 @@ code test2
vmret,
test2 8 #eq
+\ sub 2 args
vm$
-code test3 \ sub 2 args
+code test3
8 0 vmprelude,
4 sf+>operand
operand>result
@@ -45,4 +46,74 @@ code test3 \ sub 2 args
vmret,
54 12 test3 42 #eq
+\ assign 2 local vars
+vm$
+code test4
+ 0 8 vmprelude,
+ \ foo = 42
+ 42 const>operand
+ operand>result
+ 4 sf+>operand
+ result>operand
+ \ bar = 5
+ 5 const>operand
+ operand>result
+ 0 sf+>operand
+ result>operand
+ \ return foo + bar
+ 4 sf+>operand
+ operand>result
+ 0 sf+>operand
+ vmadd,
+ vmret,
+test4 47 #eq
+
+\ variable reference and dereference
+vm$
+code test5
+ 0 8 vmprelude,
+ \ foo = 42
+ 42 const>operand
+ operand>result
+ 4 sf+>operand
+ result>operand
+ \ bar = &foo
+ 4 sf+>operand
+ operand>&operand
+ operand>result
+ 0 sf+>operand
+ result>operand
+ \ return *bar
+ 0 sf+>operand
+ operand>[operand]
+ operand>result
+ vmret,
+test5 42 #eq
+
+\ assign and dereference
+vm$
+code test6
+ 0 8 vmprelude,
+ \ foo = 42
+ 42 const>operand
+ operand>result
+ 4 sf+>operand
+ result>operand
+ \ bar = &foo
+ 4 sf+>operand
+ operand>&operand
+ operand>result
+ 0 sf+>operand
+ result>operand
+ \ *bar = 54
+ 54 const>operand
+ operand>result
+ 0 sf+>operand
+ operand>[operand]
+ result>operand
+ \ return foo
+ 4 sf+>operand
+ operand>result
+ vmret,
+test6 54 #eq
testend
