function.c

#define SUPPRESS_COMPILER_INLINES
#include "std.h"
#include "lpc_incl.h"
#include "swap.h"
#include "eoperators.h"
#include "compiler.h"
#include "replace_program.h"

INLINE void
dealloc_funp P1(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->name, prog->func_ref));
	if (!prog->func_ref && !prog->ref)
	    deallocate_program(prog);
    }

    FREE(fp);
}

INLINE void
free_funp P1(funptr_t *, fp)
{
    fp->hdr.ref--;
    if (fp->hdr.ref > 0) {
	return;
    }
    dealloc_funp(fp);
}

INLINE void
push_refed_funp P1(funptr_t *, fp)
{
    STACK_INC;
    sp->type = T_FUNCTION;
    sp->u.fp = fp;
}

INLINE void
push_funp P1(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 P3(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 P2(int, opcode, svalue_t *, args)
{
    funptr_t *fp;
    
    fp = (funptr_t *)DXALLOC(sizeof(funptr_hdr_t) + sizeof(efun_ptr_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 P2(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->name,
		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 P2(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 P5(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->name,
	       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) PROT((void));
extern func_t efun_table[];

svalue_t *
call_function_pointer P2(funptr_t *, funp, int, num_arg)
{
    static func_t *oefun_table = efun_table - BASE;
    
    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->name : "(null)"));
    
    setup_fake_frame(funp);
    if (current_object->flags & O_SWAPPED)
	load_ob_from_swap(current_object);

    switch (funp->hdr.type) {
    case FP_SIMUL:
	if (funp->hdr.args) {
	    check_for_destr(funp->hdr.args);
	    num_arg = merge_arg_lists(num_arg, funp->hdr.args, 0);
	}
	call_simul_efun(funp->f.simul.index, num_arg);
	break;
    case FP_EFUN:
	{
	    int i, def;
	    
	    fp = sp - num_arg + 1;
	    if (funp->hdr.args) {
		check_for_destr(funp->hdr.args);
		num_arg = merge_arg_lists(num_arg, funp->hdr.args, 0);
	    }
	    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;

	if (funp->hdr.args) {
	    array_t *v = funp->hdr.args;

	    check_for_destr(v);
	    num_arg = merge_arg_lists(num_arg, v, 0);
	}

	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;

	if (funp->hdr.args) {
	    array_t *v = funp->hdr.args;

	    check_for_destr(v);
	    num_arg = merge_arg_lists(num_arg, v, 0);
	}

	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 P2(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;
}