ref: df5ad841ec2f08c3f924229cd76581e439d37558
parent: c2cff341a39d3182820a0fc1f5462207cf78a6c2
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Thu Dec 26 16:20:46 EST 2024
vm: take the op table out to separate files
--- a/flisp.c
+++ b/flisp.c
@@ -895,1002 +895,27 @@
#if defined(COMPUTED_GOTO)
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wpedantic"
-#define OP(x) op_##x:
-#define NEXT_OP goto *ops[*ip++]
-#define GOTO_OP_OFFSET(op) [op] = &&op_##op
static const void *ops[] = {- GOTO_OP_OFFSET(OP_LOADA0),
- GOTO_OP_OFFSET(OP_LOADA1),
- GOTO_OP_OFFSET(OP_LOADV),
- GOTO_OP_OFFSET(OP_BRF),
- GOTO_OP_OFFSET(OP_POP),
- GOTO_OP_OFFSET(OP_CALL),
- GOTO_OP_OFFSET(OP_TCALL),
- GOTO_OP_OFFSET(OP_LOADG),
- GOTO_OP_OFFSET(OP_LOADA),
- GOTO_OP_OFFSET(OP_LOADC),
- GOTO_OP_OFFSET(OP_RET),
- GOTO_OP_OFFSET(OP_DUP),
- GOTO_OP_OFFSET(OP_CAR),
- GOTO_OP_OFFSET(OP_CDR),
- GOTO_OP_OFFSET(OP_CLOSURE),
- GOTO_OP_OFFSET(OP_SETA),
- GOTO_OP_OFFSET(OP_JMP),
- GOTO_OP_OFFSET(OP_LOADC0),
- GOTO_OP_OFFSET(OP_CONSP),
- GOTO_OP_OFFSET(OP_BRNE),
- GOTO_OP_OFFSET(OP_LOADT),
- GOTO_OP_OFFSET(OP_LOAD0),
- GOTO_OP_OFFSET(OP_LOADC1),
- GOTO_OP_OFFSET(OP_AREF2),
- GOTO_OP_OFFSET(OP_AREF),
- GOTO_OP_OFFSET(OP_ATOMP),
- GOTO_OP_OFFSET(OP_BRT),
- GOTO_OP_OFFSET(OP_BRNN),
- GOTO_OP_OFFSET(OP_LOAD1),
- GOTO_OP_OFFSET(OP_LT),
- GOTO_OP_OFFSET(OP_ADD2),
- GOTO_OP_OFFSET(OP_SETCDR),
- GOTO_OP_OFFSET(OP_LOADF),
- GOTO_OP_OFFSET(OP_CONS),
- GOTO_OP_OFFSET(OP_EQ),
- GOTO_OP_OFFSET(OP_SYMBOLP),
- GOTO_OP_OFFSET(OP_NOT),
- GOTO_OP_OFFSET(OP_CADR),
- GOTO_OP_OFFSET(OP_NEG),
- GOTO_OP_OFFSET(OP_NULLP),
- GOTO_OP_OFFSET(OP_BOOLEANP),
- GOTO_OP_OFFSET(OP_NUMBERP),
- GOTO_OP_OFFSET(OP_FIXNUMP),
- GOTO_OP_OFFSET(OP_BOUNDP),
- GOTO_OP_OFFSET(OP_BUILTINP),
- GOTO_OP_OFFSET(OP_FUNCTIONP),
- GOTO_OP_OFFSET(OP_VECTORP),
- GOTO_OP_OFFSET(OP_SETCAR),
- GOTO_OP_OFFSET(OP_JMPL),
- GOTO_OP_OFFSET(OP_BRFL),
- GOTO_OP_OFFSET(OP_BRTL),
- GOTO_OP_OFFSET(OP_EQV),
- GOTO_OP_OFFSET(OP_EQUAL),
- GOTO_OP_OFFSET(OP_LIST),
- GOTO_OP_OFFSET(OP_APPLY),
- GOTO_OP_OFFSET(OP_ADD),
- GOTO_OP_OFFSET(OP_SUB),
- GOTO_OP_OFFSET(OP_MUL),
- GOTO_OP_OFFSET(OP_DIV),
- GOTO_OP_OFFSET(OP_IDIV),
- GOTO_OP_OFFSET(OP_NUMEQ),
- GOTO_OP_OFFSET(OP_COMPARE),
- GOTO_OP_OFFSET(OP_ARGC),
- GOTO_OP_OFFSET(OP_VECTOR),
- GOTO_OP_OFFSET(OP_ASET),
- GOTO_OP_OFFSET(OP_LOADNIL),
- GOTO_OP_OFFSET(OP_LOADI8),
- GOTO_OP_OFFSET(OP_LOADVL),
- GOTO_OP_OFFSET(OP_LOADGL),
- GOTO_OP_OFFSET(OP_LOADAL),
- GOTO_OP_OFFSET(OP_LOADCL),
- GOTO_OP_OFFSET(OP_SETG),
- GOTO_OP_OFFSET(OP_SETGL),
- GOTO_OP_OFFSET(OP_SETAL),
- GOTO_OP_OFFSET(OP_VARGC),
- GOTO_OP_OFFSET(OP_TRYCATCH),
- GOTO_OP_OFFSET(OP_FOR),
- GOTO_OP_OFFSET(OP_TAPPLY),
- GOTO_OP_OFFSET(OP_SUB2),
- GOTO_OP_OFFSET(OP_LARGC),
- GOTO_OP_OFFSET(OP_LVARGC),
- GOTO_OP_OFFSET(OP_CALLL),
- GOTO_OP_OFFSET(OP_TCALLL),
- GOTO_OP_OFFSET(OP_BRNEL),
- GOTO_OP_OFFSET(OP_BRNNL),
- GOTO_OP_OFFSET(OP_BRN),
- GOTO_OP_OFFSET(OP_BRNL),
- GOTO_OP_OFFSET(OP_OPTARGS),
- GOTO_OP_OFFSET(OP_BRBOUND),
- GOTO_OP_OFFSET(OP_KEYARGS),
- GOTO_OP_OFFSET(OP_BOX),
- GOTO_OP_OFFSET(OP_BOXL),
- GOTO_OP_OFFSET(OP_SHIFT),
- GOTO_OP_OFFSET(OP_LOADVOID),
+#define GOTO_OP_OFFSET(op) [op] = &&op_##op
+#include "vm_goto.inc"
+#undef GOTO_OP_OFFSET
};
+#define NEXT_OP goto *ops[*ip++]
+#define OP(x) op_##x:
NEXT_OP;
-#else
-#define OP(x) case x:
-#define NEXT_OP break
+#include "vm.inc"
+#undef OP
+#undef NEXT_OP
+#pragma GCC diagnostic pop
+#else /* just a usual (portable) switch/case */
uint8_t op = *ip++;
while(1){ switch(op){-#endif
- OP(OP_LOADA0)
- PUSH(FL(stack)[bp]);
- NEXT_OP;
-
- OP(OP_LOADA1)
- PUSH(FL(stack)[bp+1]);
- NEXT_OP;
-
- OP(OP_LOADV)
- v = fn_vals(FL(stack)[bp-1]);
- assert(*ip < vector_size(v));
- PUSH(vector_elt(v, *ip++));
- NEXT_OP;
-
- OP(OP_BRF)
- ip += POP() != FL_f ? 2 : GET_INT16(ip);
- NEXT_OP;
-
- OP(OP_POP)
- POPN(1);
- NEXT_OP;
-
- OP(OP_TCALLL)
- tail = true;
- if(0){- OP(OP_CALLL)
- tail = false;
- }
- n = GET_INT32(ip);
- ip += 4;
- if(0){- OP(OP_TCALL)
- tail = true;
- if(0){- OP(OP_CALL)
- tail = false;
- }
- n = *ip++; // nargs
- }
- do_call:
- FL(stack)[ipd] = (uintptr_t)ip;
- func = FL(stack)[FL(sp)-n-1];
- if(tag(func) == TAG_FUNCTION){- if(func > (N_BUILTINS<<3)){- if(tail){- FL(curr_frame) = FL(stack)[FL(curr_frame)-3];
- for(s = -1; s < (fixnum_t)n; s++)
- FL(stack)[bp+s] = FL(stack)[FL(sp)-n+s];
- FL(sp) = bp+n;
- }
- nargs = n;
- goto apply_cl_top;
- }else{- i = uintval(func);
- if(isbuiltin(func)){- s = builtins[i].nargs;
- if(s >= 0)
- argcount(n, (unsigned)s);
- else if(s != ANYARGS && (signed)n < -s)
- argcount(n, (unsigned)-s);
- // remove function arg
- for(s = FL(sp)-n-1; s < (int)FL(sp)-1; s++)
- FL(stack)[s] = FL(stack)[s+1];
- FL(sp)--;
- switch(i){- case OP_LIST: goto apply_list;
- case OP_VECTOR: goto apply_vector;
- case OP_APPLY: goto apply_apply;
- case OP_ADD: goto apply_add;
- case OP_SUB: goto apply_sub;
- case OP_MUL: goto apply_mul;
- case OP_DIV: goto apply_div;
- case OP_AREF: goto apply_aref;
- case OP_ASET: goto apply_aset;
- default:
-#if defined(COMPUTED_GOTO)
- goto *ops[i];
-#else
- op = i;
- continue;
-#endif
- }
- }
- }
- }else if(__likely(iscbuiltin(func))){- s = FL(sp) - n;
- v = (((builtin_t*)ptr(func))[3])(&FL(stack)[s], n);
- FL(sp) = s;
- FL(stack)[s-1] = v;
- NEXT_OP;
- }
- type_error("function", func);-
- OP(OP_LOADGL)
- v = fn_vals(FL(stack)[bp-1]);
- v = vector_elt(v, GET_INT32(ip));
- ip += 4;
- if(0){- OP(OP_LOADG)
- v = fn_vals(FL(stack)[bp-1]);
- assert(*ip < vector_size(v));
- v = vector_elt(v, *ip);
- ip++;
- }
- assert(issymbol(v));
- sym = (symbol_t*)ptr(v);
- if(__unlikely(sym->binding == UNBOUND)){- FL(stack)[ipd] = (uintptr_t)ip;
- unbound_error(v);
- }
- PUSH(sym->binding);
- NEXT_OP;
-
- OP(OP_LOADA)
- i = *ip++;
- v = FL(stack)[bp+i];
- PUSH(v);
- NEXT_OP;
-
- OP(OP_LOADC)
- i = *ip++;
- v = FL(stack)[bp+nargs];
- assert(isvector(v));
- assert(i < vector_size(v));
- PUSH(vector_elt(v, i));
- NEXT_OP;
-
- OP(OP_BOX)
- i = *ip++;
- v = mk_cons();
- car_(v) = FL(stack)[bp+i];
- cdr_(v) = FL_nil;
- FL(stack)[bp+i] = v;
- NEXT_OP;
-
- OP(OP_BOXL)
- i = GET_INT32(ip); ip += 4;
- v = mk_cons();
- car_(v) = FL(stack)[bp+i];
- cdr_(v) = FL_nil;
- FL(stack)[bp+i] = v;
- NEXT_OP;
-
- OP(OP_SHIFT)
- i = *ip++;
- FL(stack)[FL(sp)-1-i] = FL(stack)[FL(sp)-1];
- FL(sp) -= i;
- NEXT_OP;
-
- OP(OP_RET)
- v = POP();
- FL(sp) = FL(curr_frame);
- FL(curr_frame) = FL(stack)[FL(sp)-3];
- if(FL(curr_frame) == top_frame)
- return v;
- FL(sp) -= 4+nargs;
- ipd = FL(curr_frame)-1;
- ip = (uint8_t*)FL(stack)[ipd];
- nargs = FL(stack)[FL(curr_frame)-2];
- bp = FL(curr_frame) - 4 - nargs;
- FL(stack)[FL(sp)-1] = v;
- NEXT_OP;
-
- OP(OP_DUP)
- FL(stack)[FL(sp)] = FL(stack)[FL(sp)-1];
- FL(sp)++;
- NEXT_OP;
-
- OP(OP_CAR)
- v = FL(stack)[FL(sp)-1];
- if(__likely(iscons(v)))
- v = car_(v);
- else if(__unlikely(v != FL_nil)){- FL(stack)[ipd] = (uintptr_t)ip;
- type_error("cons", v);- }
- FL(stack)[FL(sp)-1] = v;
- NEXT_OP;
-
- OP(OP_CDR)
- v = FL(stack)[FL(sp)-1];
- if(__likely(iscons(v)))
- v = cdr_(v);
- else if(__unlikely(v != FL_nil)){- FL(stack)[ipd] = (uintptr_t)ip;
- type_error("cons", v);- }
- FL(stack)[FL(sp)-1] = v;
- NEXT_OP;
-
- OP(OP_CLOSURE)
- n = *ip++;
- assert(n > 0);
- pv = alloc_words(n + 1);
- v = tagptr(pv, TAG_VECTOR);
- i = 0;
- pv[i++] = fixnum(n);
- do{- pv[i] = FL(stack)[FL(sp)-n + i-1];
- i++;
- }while(i <= n);
- POPN(n);
- PUSH(v);
- if(__unlikely((value_t*)FL(curheap) > (value_t*)FL(lim)-2))
- gc(0);
- pv = (value_t*)FL(curheap);
- FL(curheap) += 4*sizeof(value_t);
- e = FL(stack)[FL(sp)-2]; // closure to copy
- assert(isfunction(e));
- pv[0] = ((value_t*)ptr(e))[0];
- pv[1] = ((value_t*)ptr(e))[1];
- pv[2] = FL(stack)[FL(sp)-1]; // env
- pv[3] = ((value_t*)ptr(e))[3];
- POPN(1);
- FL(stack)[FL(sp)-1] = tagptr(pv, TAG_FUNCTION);
- NEXT_OP;
-
- OP(OP_SETA)
- v = FL(stack)[FL(sp)-1];
- i = *ip++;
- FL(stack)[bp+i] = v;
- NEXT_OP;
-
- OP(OP_JMP)
- ip += GET_INT16(ip);
- NEXT_OP;
-
- OP(OP_LOADC0)
- PUSH(vector_elt(FL(stack)[bp+nargs], 0));
- NEXT_OP;
-
- OP(OP_CONSP)
- FL(stack)[FL(sp)-1] = iscons(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
- NEXT_OP;
-
- OP(OP_BRNE)
- ip += FL(stack)[FL(sp)-2] != FL(stack)[FL(sp)-1] ? GET_INT16(ip) : 2;
- POPN(2);
- NEXT_OP;
-
- OP(OP_LOADT)
- PUSH(FL_t);
- NEXT_OP;
-
- OP(OP_LOADVOID)
- PUSH(FL_void);
- NEXT_OP;
-
- OP(OP_LOAD0)
- PUSH(fixnum(0));
- NEXT_OP;
-
- OP(OP_LOADC1)
- PUSH(vector_elt(FL(stack)[bp+nargs], 1));
- NEXT_OP;
-
- OP(OP_AREF2)
- n = 2;
- if(0){- OP(OP_AREF)
- FL(stack)[ipd] = (uintptr_t)ip;
- n = 3 + *ip++;
- }
- apply_aref:
- v = FL(stack)[FL(sp)-n];
- for(i = n-1; i > 0; i--){- if(isarray(v)){- FL(stack)[FL(sp)-i-1] = v;
- v = cvalue_array_aref(&FL(stack)[FL(sp)-i-1]);
- continue;
- }
- e = FL(stack)[FL(sp)-i];
- isz = tosize(e);
- if(isvector(v)){- if(__unlikely(isz >= vector_size(v)))
- bounds_error(v, e);
- v = vector_elt(v, isz);
- continue;
- }
- if(!iscons(v) && v != FL_nil)
- type_error("sequence", v);- for(value_t v0 = v;; isz--){- if(isz == 0){- v = car_(v);
- break;
- }
- v = cdr_(v);
- if(__unlikely(!iscons(v)))
- bounds_error(v0, e);
- }
- }
- POPN(n);
- PUSH(v);
- NEXT_OP;
-
- OP(OP_ATOMP)
- FL(stack)[FL(sp)-1] = iscons(FL(stack)[FL(sp)-1]) ? FL_f : FL_t;
- NEXT_OP;
-
- OP(OP_BRT)
- ip += POP() != FL_f ? GET_INT16(ip) : 2;
- NEXT_OP;
-
- OP(OP_BRNN)
- ip += POP() != FL_nil ? GET_INT16(ip) : 2;
- NEXT_OP;
-
- OP(OP_LOAD1)
- PUSH(fixnum(1));
- NEXT_OP;
-
- OP(OP_LT)
- {- value_t a = FL(stack)[FL(sp)-2], b = FL(stack)[FL(sp)-1];
- POPN(1);
- if(bothfixnums(a, b)){- FL(stack)[FL(sp)-1] = (fixnum_t)a < (fixnum_t)b ? FL_t : FL_f;
- }else{- x = numeric_compare(a, b, false, false, false);
- if(x > 1)
- x = numval(fl_compare(a, b));
- FL(stack)[FL(sp)-1] = x < 0 ? FL_t : FL_f;
- }
- }
- NEXT_OP;
-
- OP(OP_ADD2)
- do_add2:
- FL(stack)[ipd] = (uintptr_t)ip;
- if(0){- OP(OP_SUB2)
- do_sub2:
- FL(stack)[ipd] = (uintptr_t)ip;
- FL(stack)[FL(sp)-1] = fl_neg(FL(stack)[FL(sp)-1]);
- }
- {- fixnum_t a, b, c;
- a = FL(stack)[FL(sp)-2];
- b = FL(stack)[FL(sp)-1];
- if(bothfixnums(a, b) && !sadd_overflow(numval(a), numval(b), &c) && fits_fixnum(c)){- v = fixnum(c);
- }else{- v = fl_add_any(&FL(stack)[FL(sp)-2], 2);
- }
- }
- POPN(1);
- FL(stack)[FL(sp)-1] = v;
- NEXT_OP;
-
- OP(OP_SETCDR)
- v = FL(stack)[FL(sp)-2];
- if(__unlikely(!iscons(v))){- FL(stack)[ipd] = (uintptr_t)ip;
- type_error("cons", v);- }
- cdr_(v) = FL(stack)[FL(sp)-1];
- POPN(1);
- NEXT_OP;
-
- OP(OP_LOADF)
- PUSH(FL_f);
- NEXT_OP;
-
- OP(OP_CONS)
- if(FL(curheap) > FL(lim))
- gc(0);
- c = (cons_t*)FL(curheap);
- FL(curheap) += sizeof(cons_t);
- c->car = FL(stack)[FL(sp)-2];
- c->cdr = FL(stack)[FL(sp)-1];
- FL(stack)[FL(sp)-2] = tagptr(c, TAG_CONS);
- POPN(1);
- NEXT_OP;
-
- OP(OP_EQ)
- FL(stack)[FL(sp)-2] = FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1] ? FL_t : FL_f;
- POPN(1);
- NEXT_OP;
-
- OP(OP_SYMBOLP)
- FL(stack)[FL(sp)-1] = issymbol(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
- NEXT_OP;
-
- OP(OP_NOT)
- FL(stack)[FL(sp)-1] = FL(stack)[FL(sp)-1] == FL_f ? FL_t : FL_f;
- NEXT_OP;
-
- OP(OP_CADR)
- v = FL(stack)[FL(sp)-1];
- if(__likely(iscons(v))){- v = cdr_(v);
- if(__likely(iscons(v)))
- v = car_(v);
- else
- goto cadr_nil;
- }else{- cadr_nil:
- if(__unlikely(v != FL_nil)){- FL(stack)[ipd] = (uintptr_t)ip;
- type_error("cons", v);- }
- }
- FL(stack)[FL(sp)-1] = v;
- NEXT_OP;
-
- OP(OP_NEG)
- do_neg:
- FL(stack)[ipd] = (uintptr_t)ip;
- FL(stack)[FL(sp)-1] = fl_neg(FL(stack)[FL(sp)-1]);
- NEXT_OP;
-
- OP(OP_NULLP)
- FL(stack)[FL(sp)-1] = FL(stack)[FL(sp)-1] == FL_nil ? FL_t : FL_f;
- NEXT_OP;
-
- OP(OP_BOOLEANP)
- v = FL(stack)[FL(sp)-1];
- FL(stack)[FL(sp)-1] = (v == FL_t || v == FL_f) ? FL_t : FL_f;
- NEXT_OP;
-
- OP(OP_NUMBERP)
- v = FL(stack)[FL(sp)-1];
- FL(stack)[FL(sp)-1] = fl_isnumber(v) ? FL_t : FL_f;
- NEXT_OP;
-
- OP(OP_FIXNUMP)
- FL(stack)[FL(sp)-1] = isfixnum(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
- NEXT_OP;
-
- OP(OP_BOUNDP)
- FL(stack)[ipd] = (uintptr_t)ip;
- sym = tosymbol(FL(stack)[FL(sp)-1]);
- FL(stack)[FL(sp)-1] = sym->binding == UNBOUND ? FL_f : FL_t;
- NEXT_OP;
-
- OP(OP_BUILTINP)
- v = FL(stack)[FL(sp)-1];
- FL(stack)[FL(sp)-1] = (isbuiltin(v) || iscbuiltin(v)) ? FL_t : FL_f;
- NEXT_OP;
-
- OP(OP_FUNCTIONP)
- v = FL(stack)[FL(sp)-1];
- FL(stack)[FL(sp)-1] =
- ((tag(v) == TAG_FUNCTION &&
- (isbuiltin(v) || v>(N_BUILTINS<<3))) ||
- iscbuiltin(v)) ? FL_t : FL_f;
- NEXT_OP;
-
- OP(OP_VECTORP)
- FL(stack)[FL(sp)-1] = isvector(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
- NEXT_OP;
-
- OP(OP_JMPL)
- ip += GET_INT32(ip);
- NEXT_OP;
-
- OP(OP_BRFL)
- ip += POP() == FL_f ? GET_INT32(ip) : 4;
- NEXT_OP;
-
- OP(OP_BRTL)
- ip += POP() != FL_f ? GET_INT32(ip) : 4;
- NEXT_OP;
-
- OP(OP_BRNEL)
- ip += FL(stack)[FL(sp)-2] != FL(stack)[FL(sp)-1] ? GET_INT32(ip) : 4;
- POPN(2);
- NEXT_OP;
-
- OP(OP_BRNNL)
- ip += POP() != FL_nil ? GET_INT32(ip) : 4;
- NEXT_OP;
-
- OP(OP_BRN)
- ip += POP() == FL_nil ? GET_INT16(ip) : 2;
- NEXT_OP;
-
- OP(OP_BRNL)
- ip += POP() == FL_nil ? GET_INT32(ip) : 4;
- NEXT_OP;
-
- OP(OP_EQV)
- if(FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1])
- v = FL_t;
- else if(!leafp(FL(stack)[FL(sp)-2]) || !leafp(FL(stack)[FL(sp)-1]))
- v = FL_f;
- else
- v = compare_(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], 1) == 0 ? FL_t : FL_f;
- FL(stack)[FL(sp)-2] = v;
- POPN(1);
- NEXT_OP;
-
- OP(OP_EQUAL)
- if(FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1])
- v = FL_t;
- else
- v = compare_(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], 1) == 0 ? FL_t : FL_f;
- FL(stack)[FL(sp)-2] = v;
- POPN(1);
- NEXT_OP;
-
- OP(OP_SETCAR)
- v = FL(stack)[FL(sp)-2];
- if(__unlikely(!iscons(v))){- FL(stack)[ipd] = (uintptr_t)ip;
- type_error("cons", v);- }
- car_(v) = FL(stack)[FL(sp)-1];
- POPN(1);
- NEXT_OP;
-
- OP(OP_LIST)
- n = *ip++;
- apply_list:
- if(n > 0){- v = list(&FL(stack)[FL(sp)-n], n, 0);
- POPN(n);
- PUSH(v);
- }else{- PUSH(FL_nil);
- }
- NEXT_OP;
-
- OP(OP_TAPPLY)
- tail = true;
- if(0){- OP(OP_APPLY)
- tail = false;
- }
- n = *ip++;
- apply_apply:
- v = POP(); // arglist
- n = FL(sp)-(n-2); // n-2 == # leading arguments not in the list
- while(iscons(v)){- if(FL(sp) >= FL(nstack))
- grow_stack();
- PUSH(car_(v));
- v = cdr_(v);
- }
- if(v != FL_nil){- FL(stack)[ipd] = (uintptr_t)ip;
- lerrorf(FL(ArgError), "apply: last argument: not a list");
- }
- n = FL(sp)-n;
- goto do_call;
-
- OP(OP_ADD)
- n = *ip++;
- if(n == 2)
- goto do_add2;
- apply_add:
- FL(stack)[ipd] = (uintptr_t)ip;
- v = fl_add_any(&FL(stack)[FL(sp)-n], n);
- POPN(n);
- PUSH(v);
- NEXT_OP;
-
- OP(OP_SUB)
- n = *ip++;
- apply_sub:
- if(n == 2)
- goto do_sub2;
- if(n == 1)
- goto do_neg;
- FL(stack)[ipd] = (uintptr_t)ip;
- i = FL(sp)-n;
- // we need to pass the full arglist on to fl_add_any
- // so it can handle rest args properly
- PUSH(FL(stack)[i]);
- FL(stack)[i] = fixnum(0);
- FL(stack)[i+1] = fl_neg(fl_add_any(&FL(stack)[i], n));
- FL(stack)[i] = POP();
- v = fl_add_any(&FL(stack)[i], 2);
- POPN(n);
- PUSH(v);
- NEXT_OP;
-
- OP(OP_MUL)
- n = *ip++;
- apply_mul:
- FL(stack)[ipd] = (uintptr_t)ip;
- v = fl_mul_any(&FL(stack)[FL(sp)-n], n);
- POPN(n);
- PUSH(v);
- NEXT_OP;
-
- OP(OP_DIV)
- n = *ip++;
- apply_div:
- FL(stack)[ipd] = (uintptr_t)ip;
- i = FL(sp)-n;
- if(n == 1){- FL(stack)[FL(sp)-1] = fl_div2(fixnum(1), FL(stack)[i]);
- }else{- if(n > 2){- PUSH(FL(stack)[i]);
- FL(stack)[i] = fixnum(1);
- FL(stack)[i+1] = fl_mul_any(&FL(stack)[i], n);
- FL(stack)[i] = POP();
- }
- v = fl_div2(FL(stack)[i], FL(stack)[i+1]);
- POPN(n);
- PUSH(v);
- }
- NEXT_OP;
-
- OP(OP_IDIV)
- FL(stack)[ipd] = (uintptr_t)ip;
- v = FL(stack)[FL(sp)-2];
- e = FL(stack)[FL(sp)-1];
- if(bothfixnums(v, e)){- if(e == 0)
- DivideByZeroError();
- v = fixnum(numval(v) / numval(e));
- }else{- v = fl_idiv2(v, e);
- }
- POPN(1);
- FL(stack)[FL(sp)-1] = v;
- NEXT_OP;
-
- OP(OP_NUMEQ)
- v = FL(stack)[FL(sp)-2]; e = FL(stack)[FL(sp)-1];
- if(bothfixnums(v, e))
- v = v == e ? FL_t : FL_f;
- else{- FL(stack)[ipd] = (uintptr_t)ip;
- v = numeric_compare(v, e, true, false, true) == 0 ? FL_t : FL_f;
- }
- POPN(1);
- FL(stack)[FL(sp)-1] = v;
- NEXT_OP;
-
- OP(OP_COMPARE)
- FL(stack)[FL(sp)-2] = compare_(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], 0);
- POPN(1);
- NEXT_OP;
-
- OP(OP_ARGC)
- n = *ip++;
- if(0){- OP(OP_LARGC)
- n = GET_INT32(ip);
- ip += 4;
- }
- FL(stack)[ipd] = (uintptr_t)ip;
- argcount(nargs, n);
- NEXT_OP;
-
- OP(OP_VECTOR)
- n = *ip++;
- apply_vector:
- v = alloc_vector(n, 0);
- if(n){- memcpy(&vector_elt(v, 0), &FL(stack)[FL(sp)-n], n*sizeof(value_t));
- POPN(n);
- }
- PUSH(v);
- NEXT_OP;
-
- OP(OP_ASET)
- FL(stack)[ipd] = (uintptr_t)ip;
- v = FL(stack)[FL(sp)-3];
- n = 3;
- if(0){- apply_aset:
- v = FL(stack)[FL(sp)-n];
- for(i = n-1; i >= 3; i--){- if(isarray(v)){- FL(stack)[FL(sp)-i-1] = v;
- v = cvalue_array_aref(&FL(stack)[FL(sp)-i-1]);
- continue;
- }
- e = FL(stack)[FL(sp)-i];
- isz = tosize(e);
- if(isvector(v)){- if(__unlikely(isz >= vector_size(v)))
- bounds_error(v, e);
- v = vector_elt(v, isz);
- continue;
- }
- if(!iscons(v) && v != FL_nil)
- type_error("sequence", v);- for(value_t v0 = v;; isz--){- if(isz == 0){- v = car_(v);
- break;
- }
- v = cdr_(v);
- if(__unlikely(!iscons(v)))
- bounds_error(v0, e);
- }
- }
- FL(stack)[FL(sp)-3] = v;
- }
- e = FL(stack)[FL(sp)-2];
- isz = tosize(e);
- if(isvector(v)){- if(__unlikely(isz >= vector_size(v)))
- bounds_error(v, e);
- vector_elt(v, isz) = (e = FL(stack)[FL(sp)-1]);
- }else if(iscons(v) || v == FL_nil){- for(value_t v0 = v;; isz--){- if(isz == 0){- car_(v) = (e = FL(stack)[FL(sp)-1]);
- break;
- }
- v = cdr_(v);
- if(__unlikely(!iscons(v)))
- bounds_error(v0, e);
- }
- }else if(isarray(v)){- e = cvalue_array_aset(&FL(stack)[FL(sp)-3]);
- }else{- type_error("sequence", v);- }
- POPN(n);
- PUSH(e);
- NEXT_OP;
-
- OP(OP_FOR)
- FL(stack)[ipd] = (uintptr_t)ip;
- s = tofixnum(FL(stack)[FL(sp)-3]);
- hi = tofixnum(FL(stack)[FL(sp)-2]);
- v = FL_void;
- FL(sp) += 2;
- n = FL(sp);
- for(; s <= hi; s++){- FL(stack)[FL(sp)-2] = FL(stack)[FL(sp)-3];
- FL(stack)[FL(sp)-1] = fixnum(s);
- v = _applyn(1);
- FL(sp) = n;
- }
- POPN(4);
- FL(stack)[FL(sp)-1] = v;
- NEXT_OP;
-
- OP(OP_LOADNIL)
- PUSH(FL_nil);
- NEXT_OP;
-
- OP(OP_LOADI8)
- s = (int8_t)*ip++;
- PUSH(fixnum(s));
- NEXT_OP;
-
- OP(OP_LOADVL)
- v = fn_vals(FL(stack)[bp-1]);
- v = vector_elt(v, GET_INT32(ip));
- ip += 4;
- PUSH(v);
- NEXT_OP;
-
- OP(OP_SETGL)
- v = fn_vals(FL(stack)[bp-1]);
- v = vector_elt(v, GET_INT32(ip));
- ip += 4;
- if(0){- OP(OP_SETG)
- v = fn_vals(FL(stack)[bp-1]);
- assert(*ip < vector_size(v));
- v = vector_elt(v, *ip);
- ip++;
- }
- assert(issymbol(v));
- sym = (symbol_t*)ptr(v);
- v = FL(stack)[FL(sp)-1];
- if(!isconstant(sym))
- sym->binding = v;
- NEXT_OP;
-
- OP(OP_LOADAL)
- assert(nargs > 0);
- i = GET_INT32(ip);
- ip += 4;
- v = FL(stack)[bp+i];
- PUSH(v);
- NEXT_OP;
-
- OP(OP_SETAL)
- v = FL(stack)[FL(sp)-1];
- i = GET_INT32(ip);
- ip += 4;
- FL(stack)[bp+i] = v;
- NEXT_OP;
-
- OP(OP_LOADCL)
- i = GET_INT32(ip);
- ip += 4;
- v = FL(stack)[bp+nargs];
- PUSH(vector_elt(v, i));
- NEXT_OP;
-
- OP(OP_VARGC)
- i = *ip++;
- if(0){- OP(OP_LVARGC)
- i = GET_INT32(ip);
- ip += 4;
- }
- s = (fixnum_t)nargs - (fixnum_t)i;
- if(s > 0){- v = list(&FL(stack)[bp+i], s, 0);
- FL(stack)[bp+i] = v;
- if(s > 1){- FL(stack)[bp+i+1] = FL(stack)[bp+nargs+0];
- FL(stack)[bp+i+2] = FL(stack)[bp+nargs+1];
- FL(stack)[bp+i+3] = i+1;
- FL(stack)[bp+i+4] = 0;
- FL(sp) = bp+i+5;
- FL(curr_frame) = FL(sp);
- }
- }else if(__unlikely(s < 0)){- FL(stack)[ipd] = (uintptr_t)ip;
- lerrorf(FL(ArgError), "too few arguments");
- }else{- FL(sp)++;
- FL(stack)[FL(sp)-2] = i+1;
- FL(stack)[FL(sp)-3] = FL(stack)[FL(sp)-4];
- FL(stack)[FL(sp)-4] = FL(stack)[FL(sp)-5];
- FL(stack)[FL(sp)-5] = FL_nil;
- FL(curr_frame) = FL(sp);
- }
- ipd = FL(sp)-1;
- nargs = i+1;
- NEXT_OP;
-
- OP(OP_TRYCATCH)
- FL(stack)[ipd] = (uintptr_t)ip;
- v = do_trycatch();
- POPN(1);
- FL(stack)[FL(sp)-1] = v;
- NEXT_OP;
-
- OP(OP_OPTARGS)
- i = GET_INT32(ip);
- ip += 4;
- n = GET_INT32(ip);
- ip += 4;
- if(__unlikely(nargs < i)){- FL(stack)[ipd] = (uintptr_t)ip;
- lerrorf(FL(ArgError), "too few arguments");
- }
- if((int32_t)n > 0){- if(__unlikely(nargs > n)){- FL(stack)[ipd] = (uintptr_t)ip;
- lerrorf(FL(ArgError), "too many arguments");
- }
- }else
- n = -n;
- if(__likely(n > nargs)){- n -= nargs;
- FL(sp) += n;
- FL(stack)[FL(sp)-1] = FL(stack)[FL(sp)-n-1];
- FL(stack)[FL(sp)-2] = nargs+n;
- FL(stack)[FL(sp)-3] = FL(stack)[FL(sp)-n-3];
- FL(stack)[FL(sp)-4] = FL(stack)[FL(sp)-n-4];
- FL(curr_frame) = FL(sp);
- ipd = FL(sp)-1;
- for(i = 0; i < n; i++)
- FL(stack)[bp+nargs+i] = UNBOUND;
- nargs += n;
- }
- NEXT_OP;
-
- OP(OP_BRBOUND)
- i = GET_INT32(ip);
- ip += 4;
- v = FL(stack)[bp+i];
- PUSH(v != UNBOUND ? FL_t : FL_f);
- NEXT_OP;
-
- OP(OP_KEYARGS)
- v = fn_vals(FL(stack)[bp-1]);
- v = vector_elt(v, 0);
- i = GET_INT32(ip);
- ip += 4;
- n = GET_INT32(ip);
- ip += 4;
- s = GET_INT32(ip);
- ip += 4;
- FL(stack)[ipd] = (uintptr_t)ip;
- nargs = process_keys(v, i, n, labs(s)-(i+n), bp, nargs, s<0);
- ipd = FL(sp)-1;
- NEXT_OP;
-
-#if defined(COMPUTED_GOTO)
-#pragma GCC diagnostic pop
-#else
+#define NEXT_OP break
+#define OP(x) case x:
+#include "vm.inc"
+#undef OP
+#undef NEXT_OP
}
op = *ip++;
}
--- a/mkfile
+++ b/mkfile
@@ -56,7 +56,7 @@
`{ls `{echo $OFILES | sed 's/\.'$O'/.c/g'} >[2]/dev/null} | sort >$targetcvalues.$O: fl_arith_any.inc
-flisp.$O: maxstack.inc
+flisp.$O: maxstack.inc vm.inc
plan9/flisp.boot.s:D: flisp.boot
aux/data2s boot <flisp.boot >$target
--- /dev/null
+++ b/vm.inc
@@ -1,0 +1,885 @@
+OP(OP_LOADA0)
+ PUSH(FL(stack)[bp]);
+ NEXT_OP;
+
+OP(OP_LOADA1)
+ PUSH(FL(stack)[bp+1]);
+ NEXT_OP;
+
+OP(OP_LOADV)
+ v = fn_vals(FL(stack)[bp-1]);
+ assert(*ip < vector_size(v));
+ PUSH(vector_elt(v, *ip++));
+ NEXT_OP;
+
+OP(OP_BRF)
+ ip += POP() != FL_f ? 2 : GET_INT16(ip);
+ NEXT_OP;
+
+OP(OP_POP)
+ POPN(1);
+ NEXT_OP;
+
+OP(OP_TCALLL)
+ tail = true;
+ if(0){+OP(OP_CALLL)
+ tail = false;
+ }
+ n = GET_INT32(ip);
+ ip += 4;
+ if(0){+OP(OP_TCALL)
+ tail = true;
+ if(0){+OP(OP_CALL)
+ tail = false;
+ }
+ n = *ip++; // nargs
+ }
+do_call:
+ FL(stack)[ipd] = (uintptr_t)ip;
+ func = FL(stack)[FL(sp)-n-1];
+ if(tag(func) == TAG_FUNCTION){+ if(func > (N_BUILTINS<<3)){+ if(tail){+ FL(curr_frame) = FL(stack)[FL(curr_frame)-3];
+ for(s = -1; s < (fixnum_t)n; s++)
+ FL(stack)[bp+s] = FL(stack)[FL(sp)-n+s];
+ FL(sp) = bp+n;
+ }
+ nargs = n;
+ goto apply_cl_top;
+ }else{+ i = uintval(func);
+ if(isbuiltin(func)){+ s = builtins[i].nargs;
+ if(s >= 0)
+ argcount(n, (unsigned)s);
+ else if(s != ANYARGS && (signed)n < -s)
+ argcount(n, (unsigned)-s);
+ // remove function arg
+ for(s = FL(sp)-n-1; s < (int)FL(sp)-1; s++)
+ FL(stack)[s] = FL(stack)[s+1];
+ FL(sp)--;
+ switch(i){+ case OP_LIST: goto apply_list;
+ case OP_VECTOR: goto apply_vector;
+ case OP_APPLY: goto apply_apply;
+ case OP_ADD: goto apply_add;
+ case OP_SUB: goto apply_sub;
+ case OP_MUL: goto apply_mul;
+ case OP_DIV: goto apply_div;
+ case OP_AREF: goto apply_aref;
+ case OP_ASET: goto apply_aset;
+ default:
+#if defined(COMPUTED_GOTO)
+ goto *ops[i];
+#else
+ op = i;
+ continue;
+#endif
+ }
+ }
+ }
+ }else if(__likely(iscbuiltin(func))){+ s = FL(sp) - n;
+ v = (((builtin_t*)ptr(func))[3])(&FL(stack)[s], n);
+ FL(sp) = s;
+ FL(stack)[s-1] = v;
+ NEXT_OP;
+ }
+ type_error("function", func);+
+OP(OP_LOADGL)
+ v = fn_vals(FL(stack)[bp-1]);
+ v = vector_elt(v, GET_INT32(ip));
+ ip += 4;
+ if(0){+OP(OP_LOADG)
+ v = fn_vals(FL(stack)[bp-1]);
+ assert(*ip < vector_size(v));
+ v = vector_elt(v, *ip);
+ ip++;
+ }
+ assert(issymbol(v));
+ sym = (symbol_t*)ptr(v);
+ if(__unlikely(sym->binding == UNBOUND)){+ FL(stack)[ipd] = (uintptr_t)ip;
+ unbound_error(v);
+ }
+ PUSH(sym->binding);
+ NEXT_OP;
+
+OP(OP_LOADA)
+ i = *ip++;
+ v = FL(stack)[bp+i];
+ PUSH(v);
+ NEXT_OP;
+
+OP(OP_LOADC)
+ i = *ip++;
+ v = FL(stack)[bp+nargs];
+ assert(isvector(v));
+ assert(i < vector_size(v));
+ PUSH(vector_elt(v, i));
+ NEXT_OP;
+
+OP(OP_BOX)
+ i = *ip++;
+ v = mk_cons();
+ car_(v) = FL(stack)[bp+i];
+ cdr_(v) = FL_nil;
+ FL(stack)[bp+i] = v;
+ NEXT_OP;
+
+OP(OP_BOXL)
+ i = GET_INT32(ip); ip += 4;
+ v = mk_cons();
+ car_(v) = FL(stack)[bp+i];
+ cdr_(v) = FL_nil;
+ FL(stack)[bp+i] = v;
+ NEXT_OP;
+
+OP(OP_SHIFT)
+ i = *ip++;
+ FL(stack)[FL(sp)-1-i] = FL(stack)[FL(sp)-1];
+ FL(sp) -= i;
+ NEXT_OP;
+
+OP(OP_RET)
+ v = POP();
+ FL(sp) = FL(curr_frame);
+ FL(curr_frame) = FL(stack)[FL(sp)-3];
+ if(FL(curr_frame) == top_frame)
+ return v;
+ FL(sp) -= 4+nargs;
+ ipd = FL(curr_frame)-1;
+ ip = (uint8_t*)FL(stack)[ipd];
+ nargs = FL(stack)[FL(curr_frame)-2];
+ bp = FL(curr_frame) - 4 - nargs;
+ FL(stack)[FL(sp)-1] = v;
+ NEXT_OP;
+
+OP(OP_DUP)
+ FL(stack)[FL(sp)] = FL(stack)[FL(sp)-1];
+ FL(sp)++;
+ NEXT_OP;
+
+OP(OP_CAR)
+ v = FL(stack)[FL(sp)-1];
+ if(__likely(iscons(v)))
+ v = car_(v);
+ else if(__unlikely(v != FL_nil)){+ FL(stack)[ipd] = (uintptr_t)ip;
+ type_error("cons", v);+ }
+ FL(stack)[FL(sp)-1] = v;
+ NEXT_OP;
+
+OP(OP_CDR)
+ v = FL(stack)[FL(sp)-1];
+ if(__likely(iscons(v)))
+ v = cdr_(v);
+ else if(__unlikely(v != FL_nil)){+ FL(stack)[ipd] = (uintptr_t)ip;
+ type_error("cons", v);+ }
+ FL(stack)[FL(sp)-1] = v;
+ NEXT_OP;
+
+OP(OP_CLOSURE)
+ n = *ip++;
+ assert(n > 0);
+ pv = alloc_words(n + 1);
+ v = tagptr(pv, TAG_VECTOR);
+ i = 0;
+ pv[i++] = fixnum(n);
+ do{+ pv[i] = FL(stack)[FL(sp)-n + i-1];
+ i++;
+ }while(i <= n);
+ POPN(n);
+ PUSH(v);
+ if(__unlikely((value_t*)FL(curheap) > (value_t*)FL(lim)-2))
+ gc(0);
+ pv = (value_t*)FL(curheap);
+ FL(curheap) += 4*sizeof(value_t);
+ e = FL(stack)[FL(sp)-2]; // closure to copy
+ assert(isfunction(e));
+ pv[0] = ((value_t*)ptr(e))[0];
+ pv[1] = ((value_t*)ptr(e))[1];
+ pv[2] = FL(stack)[FL(sp)-1]; // env
+ pv[3] = ((value_t*)ptr(e))[3];
+ POPN(1);
+ FL(stack)[FL(sp)-1] = tagptr(pv, TAG_FUNCTION);
+ NEXT_OP;
+
+OP(OP_SETA)
+ v = FL(stack)[FL(sp)-1];
+ i = *ip++;
+ FL(stack)[bp+i] = v;
+ NEXT_OP;
+
+OP(OP_JMP)
+ ip += GET_INT16(ip);
+ NEXT_OP;
+
+OP(OP_LOADC0)
+ PUSH(vector_elt(FL(stack)[bp+nargs], 0));
+ NEXT_OP;
+
+OP(OP_CONSP)
+ FL(stack)[FL(sp)-1] = iscons(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
+ NEXT_OP;
+
+OP(OP_BRNE)
+ ip += FL(stack)[FL(sp)-2] != FL(stack)[FL(sp)-1] ? GET_INT16(ip) : 2;
+ POPN(2);
+ NEXT_OP;
+
+OP(OP_LOADT)
+ PUSH(FL_t);
+ NEXT_OP;
+
+OP(OP_LOADVOID)
+ PUSH(FL_void);
+ NEXT_OP;
+
+OP(OP_LOAD0)
+ PUSH(fixnum(0));
+ NEXT_OP;
+
+OP(OP_LOADC1)
+ PUSH(vector_elt(FL(stack)[bp+nargs], 1));
+ NEXT_OP;
+
+OP(OP_AREF2)
+ n = 2;
+ if(0){+OP(OP_AREF)
+ FL(stack)[ipd] = (uintptr_t)ip;
+ n = 3 + *ip++;
+ }
+apply_aref:
+ v = FL(stack)[FL(sp)-n];
+ for(i = n-1; i > 0; i--){+ if(isarray(v)){+ FL(stack)[FL(sp)-i-1] = v;
+ v = cvalue_array_aref(&FL(stack)[FL(sp)-i-1]);
+ continue;
+ }
+ e = FL(stack)[FL(sp)-i];
+ isz = tosize(e);
+ if(isvector(v)){+ if(__unlikely(isz >= vector_size(v)))
+ bounds_error(v, e);
+ v = vector_elt(v, isz);
+ continue;
+ }
+ if(!iscons(v) && v != FL_nil)
+ type_error("sequence", v);+ for(value_t v0 = v;; isz--){+ if(isz == 0){+ v = car_(v);
+ break;
+ }
+ v = cdr_(v);
+ if(__unlikely(!iscons(v)))
+ bounds_error(v0, e);
+ }
+ }
+ POPN(n);
+ PUSH(v);
+ NEXT_OP;
+
+OP(OP_ATOMP)
+ FL(stack)[FL(sp)-1] = iscons(FL(stack)[FL(sp)-1]) ? FL_f : FL_t;
+ NEXT_OP;
+
+OP(OP_BRT)
+ ip += POP() != FL_f ? GET_INT16(ip) : 2;
+ NEXT_OP;
+
+OP(OP_BRNN)
+ ip += POP() != FL_nil ? GET_INT16(ip) : 2;
+ NEXT_OP;
+
+OP(OP_LOAD1)
+ PUSH(fixnum(1));
+ NEXT_OP;
+
+OP(OP_LT)
+ {+ value_t a = FL(stack)[FL(sp)-2], b = FL(stack)[FL(sp)-1];
+ POPN(1);
+ if(bothfixnums(a, b)){+ FL(stack)[FL(sp)-1] = (fixnum_t)a < (fixnum_t)b ? FL_t : FL_f;
+ }else{+ x = numeric_compare(a, b, false, false, false);
+ if(x > 1)
+ x = numval(fl_compare(a, b));
+ FL(stack)[FL(sp)-1] = x < 0 ? FL_t : FL_f;
+ }
+ }
+ NEXT_OP;
+
+OP(OP_ADD2)
+do_add2:
+ FL(stack)[ipd] = (uintptr_t)ip;
+ if(0){+OP(OP_SUB2)
+do_sub2:
+ FL(stack)[ipd] = (uintptr_t)ip;
+ FL(stack)[FL(sp)-1] = fl_neg(FL(stack)[FL(sp)-1]);
+ }
+ {+ fixnum_t a, b, c;
+ a = FL(stack)[FL(sp)-2];
+ b = FL(stack)[FL(sp)-1];
+ if(bothfixnums(a, b) && !sadd_overflow(numval(a), numval(b), &c) && fits_fixnum(c)){+ v = fixnum(c);
+ }else{+ v = fl_add_any(&FL(stack)[FL(sp)-2], 2);
+ }
+ }
+ POPN(1);
+ FL(stack)[FL(sp)-1] = v;
+ NEXT_OP;
+
+OP(OP_SETCDR)
+ v = FL(stack)[FL(sp)-2];
+ if(__unlikely(!iscons(v))){+ FL(stack)[ipd] = (uintptr_t)ip;
+ type_error("cons", v);+ }
+ cdr_(v) = FL(stack)[FL(sp)-1];
+ POPN(1);
+ NEXT_OP;
+
+OP(OP_LOADF)
+ PUSH(FL_f);
+ NEXT_OP;
+
+OP(OP_CONS)
+ if(FL(curheap) > FL(lim))
+ gc(0);
+ c = (cons_t*)FL(curheap);
+ FL(curheap) += sizeof(cons_t);
+ c->car = FL(stack)[FL(sp)-2];
+ c->cdr = FL(stack)[FL(sp)-1];
+ FL(stack)[FL(sp)-2] = tagptr(c, TAG_CONS);
+ POPN(1);
+ NEXT_OP;
+
+OP(OP_EQ)
+ FL(stack)[FL(sp)-2] = FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1] ? FL_t : FL_f;
+ POPN(1);
+ NEXT_OP;
+
+OP(OP_SYMBOLP)
+ FL(stack)[FL(sp)-1] = issymbol(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
+ NEXT_OP;
+
+OP(OP_NOT)
+ FL(stack)[FL(sp)-1] = FL(stack)[FL(sp)-1] == FL_f ? FL_t : FL_f;
+ NEXT_OP;
+
+OP(OP_CADR)
+ v = FL(stack)[FL(sp)-1];
+ if(__likely(iscons(v))){+ v = cdr_(v);
+ if(__likely(iscons(v)))
+ v = car_(v);
+ else
+ goto cadr_nil;
+ }else{+ cadr_nil:
+ if(__unlikely(v != FL_nil)){+ FL(stack)[ipd] = (uintptr_t)ip;
+ type_error("cons", v);+ }
+ }
+ FL(stack)[FL(sp)-1] = v;
+ NEXT_OP;
+
+OP(OP_NEG)
+do_neg:
+ FL(stack)[ipd] = (uintptr_t)ip;
+ FL(stack)[FL(sp)-1] = fl_neg(FL(stack)[FL(sp)-1]);
+ NEXT_OP;
+
+OP(OP_NULLP)
+ FL(stack)[FL(sp)-1] = FL(stack)[FL(sp)-1] == FL_nil ? FL_t : FL_f;
+ NEXT_OP;
+
+OP(OP_BOOLEANP)
+ v = FL(stack)[FL(sp)-1];
+ FL(stack)[FL(sp)-1] = (v == FL_t || v == FL_f) ? FL_t : FL_f;
+ NEXT_OP;
+
+OP(OP_NUMBERP)
+ v = FL(stack)[FL(sp)-1];
+ FL(stack)[FL(sp)-1] = fl_isnumber(v) ? FL_t : FL_f;
+ NEXT_OP;
+
+OP(OP_FIXNUMP)
+ FL(stack)[FL(sp)-1] = isfixnum(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
+ NEXT_OP;
+
+OP(OP_BOUNDP)
+ FL(stack)[ipd] = (uintptr_t)ip;
+ sym = tosymbol(FL(stack)[FL(sp)-1]);
+ FL(stack)[FL(sp)-1] = sym->binding == UNBOUND ? FL_f : FL_t;
+ NEXT_OP;
+
+OP(OP_BUILTINP)
+ v = FL(stack)[FL(sp)-1];
+ FL(stack)[FL(sp)-1] = (isbuiltin(v) || iscbuiltin(v)) ? FL_t : FL_f;
+ NEXT_OP;
+
+OP(OP_FUNCTIONP)
+ v = FL(stack)[FL(sp)-1];
+ FL(stack)[FL(sp)-1] =
+ ((tag(v) == TAG_FUNCTION &&
+ (isbuiltin(v) || v>(N_BUILTINS<<3))) ||
+ iscbuiltin(v)) ? FL_t : FL_f;
+ NEXT_OP;
+
+OP(OP_VECTORP)
+ FL(stack)[FL(sp)-1] = isvector(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
+ NEXT_OP;
+
+OP(OP_JMPL)
+ ip += GET_INT32(ip);
+ NEXT_OP;
+
+OP(OP_BRFL)
+ ip += POP() == FL_f ? GET_INT32(ip) : 4;
+ NEXT_OP;
+
+OP(OP_BRTL)
+ ip += POP() != FL_f ? GET_INT32(ip) : 4;
+ NEXT_OP;
+
+OP(OP_BRNEL)
+ ip += FL(stack)[FL(sp)-2] != FL(stack)[FL(sp)-1] ? GET_INT32(ip) : 4;
+ POPN(2);
+ NEXT_OP;
+
+OP(OP_BRNNL)
+ ip += POP() != FL_nil ? GET_INT32(ip) : 4;
+ NEXT_OP;
+
+OP(OP_BRN)
+ ip += POP() == FL_nil ? GET_INT16(ip) : 2;
+ NEXT_OP;
+
+OP(OP_BRNL)
+ ip += POP() == FL_nil ? GET_INT32(ip) : 4;
+ NEXT_OP;
+
+OP(OP_EQV)
+ if(FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1])
+ v = FL_t;
+ else if(!leafp(FL(stack)[FL(sp)-2]) || !leafp(FL(stack)[FL(sp)-1]))
+ v = FL_f;
+ else
+ v = compare_(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], 1) == 0 ? FL_t : FL_f;
+ FL(stack)[FL(sp)-2] = v;
+ POPN(1);
+ NEXT_OP;
+
+OP(OP_EQUAL)
+ if(FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1])
+ v = FL_t;
+ else
+ v = compare_(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], 1) == 0 ? FL_t : FL_f;
+ FL(stack)[FL(sp)-2] = v;
+ POPN(1);
+ NEXT_OP;
+
+OP(OP_SETCAR)
+ v = FL(stack)[FL(sp)-2];
+ if(__unlikely(!iscons(v))){+ FL(stack)[ipd] = (uintptr_t)ip;
+ type_error("cons", v);+ }
+ car_(v) = FL(stack)[FL(sp)-1];
+ POPN(1);
+ NEXT_OP;
+
+OP(OP_LIST)
+ n = *ip++;
+apply_list:
+ if(n > 0){+ v = list(&FL(stack)[FL(sp)-n], n, 0);
+ POPN(n);
+ PUSH(v);
+ }else{+ PUSH(FL_nil);
+ }
+ NEXT_OP;
+
+OP(OP_TAPPLY)
+ tail = true;
+ if(0){+OP(OP_APPLY)
+ tail = false;
+ }
+ n = *ip++;
+apply_apply:
+ v = POP(); // arglist
+ n = FL(sp)-(n-2); // n-2 == # leading arguments not in the list
+ while(iscons(v)){+ if(FL(sp) >= FL(nstack))
+ grow_stack();
+ PUSH(car_(v));
+ v = cdr_(v);
+ }
+ if(v != FL_nil){+ FL(stack)[ipd] = (uintptr_t)ip;
+ lerrorf(FL(ArgError), "apply: last argument: not a list");
+ }
+ n = FL(sp)-n;
+ goto do_call;
+
+OP(OP_ADD)
+ n = *ip++;
+ if(n == 2)
+ goto do_add2;
+apply_add:
+ FL(stack)[ipd] = (uintptr_t)ip;
+ v = fl_add_any(&FL(stack)[FL(sp)-n], n);
+ POPN(n);
+ PUSH(v);
+ NEXT_OP;
+
+OP(OP_SUB)
+ n = *ip++;
+apply_sub:
+ if(n == 2)
+ goto do_sub2;
+ if(n == 1)
+ goto do_neg;
+ FL(stack)[ipd] = (uintptr_t)ip;
+ i = FL(sp)-n;
+ // we need to pass the full arglist on to fl_add_any
+ // so it can handle rest args properly
+ PUSH(FL(stack)[i]);
+ FL(stack)[i] = fixnum(0);
+ FL(stack)[i+1] = fl_neg(fl_add_any(&FL(stack)[i], n));
+ FL(stack)[i] = POP();
+ v = fl_add_any(&FL(stack)[i], 2);
+ POPN(n);
+ PUSH(v);
+ NEXT_OP;
+
+OP(OP_MUL)
+ n = *ip++;
+apply_mul:
+ FL(stack)[ipd] = (uintptr_t)ip;
+ v = fl_mul_any(&FL(stack)[FL(sp)-n], n);
+ POPN(n);
+ PUSH(v);
+ NEXT_OP;
+
+OP(OP_DIV)
+ n = *ip++;
+apply_div:
+ FL(stack)[ipd] = (uintptr_t)ip;
+ i = FL(sp)-n;
+ if(n == 1){+ FL(stack)[FL(sp)-1] = fl_div2(fixnum(1), FL(stack)[i]);
+ }else{+ if(n > 2){+ PUSH(FL(stack)[i]);
+ FL(stack)[i] = fixnum(1);
+ FL(stack)[i+1] = fl_mul_any(&FL(stack)[i], n);
+ FL(stack)[i] = POP();
+ }
+ v = fl_div2(FL(stack)[i], FL(stack)[i+1]);
+ POPN(n);
+ PUSH(v);
+ }
+ NEXT_OP;
+
+OP(OP_IDIV)
+ FL(stack)[ipd] = (uintptr_t)ip;
+ v = FL(stack)[FL(sp)-2];
+ e = FL(stack)[FL(sp)-1];
+ if(bothfixnums(v, e)){+ if(e == 0)
+ DivideByZeroError();
+ v = fixnum(numval(v) / numval(e));
+ }else{+ v = fl_idiv2(v, e);
+ }
+ POPN(1);
+ FL(stack)[FL(sp)-1] = v;
+ NEXT_OP;
+
+OP(OP_NUMEQ)
+ v = FL(stack)[FL(sp)-2]; e = FL(stack)[FL(sp)-1];
+ if(bothfixnums(v, e))
+ v = v == e ? FL_t : FL_f;
+ else{+ FL(stack)[ipd] = (uintptr_t)ip;
+ v = numeric_compare(v, e, true, false, true) == 0 ? FL_t : FL_f;
+ }
+ POPN(1);
+ FL(stack)[FL(sp)-1] = v;
+ NEXT_OP;
+
+OP(OP_COMPARE)
+ FL(stack)[FL(sp)-2] = compare_(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], 0);
+ POPN(1);
+ NEXT_OP;
+
+OP(OP_ARGC)
+ n = *ip++;
+ if(0){+OP(OP_LARGC)
+ n = GET_INT32(ip);
+ ip += 4;
+ }
+ FL(stack)[ipd] = (uintptr_t)ip;
+ argcount(nargs, n);
+ NEXT_OP;
+
+OP(OP_VECTOR)
+ n = *ip++;
+apply_vector:
+ v = alloc_vector(n, 0);
+ if(n){+ memcpy(&vector_elt(v, 0), &FL(stack)[FL(sp)-n], n*sizeof(value_t));
+ POPN(n);
+ }
+ PUSH(v);
+ NEXT_OP;
+
+OP(OP_ASET)
+ FL(stack)[ipd] = (uintptr_t)ip;
+ v = FL(stack)[FL(sp)-3];
+ n = 3;
+ if(0){+apply_aset:
+ v = FL(stack)[FL(sp)-n];
+ for(i = n-1; i >= 3; i--){+ if(isarray(v)){+ FL(stack)[FL(sp)-i-1] = v;
+ v = cvalue_array_aref(&FL(stack)[FL(sp)-i-1]);
+ continue;
+ }
+ e = FL(stack)[FL(sp)-i];
+ isz = tosize(e);
+ if(isvector(v)){+ if(__unlikely(isz >= vector_size(v)))
+ bounds_error(v, e);
+ v = vector_elt(v, isz);
+ continue;
+ }
+ if(!iscons(v) && v != FL_nil)
+ type_error("sequence", v);+ for(value_t v0 = v;; isz--){+ if(isz == 0){+ v = car_(v);
+ break;
+ }
+ v = cdr_(v);
+ if(__unlikely(!iscons(v)))
+ bounds_error(v0, e);
+ }
+ }
+ FL(stack)[FL(sp)-3] = v;
+ }
+ e = FL(stack)[FL(sp)-2];
+ isz = tosize(e);
+ if(isvector(v)){+ if(__unlikely(isz >= vector_size(v)))
+ bounds_error(v, e);
+ vector_elt(v, isz) = (e = FL(stack)[FL(sp)-1]);
+ }else if(iscons(v) || v == FL_nil){+ for(value_t v0 = v;; isz--){+ if(isz == 0){+ car_(v) = (e = FL(stack)[FL(sp)-1]);
+ break;
+ }
+ v = cdr_(v);
+ if(__unlikely(!iscons(v)))
+ bounds_error(v0, e);
+ }
+ }else if(isarray(v)){+ e = cvalue_array_aset(&FL(stack)[FL(sp)-3]);
+ }else{+ type_error("sequence", v);+ }
+ POPN(n);
+ PUSH(e);
+ NEXT_OP;
+
+OP(OP_FOR)
+ FL(stack)[ipd] = (uintptr_t)ip;
+ s = tofixnum(FL(stack)[FL(sp)-3]);
+ hi = tofixnum(FL(stack)[FL(sp)-2]);
+ v = FL_void;
+ FL(sp) += 2;
+ n = FL(sp);
+ for(; s <= hi; s++){+ FL(stack)[FL(sp)-2] = FL(stack)[FL(sp)-3];
+ FL(stack)[FL(sp)-1] = fixnum(s);
+ v = _applyn(1);
+ FL(sp) = n;
+ }
+ POPN(4);
+ FL(stack)[FL(sp)-1] = v;
+ NEXT_OP;
+
+OP(OP_LOADNIL)
+ PUSH(FL_nil);
+ NEXT_OP;
+
+OP(OP_LOADI8)
+ s = (int8_t)*ip++;
+ PUSH(fixnum(s));
+ NEXT_OP;
+
+OP(OP_LOADVL)
+ v = fn_vals(FL(stack)[bp-1]);
+ v = vector_elt(v, GET_INT32(ip));
+ ip += 4;
+ PUSH(v);
+ NEXT_OP;
+
+OP(OP_SETGL)
+ v = fn_vals(FL(stack)[bp-1]);
+ v = vector_elt(v, GET_INT32(ip));
+ ip += 4;
+ if(0){+OP(OP_SETG)
+ v = fn_vals(FL(stack)[bp-1]);
+ assert(*ip < vector_size(v));
+ v = vector_elt(v, *ip);
+ ip++;
+ }
+ assert(issymbol(v));
+ sym = (symbol_t*)ptr(v);
+ v = FL(stack)[FL(sp)-1];
+ if(!isconstant(sym))
+ sym->binding = v;
+ NEXT_OP;
+
+OP(OP_LOADAL)
+ assert(nargs > 0);
+ i = GET_INT32(ip);
+ ip += 4;
+ v = FL(stack)[bp+i];
+ PUSH(v);
+ NEXT_OP;
+
+OP(OP_SETAL)
+ v = FL(stack)[FL(sp)-1];
+ i = GET_INT32(ip);
+ ip += 4;
+ FL(stack)[bp+i] = v;
+ NEXT_OP;
+
+OP(OP_LOADCL)
+ i = GET_INT32(ip);
+ ip += 4;
+ v = FL(stack)[bp+nargs];
+ PUSH(vector_elt(v, i));
+ NEXT_OP;
+
+OP(OP_VARGC)
+ i = *ip++;
+ if(0){+OP(OP_LVARGC)
+ i = GET_INT32(ip);
+ ip += 4;
+ }
+ s = (fixnum_t)nargs - (fixnum_t)i;
+ if(s > 0){+ v = list(&FL(stack)[bp+i], s, 0);
+ FL(stack)[bp+i] = v;
+ if(s > 1){+ FL(stack)[bp+i+1] = FL(stack)[bp+nargs+0];
+ FL(stack)[bp+i+2] = FL(stack)[bp+nargs+1];
+ FL(stack)[bp+i+3] = i+1;
+ FL(stack)[bp+i+4] = 0;
+ FL(sp) = bp+i+5;
+ FL(curr_frame) = FL(sp);
+ }
+ }else if(__unlikely(s < 0)){+ FL(stack)[ipd] = (uintptr_t)ip;
+ lerrorf(FL(ArgError), "too few arguments");
+ }else{+ FL(sp)++;
+ FL(stack)[FL(sp)-2] = i+1;
+ FL(stack)[FL(sp)-3] = FL(stack)[FL(sp)-4];
+ FL(stack)[FL(sp)-4] = FL(stack)[FL(sp)-5];
+ FL(stack)[FL(sp)-5] = FL_nil;
+ FL(curr_frame) = FL(sp);
+ }
+ ipd = FL(sp)-1;
+ nargs = i+1;
+ NEXT_OP;
+
+OP(OP_TRYCATCH)
+ FL(stack)[ipd] = (uintptr_t)ip;
+ v = do_trycatch();
+ POPN(1);
+ FL(stack)[FL(sp)-1] = v;
+ NEXT_OP;
+
+OP(OP_OPTARGS)
+ i = GET_INT32(ip);
+ ip += 4;
+ n = GET_INT32(ip);
+ ip += 4;
+ if(__unlikely(nargs < i)){+ FL(stack)[ipd] = (uintptr_t)ip;
+ lerrorf(FL(ArgError), "too few arguments");
+ }
+ if((int32_t)n > 0){+ if(__unlikely(nargs > n)){+ FL(stack)[ipd] = (uintptr_t)ip;
+ lerrorf(FL(ArgError), "too many arguments");
+ }
+ }else
+ n = -n;
+ if(__likely(n > nargs)){+ n -= nargs;
+ FL(sp) += n;
+ FL(stack)[FL(sp)-1] = FL(stack)[FL(sp)-n-1];
+ FL(stack)[FL(sp)-2] = nargs+n;
+ FL(stack)[FL(sp)-3] = FL(stack)[FL(sp)-n-3];
+ FL(stack)[FL(sp)-4] = FL(stack)[FL(sp)-n-4];
+ FL(curr_frame) = FL(sp);
+ ipd = FL(sp)-1;
+ for(i = 0; i < n; i++)
+ FL(stack)[bp+nargs+i] = UNBOUND;
+ nargs += n;
+ }
+ NEXT_OP;
+
+OP(OP_BRBOUND)
+ i = GET_INT32(ip);
+ ip += 4;
+ v = FL(stack)[bp+i];
+ PUSH(v != UNBOUND ? FL_t : FL_f);
+ NEXT_OP;
+
+OP(OP_KEYARGS)
+ v = fn_vals(FL(stack)[bp-1]);
+ v = vector_elt(v, 0);
+ i = GET_INT32(ip);
+ ip += 4;
+ n = GET_INT32(ip);
+ ip += 4;
+ s = GET_INT32(ip);
+ ip += 4;
+ FL(stack)[ipd] = (uintptr_t)ip;
+ nargs = process_keys(v, i, n, labs(s)-(i+n), bp, nargs, s<0);
+ ipd = FL(sp)-1;
+ NEXT_OP;
--- /dev/null
+++ b/vm_goto.inc
@@ -1,0 +1,94 @@
+GOTO_OP_OFFSET(OP_LOADA0),
+GOTO_OP_OFFSET(OP_LOADA1),
+GOTO_OP_OFFSET(OP_LOADV),
+GOTO_OP_OFFSET(OP_BRF),
+GOTO_OP_OFFSET(OP_POP),
+GOTO_OP_OFFSET(OP_CALL),
+GOTO_OP_OFFSET(OP_TCALL),
+GOTO_OP_OFFSET(OP_LOADG),
+GOTO_OP_OFFSET(OP_LOADA),
+GOTO_OP_OFFSET(OP_LOADC),
+GOTO_OP_OFFSET(OP_RET),
+GOTO_OP_OFFSET(OP_DUP),
+GOTO_OP_OFFSET(OP_CAR),
+GOTO_OP_OFFSET(OP_CDR),
+GOTO_OP_OFFSET(OP_CLOSURE),
+GOTO_OP_OFFSET(OP_SETA),
+GOTO_OP_OFFSET(OP_JMP),
+GOTO_OP_OFFSET(OP_LOADC0),
+GOTO_OP_OFFSET(OP_CONSP),
+GOTO_OP_OFFSET(OP_BRNE),
+GOTO_OP_OFFSET(OP_LOADT),
+GOTO_OP_OFFSET(OP_LOAD0),
+GOTO_OP_OFFSET(OP_LOADC1),
+GOTO_OP_OFFSET(OP_AREF2),
+GOTO_OP_OFFSET(OP_AREF),
+GOTO_OP_OFFSET(OP_ATOMP),
+GOTO_OP_OFFSET(OP_BRT),
+GOTO_OP_OFFSET(OP_BRNN),
+GOTO_OP_OFFSET(OP_LOAD1),
+GOTO_OP_OFFSET(OP_LT),
+GOTO_OP_OFFSET(OP_ADD2),
+GOTO_OP_OFFSET(OP_SETCDR),
+GOTO_OP_OFFSET(OP_LOADF),
+GOTO_OP_OFFSET(OP_CONS),
+GOTO_OP_OFFSET(OP_EQ),
+GOTO_OP_OFFSET(OP_SYMBOLP),
+GOTO_OP_OFFSET(OP_NOT),
+GOTO_OP_OFFSET(OP_CADR),
+GOTO_OP_OFFSET(OP_NEG),
+GOTO_OP_OFFSET(OP_NULLP),
+GOTO_OP_OFFSET(OP_BOOLEANP),
+GOTO_OP_OFFSET(OP_NUMBERP),
+GOTO_OP_OFFSET(OP_FIXNUMP),
+GOTO_OP_OFFSET(OP_BOUNDP),
+GOTO_OP_OFFSET(OP_BUILTINP),
+GOTO_OP_OFFSET(OP_FUNCTIONP),
+GOTO_OP_OFFSET(OP_VECTORP),
+GOTO_OP_OFFSET(OP_SETCAR),
+GOTO_OP_OFFSET(OP_JMPL),
+GOTO_OP_OFFSET(OP_BRFL),
+GOTO_OP_OFFSET(OP_BRTL),
+GOTO_OP_OFFSET(OP_EQV),
+GOTO_OP_OFFSET(OP_EQUAL),
+GOTO_OP_OFFSET(OP_LIST),
+GOTO_OP_OFFSET(OP_APPLY),
+GOTO_OP_OFFSET(OP_ADD),
+GOTO_OP_OFFSET(OP_SUB),
+GOTO_OP_OFFSET(OP_MUL),
+GOTO_OP_OFFSET(OP_DIV),
+GOTO_OP_OFFSET(OP_IDIV),
+GOTO_OP_OFFSET(OP_NUMEQ),
+GOTO_OP_OFFSET(OP_COMPARE),
+GOTO_OP_OFFSET(OP_ARGC),
+GOTO_OP_OFFSET(OP_VECTOR),
+GOTO_OP_OFFSET(OP_ASET),
+GOTO_OP_OFFSET(OP_LOADNIL),
+GOTO_OP_OFFSET(OP_LOADI8),
+GOTO_OP_OFFSET(OP_LOADVL),
+GOTO_OP_OFFSET(OP_LOADGL),
+GOTO_OP_OFFSET(OP_LOADAL),
+GOTO_OP_OFFSET(OP_LOADCL),
+GOTO_OP_OFFSET(OP_SETG),
+GOTO_OP_OFFSET(OP_SETGL),
+GOTO_OP_OFFSET(OP_SETAL),
+GOTO_OP_OFFSET(OP_VARGC),
+GOTO_OP_OFFSET(OP_TRYCATCH),
+GOTO_OP_OFFSET(OP_FOR),
+GOTO_OP_OFFSET(OP_TAPPLY),
+GOTO_OP_OFFSET(OP_SUB2),
+GOTO_OP_OFFSET(OP_LARGC),
+GOTO_OP_OFFSET(OP_LVARGC),
+GOTO_OP_OFFSET(OP_CALLL),
+GOTO_OP_OFFSET(OP_TCALLL),
+GOTO_OP_OFFSET(OP_BRNEL),
+GOTO_OP_OFFSET(OP_BRNNL),
+GOTO_OP_OFFSET(OP_BRN),
+GOTO_OP_OFFSET(OP_BRNL),
+GOTO_OP_OFFSET(OP_OPTARGS),
+GOTO_OP_OFFSET(OP_BRBOUND),
+GOTO_OP_OFFSET(OP_KEYARGS),
+GOTO_OP_OFFSET(OP_BOX),
+GOTO_OP_OFFSET(OP_BOXL),
+GOTO_OP_OFFSET(OP_SHIFT),
+GOTO_OP_OFFSET(OP_LOADVOID),