commit dabead736c7b0df5d458e0bc545a3a2fa3a9ec88
parent 38057c4b2d3ec3ec77dcd059a98b071da2e1e6fa
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 7 Jun 2022 09:02:46 -0400
cc: simplify binop code generation
This whole "reg stack" thing was too complicated. Let's bite the bullet of
inefficient code generation for now and we'll tackle performance later.
Diffstat:
4 files changed, 37 insertions(+), 32 deletions(-)
diff --git a/fs/asm.fs b/fs/asm.fs
@@ -42,6 +42,7 @@
: [r]! ( reg -- ) $500 or ( mod 1 + 32 ) tgt-or-src! ;
: eax AX r! ;
+: ebx BX r! ;
: ebp BP r! ;
: [ebp] BP [r]! 0 to disp ;
: i32 IMM $400 or to src ;
@@ -63,5 +64,7 @@
: mul, 4 $f7 modrm1, ;
: neg, 3 $f7 modrm1, ;
: not, 2 $f7 modrm1, ;
+: pop, prefix, $58 tgtid or c, asm$ ;
+: push, prefix, $50 tgtid or c, asm$ ;
: sub, isimm? if 5 $81 else src $29 then modrm2, ;
: ret, $c3 inh, ;
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -1,45 +1,25 @@
\ C compiler code generation
\ Requires wordtbl asm cc/tree cc/ast
-\ Target register stack: AST element setting a value to a register such as
-\ Constant don't always push to the same register. During a binary op, we need
-\ the same Constant op will push once to eax and once to ebx. For this reason,
-\ we have the register selection words below.
-\ The principle is this we "push" values with ">reg". Constant does this. We
-\ "pull" values with "reg>". BinaryOp and Return does this. Then, at the end
-\ of each statement, we verify that our levels of push and pull match.
-\ Some operations affect the currently active reg, like unary ops. You'll then
-\ want to use "curreg".
-\ Because eax is special (it's sometimes the only accumulator we can use),
-\ reg pushing goes *downwards* from edx to eax to minimize conflicts.
-
-4 value reglvl \ 0=AX 1=CX 2=DX 3=BX
-: _regerr abort" register stack overflow/underflow/imbalance" ;
-: curreg reglvl 4 < not if _regerr then reglvl r! ;
-: >reg reglvl 1- to reglvl curreg ;
-: reg> curreg reglvl 1+ to reglvl ;
-\ use this when you need 2 register at once in the *opposite* order of what
-\ you'd get with "reg> curreg". only drops reglvl by 1.
-: reg>> reglvl dup 2 > if _regerr then 1+ dup r! dup 1- r! to reglvl ;
+\ Register roles in code generation
+\ The register hold the "general current result" is EAX.
\ Code generation
: _err ( node -- ) printast abort" unexpected node" ;
UOPSCNT wordtbl opgentbl ( -- )
-:w ( - ) curreg neg, ;
-:w ( ~ ) curreg not, ;
+:w ( - ) eax neg, ;
+:w ( ~ ) eax not, ;
:w ( ! ) abort" TODO" ;
: genuop ( opid -- ) opgentbl swap wexec ;
+\ In binary Ops, the result is in EAX and the source operand is EBX.
BOPSCNT wordtbl opgentbl ( -- )
-:w ( + ) reg>> add, ;
-:w ( - ) reg>> sub, ;
-:w ( * )
- eax reg> mov,
- reg> mul,
- >reg eax mov, ;
+:w ( + ) eax ebx add, ;
+:w ( - ) eax ebx sub, ;
+:w ( * ) ebx mul, ;
:w ( / ) abort" TODO" ;
: genbop ( opid -- ) opgentbl swap wexec ;
@@ -49,20 +29,29 @@ alias noop gennode ( node -- ) \ forward declaration
: genchildren ( node -- )
firstchild ?dup if begin dup gennode nextsibling ?dup not until then ;
+1 value _debug
+: spit ( a u -- ) A>r >r >A begin Ac@+ .x1 spc> next r>A ;
+
ASTIDCNT wordtbl gentbl ( node -- )
'w _err
'w genchildren ( Unit )
-:w ( Function ) dup strdata entry genchildren ;
+:w ( Function )
+ _debug if ." debugging: " dup strdata stype nl> then
+ dup strdata entry genchildren
+ _debug if current here current - spit nl> then ;
:w ( Return ) genchildren
ebp 4 i32 sub,
- [ebp] reg> mov, ;
-:w ( Constant ) >reg intdata i32 mov, ;
+ [ebp] eax mov, ;
+:w ( Constant ) eax intdata i32 mov, ;
:w ( Statements ) genchildren ret, ;
'w genchildren ( Arguments )
'w genchildren ( Expression )
:w ( UnaryOp ) dup genchildren intdata genuop ;
'w genchildren ( Factor )
-:w ( BinaryOp ) dup genchildren intdata genbop ;
+:w ( BinaryOp )
+ dup childcount 2 = not if abort" binop node with more than 2 children!" then
+ dup firstchild dup nextsibling ( parent n1 n2 )
+ gennode eax push, gennode ebx pop, intdata genbop ;
: _ ( node -- ) gentbl over astid wexec ;
current to gennode
diff --git a/fs/cc/tree.fs b/fs/cc/tree.fs
@@ -50,6 +50,9 @@
parentnode nextsibling then then ;
: lastchild ( node -- child )
firstchild dup if begin dup nextsibling ?dup not if exit then nip again then ;
+: nodedepth ( node -- n ) firstchild ?dup if nodedepth 1+ else 0 then ;
+: childcount ( node -- n )
+ 0 swap firstchild ?dup if begin swap 1+ swap nextsibling ?dup not until then ;
: createnode ( slots flags id -- node ) here >r c, c, c, 16 allot0 r> ;
: addnode ( node parent -- )
dup nodeclosed? if abort" node is closed" then
diff --git a/tests/testcctree.fs b/tests/testcctree.fs
@@ -36,6 +36,16 @@ n1 firstchild n3 #eq
: foo S" foo" ;
n3 strdata foo S= #
+root nodedepth 2 #eq
+n1 nodedepth 1 #eq
+n2 nodedepth 0 #eq
+n3 nodedepth 0 #eq
+
+root childcount 2 #eq
+n1 childcount 1 #eq
+n2 childcount 0 #eq
+n3 childcount 0 #eq
+
: traverse
root begin dup nodeid dup .x1 c, nextnode ?dup not until ;
create expected 1 c, 2 c, 4 c, 3 c,
