commit a9d81338b19f21f7220e340a1c50870b40587120
parent 249af91ff9d9ffbd8962efcad999de442e609658
Author: Quentin Carbonneaux <quentin.carbonneaux@yale.edu>
Date: Wed, 15 Feb 2017 20:17:13 -0500
add support for closure calls
Compiling languages with closures often requires passing
an extra environment parameter to the called function.
One solution is to use a convention, and reserve, say,
the first argument for that purpose. However, that
makes binding to C a little less smooth.
Alternatively, QBE now provides a way to remain fully
ABI compatible with C by having a "hidden" environment
argument (marked with the keyword 'env'). Calling a
function expecting an environment from C will make the
contents of the environment undefined, but the normal
arguments will be passed without alteration. Conversely,
calling a C function like it is a closure by passing
it an environemnt will work smoothly.
Diffstat:
| M | all.h | | | 4 | ++++ |
| M | parse.c | | | 24 | +++++++++++++++++++++--- |
| M | sysv.c | | | 66 | ++++++++++++++++++++++++++++++++++++++++++------------------------ |
| M | tools/lexh.c | | | 2 | +- |
4 files changed, 68 insertions(+), 28 deletions(-)
diff --git a/all.h b/all.h
@@ -264,8 +264,12 @@ enum Op {
/* function instructions */
Opar = NPubOp,
Oparc,
+ Opare,
+#define ispar(o) (Opar <= o && o <= Opare)
Oarg,
Oargc,
+ Oarge,
+#define isarg(o) (Oarg <= o && o <= Oarge)
Ocall,
Ovacall,
diff --git a/parse.c b/parse.c
@@ -60,9 +60,11 @@ OpDesc opdesc[NOp] = {
[Oxcmp] = { "xcmp", 1, {A(w,l,s,d), A(w,l,s,d)}, 1, 0, 0 },
[Oxtest] = { "xtest", 1, {A(w,l,e,e), A(w,l,e,e)}, 1, 0, 0 },
[Oaddr] = { "addr", 0, {A(m,m,e,e), A(x,x,e,e)}, 0, 1, 0 },
- [Opar] = { "parn", 0, {A(x,x,x,x), A(x,x,x,x)}, 0, 0, 0 },
+ [Opar] = { "par", 0, {A(x,x,x,x), A(x,x,x,x)}, 0, 0, 0 },
+ [Opare] = { "pare", 0, {A(x,x,x,x), A(x,x,x,x)}, 0, 0, 0 },
[Oparc] = { "parc", 0, {A(e,x,e,e), A(e,x,e,e)}, 0, 0, 0 },
[Oarg] = { "arg", 0, {A(w,l,s,d), A(x,x,x,x)}, 0, 0, 0 },
+ [Oarge] = { "arge", 0, {A(w,l,s,d), A(x,x,x,x)}, 0, 0, 0 },
[Oargc] = { "argc", 0, {A(e,x,e,e), A(e,l,e,e)}, 0, 0, 0 },
[Ocall] = { "call", 0, {A(m,m,m,m), A(x,x,x,x)}, 0, 0, 0 },
[Ovacall] = { "vacall", 0, {A(m,m,m,m), A(x,x,x,x)}, 0, 0, 0 },
@@ -108,6 +110,7 @@ enum {
Talloc2,
Tcall,
+ Tenv,
Tphi,
Tjmp,
Tjnz,
@@ -156,6 +159,7 @@ static char *kwmap[Ntok] = {
[Talloc1] = "alloc1",
[Talloc2] = "alloc2",
[Tcall] = "call",
+ [Tenv] = "env",
[Tphi] = "phi",
[Tjmp] = "jmp",
[Tjnz] = "jnz",
@@ -493,17 +497,25 @@ parsecls(int *tyn)
static int
parserefl(int arg)
{
- int k, ty;
+ int k, ty, env, hasenv;
Ref r;
+ hasenv = 0;
expect(Tlparen);
while (peek() != Trparen && peek() != Tdots) {
if (curi - insb >= NIns)
err("too many instructions (1)");
+ env = peek() == Tenv;
+ if (env)
+ next();
k = parsecls(&ty);
r = parseref();
if (req(r, R))
- err("invalid reference argument");
+ err("invalid argument");
+ if (hasenv && env)
+ err("only one environment allowed");
+ if (env && k != Kl)
+ err("environment must be of type l");
if (!arg && rtype(r) != RTmp)
err("invalid function parameter");
if (k == 4)
@@ -511,12 +523,18 @@ parserefl(int arg)
*curi = (Ins){Oargc, R, {TYPE(ty), r}, Kl};
else
*curi = (Ins){Oparc, r, {TYPE(ty)}, Kl};
+ else if (env)
+ if (arg)
+ *curi = (Ins){Oarge, R, {r}, k};
+ else
+ *curi = (Ins){Opare, r, {R}, k};
else
if (arg)
*curi = (Ins){Oarg, R, {r}, k};
else
*curi = (Ins){Opar, r, {R}, k};
curi++;
+ hasenv |= env;
if (peek() == Trparen)
break;
expect(Tcomma);
diff --git a/sysv.c b/sysv.c
@@ -171,7 +171,7 @@ selret(Blk *b, Fn *fn)
}
static int
-argsclass(Ins *i0, Ins *i1, AClass *ac, int op, AClass *aret)
+argsclass(Ins *i0, Ins *i1, AClass *ac, int op, AClass *aret, Ref *env)
{
int nint, ni, nsse, ns, n, *pn;
AClass *a;
@@ -182,8 +182,9 @@ argsclass(Ins *i0, Ins *i1, AClass *ac, int op, AClass *aret)
else
nint = 6;
nsse = 8;
- for (i=i0, a=ac; i<i1; i++, a++) {
- if (i->op == op) {
+ for (i=i0, a=ac; i<i1; i++, a++)
+ switch (i->op - op + Oarg) {
+ case Oarg:
if (KBASE(i->cls) == 0)
pn = &nint;
else
@@ -196,7 +197,8 @@ argsclass(Ins *i0, Ins *i1, AClass *ac, int op, AClass *aret)
a->align = 3;
a->size = 8;
a->cls[0] = i->cls;
- } else {
+ break;
+ case Oargc:
n = i->arg[0].val;
typclass(a, &typ[n]);
if (a->inmem)
@@ -212,8 +214,14 @@ argsclass(Ins *i0, Ins *i1, AClass *ac, int op, AClass *aret)
nsse -= ns;
} else
a->inmem = 1;
+ break;
+ case Oarge:
+ if (op == Opar)
+ *env = i->to;
+ else
+ *env = i->arg[0];
+ break;
}
- }
return ((6-nint) << 4) | ((8-nsse) << 8);
}
@@ -236,7 +244,7 @@ MAKESURE(rclob_has_correct_size, sizeof rclob == NRClob * sizeof(int));
* | | | ` sse regs returned (0..2)
* | | ` gp regs passed (0..6)
* | ` sse regs passed (0..8)
- * ` 1 if calling a vararg function (0..1)
+ * ` 1 if rax used to pass data (0..1)
*/
bits
@@ -268,22 +276,22 @@ bits
argregs(Ref r, int p[2])
{
bits b;
- int j, ni, nf, va;
+ int j, ni, nf, ra;
assert(rtype(r) == RCall);
b = 0;
ni = (r.val >> 4) & 15;
nf = (r.val >> 8) & 15;
- va = (r.val >> 12) & 1;
+ ra = (r.val >> 12) & 1;
for (j=0; j<ni; j++)
b |= BIT(rsave[j]);
for (j=0; j<nf; j++)
b |= BIT(XMM0+j);
if (p) {
- p[0] = ni + va;
+ p[0] = ni + ra;
p[1] = nf;
}
- return b | (va ? BIT(RAX) : 0);
+ return b | (ra ? BIT(RAX) : 0);
}
static Ref
@@ -300,18 +308,20 @@ selcall(Fn *fn, Ins *i0, Ins *i1, RAlloc **rap)
{
Ins *i;
AClass *ac, *a, aret;
- int ca, ni, ns, al, va;
+ int ca, ni, ns, al, varc, envc;
uint stk, off;
- Ref r, r1, r2, reg[2];
+ Ref r, r1, r2, reg[2], env;
RAlloc *ra;
+ env = R;
ac = alloc((i1-i0) * sizeof ac[0]);
+
if (!req(i1->arg[1], R)) {
assert(rtype(i1->arg[1]) == RType);
typclass(&aret, &typ[i1->arg[1].val]);
- ca = argsclass(i0, i1, ac, Oarg, &aret);
+ ca = argsclass(i0, i1, ac, Oarg, &aret, &env);
} else
- ca = argsclass(i0, i1, ac, Oarg, 0);
+ ca = argsclass(i0, i1, ac, Oarg, 0, &env);
for (stk=0, a=&ac[i1-i0]; a>ac;)
if ((--a)->inmem) {
@@ -366,10 +376,15 @@ selcall(Fn *fn, Ins *i0, Ins *i1, RAlloc **rap)
ca += 1 << 2;
}
}
- va = i1->op == Ovacall;
- ca |= va << 12;
+ envc = !req(R, env);
+ varc = i1->op == Ovacall;
+ if (varc && envc)
+ err("sysv abi does not support variadic env calls");
+ ca |= (varc | envc) << 12;
emit(Ocall, i1->cls, R, i1->arg[0], CALL(ca));
- if (va)
+ if (envc)
+ emit(Ocopy, Kl, TMP(RAX), env, R);
+ if (varc)
emit(Ocopy, Kw, TMP(RAX), getcon((ca >> 8) & 15, fn), R);
ni = ns = 0;
@@ -418,17 +433,18 @@ selpar(Fn *fn, Ins *i0, Ins *i1)
AClass *ac, *a, aret;
Ins *i;
int ni, ns, s, al, fa;
- Ref r;
+ Ref r, env;
+ env = R;
ac = alloc((i1-i0) * sizeof ac[0]);
curi = &insb[NIns];
ni = ns = 0;
if (fn->retty >= 0) {
typclass(&aret, &typ[fn->retty]);
- fa = argsclass(i0, i1, ac, Opar, &aret);
+ fa = argsclass(i0, i1, ac, Opar, &aret, &env);
} else
- fa = argsclass(i0, i1, ac, Opar, 0);
+ fa = argsclass(i0, i1, ac, Opar, 0, &env);
for (i=i0, a=ac; i<i1; i++, a++) {
if (i->op != Oparc || a->inmem)
@@ -478,6 +494,9 @@ selpar(Fn *fn, Ins *i0, Ins *i1)
emit(Ocopy, i->cls, i->to, r, R);
}
+ if (!req(R, env))
+ emit(Ocopy, Kl, env, TMP(RAX), R);
+
return fa | (s*4)<<12;
}
@@ -641,8 +660,8 @@ abi(Fn *fn)
b->visit = 0;
/* lower parameters */
- for (b=fn->start, i=b->ins; i-b->ins < b->nins; i++)
- if (i->op != Opar && i->op != Oparc)
+ for (b=fn->start, i=b->ins; i-b->ins<b->nins; i++)
+ if (!ispar(i->op))
break;
fa = selpar(fn, b->ins, i);
n = b->nins - (i - b->ins) + (&insb[NIns] - curi);
@@ -670,8 +689,7 @@ abi(Fn *fn)
case Ocall:
case Ovacall:
for (i0=i; i0>b->ins; i0--)
- if ((i0-1)->op != Oarg)
- if ((i0-1)->op != Oargc)
+ if (!isarg((i0-1)->op))
break;
selcall(fn, i0, i, &ral);
i = i0;
diff --git a/tools/lexh.c b/tools/lexh.c
@@ -22,7 +22,7 @@ char *tok[] = {
"ceql", "cnel", "cles", "clts", "cgts", "cges",
"cnes", "ceqs", "cos", "cuos", "cled", "cltd",
"cgtd", "cged", "cned", "ceqd", "cod", "cuod",
- "vaarg", "vastart", "...",
+ "vaarg", "vastart", "...", "env",
"call", "phi", "jmp", "jnz", "ret", "export",
"function", "type", "data", "align", "l", "w",
