EVAL_INLINE lref_t subr_apply(lref_t function, size_t argc, lref_t argv[], lref_t * env, lref_t * retval)
{
lref_t arg1;
lref_t args;
size_t ii;
UNREFERENCED(env);
fstack_enter_frame(FRAME_SUBR);
fstack_push((lref_t)function);
switch (SUBR_TYPE(function))
{
case SUBR_0:
*retval = (SUBR_F0(function) ());
break;
case SUBR_1:
*retval = (SUBR_F1(function) (_ARGV(0)));
break;
case SUBR_2:
*retval = (SUBR_F2(function) (_ARGV(0), _ARGV(1)));
break;
case SUBR_3:
*retval = (SUBR_F3(function) (_ARGV(0), _ARGV(1), _ARGV(2)));
break;
case SUBR_4:
*retval = (SUBR_F4(function) (_ARGV(0), _ARGV(1), _ARGV(2), _ARGV(3)));
break;
case SUBR_2N:
arg1 = _ARGV(0);
arg1 = SUBR_F2(function) (arg1, _ARGV(1));
for (ii = 2; ii < argc; ii++)
arg1 = SUBR_F2(function) (arg1, _ARGV(ii));
*retval = arg1;
break;
case SUBR_ARGC:
*retval = (SUBR_FARGC(function) (argc, argv));
break;
case SUBR_N:
args = arg_list_from_buffer(argc, argv);
*retval = (SUBR_F1(function) (args));
break;
}
fstack_leave_frame();
return NIL;
}
EVAL_INLINE lref_t apply(lref_t function, size_t argc, lref_t argv[], lref_t *env, lref_t *retval)
{
lref_t args[3];
if (SUBRP(function)) {
return subr_apply(function, argc, argv, env, retval);
} else if (CLOSUREP(function)) {
lref_t c_code = CLOSURE_CODE(function);
*env = extend_env(arg_list_from_buffer(argc, argv),
CAR(c_code),
CLOSURE_ENV(function));
return CDR(c_code); /* tail call */
} else if (argc > 0) {
if (HASHP(function) || STRUCTUREP(function)) {
args[0] = function;
args[1] = argv[0];
args[2] = (argc > 1) ? argv[1] : NIL;
*retval = lslot_ref(MAX2(argc + 1, 2), args);
return NIL;
} else if (SYMBOLP(function)) {
if (HASHP(argv[0]) || STRUCTUREP(argv[0])) {
args[0] = argv[0];
args[1] = function;
args[2] = (argc > 1) ? argv[1] : NIL;
*retval = lslot_ref(MAX2(argc + 1, 2), args);
return NIL;
}
}
}
vmerror_wrong_type(function);
return NIL;
}
EVAL_INLINE lref_t apply(lref_t function,
size_t argc, lref_t argv[],
lref_t * env, lref_t * retval)
{
if (SUBRP(function))
return subr_apply(function, argc, argv, env, retval);
if (CLOSUREP(function))
{
lref_t c_code = CLOSURE_CODE(function);
*env = extend_env(arg_list_from_buffer(argc, argv),
CAR(c_code),
CLOSURE_ENV(function));
return CDR(c_code); /* tail call */
}
vmerror_wrong_type(function);
return NIL;
}
