#define SUPPRESS_COMPILER_INLINES
#include "std.h"
#include "lpc_incl.h"
#include "eoperators.h"
#include "compiler.h"
#include "replace_program.h"
INLINE void
dealloc_funp (funptr_t * fp)
{
program_t *prog = 0;
switch (fp->hdr.type) {
case FP_LOCAL | FP_NOT_BINDABLE:
if (fp->hdr.owner)
prog = fp->hdr.owner->prog;
break;
case FP_FUNCTIONAL:
case FP_FUNCTIONAL | FP_NOT_BINDABLE:
prog = fp->f.functional.prog;
break;
}
if (fp->hdr.owner)
free_object(&fp->hdr.owner, "free_funp");
if (fp->hdr.args)
free_array(fp->hdr.args);
if (prog) {
prog->func_ref--;
debug(d_flag, ("subtr func ref /%s: now %i\n",
prog->filename, prog->func_ref));
if (!prog->func_ref && !prog->ref)
deallocate_program(prog);
}
FREE(fp);
}
INLINE void
free_funp (funptr_t * fp)
{
fp->hdr.ref--;
if (fp->hdr.ref > 0) {
return;
}
dealloc_funp(fp);
}
INLINE void
push_refed_funp (funptr_t * fp)
{
STACK_INC;
sp->type = T_FUNCTION;
sp->u.fp = fp;
}
INLINE void
push_funp (funptr_t * fp)
{
STACK_INC;
sp->type = T_FUNCTION;
sp->u.fp = fp;
fp->hdr.ref++;
}
/* num_arg args are on the stack, and the args from the array vec should be
* put in front of them. This is so that the order of arguments is logical.
*
* evaluate( (: f, a :), b) -> f(a,b) and not f(b, a) which would happen
* if we simply pushed the args from vec at this point. (Note that the
* old function pointers are broken in this regard)
*/
int merge_arg_lists (int num_arg, array_t * arr, int start) {
int num_arr_arg = arr->size - start;
svalue_t *sptr;
if (num_arr_arg) {
CHECK_STACK_OVERFLOW(num_arr_arg);
sptr = (sp += num_arr_arg);
if (num_arg) {
/* We need to do some stack movement so that the order
of arguments is logical */
while (num_arg--) {
*sptr = *(sptr - num_arr_arg);
sptr--;
}
}
num_arg = arr->size;
while (--num_arg >= start)
assign_svalue_no_free(sptr--, &arr->item[num_arg]);
/* could just return num_arr_arg if num_arg is 0 but .... -Sym */
return (sp - sptr);
}
return num_arg;
}
INLINE funptr_t *
make_efun_funp (int opcode, svalue_t * args)
{
funptr_t *fp;
fp = (funptr_t *)DXALLOC(sizeof(funptr_t),
TAG_FUNP, "make_efun_funp");
fp->hdr.owner = current_object;
add_ref( current_object, "make_efun_funp" );
fp->hdr.type = FP_EFUN;
fp->f.efun.index = opcode;
if (args->type == T_ARRAY) {
fp->hdr.args = args->u.arr;
args->u.arr->ref++;
} else
fp->hdr.args = 0;
fp->hdr.ref = 1;
return fp;
}
INLINE funptr_t *
make_lfun_funp (int index, svalue_t * args)
{
funptr_t *fp;
int newindex;
if (replace_program_pending(current_object))
error("cannot bind an lfun fp to an object with a pending replace_program()\n");
fp = (funptr_t *)DXALLOC(sizeof(funptr_hdr_t) + sizeof(local_ptr_t),
TAG_FUNP, "make_lfun_funp");
fp->hdr.owner = current_object;
add_ref( current_object, "make_lfun_funp" );
fp->hdr.type = FP_LOCAL | FP_NOT_BINDABLE;
fp->hdr.owner->prog->func_ref++;
debug(d_flag, ("add func ref /%s: now %i\n",
fp->hdr.owner->prog->filename,
fp->hdr.owner->prog->func_ref));
newindex = index + function_index_offset;
if (current_object->prog->function_flags[newindex] & FUNC_ALIAS)
newindex = current_object->prog->function_flags[newindex] & ~FUNC_ALIAS;
fp->f.local.index = newindex;
if (args->type == T_ARRAY) {
fp->hdr.args = args->u.arr;
args->u.arr->ref++;
} else
fp->hdr.args = 0;
fp->hdr.ref = 1;
return fp;
}
INLINE funptr_t *
make_simul_funp (int index, svalue_t * args)
{
funptr_t *fp;
fp = (funptr_t *)DXALLOC(sizeof(funptr_hdr_t) + sizeof(simul_ptr_t),
TAG_FUNP, "make_simul_funp");
fp->hdr.owner = current_object;
add_ref( current_object, "make_simul_funp" );
fp->hdr.type = FP_SIMUL;
fp->f.simul.index = index;
if (args->type == T_ARRAY) {
fp->hdr.args = args->u.arr;
args->u.arr->ref++;
} else
fp->hdr.args = 0;
fp->hdr.ref = 1;
return fp;
}
INLINE funptr_t *
make_functional_funp (short num_arg, short num_local, short len, svalue_t * args, int flag)
{
funptr_t *fp;
if (replace_program_pending(current_object))
error("cannot bind a functional to an object with a pending replace_program()\n");
fp = (funptr_t *)DXALLOC(sizeof(funptr_hdr_t) + sizeof(functional_t),
TAG_FUNP, "make_functional_funp");
fp->hdr.owner = current_object;
add_ref( current_object, "make_functional_funp" );
fp->hdr.type = FP_FUNCTIONAL + flag;
current_prog->func_ref++;
debug(d_flag, ("add func ref /%s: now %i\n",
current_prog->filename,
current_prog->func_ref));
fp->f.functional.prog = current_prog;
fp->f.functional.offset = pc - current_prog->program;
fp->f.functional.num_arg = num_arg;
fp->f.functional.num_local = num_local;
fp->f.functional.fio = function_index_offset;
fp->f.functional.vio = variable_index_offset;
pc += len;
if (args && args->type == T_ARRAY) {
fp->hdr.args = args->u.arr;
args->u.arr->ref++;
fp->f.functional.num_arg += args->u.arr->size;
} else
fp->hdr.args = 0;
fp->hdr.ref = 1;
return fp;
}
typedef void (*func_t) (void);
extern func_t efun_table[];
svalue_t *
call_function_pointer (funptr_t * funp, int num_arg)
{
static func_t *oefun_table = efun_table - BASE;
array_t *v;
if (!funp->hdr.owner || (funp->hdr.owner->flags & O_DESTRUCTED))
error("Owner (/%s) of function pointer is destructed.\n",
(funp->hdr.owner ? funp->hdr.owner->obname : "(null)"));
setup_fake_frame(funp);
if ((v=funp->hdr.args)) {
check_for_destr(v);
num_arg = merge_arg_lists(num_arg, v, 0);
}
switch (funp->hdr.type) {
case FP_SIMUL:
call_simul_efun(funp->f.simul.index, num_arg);
break;
case FP_EFUN:
{
int i, def;
fp = sp - num_arg + 1;
i = funp->f.efun.index;
if (num_arg == instrs[i].min_arg - 1 &&
((def = instrs[i].Default) != DEFAULT_NONE)) {
if (def == DEFAULT_THIS_OBJECT) {
push_object(current_object);
} else {
push_number(def);
}
num_arg++;
} else
if (num_arg < instrs[i].min_arg) {
error("Too few arguments to efun %s in efun pointer.\n", query_instr_name(i));
} else if (num_arg > instrs[i].max_arg && instrs[i].max_arg != -1) {
error("Too many arguments to efun %s in efun pointer.\n", query_instr_name(i));
}
/* possibly we should add TRACE, OPC, etc here;
also on eval_cost here, which is ok for just 1 efun */
{
int j, n = num_arg;
st_num_arg = num_arg;
if (n >= 4 || instrs[i].max_arg == -1)
n = instrs[i].min_arg;
for (j = 0; j < n; j++) {
CHECK_TYPES(sp - num_arg + j + 1, instrs[i].type[j], j + 1, i);
}
(*oefun_table[i])();
free_svalue(&apply_ret_value, "call_function_pointer");
if (instrs[i].ret_type == TYPE_NOVALUE)
apply_ret_value = const0;
else
apply_ret_value = *sp--;
remove_fake_frame();
return &apply_ret_value;
}
}
case FP_LOCAL | FP_NOT_BINDABLE: {
function_t *func;
fp = sp - num_arg + 1;
if (current_object->prog->function_flags[funp->f.local.index] & (FUNC_PROTOTYPE|FUNC_UNDEFINED))
error("Undefined lfun pointer called: %s\n", function_name(current_object->prog, funp->f.local.index));
push_control_stack(FRAME_FUNCTION);
current_prog = funp->hdr.owner->prog;
caller_type = ORIGIN_LOCAL;
csp->num_local_variables = num_arg;
func = setup_new_frame(funp->f.local.index);
call_program(current_prog, func->address);
break;
}
case FP_FUNCTIONAL:
case FP_FUNCTIONAL | FP_NOT_BINDABLE: {
fp = sp - num_arg + 1;
push_control_stack(FRAME_FUNP);
current_prog = funp->f.functional.prog;
csp->fr.funp = funp;
caller_type = ORIGIN_FUNCTIONAL;
setup_variables(num_arg, funp->f.functional.num_local,
funp->f.functional.num_arg);
function_index_offset = funp->f.functional.fio;
variable_index_offset = funp->f.functional.vio;
call_program(funp->f.functional.prog, funp->f.functional.offset);
break;
}
default:
error("Unsupported function pointer type.\n");
}
free_svalue(&apply_ret_value, "call_function_pointer");
apply_ret_value = *sp--;
remove_fake_frame();
return &apply_ret_value;
}
svalue_t *
safe_call_function_pointer (funptr_t * funp, int num_arg)
{
error_context_t econ;
svalue_t *ret;
if (!save_context(&econ))
return 0;
if (!SETJMP(econ.context)) {
ret = call_function_pointer(funp, num_arg);
} else {
restore_context(&econ);
/* condition was restored to where it was when we came in */
pop_n_elems(num_arg);
ret = 0;
}
pop_context(&econ);
return ret;
}