
/********************************************
fcall.c

libmawk changes (C) 2009-2010, Tibor 'Igor2' Palinkas;
based on mawk code coming with the below copyright:

copyright 1991, Michael D. Brennan

This is a source file for mawk, an implementation of
the AWK programming language.

Mawk is distributed without warranty under the terms of
the GNU General Public License, version 2, 1991.
********************************************/
#include "mawk.h"
#include "symtype.h"
#include "code.h"

/* This file has functions involved with type checking of
   function calls
*/

static FCALL_REC *first_pass(mawk_state_t *, FCALL_REC *);
static CA_REC *call_arg_check(mawk_state_t *, FBLOCK *, CA_REC *, INST *, unsigned);
static int arg_cnt_ok(mawk_state_t *, FBLOCK *, CA_REC *, unsigned);
static void relocate_arglist(CA_REC *, int, unsigned, int);

/* type checks a list of call arguments,
   returns a list of arguments whose type is still unknown
*/
static CA_REC *call_arg_check(mawk_state_t *MAWK, FBLOCK *callee, CA_REC *entry_list, INST *start, unsigned line_no)
{
	/*		 start -> to locate patch */
	/*		 line_no -> for error messages */
	register CA_REC *q;
	CA_REC *exit_list = (CA_REC *) 0;

	MAWK->check_progress = 0;

	/* loop :
	   take q off entry_list
	   mawk_test it
	   if OK  mawk_zfree(MAWK, q)  else put on exit_list  */
	while ((q = entry_list)) {
		entry_list = q->link;

		if (q->type == ST_NONE) {
			/* try to infer the type */
			/* it might now be in symbol table */
			if (q->sym_p->type == ST_VAR) {
				/* set type and patch */
				q->type = CA_EXPR;
				start[q->call_offset + 1].ptr = (PTR) q->sym_p->stval.cp;
			}
			else if (q->sym_p->type == ST_ARRAY) {
				q->type = CA_ARRAY;
				start[q->call_offset].op = A_PUSHA;
				start[q->call_offset + 1].ptr = (PTR) q->sym_p->stval.array;
			}
			else {										/* try to infer from callee */

				switch (callee->typev[q->arg_num]) {
				case ST_LOCAL_VAR:
					q->type = CA_EXPR;
					q->sym_p->type = ST_VAR;
					q->sym_p->stval.cp = MAWK_ZMALLOC(MAWK, mawk_cell_t);
					q->sym_p->stval.cp->type = C_NOINIT;
					start[q->call_offset + 1].ptr = (PTR) q->sym_p->stval.cp;
					break;

				case ST_LOCAL_ARRAY:
					q->type = CA_ARRAY;
					q->sym_p->type = ST_ARRAY;
					q->sym_p->stval.array = mawk_array_new(MAWK, NULL);
					start[q->call_offset].op = A_PUSHA;
					start[q->call_offset + 1].ptr = (PTR) q->sym_p->stval.array;
					break;
				}
			}
		}
		else if (q->type == ST_LOCAL_NONE) {
			/* try to infer the type */
			if (*q->type_p == ST_LOCAL_VAR) {
				/* set type , don't need to patch */
				q->type = CA_EXPR;
			}
			else if (*q->type_p == ST_LOCAL_ARRAY) {
				q->type = CA_ARRAY;
				start[q->call_offset].op = LA_PUSHA;
				/* offset+1 op is OK */
			}
			else {										/* try to infer from callee */

				switch (callee->typev[q->arg_num]) {
				case ST_LOCAL_VAR:
					q->type = CA_EXPR;
					*q->type_p = ST_LOCAL_VAR;
					/* do not need to patch */
					break;

				case ST_LOCAL_ARRAY:
					q->type = CA_ARRAY;
					*q->type_p = ST_LOCAL_ARRAY;
					start[q->call_offset].op = LA_PUSHA;
					break;
				}
			}
		}

		/* if we still do not know the type put on the new list
		   else type check */
		if (q->type == ST_NONE || q->type == ST_LOCAL_NONE) {
			q->link = exit_list;
			exit_list = q;
		}
		else {											/* type known */

			if (callee->typev[q->arg_num] == ST_LOCAL_NONE)
				callee->typev[q->arg_num] = q->type;
			else if (q->type != callee->typev[q->arg_num])
				mawk_compile_error(MAWK, "type error in arg(%d) in call to %s", q->arg_num + 1, callee->name);

			MAWK_ZFREE(MAWK, q);
			MAWK->check_progress = 1;
		}
	}															/* while */

	return exit_list;
}


