commit c67fc35682103fff78f9e9b9281ac77dd4a1ed11
parent 253555cf3fd322432b8bc3ab9c27b56ea286742a
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 22 Nov 2022 19:58:19 -0500
comp/c: fix bugs with nested function calls mixed with expressions
My calling system in CC would break down when one started mixing function calls
inside expressions that were inside function calls. We would get mixed up in
argument tracking.
To fix this, I had to re-design the VM call system which, happily, ended up
simpler. Yay!
Diffstat:
7 files changed, 45 insertions(+), 55 deletions(-)
diff --git a/fs/comp/c/gen.fs b/fs/comp/c/gen.fs
@@ -237,13 +237,13 @@ ASTIDCNT wordtbl gentbl ( node -- )
dup CType :funcsig? _assert CType type
else
vmop loc VM_CONSTANT = if vmop arg wordfunctype else TYPE_VOID then then
- ( node type ) vmop :push rot ( type 'copy node )
- \ pass arguments
- Node firstchild begin ( argnode )
- Node nextsibling ?dup while ( argnode )
- dup gennode vmcallarg, repeat
- \ call
- vmop :pop vmcall, ( type ) if vmpspop, then ;
+ ( node type ) >r \ V1=type
+ dup Node :childcount 1- dup >r ( node nargs ) \ V2=nargs
+ vmop :push >r ( node nargs ) \ V3='callop
+ ?dup if >r ( node ) Node :lastchild begin ( argnode )
+ dup gennode vmop :push swap Node prevsibling next then ( node )
+ ( argN .. arg0 node ) drop r> ( 'callop ) vmop :pop
+ r> ( nargs ) vmcall, r> ( type ) if vmpspop, then ;
:w ( For )
breaklvl >r
Node firstchild dup _assert dup gennode$ ( exprnode ) \ initialization
diff --git a/fs/comp/c/vm/forth.fs b/fs/comp/c/vm/forth.fs
@@ -64,26 +64,13 @@ struct+[ VMOp
locsz ?dup if r+, then
exit, ;
-\ a stack of :push'ed VMOps that are to be sent as args
-$10 const MAXCALLARGS
-create callargs MAXCALLARGS CELLSZ * allot
-here const _limit
-callargs value _cur
-\ Write op to args
-: vmcallarg, ( -- ) vmop :push to!+ _cur _cur _limit < _assert ;
-
-\ Call the address in current op. If the function has a result, you need to
-\ pop it with vmpspop,
-: vmcall, ( -- )
- \ Let's push the args to PS first
- vmop :push \ we keep call addr for later
- callargs begin ( 'pushed a )
- dup _cur < while
- @+ vmop :pop vmop :compile$ repeat drop
- vmop :pop VM_CONSTANT vmop loc = if
+: vmcall, ( ?argN .. ?arg0 nargs -- ) dup >r \ V1=nargs
+ vmop :push >r
+ ?dup if >r begin vmop :pop vmop :compile$ next then
+ r> vmop :pop VM_CONSTANT vmop loc = if
vmop arg execute, vmop :init
else vmop :compile$ compile execute PS- then
- callargs to@! _cur callargs - ( callsz ) neg to+ psoff ;
+ r> ( nargs ) CELLSZ * neg to+ psoff ;
\ Allocate a new register for active op and pop 4b from PS into it.
: vmpspop, vmop :noop# PS+ vmop :>reg ;
diff --git a/fs/comp/c/vm/i386.fs b/fs/comp/c/vm/i386.fs
@@ -140,18 +140,16 @@ struct+[ VMOp
vmop loc if bp 0 d) vmop :compile mov, then
ret, ;
-0 value callsz \ size in bytes of args added to current call
-
-\ Write op to args
-: vmcallarg, ( -- )
- vmop :>simple 4 to+ callsz callsz neg bp d) vmop :compile mov, vmop :init ;
-
-\ Call the address in current op. If the function has a result, you need to
-\ pop it with vmpspop,
-: vmcall, ( -- )
- callsz ?dup if bp i) sub, 0 to callsz then
+: vmcall, ( ?argN .. ?arg0 nargs -- )
+ vmop :push >r \ V1=callop
+ ?dup if dup >r \ V2=nargs
+ >r begin ( ... arg )
+ vmop :pop vmop :>simple
+ bp V2 r@ - 1+ CELLSZ * neg d) vmop :compile mov, vmop :init next
+ bp r> ( nargs ) CELLSZ * i) sub,
+ then
pushregs
- VM_CONSTANT vmop loc = if
+ r> vmop :pop VM_CONSTANT vmop loc = if
vmop arg VM_NONE to vmop loc abs>rel else vmop :compile then
call, popregs vmop :init ;
diff --git a/fs/emul/uxn/vm.c b/fs/emul/uxn/vm.c
@@ -47,11 +47,8 @@ static unsigned short signext(unsigned short val) {
if (val >= $80) return val - $100; else return val;
}
-// TODO: there's something strange here. If I try to parametrize the stack in
-// push8(), code generation becomes all messed up. For now, we have a hackish
-// STH()...
-static void push8(unsigned char val) {
- if (src->ptr == $ff) { error(2); } else { src->dat[src->ptr++] = val; }
+static void push8(Stack *s, unsigned char val) {
+ if (s->ptr == $ff) { error(2); } else { s->dat[s->ptr++] = val; }
}
static void push16(Stack *s, unsigned short val) {
if (s->ptr >= $fe) { error(2); } else {
@@ -60,7 +57,9 @@ static void push16(Stack *s, unsigned short val) {
s->ptr += 2 ;
}
}
-static void push(unsigned short val) { if (bs) push16(src, val); else push8(val); }
+static void pushs(Stack *s, unsigned short val) {
+ if (bs) push16(s, val); else push8(s, val); }
+static void push(unsigned short val) { pushs(src, val); }
static unsigned char pop8() {
if (!*sp) { error(0); } else { return src->dat[--*sp]; }
@@ -123,24 +122,22 @@ static void OVR() {
unsigned short x = pop();
unsigned short y = pop();
push(y); push(x); push(y); }
-static void EQU() { push8(pop() == pop()); }
-static void NEQ() { push8(pop() != pop()); }
+static void EQU() { push8(src, pop() == pop()); }
+static void NEQ() { push8(src, pop() != pop()); }
static void GTH() {
unsigned short a = pop();
unsigned short b = pop();
- push8(b > a); }
+ push8(src, b > a); }
static void LTH() {
unsigned short a = pop();
unsigned short b = pop();
- push8(b < a); }
+ push8(src, b < a); }
static void JMP() { warp(pop()); }
static void JCN() { unsigned short a = pop(); if (pop8()) { warp(a); } }
static void JSR() {
unsigned short a = pop();
push16(dst, pc); warp(a); }
-static void STH() {
- unsigned short n = pop();
- src = dst; push(n); }
+static void STH() { pushs( dst, pop()); }
static void LDZ() { push(peek(pop8())); }
static void STZ() { unsigned short a = pop8(); poke(a, pop()); }
static void LDR() { push(peek(pc+signext(pop8()))); }
diff --git a/fs/tests/comp/c/cc.fs b/fs/tests/comp/c/cc.fs
@@ -98,6 +98,8 @@ to' myval ptrari4 #
to' myval unaryop2 to' myval #eq
myval 42 #eq
ptrari5 6 + @ 42 #eq
+funcall1 138 #eq
+42 funcall2 85 #eq
\ and what about inline functions?
:c int myinline() { return 42; }
diff --git a/fs/tests/comp/c/test.c b/fs/tests/comp/c/test.c
@@ -442,3 +442,10 @@ int* unaryop2(int *n) {
!*n;
return n;
}
+// Function calls with other function calls in arguments used to mess things up
+int funcall1() {
+ return adder(54, retconst() + retconst());
+}
+int funcall2(int x) {
+ return adder(++x, 42);
+}
diff --git a/fs/tests/comp/c/vm.fs b/fs/tests/comp/c/vm.fs
@@ -170,16 +170,15 @@ code test10 \ returns 42 if arg >= 10, 54 otherwise
15 test10 42 #eq
\ function calls
-ops$
code test11 ( n -- n-42 )
- 4 0 vmprelude,
- selop1 0 ps+>op
- vmcallarg,
+ 4 0 vmprelude, ops$
42 const>op
- vmcallarg,
+ vmop :push
+ 0 ps+>op
+ vmop :push
' test1 const>op ( a b -- a-b )
TYPE_VOID* to vmop type
- vmcall,
+ 2 vmcall,
vmpspop,
vmret,
54 test11 12 #eq
