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;
}
/*
* Converts any LPC datatype into an arbitrary string format
* and returns a pointer to this string.
* Scary number of parameters for a recursive function.
*/
void svalue_to_string (svalue_t * obj, outbuffer_t * outbuf, int indent, int trailing, int indent2)
{
int i;
/* prevent an infinite recursion on self-referential structures */
if (indent > 20) {
outbuf_add(outbuf, "...");
return;
}
if (!indent2)
add_space(outbuf, indent);
switch ((obj->type & ~T_FREED)) {
case T_INVALID:
outbuf_add(outbuf, "T_INVALID");
break;
case T_LVALUE:
outbuf_add(outbuf, "lvalue: ");
svalue_to_string(obj->u.lvalue, outbuf, indent + 2, trailing, 0);
break;
case T_REF:
if(!obj->u.ref->lvalue)
kill_ref(obj->u.ref);
else {
outbuf_add(outbuf, "ref: ");
svalue_to_string(obj->u.ref->lvalue, outbuf, indent + 2, trailing, 0);
}
break;
case T_NUMBER:
numadd(outbuf, obj->u.number);
break;
case T_REAL:
outbuf_addv(outbuf, "%f", obj->u.real);
break;
case T_STRING:
outbuf_add(outbuf, "\"");
outbuf_add(outbuf, obj->u.string);
outbuf_add(outbuf, "\"");
break;
case T_CLASS:
{
int n = obj->u.arr->size;
outbuf_add(outbuf, "CLASS( ");
numadd(outbuf, n);
outbuf_add(outbuf, n == 1 ? " element\n" : " elements\n");
for (i = 0; i < (obj->u.arr->size) - 1; i++)
svalue_to_string(&(obj->u.arr->item[i]), outbuf,
indent + 2, 1, 0);
if(obj->u.arr->size)
svalue_to_string(&(obj->u.arr->item[i]), outbuf,
indent + 2, 0, 0);
outbuf_add(outbuf, "\n");
add_space(outbuf, indent);
outbuf_add(outbuf, " )");
break;
}
case T_ARRAY:
if (!(obj->u.arr->size)) {
outbuf_add(outbuf, "({ })");
} else {
outbuf_add(outbuf, "({ /* sizeof() == ");
numadd(outbuf, obj->u.arr->size);
outbuf_add(outbuf, " */\n");
for (i = 0; i < (obj->u.arr->size) - 1; i++)
svalue_to_string(&(obj->u.arr->item[i]), outbuf, indent + 2, 1, 0);
svalue_to_string(&(obj->u.arr->item[i]), outbuf, indent + 2, 0, 0);
outbuf_add(outbuf, "\n");
add_space(outbuf, indent);
outbuf_add(outbuf, "})");
}
break;
#ifndef NO_BUFFER_TYPE
case T_BUFFER:
outbuf_add(outbuf, "<buffer>");
break;
#endif
case T_FUNCTION:
{
svalue_t tmp;
object_t *ob;
tmp.type = T_ARRAY;
outbuf_add(outbuf, "(: ");
switch (obj->u.fp->hdr.type) {
case FP_LOCAL | FP_NOT_BINDABLE:
ob = obj->u.fp->hdr.owner;
if (!ob || ob->flags & O_DESTRUCTED) {
outbuf_add(outbuf, "0");
break;
}
outbuf_add(outbuf, function_name(ob->prog,
obj->u.fp->f.local.index));
break;
case FP_SIMUL:
outbuf_add(outbuf, simuls[obj->u.fp->f.simul.index].func->funcname);
break;
case FP_FUNCTIONAL:
case FP_FUNCTIONAL | FP_NOT_BINDABLE:
{
char buf[10];
int n = obj->u.fp->f.functional.num_arg;
outbuf_add(outbuf, "<code>(");
for (i=1; i < n; i++) {
sprintf(buf, "$%i, ", i);
outbuf_add(outbuf, buf);
}
if (n) {
sprintf(buf, "$%i", n);
outbuf_add(outbuf, buf);
}
outbuf_add(outbuf, ")");
break;
}
case FP_EFUN:
{
int i;
i = obj->u.fp->f.efun.index;
outbuf_add(outbuf, query_instr_name(i));
break;
}
}
if (obj->u.fp->hdr.args) {
for (i=0; i<obj->u.fp->hdr.args->size; i++) {
outbuf_add(outbuf, ", ");
svalue_to_string(&(obj->u.fp->hdr.args->item[i]), outbuf, indent, 0, 0);
}
}
}
outbuf_add(outbuf, " :)");
break;
case T_MAPPING:
if (!(obj->u.map->count)) {
outbuf_add(outbuf, "([ ])");
} else {
outbuf_add(outbuf, "([ /* sizeof() == ");
numadd(outbuf, obj->u.map->count);
outbuf_add(outbuf, " */\n");
for (i = 0; i <= obj->u.map->table_size; i++) {
mapping_node_t *elm;
for (elm = obj->u.map->table[i]; elm; elm = elm->next) {
svalue_to_string(&(elm->values[0]), outbuf, indent + 2, 0, 0);
outbuf_add(outbuf, " : ");
svalue_to_string(&(elm->values[1]), outbuf, indent + 4, 1, 1);
}
}
add_space(outbuf, indent);
outbuf_add(outbuf, "])");
}
break;
case T_OBJECT:
{
svalue_t *temp;
if (obj->u.ob->flags & O_DESTRUCTED) {
numadd(outbuf, 0);
break;
}
outbuf_addchar(outbuf, '/');
outbuf_add(outbuf, obj->u.ob->obname);
if (!max_eval_error && !too_deep_error) {
push_object(obj->u.ob);
temp = safe_apply_master_ob(APPLY_OBJECT_NAME, 1);
if (temp && temp != (svalue_t *) -1 && (temp->type == T_STRING)) {
outbuf_add(outbuf, " (\"");
outbuf_add(outbuf, temp->u.string);
outbuf_add(outbuf, "\")");
}
}
break;
}
default:
outbuf_addv(outbuf, "!ERROR: GARBAGE SVALUE: %x!", obj->type);
} /* end of switch (obj->type) */
if (trailing)
outbuf_add(outbuf, ",\n");
} /* end of svalue_to_string() */