static int arg_cnt_ok(mawk_state_t *MAWK, FBLOCK *fbp, CA_REC *q, unsigned line_no)
{
	if ((int) q->arg_num >= (int) fbp->nargs)
		/* casts shutup stupid warning from solaris sun cc */
	{
		mawk_compile_error(MAWK, "too many arguments in call to %s", fbp->name);
		return 0;
	}
	else
		return 1;
}

static INST *update_start(mawk_state_t *MAWK, register FCALL_REC *p)
{
	switch (p->call_scope) {
		case SCOPE_MAIN:
			p->call_start = MAWK->main_start;
			break;

		case SCOPE_BEGIN:
			p->call_start = MAWK->begin_start;
			break;

		case SCOPE_END:
			p->call_start = MAWK->end_start;
			break;

		case SCOPE_FUNCT:
			p->call_start = p->call->code;
			break;
	}

	return p->call_start;
}

 /* function calls whose arg types need checking
    are stored on this list */

/* Corner case: a c function call with an argument referring to a global
   variable that has not yet been seen. In this case we should create that
   var, but because we can't look into the C code, we don't know if it's an
   array or not. So instead we delay resolving the symbol until the whole
   script is parsed and expect one of 3 cases:
   - the script references the var elsewhere as non-array -> it's not an array
   - the script references the var elsewhere as array -> it's an array
   - no reference elsewhere -> safe to pass NIL without even creating it
     (but throw an error because this is very likely a bug in the script)
*/
static void ccall_finalize_call(mawk_state_t *MAWK, register FCALL_REC *p)
{
	CA_REC *n;
	INST *start = update_start(MAWK, p);

	for(n = p->arg_list; n != NULL; n = n->link) {
		if ((n->type != ST_NONE) || (n->sym_p == NULL)) /* care only about unbound globals */
			continue;
		
		switch(n->sym_p->type) {
			case ST_NONE:
				mawk_errmsg(MAWK, 0, "uninitialized variable in C call %s()", p->callee->name);
				break;

			case ST_VAR:
				start[n->call_offset + 1].ptr = (PTR)n->sym_p->stval.cp;
				break;

			case ST_ARRAY:
				start[n->call_offset].op = A_PUSHA;
				start[n->call_offset + 1].ptr = (PTR)n->sym_p->stval.array;
				break;

			default:
				mawk_errmsg(MAWK, 0, "internal error: unknown argument symbol type %d in C call %s()", n->sym_p->type, p->callee->name);
				break;
		}
	}
}


/* on first pass thru the resolve list
   we check :
      if forward referenced functions were really defined
      if right number of arguments
   and compute call_start which is now known
*/

static FCALL_REC *first_pass(mawk_state_t *MAWK, register FCALL_REC *p)
{
	FCALL_REC dummy;
	register FCALL_REC *q = &dummy;	/* trails p */

	q->link = p;
	while (p) {
		if (!p->callee->code) {
			/* callee never defined - could be a C call*/
			ccall_finalize_call(MAWK, p);
			if (!MAWK->suppress_undefined_function_warning)
				mawk_compile_error(MAWK, "function %s never defined", p->callee->name);
			/* delete p from list */
			q->link = p->link;
			MAWK_ZFREE(MAWK, p);
		}
		/* note p->arg_list starts with last argument */
		else if (!p->arg_list /* nothing to do */  ||
						 (!p->arg_cnt_checked && !arg_cnt_ok(MAWK, p->callee, p->arg_list, p->line_no))) {
			q->link = p->link;				/* delete p */
			/* the ! arg_list case is not an error so free memory */
			MAWK_ZFREE(MAWK, p);
		}
		else {
			/* keep p and set call_start */
			q = p;
			update_start(MAWK, p);
		}
		p = q->link;
	}
	return dummy.link;
}

/* continuously walk the resolve_list making type deductions
   until this list goes empty or no more progress can be made
   (An example where no more progress can be made is at end of file
*/

