mirror/mawk
1
0
Fork 0
mirror of https://github.com/ThomasDickey/mawk-snapshots.git synced 2026-01-27 03:14:29 +00:00
Code Issues Packages Projects Releases Wiki Activity
mawk/fcall.c
Thomas E. Dickey 2436c81a5d
snapshot of project "mawk", label t20231101
2023-11-02 08:12:37 +00:00

530 lines
12 KiB
C
Raw Permalink Blame History

/********************************************
fcall.c
copyright 2009-2020,2023 Thomas E. Dickey
copyright 1991-1993,1995, 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.
********************************************/
/*
* $MawkId: fcall.c,v 1.18 2023/08/17 22:44:27 tom Exp $
*/
#include <mawk.h>
#include <symtype.h>
#include <code.h>
/* This file has functions involved with type checking of
function calls
*/
static void relocate_arglist(CA_REC *, int, unsigned, int);
static int check_progress;
/* flag that indicates call_arg_check() was able to type
check some call arguments */
#if OPT_TRACE
static void
trace_arg_list(CA_REC * arg_list)
{
CA_REC *item;
int count = 0;
TRACE(("trace_arg_list\n"));
while ((item = arg_list) != 0) {
arg_list = item->link;
TRACE(("...arg %d is %s\n", item->arg_num + 1, type_to_str(item->type)));
++count;
}
}
#else
#define trace_arg_list(arg_list) /* nothing */
#endif
#if OPT_TRACE
/*
* FIXME: pass in the maximum offset, but keep track of jumps forward (and
* range) which extend beyond the last halt/stop/ret/ret0, to give a more
* precise value for the code size.
*/
static int
inst_len(INST * p)
{
int result = 0;
while (p != 0 && p->op != _HALT) {
++result;
switch ((MAWK_OPCODES) (p++->op)) {
case _HALT:
case _STOP:
case FE_PUSHA:
case FE_PUSHI:
case A_TEST:
case A_DEL:
case DEL_A:
case POP_AL:
case _POP:
case _ADD:
case _SUB:
case _MUL:
case _DIV:
case _MOD:
case _POW:
case _NOT:
case _UMINUS:
case _UPLUS:
case _TEST:
case _CAT:
case _ASSIGN:
case _ADD_ASG:
case _SUB_ASG:
case _MUL_ASG:
case _DIV_ASG:
case _MOD_ASG:
case _POW_ASG:
case NF_PUSHI:
case F_ASSIGN:
case F_ADD_ASG:
case F_SUB_ASG:
case F_MUL_ASG:
case F_DIV_ASG:
case F_MOD_ASG:
case F_POW_ASG:
case _POST_INC:
case _POST_DEC:
case _PRE_INC:
case _PRE_DEC:
case F_POST_INC:
case F_POST_DEC:
case F_PRE_INC:
case F_PRE_DEC:
case _EQ:
case _NEQ:
case _LT:
case _LTE:
case _GT:
case _GTE:
case _MATCH2:
case _EXIT:
case _EXIT0:
case _NEXT:
case _NEXTFILE:
case _RET:
case _RET0:
case _OMAIN:
case _JMAIN:
case OL_GL:
case OL_GL_NR:
/* simple_codes */
break;
case L_PUSHA:
case L_PUSHI:
case LAE_PUSHI:
case LAE_PUSHA:
case LA_PUSHA:
case F_PUSHA:
case F_PUSHI:
case AE_PUSHA:
case AE_PUSHI:
case A_PUSHA:
case _PUSHI:
case _PUSHA:
case _MATCH0:
case _MATCH1:
case _PUSHS:
case _PUSHD:
case _PUSHC:
case _PUSHINT:
case _BUILTIN:
case _PRINT:
case _JMP:
case _JNZ:
case _JZ:
case _LJZ:
case _LJNZ:
case SET_ALOOP:
case ALOOP:
case A_CAT:
++result;
break;
case A_LENGTH:
case _LENGTH:
++result;
break;
case _CALLX:
case _CALL:
result += 2;
break;
case _RANGE:
result += 4;
break;
}
}
return result;
}
#endif /* OPT_TRACE */
/* type checks a list of call arguments,
returns a list of arguments whose type is still unknown
*/
static CA_REC *
call_arg_check(FBLOCK * callee,
CA_REC * entry_list,
INST * start)
{
register CA_REC *q;
CA_REC *exit_list = (CA_REC *) 0;
TRACE(("call_arg_check\n"));
check_progress = 0;
/* loop :
take q off entry_list
test it
if OK zfree(q) else put on exit_list */
while ((q = entry_list)) {
entry_list = q->link;
TRACE(("...arg %d is %s\n", q->arg_num + 1, type_to_str(q->type)));
if (q->type == ST_NONE) {
/* try to infer the type */
/* it might now be in symbol table */
if (q->sym_p->type == ST_VAR) {
TRACE(("...use CA_EXPR\n"));
/* 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) {
TRACE(("...use CA_ARRAY\n"));
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 */
TRACE(("...infer?\n"));
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 = ZMALLOC(CELL);
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 = new_ARRAY();
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) {
TRACE(("...infer2?\n"));
/* 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]) {
#if OPT_CALLX
TRACE(("OOPS: arg %d (code %p, size %ld), actual %s vs %s\n",
q->arg_num + 1,
callee->code,
callee->size,
type_to_str(q->type),
type_to_str(callee->typev[q->arg_num])));
callee->typev[q->arg_num] = q->type;
callee->defer = 1;
#else
token_lineno = q->call_lineno;
compile_error("type error in arg(%d) in call to %s (actual %s vs %s)",
q->arg_num + 1, callee->name,
type_to_str(q->type),
type_to_str(callee->typev[q->arg_num]));
#endif
}
ZFREE(q);
check_progress = 1;
}
TRACE(("%s: code %p size %ld.%ld:%d\n", callee->name, callee->code,
callee->size / sizeof(INST),
callee->size % sizeof(INST),
inst_len(callee->code)));
} /* while */
return exit_list;
}
static int
arg_cnt_ok(FBLOCK * fbp,
CA_REC * q)
{
if ((int) q->arg_num >= (int) fbp->nargs) {
token_lineno = q->call_lineno;
compile_error("too many arguments in call to %s", fbp->name);
return 0;
} else
return 1;
}
FCALL_REC *resolve_list;
/* function calls whose arg types need checking
are stored on this list */
/* 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(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 */
compile_error("function %s never defined", p->callee->name);
/* delete p from list */
q->link = p->link;
/* don't worry about freeing memory, we'll exit soon */
}
/* note p->arg_list starts with last argument */
else if (!p->arg_list /* nothing to do */ ||
(!p->arg_cnt_checked &&
!arg_cnt_ok(p->callee, p->arg_list))) {
q->link = p->link; /* delete p */
/* the ! arg_list case is not an error so free memory */
ZFREE(p);
} else {
/* keep p and set call_start */
q = p;
switch (p->call_scope) {
case SCOPE_MAIN:
p->call_start = main_start;
break;
case SCOPE_BEGIN:
p->call_start = begin_start;
break;
case SCOPE_END:
p->call_start = end_start;
break;
case SCOPE_FUNCT:
p->call_start = p->call->code;
break;
}
}
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
resolve_fcalls(void)
{
register FCALL_REC *p, *old_list, *new_list;
int progress; /* a flag */
TRACE(("resolve_fcalls\n"));
old_list = first_pass(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;
TRACE(("%s@%d ", __FILE__, __LINE__));
if ((p->arg_list = call_arg_check(p->callee, p->arg_list,
p->call_start))) {
/* still have work to do , put on new_list */
progress |= check_progress;
p->link = new_list;
new_list = p;
} else {
/* done with p */
progress = 1;
ZFREE(p);
}
}
}
/* the 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
check_fcall(
FBLOCK * callee,
int call_scope,
int move_level,
FBLOCK * call,
CA_REC * arg_list)
{
FCALL_REC *p;
TRACE(("check_fcall(%s)\n", callee->name));
if (!callee->code) {
TRACE(("...forward reference\n"));
/* forward reference to a function to be defined later */
p = ZMALLOC(FCALL_REC);
p->callee = callee;
p->call_scope = (short) call_scope;
p->move_level = (short) move_level;
p->call = call;
p->arg_list = arg_list;
p->arg_cnt_checked = 0;
trace_arg_list(arg_list);
/* add to resolve list */
p->link = resolve_list;
resolve_list = p;
} else if (arg_list && arg_cnt_ok(callee, arg_list)) {
/* usually arg_list disappears here and all is well
otherwise add to resolve list */
TRACE(("%s@%d ", __FILE__, __LINE__));
if ((arg_list = call_arg_check(callee, arg_list,
code_base))) {
p = ZMALLOC(FCALL_REC);
p->callee = callee;
p->call_scope = (short) call_scope;
p->move_level = (short) move_level;
p->call = call;
p->arg_list = arg_list;
p->arg_cnt_checked = 1;
/* add to resolve list */
p->link = resolve_list;
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.
delta == relocation distance
*/
void
relocate_resolve_list(
int scope,
int move_level,
FBLOCK * fbp,
int orig_offset,
unsigned len,
int delta)
{
FCALL_REC *p = 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 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 ||
(unsigned) p->call_offset >= (unsigned) 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
*/
Reference in New Issue View Git Blame Copy Permalink