fcall.c

   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 1.7  1995/08/27  15:46:47  mike
  16  * change some errmsgs to compile_errors
  17  *
  18  * Revision 1.6  1995/06/09  22:58:24  mike
  19  * cast to shutup solaris cc on comparison of short to ushort
  20  *
  21  * Revision 1.5  1995/06/06  00:18:26  mike
  22  * change mawk_exit(1) to mawk_exit(2)
  23  *
  24  * Revision 1.4  1995/04/21  14:20:14  mike
  25  * move_level variable to fix bug in arglist patching of moved code.
  26  *
  27  * Revision 1.3  1995/02/19  22:15:37  mike
  28  * Always set the call_offset field in a CA_REC (for obscure
  29  * reasons in fcall.c (see comments) there.)
  30  *
  31  * Revision 1.2  1993/07/17  13:22:52  mike
  32  * indent and general code cleanup
  33  *
  34  * Revision 1.1.1.1  1993/07/03  18:58:11  mike
  35  * move source to cvs
  36  *
  37  * Revision 5.4  1993/01/09  19:03:44  mike
  38  * code_pop checks if the resolve_list needs relocation
  39  *
  40  * Revision 5.3  1993/01/07  02:50:33  mike
  41  * relative vs absolute code
  42  *
  43  * Revision 5.2  1993/01/01  21:30:48  mike
  44  * split new_STRING() into new_STRING and new_STRING0
  45  *
  46  * Revision 5.1  1991/12/05  07:55:54  brennan
  47  * 1.1 pre-release
  48  *
  49 */
  50
  51 #include "mawk.h"
  52 #include "symtype.h"
  53 #include "code.h"
  54
  55 /* This file has functions involved with type checking of
  56    function calls
  57 */
  58
  59 static FCALL_REC *PROTO(first_pass, (FCALL_REC *)) ;
  60 static CA_REC *PROTO(call_arg_check, (FBLOCK *, CA_REC *,
  61                                       INST *, unsigned)) ;
  62 static int PROTO(arg_cnt_ok, (FBLOCK *, CA_REC *, unsigned)) ;
  63 static void PROTO(relocate_arglist, (CA_REC *, int, unsigned, int)) ;
  64
  65
  66 static int check_progress ;
  67  /* flag that indicates call_arg_check() was able to type
  68        check some call arguments */
  69
  70 /* type checks a list of call arguments,
  71    returns a list of arguments whose type is still unknown
  72 */
  73 static CA_REC *
  74 call_arg_check(callee, entry_list, start, line_no)
  75    FBLOCK *callee ;
  76    CA_REC *entry_list ;
  77    INST *start ;                 /* to locate patch */
  78    unsigned line_no ;            /* for error messages */
  79 {
  80    register CA_REC *q ;
  81    CA_REC *exit_list = (CA_REC *) 0 ;
  82
  83    check_progress = 0 ;
  84
  85    /* loop :
  86        take q off entry_list
  87        test it
  88            if OK  zfree(q)  else put on exit_list  */
  89    while ((q = entry_list))
  90    {
  91       entry_list = q->link ;
  92
  93       if (q->type == ST_NONE)
  94       {
  95          /* try to infer the type */
  96          /* it might now be in symbol table */
  97          if (q->sym_p->type == ST_VAR)
  98          {
  99             /* set type and patch */
 100             q->type = CA_EXPR ;
 101             start[q->call_offset + 1].ptr = (PTR) q->sym_p->stval.cp ;
 102          }
 103          else if (q->sym_p->type == ST_ARRAY)
 104          {
 105             q->type = CA_ARRAY ;
 106             start[q->call_offset].op = A_PUSHA ;
 107             start[q->call_offset + 1].ptr = (PTR) q->sym_p->stval.array ;
 108          }
 109          else  /* try to infer from callee */
 110          {
 111             switch (callee->typev[q->arg_num])
 112             {
 113                case ST_LOCAL_VAR:
 114                   q->type = CA_EXPR ;
 115                   q->sym_p->type = ST_VAR ;
 116                   q->sym_p->stval.cp = ZMALLOC(CELL) ;
 117                   q->sym_p->stval.cp->type = C_NOINIT ;
 118                   start[q->call_offset + 1].ptr =
 119                      (PTR) q->sym_p->stval.cp ;
 120                   break ;
 121
 122                case ST_LOCAL_ARRAY:
 123                   q->type = CA_ARRAY ;
 124                   q->sym_p->type = ST_ARRAY ;
 125                   q->sym_p->stval.array = new_ARRAY() ;
 126                   start[q->call_offset].op = A_PUSHA ;
 127                   start[q->call_offset + 1].ptr =
 128                      (PTR) q->sym_p->stval.array ;
 129                   break ;
 130             }
 131          }
 132       }
 133       else if (q->type == ST_LOCAL_NONE)
 134       {
 135          /* try to infer the type */
 136          if (*q->type_p == ST_LOCAL_VAR)
 137          {
 138             /* set type , don't need to patch */
 139             q->type = CA_EXPR ;
 140          }
 141          else if (*q->type_p == ST_LOCAL_ARRAY)
 142          {
 143             q->type = CA_ARRAY ;
 144             start[q->call_offset].op = LA_PUSHA ;
 145             /* offset+1 op is OK */
 146          }
 147          else  /* try to infer from callee */
 148          {
 149             switch (callee->typev[q->arg_num])
 150             {
 151                case ST_LOCAL_VAR:
 152                   q->type = CA_EXPR ;
 153                   *q->type_p = ST_LOCAL_VAR ;
 154                   /* do not need to patch */
 155                   break ;
 156
 157                case ST_LOCAL_ARRAY:
 158                   q->type = CA_ARRAY ;
 159                   *q->type_p = ST_LOCAL_ARRAY ;
 160                   start[q->call_offset].op = LA_PUSHA ;
 161                   break ;
 162             }
 163          }
 164       }
 165
 166       /* if we still do not know the type put on the new list
 167        else type check */
 168       if (q->type == ST_NONE || q->type == ST_LOCAL_NONE)
 169       {
 170          q->link = exit_list ;
 171          exit_list = q ;
 172       }
 173       else  /* type known */
 174       {
 175          if (callee->typev[q->arg_num] == ST_LOCAL_NONE)
 176             callee->typev[q->arg_num] = q->type ;
 177          else if (q->type != callee->typev[q->arg_num])
 178             compile_error("type error in arg(%d) in call to %s",
 179                      q->arg_num + 1, callee->name) ;
 180
 181          ZFREE(q) ;
 182          check_progress = 1 ;
 183       }
 184    }                            /* while */
 185
 186    return exit_list ;
 187 }
 188
 189
 190 static int
 191 arg_cnt_ok(fbp, q, line_no)
 192    FBLOCK *fbp ;
 193    CA_REC *q ;
 194    unsigned line_no ;
 195 {
 196    if ((int)q->arg_num >= (int)fbp->nargs)
 197    /* casts shutup stupid warning from solaris sun cc */
 198    {
 199       compile_error("too many arguments in call to %s", fbp->name) ;
 200       return 0 ;
 201    }
 202    else  return 1 ;
 203 }
 204
 205
 206 FCALL_REC *resolve_list ;
 207  /* function calls whose arg types need checking
 208            are stored on this list */
 209
 210
 211 /* on first pass thru the resolve list
 212    we check :
 213       if forward referenced functions were really defined
 214       if right number of arguments
 215    and compute call_start which is now known
 216 */
 217
 218 static FCALL_REC *
 219 first_pass(p)
 220    register FCALL_REC *p ;
 221 {
 222    FCALL_REC dummy ;
 223    register FCALL_REC *q = &dummy ;      /* trails p */
 224
 225    q->link = p ;
 226    while (p)
 227    {
 228       if (!p->callee->code)
 229       {
 230          /* callee never defined */
 231          compile_error("function %s never defined", p->callee->name) ;
 232          /* delete p from list */
 233          q->link = p->link ;
 234          /* don't worry about freeing memory, we'll exit soon */
 235       }
 236       /* note p->arg_list starts with last argument */
 237       else if (!p->arg_list /* nothing to do */  ||
 238                (!p->arg_cnt_checked &&
 239                 !arg_cnt_ok(p->callee, p->arg_list, p->line_no)))
 240       {
 241          q->link = p->link ;     /* delete p */
 242          /* the ! arg_list case is not an error so free memory */
 243          ZFREE(p) ;
 244       }
 245       else
 246       {
 247          /* keep p and set call_start */
 248          q = p ;
 249          switch (p->call_scope)
 250          {
 251             case SCOPE_MAIN:
 252                p->call_start = main_start ;
 253                break ;
 254
 255             case SCOPE_BEGIN:
 256                p->call_start = begin_start ;
 257                break ;
 258
 259             case SCOPE_END:
 260                p->call_start = end_start ;
 261                break ;
 262
 263             case SCOPE_FUNCT:
 264                p->call_start = p->call->code ;
 265                break ;
 266          }
 267       }
 268       p = q->link ;
 269    }
 270    return dummy.link ;
 271 }
 272
 273 /* continuously walk the resolve_list making type deductions
 274    until this list goes empty or no more progress can be made
 275    (An example where no more progress can be made is at end of file
 276 */
 277
 278 void
 279 resolve_fcalls()
 280 {
 281    register FCALL_REC *p, *old_list, *new_list ;
 282    int progress ;                /* a flag */
 283
 284    old_list = first_pass(resolve_list) ;
 285    new_list = (FCALL_REC *) 0 ;
 286    progress = 0 ;
 287
 288    while (1)
 289    {
 290       if (!old_list)
 291       {
 292          /* flop the lists */
 293          old_list = new_list ;
 294          if (!old_list          /* nothing left */
 295              || !progress /* can't do any more */ )
 296             return ;
 297
 298          new_list = (FCALL_REC *) 0 ;  progress = 0 ;
 299       }
 300
 301       p = old_list ;
 302       old_list = p->link ;
 303
 304       if ((p->arg_list = call_arg_check(p->callee, p->arg_list,
 305                                        p->call_start, p->line_no)))
 306       {
 307          /* still have work to do , put on new_list   */
 308          progress |= check_progress ;
 309          p->link = new_list ;  new_list = p ;
 310       }
 311       else
 312       {
 313          /* done with p */
 314          progress = 1 ;
 315          ZFREE(p) ;
 316       }
 317    }
 318 }
 319
 320 /* the parser has just reduced a function call ;
 321    the info needed to type check is passed in.  If type checking
 322    can not be done yet (most common reason -- function referenced
 323    but not defined), a node is added to the resolve list.
 324 */
 325 void
 326 check_fcall(callee, call_scope, move_level, call, arg_list, line_no)
 327    FBLOCK *callee ;
 328    int call_scope ;
 329    int move_level ;
 330    FBLOCK *call ;
 331    CA_REC *arg_list ;
 332    unsigned line_no ;
 333 {
 334    FCALL_REC *p ;
 335
 336    if (!callee->code)
 337    {
 338       /* forward reference to a function to be defined later */
 339       p = ZMALLOC(FCALL_REC) ;
 340       p->callee = callee ;
 341       p->call_scope = call_scope ;
 342       p->move_level = move_level ;
 343       p->call = call ;
 344       p->arg_list = arg_list ;
 345       p->arg_cnt_checked = 0 ;
 346       p->line_no = line_no ;
 347       /* add to resolve list */
 348       p->link = resolve_list ; resolve_list = p ;
 349    }
 350    else if (arg_list && arg_cnt_ok(callee, arg_list, line_no))
 351    {
 352       /* usually arg_list disappears here and all is well
 353          otherwise add to resolve list */
 354
 355       if ((arg_list = call_arg_check(callee, arg_list,
 356                                     code_base, line_no)))
 357       {
 358          p = ZMALLOC(FCALL_REC) ;
 359          p->callee = callee ;
 360          p->call_scope = call_scope ;
 361          p->move_level = move_level ;
 362          p->call = call ;
 363          p->arg_list = arg_list ;
 364          p->arg_cnt_checked = 1 ;
 365          p->line_no = line_no ;
 366          /* add to resolve list */
 367          p->link = resolve_list ; resolve_list = p ;
 368       }
 369    }
 370 }
 371
 372
 373 /* code_pop() has just moved some code.  If this code contains
 374    a function call, it might need to be relocated on the
 375    resolve list too.  This function does it.
 376 */
 377
 378 void
 379 relocate_resolve_list(scope, move_level, fbp, orig_offset, len, delta)
 380    int scope ;
 381    int move_level ;
 382    FBLOCK *fbp ;
 383    int orig_offset ;
 384    unsigned len ;
 385    int delta ;                   /* relocation distance */
 386 {
 387    FCALL_REC *p = resolve_list ;
 388
 389    while (p)
 390    {
 391       if (scope == p->call_scope && move_level == p->move_level &&
 392           (scope == SCOPE_FUNCT ? fbp == p->call : 1))
 393       {
 394          relocate_arglist(p->arg_list, orig_offset,
 395                           len, delta) ;
 396       }
 397       p = p->link ;
 398    }
 399 }
 400
 401 static void
 402 relocate_arglist(arg_list, offset, len, delta)
 403    CA_REC *arg_list ;
 404    int offset ;
 405    unsigned len ;
 406    int delta ;
 407 {
 408    register CA_REC *p ;
 409
 410    if (!arg_list)  return ;
 411
 412    p = arg_list ;
 413    /* all nodes must be relocated or none, so test the
 414      first one */
 415
 416    /* Note: call_offset is always set even for args that don't need to
 417       be patched so that this check works. */
 418    if ( p->call_offset < offset || p->call_offset >= offset + len )
 419       return ;
 420
 421    /* relocate the whole list */
 422    do
 423    {
 424       p->call_offset += delta ;
 425       p = p->link ;
 426    }
 427    while (p);
 428 }
 429
 430
 431
 432
 433
 434 /*  example where typing cannot progress
 435
 436 { f(z) }
 437
 438 function f(x) { print NR }
 439
 440 # this is legal, does something useful, but absurdly written
 441 # We have to design so this works
 442 */