void mawk_resolve_fcalls(mawk_state_t * MAWK)
{
	register FCALL_REC *p, *old_list, *new_list;
	int progress;									/* a flag */

	old_list = first_pass(MAWK, MAWK->resolve_list);
	new_list = (FCALL_REC *) 0;
	progress = 0;

	while (1) {
		if (!old_list) {
			/* flop the lists */
			old_list = new_list;
			if (!old_list							/* nothing left */
					|| !progress /* can't do any more */ )
				return;

			new_list = (FCALL_REC *) 0;
			progress = 0;
		}

		p = old_list;
		old_list = p->link;

		if ((p->arg_list = call_arg_check(MAWK, p->callee, p->arg_list, p->call_start, p->line_no))) {
			/* still have work to do , put on new_list   */
			progress |= MAWK->check_progress;
			p->link = new_list;
			new_list = p;
		}
		else {
			/* done with p */
			progress = 1;
			MAWK_ZFREE(MAWK, p);
		}
	}
}

/* the mawk_parser has just reduced a function call ;
   the info needed to type check is passed in.	If type checking
   can not be done yet (most common reason -- function referenced
   but not defined), a node is added to the resolve list.
*/
void mawk_check_fcall(mawk_state_t *MAWK, FBLOCK *callee, int call_scope, int move_level, FBLOCK *call, CA_REC *arg_list, unsigned line_no)
{
	FCALL_REC *p;

	if (!callee->code) {
		/* forward reference to a function to be defined later */
		p = MAWK_ZMALLOC(MAWK, FCALL_REC);
		p->callee = callee;
		p->call_scope = call_scope;
		p->move_level = move_level;
		p->call = call;
		p->arg_list = arg_list;
		p->arg_cnt_checked = 0;
		p->line_no = line_no;
		/* add to resolve list */
		p->link = MAWK->resolve_list;
		MAWK->resolve_list = p;
	}
	else if (arg_list && arg_cnt_ok(MAWK, callee, arg_list, line_no)) {
		/* usually arg_list disappears here and all is well
		   otherwise add to resolve list */

		if ((arg_list = call_arg_check(MAWK, callee, arg_list, mawk_code_base, line_no))) {
			p = MAWK_ZMALLOC(MAWK, FCALL_REC);
			p->callee = callee;
			p->call_scope = call_scope;
			p->move_level = move_level;
			p->call = call;
			p->arg_list = arg_list;
			p->arg_cnt_checked = 1;
			p->line_no = line_no;
			/* add to resolve list */
			p->link = MAWK->resolve_list;
			MAWK->resolve_list = p;
		}
	}
}

void mawk_check_ccall(mawk_state_t *MAWK, FBLOCK *callee, int call_scope, int move_level, FBLOCK *call, CA_REC *arg_list, unsigned line_no)
{
	FCALL_REC *p;

	p = MAWK_ZMALLOC(MAWK, FCALL_REC);
	p->callee = callee;
	p->call_scope = call_scope;
	p->move_level = move_level;
	p->call = call;
	p->arg_list = arg_list;
	p->arg_cnt_checked = 1;
	p->line_no = line_no;
	/* add to resolve list */
	p->link = MAWK->resolve_list;
	MAWK->resolve_list = p;

}


/* code_pop() has just moved some code.	 If this code contains
   a function call, it might need to be relocated on the
   resolve list too.  This function does it.
*/
void mawk_relocate_resolve_list(mawk_state_t *MAWK, int scope, int move_level, FBLOCK *fbp, int orig_offset, unsigned len, int delta)
{
	/* delta -> relocation distance */
	FCALL_REC *p = MAWK->resolve_list;

	while (p) {
		if (scope == p->call_scope && move_level == p->move_level && (scope == SCOPE_FUNCT ? fbp == p->call : 1)) {
			relocate_arglist(p->arg_list, orig_offset, len, delta);
		}
		p = p->link;
	}
}

static void relocate_arglist(CA_REC *arg_list, int offset, unsigned len, int delta)
{
	register CA_REC *p;

	if (!arg_list)
		return;

	p = arg_list;
	/* all nodes must be relocated or none, so mawk_test the
	   first one */

	/* Note: call_offset is always set even for args that don't need to
	   be patched so that this check works. */
	if (p->call_offset < offset || p->call_offset >= offset + len)
		return;

	/* relocate the whole list */
	do {
		p->call_offset += delta;
		p = p->link;
	}
	while (p);
}

/*  example where typing cannot progress

{ f(z) }

function f(x) { print NR }

# this is legal, does something useful, but absurdly written
# We have to design so this works
*/
