mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-04-23 10:00:58 -07:00
Code Issues Projects Releases Packages Wiki Activity

Simplify the interpreter code for calling functions

Browse source
This commit is contained in:
jjgarcia 2008-06-19 15:08:38 +00:00
parent aa50e7ef4c
commit e65ebd076c
4 changed files with 187 additions and 203 deletions
Download patch file Download diff file Expand all files Collapse all files

21
src/c/compiler.d
View file

@ -783,13 +783,8 @@ c_block(cl_object body, int old_flags) {
[OP_CALL + nargs]
function_name
[OP_PCALL + nargs]
function_name
[OP_FCALL + nargs]
[OP_PFCALL + nargs]
OP_CALL and OP_FCALL leave all arguments in the VALUES() array,
while OP_PCALL and OP_PFCALL leave the first argument in the
stack.
@ -822,16 +817,19 @@ c_call(cl_object args, int flags) {
* calls: OP_STEPFCALL. */
asm_function(name, (flags & FLAG_GLOBAL) | FLAG_REG0);
asm_op2(OP_STEPCALL, nargs);
flags = FLAG_REG0;
asm_op(OP_POP1);
flags = FLAG_VALUES;
} else if (SYMBOLP(name) &&
((flags & FLAG_GLOBAL) || Null(c_tag_ref(name, @':function'))))
{
asm_op2(push? OP_PCALLG : OP_CALLG, nargs);
asm_op2(OP_CALLG, nargs);
asm_c(name);
flags = FLAG_VALUES;
} else {
/* Fixme!! We can optimize the case of global functions! */
asm_function(name, (flags & FLAG_GLOBAL) | FLAG_REG0);
asm_op2(push? OP_PCALL : OP_CALL, nargs);
asm_op2(OP_CALL, nargs);
flags = FLAG_VALUES;
}
return flags;
}
@ -860,10 +858,12 @@ c_funcall(cl_object args, int flags) {
nargs = c_arguments(args);
if (ENV->stepping) {
asm_op2(OP_STEPCALL, nargs);
flags = FLAG_REG0;
flags = FLAG_VALUES;
} else {
asm_op2((flags & FLAG_PUSH)? OP_PFCALL : OP_FCALL, nargs);
asm_op2(OP_FCALL, nargs);
flags = FLAG_VALUES;
}
asm_op(OP_POP1);
return flags;
}
@ -1472,6 +1472,7 @@ c_multiple_value_call(cl_object args, int flags) {
asm_op(op);
}
asm_op(OP_MCALL);
asm_op(OP_POP1);
return FLAG_VALUES;
}

33
src/c/disassembler.d
View file

