Aren/NetBSD
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
d7bbfe60cd
NetBSD/gnu/usr.bin/awk/fcall.c
jtc f4e00a39c2 Updated to mawk 1.1.4
1993-07-02 23:56:52 +00:00

366 lines
9.5 KiB
C
Raw Blame History

/********************************************
fcall.c
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.
********************************************/
/*$Log: fcall.c,v $
/*Revision 1.2 1993/07/02 23:57:16 jtc
/*Updated to mawk 1.1.4
/*
* Revision 5.1 1991/12/05 07:55:54 brennan
* 1.1 pre-release
*
*/
#include "mawk.h"
#include "symtype.h"
#include "code.h"
/* This file has functions involved with type checking of
function calls
*/
static FCALL_REC *PROTO(first_pass, (FCALL_REC *) ) ;
static CA_REC *PROTO(call_arg_check, (FBLOCK *, CA_REC *,
INST *, unsigned) ) ;
static int PROTO(arg_cnt_ok, (FBLOCK *,CA_REC *, unsigned) ) ;
static int check_progress ;
/* flag that indicates call_arg_check() was able to type
check some call arguments */
/* type checks a list of call arguments,
returns a list of arguments whose type is still unknown
*/
static CA_REC *call_arg_check( callee, entry_list , start, line_no)
FBLOCK *callee ;
CA_REC *entry_list ;
INST *start ; /* to locate patch */
unsigned line_no ; /* for error messages */
{ register CA_REC *q ;
CA_REC *exit_list = (CA_REC *) 0 ;
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 ;
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 = new_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 )
{ /* 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] )
{
errmsg(0, "line %u: type error in arg(%d) in call to %s",
line_no, q->arg_num+1, callee->name) ;
if ( ++compile_error_count == MAX_COMPILE_ERRORS )
mawk_exit(1) ;
}
zfree(q, sizeof(CA_REC)) ;
check_progress = 1 ;
}
} /* while */
return exit_list ;
}
static int arg_cnt_ok( fbp, q, line_no )
FBLOCK *fbp ;
CA_REC *q ;
unsigned line_no ;
{
if ( q->arg_num >= fbp->nargs )
{
errmsg(0, "line %u: too many arguments in call to %s" ,
line_no, fbp->name ) ;
if ( ++compile_error_count == MAX_COMPILE_ERRORS )
mawk_exit(1) ;
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( p )
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 */
errmsg(0, "line %u: function %s never defined" ,
p->line_no, p->callee->name) ;
if ( ++compile_error_count == MAX_COMPILE_ERRORS )
mawk_exit(1) ;
/* delete p from list */
q->link = p->link ;
/* don't worry about freeing memory, we'll exit soon */
}
else /* note p->arg_list starts with last argument */
if ( ! p->arg_list /* nothing to do */ ||
! p->arg_cnt_checked &&
! arg_cnt_ok(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 */
zfree(p, sizeof(FCALL_REC)) ;
}
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_code.start ;
break ;
case SCOPE_END :
p->call_start = end_code.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()
{ register FCALL_REC *p, *old_list , *new_list ;
int progress ; /* a flag */
old_list = first_pass(resolve_list) ;
new_list = (FCALL_REC *) 0 ;
progress = 0 ;
while ( 1 )
{
if ( !(p = old_list) )
{ /* flop the lists */
if ( !(p = old_list = new_list) /* nothing left */
|| ! progress /* can't do any more */ ) return ;
/* reset after flop */
new_list = (FCALL_REC *) 0 ; progress = 0 ;
}
old_list = p->link ;
if ( p->arg_list = call_arg_check(p->callee, p->arg_list ,
p->call_start, p->line_no) )
{
/* 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, sizeof(FCALL_REC)) ; }
}
}
/* 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( callee, call_scope, call, arg_list, line_no )
FBLOCK *callee ;
int call_scope ;
FBLOCK *call ;
CA_REC *arg_list ;
unsigned line_no ;
{
FCALL_REC *p ;
INST *call_start ;
if ( ! callee->code )
{ /* forward reference to a function to be defined later */
p = (FCALL_REC *) zmalloc(sizeof(FCALL_REC)) ;
p->callee = callee ;
p->call_scope = call_scope ;
p->call = call ;
p->arg_list = arg_list ;
p->arg_cnt_checked = 0 ;
p->line_no = line_no ;
/* add to resolve list */
p->link = resolve_list ; resolve_list = p ;
}
else
if ( arg_list && arg_cnt_ok( callee, arg_list, line_no ) )
{
switch ( call_scope )
{
case SCOPE_MAIN :
call_start = main_start ;
break ;
case SCOPE_BEGIN :
call_start = begin_code.start ;
break ;
case SCOPE_END :
call_start = end_code.start ;
break ;
case SCOPE_FUNCT :
call_start = call->code ;
break ;
}
/* usually arg_list disappears here and all is well
otherwise add to resolve list */
if ( arg_list = call_arg_check(callee, arg_list,
call_start, line_no) )
{
p = (FCALL_REC *) zmalloc(sizeof(FCALL_REC)) ;
p->callee = callee ;
p->call_scope = call_scope ;
p->call = call ;
p->arg_list = arg_list ;
p->arg_cnt_checked = 1 ;
p->line_no = line_no ;
/* add to resolve list */
p->link = resolve_list ; resolve_list = 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