lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

some tweaks to the vm

This commit is contained in:
JeffBezanson 2009-04-22 23:00:13 +00:00
parent 27120b0ce4
commit e4488bb065
1 changed files with 39 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
femtolisp/flisp.c
View File

@ -798,50 +798,49 @@ static value_t apply_cl(uint32_t nargs)
nargs = i+1; nargs = i+1;
break; break;
case OP_LET: case OP_LET:
ip++; ip++;
// last arg is closure environment to use // last arg is closure environment to use
nargs--; nargs--;
Stack[SP-2] = Stack[SP-1]; Stack[SP-2] = Stack[SP-1];
POPN(1); POPN(1);
pvals = &Stack[SP-1]; pvals = &Stack[SP-1];
break; break;
case OP_NOP: break; case OP_NOP: break;
case OP_DUP: v = Stack[SP-1]; PUSH(v); break; case OP_DUP: v = Stack[SP-1]; PUSH(v); break;
case OP_POP: POPN(1); break; case OP_POP: POPN(1); break;
case OP_TCALL: case OP_TCALL:
case OP_CALL: case OP_CALL:
i = code[ip++]; // nargs n = code[ip++]; // nargs
do_call: do_call:
s = SP; s = SP;
func = Stack[SP-i-1]; func = Stack[SP-n-1];
if (isfunction(func)) { if (isfunction(func)) {
if (op == OP_TCALL) { if (op == OP_TCALL) {
for(s=-1; s < (fixnum_t)i; s++) for(s=-1; s < (fixnum_t)n; s++)
Stack[bp+s] = Stack[SP-i+s]; Stack[bp+s] = Stack[SP-n+s];
SP = bp+i; SP = bp+n;
nargs = i; nargs = n;
goto apply_cl_top; goto apply_cl_top;
} }
else { else {
v = apply_cl(i); v = apply_cl(n);
} }
} }
else if (isbuiltinish(func)) { else if (isbuiltinish(func)) {
op = uintval(func); op = uintval(func);
if (op > N_BUILTINS) { if (op > N_BUILTINS) {
v = ((builtin_t)ptr(func))(&Stack[SP-i], i); v = ((builtin_t)ptr(func))(&Stack[SP-n], n);
} }
else { else {
s = builtin_arg_counts[op]; s = builtin_arg_counts[op];
if (s >= 0) if (s >= 0)
argcount(builtin_names[op], i, s); argcount(builtin_names[op], n, s);
else if (s != ANYARGS && (signed)i < -s) else if (s != ANYARGS && (signed)n < -s)
argcount(builtin_names[op], i, -s); argcount(builtin_names[op], n, -s);
// remove function arg // remove function arg
for(s=SP-i-1; s < (int)SP-1; s++) for(s=SP-n-1; s < (int)SP-1; s++)
Stack[s] = Stack[s+1]; Stack[s] = Stack[s+1];
SP--; SP--;
n = i;
switch (op) { switch (op) {
case OP_LIST: goto apply_list; case OP_LIST: goto apply_list;
case OP_ADD: goto apply_add; case OP_ADD: goto apply_add;
@ -857,7 +856,7 @@ static value_t apply_cl(uint32_t nargs)
else { else {
type_error("apply", "function", func); type_error("apply", "function", func);
} }
SP = s-i-1; SP = s-n-1;
PUSH(v); PUSH(v);
break; break;
case OP_JMP: ip = (uint32_t)*(uint16_t*)&code[ip]; break; case OP_JMP: ip = (uint32_t)*(uint16_t*)&code[ip]; break;
@ -953,12 +952,14 @@ static value_t apply_cl(uint32_t nargs)
Stack[SP-2] = tagptr(c, TAG_CONS); Stack[SP-2] = tagptr(c, TAG_CONS);
POPN(1); break; POPN(1); break;
case OP_CAR: case OP_CAR:
c = tocons(Stack[SP-1], "car"); v = Stack[SP-1];
Stack[SP-1] = c->car; if (!iscons(v)) type_error("car", "cons", v);
Stack[SP-1] = car_(v);
break; break;
case OP_CDR: case OP_CDR:
c = tocons(Stack[SP-1], "cdr"); v = Stack[SP-1];
Stack[SP-1] = c->cdr; if (!iscons(v)) type_error("cdr", "cons", v);
Stack[SP-1] = cdr_(v);
break; break;
case OP_SETCAR: case OP_SETCAR:
car(Stack[SP-2]) = Stack[SP-1]; car(Stack[SP-2]) = Stack[SP-1];
@ -967,29 +968,31 @@ static value_t apply_cl(uint32_t nargs)
cdr(Stack[SP-2]) = Stack[SP-1]; cdr(Stack[SP-2]) = Stack[SP-1];
POPN(1); break; POPN(1); break;
case OP_LIST: case OP_LIST:
i = code[ip++]; n = code[ip++];
apply_list: apply_list:
if (i > 0) if (n > 0) {
v = list(&Stack[SP-i], i); v = list(&Stack[SP-n], n);
else POPN(n);
v = NIL; PUSH(v);
POPN(i); }
PUSH(v); else {
PUSH(NIL);
}
break; break;
case OP_TAPPLY: case OP_TAPPLY:
case OP_APPLY: case OP_APPLY:
v = POP(); // arglist v = POP(); // arglist
i = SP; n = SP;
while (iscons(v)) { while (iscons(v)) {
if (SP-i == MAX_ARGS) { if (SP-n == MAX_ARGS) {
PUSH(v); PUSH(v);
break; break;
} }
PUSH(car_(v)); PUSH(car_(v));
v = cdr_(v); v = cdr_(v);
} }
i = SP-i; n = SP-n;
if (op==OP_TAPPLY) op = OP_TCALL; if (op==OP_TAPPLY) op = OP_TCALL;
goto do_call; goto do_call;
@ -1278,16 +1281,7 @@ static value_t apply_cl(uint32_t nargs)
case OP_SETC: case OP_SETC:
s = code[ip++]; s = code[ip++];
i = code[ip++]; i = code[ip++];
if (captured) { v = Stack[bp+nargs];
if (nargs > 0) {
// current frame has been captured
s++;
}
v = Stack[bp];
}
else {
v = Stack[bp+nargs];
}
while (s--) while (s--)
v = vector_elt(v, vector_size(v)-1); v = vector_elt(v, vector_size(v)-1);
assert(isvector(v)); assert(isvector(v));