[unix-history] / usr / src / usr.bin / awk / fcall.c


/********************************************
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 5.1  91/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
*/
Commit	Line	Data
a7e60862 WJ	1
	2	/********************************************
	3	fcall.c
	4	copyright 1991, Michael D. Brennan
	5
	6	This is a source file for mawk, an implementation of
	7	the AWK programming language.
	8
	9	Mawk is distributed without warranty under the terms of
	10	the GNU General Public License, version 2, 1991.
	11	********************************************/
	12
	13
	14	/*$Log: fcall.c,v $
	15	* Revision 5.1 91/12/05 07:55:54 brennan
	16	* 1.1 pre-release
	17	*
	18	*/
	19
	20	#include "mawk.h"
	21	#include "symtype.h"
	22	#include "code.h"
	23
	24	/* This file has functions involved with type checking of
	25	function calls
	26	*/
	27
	28	static FCALL_REC PROTO(first_pass, (FCALL_REC ) ) ;
	29	static CA_REC PROTO(call_arg_check, (FBLOCK , CA_REC *,
	30	INST *, unsigned) ) ;
	31	static int PROTO(arg_cnt_ok, (FBLOCK ,CA_REC , unsigned) ) ;
	32
	33
	34	static int check_progress ;
	35	/* flag that indicates call_arg_check() was able to type
	36	check some call arguments */
	37
	38	/* type checks a list of call arguments,
	39	returns a list of arguments whose type is still unknown
	40	*/
	41	static CA_REC *call_arg_check( callee, entry_list , start, line_no)
	42	FBLOCK *callee ;
	43	CA_REC *entry_list ;
	44	INST start ; / to locate patch */
	45	unsigned line_no ; /* for error messages */
	46	{ register CA_REC *q ;
	47	CA_REC exit_list = (CA_REC ) 0 ;
	48
	49	check_progress = 0 ;
	50
	51	/* loop :
	52	take q off entry_list
	53	test it
	54	if OK zfree(q) else put on exit_list
	55	*/
	56
	57	while ( q = entry_list )
	58	{
	59	entry_list = q->link ;
	60
	61	if ( q->type == ST_NONE )
	62	{ /* try to infer the type */
	63	/* it might now be in symbol table */
	64	if ( q->sym_p->type == ST_VAR )
65	{ /* set type and patch */
66	q->type = CA_EXPR ;
67	start[q->call_offset+1].ptr = (PTR) q->sym_p->stval.cp ;
68	}
69	else
70	if ( q->sym_p->type == ST_ARRAY )
71	{ q->type = CA_ARRAY ;
72	start[q->call_offset].op = A_PUSHA ;
73	start[q->call_offset+1].ptr = (PTR) q->sym_p->stval.array ;
74	}
75	else /* try to infer from callee */
76	{
77	switch( callee->typev[q->arg_num] )
78	{
79	case ST_LOCAL_VAR :
80	q->type = CA_EXPR ;
81	q->sym_p->type = ST_VAR ;
82	q->sym_p->stval.cp = new_CELL() ;
83	q->sym_p->stval.cp->type = C_NOINIT ;
84	start[q->call_offset+1].ptr =
85	(PTR) q->sym_p->stval.cp ;
86	break ;
87
88	case ST_LOCAL_ARRAY :
89	q->type = CA_ARRAY ;
90	q->sym_p->type = ST_ARRAY ;
91	q->sym_p->stval.array = new_ARRAY() ;
92	start[q->call_offset].op = A_PUSHA ;
93	start[q->call_offset+1].ptr =
94	(PTR) q->sym_p->stval.array ;
95	break ;
96	}
97	}
98	}
99	else
100	if ( q->type == ST_LOCAL_NONE )
101	{ /* try to infer the type */
102	if ( * q->type_p == ST_LOCAL_VAR )
103	{ /* set type , don't need to patch */
104	q->type = CA_EXPR ;
105	}
106	else
107	if ( * q->type_p == ST_LOCAL_ARRAY )
108	{ q->type = CA_ARRAY ;
109	start[q->call_offset].op = LA_PUSHA ;
110	/* offset+1 op is OK */
111	}
112	else /* try to infer from callee */
113	{
114	switch( callee->typev[q->arg_num] )
115	{
116	case ST_LOCAL_VAR :
117	q->type = CA_EXPR ;
118	* q->type_p = ST_LOCAL_VAR ;
119	/* do not need to patch */
120	break ;
121
122	case ST_LOCAL_ARRAY :
123	q->type = CA_ARRAY ;
124	* q->type_p = ST_LOCAL_ARRAY ;
125	start[q->call_offset].op = LA_PUSHA ;
126	break ;
127	}
128	}
129	}
130
131	/* if we still do not know the type put on the new list
132	else type check */
133
134	if ( q->type == ST_NONE \|\| q->type == ST_LOCAL_NONE )
135	{
136	q->link = exit_list ;
137	exit_list = q ;
138	}
139	else /* type known */
140	{
141	if ( callee->typev[q->arg_num] == ST_LOCAL_NONE )
142	callee->typev[q->arg_num] = q->type ;
143
144	else
145	if ( q->type != callee->typev[q->arg_num] )
146	{
147	errmsg(0, "line %u: type error in arg(%d) in call to %s",
148	line_no, q->arg_num+1, callee->name) ;
149	if ( ++compile_error_count == MAX_COMPILE_ERRORS )
150	mawk_exit(1) ;
151	}
152
153	zfree(q, sizeof(CA_REC)) ;
154	check_progress = 1 ;
155	}
156	} /* while */
157
158	return exit_list ;
159	}
160
161
162	static int arg_cnt_ok( fbp, q, line_no )
163	FBLOCK *fbp ;
164	CA_REC *q ;
165	unsigned line_no ;
166	{
167	if ( q->arg_num >= fbp->nargs )
168	{
169	errmsg(0, "line %u: too many arguments in call to %s" ,
170	line_no, fbp->name ) ;
171	if ( ++compile_error_count == MAX_COMPILE_ERRORS )
172	mawk_exit(1) ;
173
174	return 0 ;
175	}
176	else return 1 ;
177	}
178
179
180	FCALL_REC *resolve_list ;
181	/* function calls whose arg types need checking
182	are stored on this list */
183
184
185	/* on first pass thru the resolve list
186	we check :
187	if forward referenced functions were really defined
188	if right number of arguments
189	and compute call_start which is now known
190	*/
191
192	static FCALL_REC *first_pass( p )
193	register FCALL_REC *p ;
194	{ FCALL_REC dummy ;
195	register FCALL_REC q = &dummy ; / trails p */
196
197	q->link = p ;
198	while ( p )
199	{
200	if ( ! p->callee->code )
201	{ /* callee never defined */
202	errmsg(0, "line %u: function %s never defined" ,
203	p->line_no, p->callee->name) ;
204	if ( ++compile_error_count == MAX_COMPILE_ERRORS )
205	mawk_exit(1) ;
206	/* delete p from list */
207	q->link = p->link ;
208	/* don't worry about freeing memory, we'll exit soon */
209	}
210	else /* note p->arg_list starts with last argument */
211	if ( ! p->arg_list /* nothing to do */ \|\|
212	! p->arg_cnt_checked &&
213	! arg_cnt_ok(p->callee, p->arg_list, p->line_no) )
214	{ q->link = p->link ; /* delete p */
215	/* the ! arg_list case is not an error so free memory */
216	zfree(p, sizeof(FCALL_REC)) ;
217	}
218	else
219	{ /* keep p and set call_start */
220	q = p ;
221	switch ( p->call_scope )
222	{
223	case SCOPE_MAIN :
224	p->call_start = main_start ;
225	break ;
226
227	case SCOPE_BEGIN :
228	p->call_start = begin_code.start ;
229	break ;
230
231	case SCOPE_END :
232	p->call_start = end_code.start ;
233	break ;
234
235	case SCOPE_FUNCT :
236	p->call_start = p->call->code ;
237	break ;
238	}
239	}
240	p = q->link ;
241	}
242	return dummy.link ;
243	}
244
245	/* continuously walk the resolve_list making type deductions
246	until this list goes empty or no more progress can be made
247	(An example where no more progress can be made is at end of file
248	*/
249
250	void resolve_fcalls()
251	{ register FCALL_REC p, old_list , *new_list ;
252	int progress ; /* a flag */
253
254	old_list = first_pass(resolve_list) ;
255	new_list = (FCALL_REC *) 0 ;
256	progress = 0 ;
257
258	while ( 1 )
259	{
260	if ( !(p = old_list) )
261	{ /* flop the lists */
262	if ( !(p = old_list = new_list) /* nothing left */
263	\|\| ! progress /* can't do any more */ ) return ;
264
265	/* reset after flop */
266	new_list = (FCALL_REC *) 0 ; progress = 0 ;
267	}
268
269	old_list = p->link ;
270
271	if ( p->arg_list = call_arg_check(p->callee, p->arg_list ,
272	p->call_start, p->line_no) )
273	{
274	/* still have work to do , put on new_list */
275	progress \|= check_progress ;
276	p->link = new_list ; new_list = p ;
277	}
278	else /* done with p */
279	{ progress = 1 ; zfree(p, sizeof(FCALL_REC)) ; }
280	}
281	}
282
283	/* the parser has just reduced a function call ;
284	the info needed to type check is passed in. If type checking
285	can not be done yet (most common reason -- function referenced
286	but not defined), a node is added to the resolve list.
287	*/
288	void check_fcall( callee, call_scope, call, arg_list, line_no )
289	FBLOCK *callee ;
290	int call_scope ;
291	FBLOCK *call ;
292	CA_REC *arg_list ;
293	unsigned line_no ;
294	{
295	FCALL_REC *p ;
296	INST *call_start ;
297
298	if ( ! callee->code )
299	{ /* forward reference to a function to be defined later */
300	p = (FCALL_REC *) zmalloc(sizeof(FCALL_REC)) ;
301	p->callee = callee ;
302	p->call_scope = call_scope ;
303	p->call = call ;
304	p->arg_list = arg_list ;
305	p->arg_cnt_checked = 0 ;
306	p->line_no = line_no ;
307	/* add to resolve list */
308	p->link = resolve_list ; resolve_list = p ;
309	}
310	else
311	if ( arg_list && arg_cnt_ok( callee, arg_list, line_no ) )
312	{
313	switch ( call_scope )
314	{
315	case SCOPE_MAIN :
316	call_start = main_start ;
317	break ;
318
319	case SCOPE_BEGIN :
320	call_start = begin_code.start ;
321	break ;
322
323	case SCOPE_END :
324	call_start = end_code.start ;
325	break ;
326
327	case SCOPE_FUNCT :
328	call_start = call->code ;
329	break ;
330	}
331
332	/* usually arg_list disappears here and all is well
333	otherwise add to resolve list */
334
335	if ( arg_list = call_arg_check(callee, arg_list,
336	call_start, line_no) )
337	{
338	p = (FCALL_REC *) zmalloc(sizeof(FCALL_REC)) ;
339	p->callee = callee ;
340	p->call_scope = call_scope ;
341	p->call = call ;
342	p->arg_list = arg_list ;
343	p->arg_cnt_checked = 1 ;
344	p->line_no = line_no ;
345	/* add to resolve list */
346	p->link = resolve_list ; resolve_list = p ;
347	}
348	}
349	}
350
351
352
353	/* example where typing cannot progress
354
355	{ f(z) }
356
357	function f(x) { print NR }
358
359	# this is legal, does something useful, but absurdly written
360	# We have to design so this works
361	*/
362