@ -303,6 +303,11 @@ disassemble(cl_object bytecodes, cl_opcode *vector) {
*/
case OP_POP: string = "POP";
goto NOARG;
/* OP_POP1
Pops a single value pushed by a OP_PUSH[V[S]] operator.
*/
case OP_POP1: string = "POP1";
goto NOARG;
/* OP_POPVALUES
Pops all values pushed by a OP_PUSHVALUES operator.
*/
@ -348,34 +353,6 @@ disassemble(cl_object bytecodes, cl_opcode *vector) {
GET_OPARG(n, vector);
goto OPARG;
/* OP_PCALL n{arg}
Calls the function in VALUES(0) with N arguments which
have been deposited in the stack. The first output value
is pushed on the stack.
*/
case OP_PCALL: string = "PCALL\t";
GET_OPARG(n, vector);
goto OPARG;
/* OP_PCALLG n{arg}, name{arg}
Calls the function NAME with N arguments which have been
deposited in the stack. The first output value is pushed on
the stack.
*/
case OP_PCALLG: string = "PCALLG\t";
GET_OPARG(n, vector);
GET_DATA(o, vector, data);
goto OPARG_ARG;
/* OP_PFCALL n{arg}
Calls the function in the stack with N arguments which
have been deposited in the stack. The first output value
is pushed on the stack.
*/
case OP_PFCALL: string = "PFCALL\t";
GET_OPARG(n, vector);
goto OPARG;
/* OP_MCALL
Similar to FCALL, but gets the number of arguments from
the stack (They all have been deposited by OP_PUSHVALUES)

180
src/c/interpreter.d
View file

@ -561,6 +561,7 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc)
register cl_object reg0 = the_env->values[0];
cl_object reg1, lex_env = env;
struct ecl_stack_frame frame_aux;
cl_index narg;
volatile struct ihs_frame ihs;
ihs_push(&ihs, bytecodes, env);
frame_aux.t = t_frame;
@ -672,30 +673,6 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc)
STACK_PUSH(the_env, aux);
THREAD_NEXT;
}
/* OP_CALL n{arg}
Calls the function in REG0 with N arguments which
have been deposited in the stack. The output values
are left in VALUES(...)
*/
CASE(OP_CALL); {
cl_fixnum n;
GET_OPARG(n, vector);
INTERPRET_FUNCALL(reg0, the_env, frame_aux, n, reg0);
THREAD_NEXT;
}
/* OP_CALLG n{arg}, name{arg}
Calls the function NAME with N arguments which have been
deposited in the stack. The output values are left in VALUES.
*/
CASE(OP_CALLG); {
cl_fixnum n;
cl_object f;
GET_OPARG(n, vector);
GET_DATA(f, vector, data);
INTERPRET_FUNCALL(reg0, the_env, frame_aux, n, f);
THREAD_NEXT;
}
CASE(OP_CALLG1); {
cl_object s;
@ -715,19 +692,36 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc)
THREAD_NEXT;
}
/* OP_CALL n{arg}
Calls the function in REG0 with N arguments which
have been deposited in the stack. The first output value
is pushed on the stack.
*/
CASE(OP_CALL); {
GET_OPARG(narg, vector);
goto DO_CALL;
}
/* OP_CALLG n{arg}, name{arg}
Calls the function NAME with N arguments which have been
deposited in the stack. The first output value is pushed on
the stack.
*/
CASE(OP_CALLG); {
GET_OPARG(narg, vector);
GET_DATA(reg0, vector, data);
goto DO_CALL;
}
/* OP_FCALL n{arg}
Calls a function in the stack with N arguments which
have been also deposited in the stack. The output values
are left in VALUES(...)
*/
CASE(OP_FCALL); {
cl_fixnum n;
cl_object fun;
GET_OPARG(n, vector);
fun = STACK_REF(the_env,-n-1);
INTERPRET_FUNCALL(reg0, the_env, frame_aux, n, fun);
STACK_POP(the_env);
THREAD_NEXT;
GET_OPARG(narg, vector);
reg0 = STACK_REF(the_env,-narg-1);
goto DO_CALL;
}
/* OP_MCALL
@ -735,56 +729,79 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc)
the stack (They all have been deposited by OP_PUSHVALUES)
*/
CASE(OP_MCALL); {
cl_fixnum n = fix(STACK_POP(the_env));
cl_object fun = STACK_REF(the_env,-n-1);
INTERPRET_FUNCALL(reg0, the_env, frame_aux, n, fun);
narg = fix(STACK_POP(the_env));
reg0 = STACK_REF(the_env,-narg-1);
goto DO_CALL;
}
DO_CALL: {
cl_object x = reg0;
cl_object frame = (cl_object)&frame_aux;
frame_aux.top = the_env->stack_top;
frame_aux.bottom = the_env->stack_top - narg;
AGAIN:
if (reg0 == OBJNULL || reg0 == Cnil)
FEundefined_function(x);
switch (type_of(reg0)) {
case t_cfunfixed:
if (narg != (cl_index)reg0->cfun.narg)
FEwrong_num_arguments(reg0);
reg0 = APPLY_fixed(narg, (cl_objectfn_fixed)reg0->cfun.entry,
frame_aux.bottom);
break;
case t_cfun:
reg0 = APPLY(narg, reg0->cfun.entry, frame_aux.bottom);
break;
case t_cclosure:
reg0 = APPLY_closure(narg, reg0->cclosure.entry,
reg0->cclosure.env, frame_aux.bottom);
break;
#ifdef CLOS
case t_instance:
switch (reg0->instance.isgf) {
case ECL_STANDARD_DISPATCH:
reg0 = _ecl_standard_dispatch(frame, reg0);
break;
case ECL_USER_DISPATCH:
reg0 = reg0->instance.slots[reg0->instance.length - 1];
goto AGAIN;
default:
FEinvalid_function(reg0);
}
break;
#endif
case t_symbol:
if (reg0->symbol.stype & stp_macro)
FEundefined_function(x);
reg0 = SYM_FUN(reg0);
goto AGAIN;
case t_bytecodes:
reg0 = ecl_apply_lambda(frame, reg0);
break;
case t_bclosure:
reg0 = ecl_apply_bclosure(frame, reg0);
break;
default:
FEinvalid_function(reg0);
}
the_env->stack_top -= narg;
THREAD_NEXT;
}
/* OP_POP
Pops a singe value pushed by a OP_PUSH* operator.
*/
CASE(OP_POP); {
reg0 = STACK_POP(the_env);
THREAD_NEXT;
}
/* OP_POP1
Pops a singe value pushed by a OP_PUSH* operator, ignoring it.
*/
CASE(OP_POP1); {
STACK_POP(the_env);
THREAD_NEXT;
}
/* OP_PCALL n{arg}
Calls the function in REG0 with N arguments which
have been deposited in the stack. The first output value
is pushed on the stack.
*/
CASE(OP_PCALL); {
cl_fixnum n;
GET_OPARG(n, vector);
INTERPRET_FUNCALL(reg0, the_env, frame_aux, n, reg0);
STACK_PUSH(the_env, reg0);
THREAD_NEXT;
}
/* OP_PCALLG n{arg}, name{arg}
Calls the function NAME with N arguments which have been
deposited in the stack. The first output value is pushed on
the stack.
*/
CASE(OP_PCALLG); {
cl_fixnum n;
cl_object f;
GET_OPARG(n, vector);
GET_DATA(f, vector, data);
INTERPRET_FUNCALL(f, the_env, frame_aux, n, f);
STACK_PUSH(the_env, f);
THREAD_NEXT;
}
/* OP_PFCALL n{arg}
Calls the function in the stack with N arguments which
have been also deposited in the stack. The first output value
is pushed on the stack.
*/
CASE(OP_PFCALL); {
cl_fixnum n;
cl_object fun;
GET_OPARG(n, vector);
fun = STACK_REF(the_env, -n-1);
INTERPRET_FUNCALL(fun, the_env, frame_aux, n, fun);
STACK_REF(the_env, -1) = fun;
THREAD_NEXT;
}
/* OP_EXIT
Marks the end of a high level construct (BLOCK, CATCH...)
or a function.
@ -1241,13 +1258,6 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc)
STACK_REF(the_env, -1) = MAKE_FIXNUM(n + i);
THREAD_NEXT;
}
/* OP_POP
Pops a singe value pushed by a OP_PUSH* operator.
*/
CASE(OP_POP); {
reg0 = STACK_POP(the_env);
THREAD_NEXT;
}
/* OP_POPVALUES
Pops all values pushed by a OP_PUSHVALUES operator.
*/

156
src/h/bytecodes.h
View file

@ -24,15 +24,14 @@ enum {
OP_PUSHV,
OP_PUSHVS,
OP_PUSHQ,
OP_CALLG,
OP_CALLG1,
OP_CALLG2,
OP_CALL,
OP_CALLG,
OP_FCALL,
OP_PCALLG,
OP_PCALL,
OP_PFCALL,
OP_MCALL,
OP_POP,
OP_POP1,
OP_EXIT,
OP_FLET,
OP_LABELS,
@ -73,7 +72,6 @@ enum {
OP_PROGV,
OP_EXIT_PROGV,
OP_PUSHVALUES,
OP_POP,
OP_POPVALUES,
OP_PUSHMOREVALUES,
OP_VALUES,
@ -165,80 +163,78 @@ typedef int16_t cl_oparg;
#else
#define ECL_OFFSET_TABLE \
static const int offsets[] = {\
&&LBL_OP_NOP - &&LBL_OP_NOP,\
&&LBL_OP_QUOTE - &&LBL_OP_NOP,\
&&LBL_OP_ENDP - &&LBL_OP_NOP,\
&&LBL_OP_CONS - &&LBL_OP_NOP,\
&&LBL_OP_CAR - &&LBL_OP_NOP,\
&&LBL_OP_CDR - &&LBL_OP_NOP,\
&&LBL_OP_LIST - &&LBL_OP_NOP,\
&&LBL_OP_LISTA - &&LBL_OP_NOP,\
&&LBL_OP_VAR - &&LBL_OP_NOP,\
&&LBL_OP_VARS - &&LBL_OP_NOP,\
&&LBL_OP_PUSH - &&LBL_OP_NOP,\
&&LBL_OP_PUSHV - &&LBL_OP_NOP,\
&&LBL_OP_PUSHVS - &&LBL_OP_NOP,\
&&LBL_OP_PUSHQ - &&LBL_OP_NOP,\
&&LBL_OP_CALLG - &&LBL_OP_NOP,\
&&LBL_OP_CALLG1 - &&LBL_OP_NOP,\
&&LBL_OP_CALLG2 - &&LBL_OP_NOP,\
&&LBL_OP_CALL - &&LBL_OP_NOP,\
&&LBL_OP_FCALL - &&LBL_OP_NOP,\
&&LBL_OP_PCALLG - &&LBL_OP_NOP,\
&&LBL_OP_PCALL - &&LBL_OP_NOP,\
&&LBL_OP_PFCALL - &&LBL_OP_NOP,\
&&LBL_OP_MCALL - &&LBL_OP_NOP,\
&&LBL_OP_EXIT - &&LBL_OP_NOP,\
&&LBL_OP_FLET - &&LBL_OP_NOP,\
&&LBL_OP_LABELS - &&LBL_OP_NOP,\
&&LBL_OP_LFUNCTION - &&LBL_OP_NOP,\
&&LBL_OP_FUNCTION - &&LBL_OP_NOP,\
&&LBL_OP_CLOSE - &&LBL_OP_NOP,\
&&LBL_OP_GO - &&LBL_OP_NOP,\
&&LBL_OP_RETURN - &&LBL_OP_NOP,\
&&LBL_OP_THROW - &&LBL_OP_NOP,\
&&LBL_OP_JMP - &&LBL_OP_NOP,\
&&LBL_OP_JNIL - &&LBL_OP_NOP,\
&&LBL_OP_JT - &&LBL_OP_NOP,\
&&LBL_OP_JEQL - &&LBL_OP_NOP,\
&&LBL_OP_JNEQL - &&LBL_OP_NOP,\
&&LBL_OP_UNBIND - &&LBL_OP_NOP,\
&&LBL_OP_UNBINDS - &&LBL_OP_NOP,\
&&LBL_OP_BIND - &&LBL_OP_NOP,\
&&LBL_OP_PBIND - &&LBL_OP_NOP,\
&&LBL_OP_VBIND - &&LBL_OP_NOP,\
&&LBL_OP_BINDS - &&LBL_OP_NOP,\
&&LBL_OP_PBINDS - &&LBL_OP_NOP,\
&&LBL_OP_VBINDS - &&LBL_OP_NOP,\
&&LBL_OP_SETQ - &&LBL_OP_NOP,\
&&LBL_OP_SETQS - &&LBL_OP_NOP,\
&&LBL_OP_PSETQ - &&LBL_OP_NOP,\
&&LBL_OP_PSETQS - &&LBL_OP_NOP,\
&&LBL_OP_VSETQ - &&LBL_OP_NOP,\
&&LBL_OP_VSETQS - &&LBL_OP_NOP,\
&&LBL_OP_BLOCK - &&LBL_OP_NOP,\
&&LBL_OP_DO - &&LBL_OP_NOP,\
&&LBL_OP_CATCH - &&LBL_OP_NOP,\
&&LBL_OP_TAGBODY - &&LBL_OP_NOP,\
&&LBL_OP_EXIT_TAGBODY - &&LBL_OP_NOP,\
&&LBL_OP_EXIT_FRAME - &&LBL_OP_NOP,\
&&LBL_OP_PROTECT - &&LBL_OP_NOP,\
&&LBL_OP_PROTECT_NORMAL - &&LBL_OP_NOP,\
&&LBL_OP_PROTECT_EXIT - &&LBL_OP_NOP,\
&&LBL_OP_PROGV - &&LBL_OP_NOP,\
&&LBL_OP_EXIT_PROGV - &&LBL_OP_NOP,\
&&LBL_OP_PUSHVALUES - &&LBL_OP_NOP,\
&&LBL_OP_POP - &&LBL_OP_NOP,\
&&LBL_OP_POPVALUES - &&LBL_OP_NOP,\
&&LBL_OP_PUSHMOREVALUES - &&LBL_OP_NOP,\
&&LBL_OP_VALUES - &&LBL_OP_NOP,\
&&LBL_OP_VALUEREG0 - &&LBL_OP_NOP,\
&&LBL_OP_NTHVAL - &&LBL_OP_NOP,\
&&LBL_OP_NIL - &&LBL_OP_NOP,\
&&LBL_OP_NOT - &&LBL_OP_NOP,\
&&LBL_OP_PUSHNIL - &&LBL_OP_NOP,\
&&LBL_OP_STEPIN - &&LBL_OP_NOP,\
&&LBL_OP_STEPCALL - &&LBL_OP_NOP,\
&&LBL_OP_STEPOUT - &&LBL_OP_NOP\
0,\
&&LBL_OP_QUOTE - &&LBL_OP_NOP,\
&&LBL_OP_ENDP - &&LBL_OP_NOP,\
&&LBL_OP_CONS - &&LBL_OP_NOP,\
&&LBL_OP_CAR - &&LBL_OP_NOP,\
&&LBL_OP_CDR - &&LBL_OP_NOP,\
&&LBL_OP_LIST - &&LBL_OP_NOP,\
&&LBL_OP_LISTA - &&LBL_OP_NOP,\
&&LBL_OP_VAR - &&LBL_OP_NOP,\
&&LBL_OP_VARS - &&LBL_OP_NOP,\
&&LBL_OP_PUSH - &&LBL_OP_NOP,\
&&LBL_OP_PUSHV - &&LBL_OP_NOP,\
&&LBL_OP_PUSHVS - &&LBL_OP_NOP,\
&&LBL_OP_PUSHQ - &&LBL_OP_NOP,\
&&LBL_OP_CALLG1 - &&LBL_OP_NOP,\
&&LBL_OP_CALLG2 - &&LBL_OP_NOP,\
&&LBL_OP_CALL - &&LBL_OP_NOP,\
&&LBL_OP_CALLG - &&LBL_OP_NOP,\
&&LBL_OP_FCALL - &&LBL_OP_NOP,\
&&LBL_OP_MCALL - &&LBL_OP_NOP,\
&&LBL_OP_POP - &&LBL_OP_NOP,\
&&LBL_OP_POP1 - &&LBL_OP_NOP,\
&&LBL_OP_EXIT - &&LBL_OP_NOP,\
&&LBL_OP_FLET - &&LBL_OP_NOP,\
&&LBL_OP_LABELS - &&LBL_OP_NOP,\
&&LBL_OP_LFUNCTION - &&LBL_OP_NOP,\
&&LBL_OP_FUNCTION - &&LBL_OP_NOP,\
&&LBL_OP_CLOSE - &&LBL_OP_NOP,\
&&LBL_OP_GO - &&LBL_OP_NOP,\
&&LBL_OP_RETURN - &&LBL_OP_NOP,\
&&LBL_OP_THROW - &&LBL_OP_NOP,\
&&LBL_OP_JMP - &&LBL_OP_NOP,\
&&LBL_OP_JNIL - &&LBL_OP_NOP,\
&&LBL_OP_JT - &&LBL_OP_NOP,\
&&LBL_OP_JEQL - &&LBL_OP_NOP,\
&&LBL_OP_JNEQL - &&LBL_OP_NOP,\
&&LBL_OP_UNBIND - &&LBL_OP_NOP,\
&&LBL_OP_UNBINDS - &&LBL_OP_NOP,\
&&LBL_OP_BIND - &&LBL_OP_NOP,\
&&LBL_OP_PBIND - &&LBL_OP_NOP,\
&&LBL_OP_VBIND - &&LBL_OP_NOP,\
&&LBL_OP_BINDS - &&LBL_OP_NOP,\
&&LBL_OP_PBINDS - &&LBL_OP_NOP,\
&&LBL_OP_VBINDS - &&LBL_OP_NOP,\
&&LBL_OP_SETQ - &&LBL_OP_NOP,\
&&LBL_OP_SETQS - &&LBL_OP_NOP,\
&&LBL_OP_PSETQ - &&LBL_OP_NOP,\
&&LBL_OP_PSETQS - &&LBL_OP_NOP,\
&&LBL_OP_VSETQ - &&LBL_OP_NOP,\
&&LBL_OP_VSETQS - &&LBL_OP_NOP,\
&&LBL_OP_BLOCK - &&LBL_OP_NOP,\
&&LBL_OP_DO - &&LBL_OP_NOP,\
&&LBL_OP_CATCH - &&LBL_OP_NOP,\
&&LBL_OP_TAGBODY - &&LBL_OP_NOP,\
&&LBL_OP_EXIT_TAGBODY - &&LBL_OP_NOP,\
&&LBL_OP_EXIT_FRAME - &&LBL_OP_NOP,\
&&LBL_OP_PROTECT - &&LBL_OP_NOP,\
&&LBL_OP_PROTECT_NORMAL - &&LBL_OP_NOP,\
&&LBL_OP_PROTECT_EXIT - &&LBL_OP_NOP,\
&&LBL_OP_PROGV - &&LBL_OP_NOP,\
&&LBL_OP_EXIT_PROGV - &&LBL_OP_NOP,\
&&LBL_OP_PUSHVALUES - &&LBL_OP_NOP,\
&&LBL_OP_POPVALUES - &&LBL_OP_NOP,\
&&LBL_OP_PUSHMOREVALUES - &&LBL_OP_NOP,\
&&LBL_OP_VALUES - &&LBL_OP_NOP,\
&&LBL_OP_VALUEREG0 - &&LBL_OP_NOP,\
&&LBL_OP_NTHVAL - &&LBL_OP_NOP,\
&&LBL_OP_NIL - &&LBL_OP_NOP,\
&&LBL_OP_NOT - &&LBL_OP_NOP,\
&&LBL_OP_PUSHNIL - &&LBL_OP_NOP,\
&&LBL_OP_STEPIN - &&LBL_OP_NOP,\
&&LBL_OP_STEPCALL - &&LBL_OP_NOP,\
&&LBL_OP_STEPOUT - &&LBL_OP_NOP,\
}
#endif