home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / iconc / csym.c < prev    next >
C/C++ Source or Header  |  1996-03-22  |  22KB  |  855 lines
  1. /*
  2.  * csym.c -- functions for symbol table management.
  3.  */
  4. #include <ctype.h>
  5. #include "::h:gsupport.h"
  6. #include "cglobals.h"
  7. #include "ctrans.h"
  8. #include "ctree.h"
  9. #include "ctoken.h"
  10. #include "csym.h"
  11. #include "ccode.h"
  12. #include "cproto.h"
  13.  
  14. /*
  15.  * Prototypes.
  16.  */
  17.  
  18. hidden struct gentry    *alcglob  Params((struct gentry *blink,
  19.                     char *name,int flag));
  20. hidden struct fentry    *alcfld   Params((struct fentry *blink, char *name,
  21.                     struct par_rec *rp));
  22. hidden struct centry    *alclit      Params((struct centry *blink,
  23.                     char *image, int len,int flag));
  24. hidden struct lentry    *alcloc      Params((struct lentry *blink,
  25.                     char *name,int flag));
  26. hidden struct par_rec   *alcprec  Params((struct rentry *rec, int offset,
  27.                     struct par_rec *next));
  28. hidden struct centry    *clookup  Params((char *image,int flag));
  29. hidden struct lentry    *dcl_loc  Params((char *id, int id_type,
  30.                                     struct lentry *next));
  31. hidden struct lentry    *llookup  Params((char *id));
  32. hidden novalue           opstrinv Params((struct implement *ip));
  33. hidden struct gentry    *putglob  Params((char *id,int id_type));
  34. hidden struct gentry    *try_gbl  Params((char *id));
  35.  
  36. int max_sym = 0;  /* max number of parameter symbols in run-time routines */
  37. int max_prm = 0;  /* max number of parameters for any invocable routine */
  38.  
  39. /*
  40.  * The operands of the invocable declaration are stored in a list for
  41.  *  later processing.
  42.  */
  43. struct strinv {
  44.    nodeptr op;
  45.    int arity;
  46.    struct strinv *next;
  47.    };
  48. struct strinv *strinvlst = NULL;
  49. int op_tbl_sz;
  50.  
  51. struct pentry *proc_lst = NULL; /* procedure list */
  52. struct rentry *rec_lst = NULL;  /* record list */
  53.  
  54.  
  55. /*
  56.  *instl_p - install procedure or record in global symbol table, returning
  57.  *  the symbol table entry.
  58.  */
  59. struct gentry *instl_p(name, flag)
  60. char *name;
  61. int flag;
  62.    {
  63.    struct gentry *gp;
  64.  
  65.    flag |= F_Global;
  66.    if ((gp = glookup(name)) == NULL) 
  67.       gp = putglob(name, flag);
  68.    else if ((gp->flag & (~F_Global)) == 0) {
  69.       /* 
  70.        * superfluous global declaration for record or proc
  71.        */
  72.       gp->flag |= flag;
  73.       }
  74.    else            /* the user can't make up his mind */
  75.       tfatal("inconsistent redeclaration", name);
  76.    return gp;
  77.    }
  78.  
  79. /*
  80.  * install - put an identifier into the global or local symbol table.
  81.  *  The basic idea here is to look in the right table and install
  82.  *  the identifier if it isn't already there.  Some semantic checks
  83.  *  are performed.
  84.  */
  85. novalue install(name, flag)
  86. char *name;
  87. int flag;
  88.    {
  89.    struct fentry *fp;
  90.    struct gentry *gp;
  91.    struct lentry *lp;
  92.    struct par_rec **rpp;
  93.    struct fldname *fnp;
  94.    int foffset;
  95.  
  96.    switch (flag) {
  97.       case F_Global:    /* a variable in a global declaration */
  98.          if ((gp = glookup(name)) == NULL)
  99.             putglob(name, flag);
  100.          else
  101.             gp->flag |= flag;
  102.          break;
  103.  
  104.       case F_Static:    /* static declaration */
  105.          ++proc_lst->nstatic;
  106.          lp = dcl_loc(name, flag, proc_lst->statics);
  107.          proc_lst->statics = lp;
  108.          break;
  109.  
  110.       case F_Dynamic:    /* local declaration */
  111.          ++proc_lst->ndynam;
  112.          lp = dcl_loc(name, flag, proc_lst->dynams);
  113.          proc_lst->dynams = lp;
  114.          break;
  115.  
  116.       case F_Argument:    /* formal parameter */
  117.          ++proc_lst->nargs;
  118.          if (proc_lst->nargs > max_prm)
  119.             max_prm = proc_lst->nargs;
  120.          lp = dcl_loc(name, flag, proc_lst->args);
  121.          proc_lst->args = lp;
  122.          break;
  123.  
  124.       case F_Field: /* field declaration */
  125.          fnp = NewStruct(fldname);
  126.          fnp->name = name;
  127.          fnp->next = rec_lst->fields;
  128.          rec_lst->fields = fnp;
  129.          foffset = rec_lst->nfields++;
  130.          if (foffset > max_prm)
  131.             max_prm = foffset;
  132.          if ((fp = flookup(name)) == NULL) {
  133.             /*
  134.              * first occurrence of this field name.
  135.              */
  136.             fhash[FHasher(name)] = alcfld(fhash[FHasher(name)], name,
  137.                alcprec(rec_lst, foffset, NULL));
  138.             }
  139.          else {
  140.             rpp = &(fp->rlist);
  141.             while (*rpp != NULL && (*rpp)->offset <= foffset &&
  142.                (*rpp)->rec != rec_lst)
  143.                rpp = &((*rpp)->next);
  144.             if (*rpp == NULL || (*rpp)->offset > foffset)
  145.                *rpp = alcprec(rec_lst, foffset, *rpp);
  146.             else
  147.                tfatal("duplicate field name", name);
  148.             }
  149.          break;
  150.  
  151.       default:
  152.          tsyserr("install: unrecognized symbol table flag.");
  153.       }
  154.    }
  155.  
  156. /*
  157.  * dcl_loc - handle declaration of a local identifier.
  158.  */
  159. static struct lentry *dcl_loc(name, flag, next)
  160. char *name;
  161. int flag;
  162. struct lentry *next;
  163.    {
  164.    register struct lentry *lp;
  165.  
  166.    if ((lp = llookup(name)) == NULL) {
  167.       lp = putloc(name,flag);
  168.       lp->next = next;
  169.       }
  170.    else if (lp->flag == flag) /* previously declared as same type */
  171.       twarn("redeclared identifier", name);
  172.    else        /* previously declared as different type */
  173.       tfatal("inconsistent redeclaration", name);
  174.    return lp;
  175.    }
  176.  
  177. /*
  178.  * putloc - make a local symbol table entry and return pointer to it.
  179.  */
  180. struct lentry *putloc(id,id_type)
  181. char *id;
  182. int id_type;
  183.    {
  184.    register struct lentry *ptr;
  185.    register struct lentry **lhash;
  186.    unsigned hashval;
  187.  
  188.    if ((ptr = llookup(id)) == NULL) {    /* add to head of hash chain */
  189.       lhash = proc_lst->lhash;
  190.       hashval = LHasher(id);
  191.       ptr = alcloc(lhash[hashval], id, id_type);
  192.       lhash[hashval] = ptr;
  193.       ptr->next = NULL;
  194.       }
  195.    return ptr;
  196.    }
  197.  
  198. /*
  199.  * putglob makes a global symbol table entry and returns a pointer to it.
  200.  */
  201. static struct gentry *putglob(id, id_type)
  202. char *id;
  203. int id_type;
  204.    {
  205.    register struct gentry *ptr;
  206.    register unsigned hashval;
  207.  
  208.    if ((ptr = glookup(id)) == NULL) {     /* add to head of hash chain */
  209.       hashval = GHasher(id);
  210.       ptr = alcglob(ghash[hashval], id, id_type);
  211.       ghash[hashval] = ptr;
  212.       }
  213.    return ptr;
  214.    }
  215.  
  216. /*
  217.  * putlit makes a constant symbol table entry and returns a pointer to it.
  218.  */
  219. struct centry *putlit(image, littype, len)
  220. char *image;
  221. int len, littype;
  222.    {
  223.    register struct centry *ptr;
  224.    register unsigned hashval;
  225.  
  226.    if ((ptr = clookup(image,littype)) == NULL) { /* add to head of hash chain */
  227.       hashval = CHasher(image);
  228.       ptr = alclit(chash[hashval], image, len, littype);
  229.       chash[hashval] = ptr;
  230.       }
  231.    return ptr;
  232.    }
  233.  
  234. /*
  235.  * llookup looks up id in local symbol table and returns pointer to
  236.  *  to it if found or NULL if not present.
  237.  */
  238.  
  239. static struct lentry *llookup(id)
  240. char *id;
  241.    {
  242.    register struct lentry *ptr;
  243.  
  244.    ptr = proc_lst->lhash[LHasher(id)];
  245.    while (ptr != NULL && ptr->name != id)
  246.       ptr = ptr->blink;
  247.    return ptr;
  248.    }
  249.  
  250. /*
  251.  * flookup looks up id in flobal symbol table and returns pointer to
  252.  *  to it if found or NULL if not present.
  253.  */
  254. struct fentry *flookup(id)
  255. char *id;
  256.    {
  257.    register struct fentry *ptr;
  258.  
  259.    ptr = fhash[FHasher(id)];
  260.    while (ptr != NULL && ptr->name != id) {
  261.       ptr = ptr->blink;
  262.       }
  263.    return ptr;
  264.    }
  265.  
  266. /*
  267.  * glookup looks up id in global symbol table and returns pointer to
  268.  *  to it if found or NULL if not present.
  269.  */
  270. struct gentry *glookup(id)
  271. char *id;
  272.    {
  273.    register struct gentry *ptr;
  274.  
  275.    ptr = ghash[GHasher(id)];
  276.    while (ptr != NULL && ptr->name != id) {
  277.       ptr = ptr->blink;
  278.       }
  279.    return ptr;
  280.    }
  281.  
  282. /*
  283.  * clookup looks up id in constant symbol table and returns pointer to
  284.  *  to it if found or NULL if not present.
  285.  */
  286. static struct centry *clookup(image,flag)
  287. char *image;
  288. int flag;
  289.    {
  290.    register struct centry *ptr;
  291.  
  292.    ptr = chash[CHasher(image)];
  293.    while (ptr != NULL && (ptr->image != image || ptr->flag != flag))
  294.       ptr = ptr->blink;
  295.  
  296.    return ptr;
  297.    }
  298.  
  299. #ifdef DeBug
  300. /*
  301.  * symdump - dump symbol tables.
  302.  */
  303. novalue symdump()
  304.    {
  305.    struct pentry *proc;
  306.  
  307.    gdump();
  308.    cdump();
  309.    rdump();
  310.    fdump();
  311.    for (proc = proc_lst; proc != NULL; proc = proc->next) {
  312.       fprintf(stderr,"\n");
  313.       fprintf(stderr,"Procedure %s\n", proc->sym_entry->name);
  314.       ldump(proc->lhash);
  315.       }
  316.    }
  317.  
  318. /*
  319.  * prt_flgs - print flags from a symbol table entry.
  320.  */
  321. static novalue prt_flgs(flags)
  322. int flags;
  323.    {
  324.    if (flags & F_Global)
  325.       fprintf(stderr, " F_Global");
  326.    if (flags & F_Proc)
  327.       fprintf(stderr, " F_Proc");
  328.    if (flags & F_Record)
  329.       fprintf(stderr, " F_Record");
  330.    if (flags & F_Dynamic)
  331.       fprintf(stderr, " F_Dynamic");
  332.    if (flags & F_Static)
  333.       fprintf(stderr, " F_Static");
  334.    if (flags & F_Builtin)
  335.       fprintf(stderr, " F_Builtin");
  336.    if (flags & F_StrInv)
  337.       fprintf(stderr, " F_StrInv");
  338.    if (flags & F_ImpError)
  339.       fprintf(stderr, " F_ImpError");
  340.    if (flags & F_Argument)
  341.       fprintf(stderr, " F_Argument");
  342.    if (flags & F_IntLit)
  343.       fprintf(stderr, " F_IntLit");
  344.    if (flags & F_RealLit)
  345.       fprintf(stderr, " F_RealLit");
  346.    if (flags & F_StrLit)
  347.       fprintf(stderr, " F_StrLit");
  348.    if (flags & F_CsetLit)
  349.       fprintf(stderr, " F_CsetLit");
  350.    if (flags & F_Field)
  351.       fprintf(stderr, " F_Field");
  352.    fprintf(stderr, "\n");
  353.    }
  354. /*
  355.  * ldump displays local symbol table to stderr.
  356.  */
  357.  
  358. novalue ldump(lhash)
  359. struct lentry **lhash;
  360.    {
  361.    register int i;
  362.    register struct lentry *lptr;
  363.  
  364.    fprintf(stderr,"   Dump of local symbol table\n");
  365.    fprintf(stderr,"     address                 name  globol-ref  flags\n");
  366.    for (i = 0; i < LHSize; i++)
  367.       for (lptr = lhash[i]; lptr != NULL; lptr = lptr->blink) {
  368.          fprintf(stderr,"    %8x %20s    ", lptr, lptr->name);
  369.          if (lptr->flag & F_Global)
  370.             fprintf(stderr, "%8x ", lptr->val.global);
  371.          else
  372.             fprintf(stderr, "       - ");
  373.          prt_flgs(lptr->flag);
  374.          }
  375.    fflush(stderr);
  376.    }
  377.  
  378. /*
  379.  * gdump displays global symbol table to stderr.
  380.  */
  381.  
  382. novalue gdump()
  383.    {
  384.    register int i;
  385.    register struct gentry *gptr;
  386.  
  387.    fprintf(stderr,"\n");
  388.    fprintf(stderr,"Dump of global symbol table\n");
  389.    fprintf(stderr,"  address                 name  nargs  flags\n");
  390.    for (i = 0; i < GHSize; i++)
  391.       for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink) {
  392.          fprintf(stderr," %8x %20s   %4d ", gptr,
  393.         gptr->name, gptr->nargs);
  394.          prt_flgs(gptr->flag);
  395.          }
  396.    fflush(stderr);
  397.    }
  398.  
  399. /*
  400.  * cdump displays constant symbol table to stderr.
  401.  */
  402.  
  403. novalue cdump()
  404.    {
  405.    register int i;
  406.    register struct centry *cptr;
  407.  
  408.    fprintf(stderr,"\n");
  409.    fprintf(stderr,"Dump of constant symbol table\n");
  410.    fprintf(stderr,
  411.       "  address  value                                      flags\n");
  412.    for (i = 0; i < CHSize; i++)
  413.       for (cptr = chash[i]; cptr != NULL; cptr = cptr->blink) {
  414.          fprintf(stderr," %8x  %-40.40s  ", cptr, cptr->image);
  415.          prt_flgs(cptr->flag);
  416.          }
  417.    fflush(stderr);
  418.    }
  419.  
  420. /*
  421.  * fdump displays field symbol table to stderr.
  422.  */
  423. novalue fdump()
  424.    {
  425.    int i;
  426.    struct par_rec *prptr;
  427.    struct fentry *fp;
  428.  
  429.    fprintf(stderr,"\n");
  430.    fprintf(stderr,"Dump of field symbol table\n");
  431.    fprintf(stderr,
  432.       "  address                field  global-ref  offset\n");
  433.    for (i = 0; i < FHSize; i++)
  434.       for (fp = fhash[i]; fp != NULL; fp = fp->blink) {
  435.          fprintf(stderr," %8x %20s\n", fp, fp->name);
  436.          for (prptr = fp->rlist; prptr != NULL; prptr = prptr->next)
  437.             fprintf(stderr,"                                  %8x    %4d\n",
  438.                prptr->sym_entry, prptr->offset);
  439.          }
  440.    fflush(stderr);
  441.    }
  442.  
  443. /*
  444.  * prt_flds - print a list of fields stored in reverse order.
  445.  */
  446. static novalue prt_flds(f)
  447. struct fldname *f;
  448.    {
  449.    if (f == NULL)
  450.      return;
  451.    prt_flds(f->next);
  452.    fprintf(stderr, "  %s", f->name);
  453.    }
  454.  
  455. /*
  456.  * rdump displays list of records and their fields.
  457.  */
  458. novalue rdump()
  459.    {
  460.    struct rentry *rp;
  461.  
  462.    fprintf(stderr,"\n");
  463.    fprintf(stderr,"Dump of record list\n");
  464.    fprintf(stderr, " global-ref   fields\n");
  465.    for (rp = rec_lst; rp != NULL; rp = rp->next) {
  466.       fprintf(stderr, "   %8x ", rp->sym_entry);
  467.       prt_flds(rp->fields);
  468.       fprintf(stderr, "\n");
  469.       }
  470.    }
  471. #endif                    /* DeBug */
  472.  
  473. /*
  474.  * alcloc allocates a local symbol table entry, fills in fields with
  475.  *  specified values and returns pointer to new entry.  
  476.  */
  477. static struct lentry *alcloc(blink, name, flag)
  478. struct lentry *blink;
  479. char *name;
  480. int flag;
  481.    {
  482.    register struct lentry *lp;
  483.  
  484.    lp = NewStruct(lentry);
  485.    lp->blink = blink;
  486.    lp->name = name;
  487.    lp->flag = flag;
  488.    return lp;
  489.    }
  490.  
  491. /*
  492.  * alcfld allocates a field symbol table entry, fills in the entry with
  493.  *  specified values and returns pointer to new entry.  
  494.  */
  495. static struct fentry *alcfld(blink, name, rp)
  496. struct fentry *blink;
  497. char *name;
  498. struct par_rec *rp;
  499.    {
  500.    register struct fentry *fp;
  501.  
  502.    fp = NewStruct(fentry);
  503.    fp->blink = blink;
  504.    fp->name = name;
  505.    fp->rlist = rp;
  506.    return fp;
  507.    }
  508.  
  509. /*
  510.  * alcglob allocates a global symbol table entry, fills in fields with
  511.  *  specified values and returns pointer to new entry.  
  512.  */
  513. static struct gentry *alcglob(blink, name, flag)
  514. struct gentry *blink;
  515. char *name;
  516. int flag;
  517.    {
  518.    register struct gentry *gp;
  519.  
  520.    gp = NewStruct(gentry);
  521.    gp->blink = blink;
  522.    gp->name = name;
  523.    gp->flag = flag;
  524.    return gp;
  525.    }
  526.  
  527. /*
  528.  * alclit allocates a constant symbol table entry, fills in fields with
  529.  *  specified values and returns pointer to new entry.  
  530.  */
  531. static struct centry *alclit(blink, image, len, flag)
  532. struct centry *blink;
  533. char *image;
  534. int len, flag;
  535.    {
  536.    register struct centry *cp;
  537.  
  538.    cp = NewStruct(centry);
  539.    cp->blink = blink;
  540.    cp->image = image;
  541.    cp->length = len;
  542.    cp->flag = flag;
  543.    switch (flag) {
  544.       case F_IntLit:
  545.          cp->u.intgr = iconint(image);
  546.          break;
  547.       case F_CsetLit:
  548.          cp->u.cset = bitvect(image, len);
  549.          break;
  550.       }
  551.    return cp;
  552.    }
  553.  
  554. /*
  555.  * alcprec allocates an entry for the parent record list for a field.
  556.  */
  557. static struct par_rec *alcprec(rec, offset, next)
  558. struct rentry *rec;
  559. int offset;
  560. struct par_rec *next;
  561.    {
  562.    register struct par_rec *rp;
  563.  
  564.    rp = NewStruct(par_rec);
  565.    rp->rec= rec;
  566.    rp->offset = offset;
  567.    rp->next = next;
  568.    return rp;
  569.    }
  570.  
  571. /*
  572.  * resolve - resolve the scope of undeclared identifiers.
  573.  */
  574. novalue resolve(proc)
  575. struct pentry *proc;
  576.    {
  577.    struct lentry **lhash;
  578.    register struct lentry *lp;
  579.    struct gentry *gp;
  580.    int i;
  581.    char *id;
  582.  
  583.    lhash = proc->lhash;
  584.  
  585.    for (i = 0; i < LHSize; ++i) {
  586.       lp = lhash[i];
  587.       while (lp != NULL) {
  588.          id = lp->name;
  589.          if (lp->flag == 0) {                /* undeclared */
  590.             if ((gp = try_gbl(id)) != NULL) {        /* check global */
  591.                lp->flag = F_Global;
  592.                lp->val.global = gp;
  593.                }
  594.             else {                    /* implicit local */
  595.                if (uwarn) {
  596.                   fprintf(stderr, "%s undeclared identifier, procedure %s\n",
  597.                      id, proc->name);
  598.                   ++twarns;
  599.                   }
  600.                lp->flag = F_Dynamic;
  601.                lp->next = proc->dynams;
  602.                proc->dynams = lp;
  603.                ++proc->ndynam;
  604.                }
  605.             }
  606.          lp = lp->blink;
  607.          }
  608.       }
  609.    }
  610.  
  611. /*
  612.  * try_glb - see if the identifier is or should be a global variable.
  613.  */
  614. static struct gentry *try_gbl(id)
  615. char *id;
  616.    {
  617.    struct gentry *gp;
  618.    register struct implement *iptr;
  619.    int nargs;
  620.    int n;
  621.  
  622.    gp = glookup(id);
  623.    if (gp == NULL) {
  624.       /*
  625.        * See if it is a built-in function.
  626.        */
  627.       iptr = db_ilkup(id, bhash);
  628.       if (iptr == NULL)
  629.          return NULL;
  630.       else {
  631.         if (iptr->in_line == NULL)
  632.            nfatal(NULL, "built-in function not installed", id);
  633.          nargs = iptr->nargs;
  634.          if (nargs > 0 && iptr->arg_flgs[nargs - 1] & VarPrm)
  635.             nargs = -nargs;
  636.          gp = putglob(id, F_Global | F_Builtin);
  637.          gp->val.builtin = iptr;
  638.  
  639.          n = n_arg_sym(iptr);
  640.          if (n > max_sym)
  641.             max_sym = n;
  642.          }
  643.       }
  644.    return gp;
  645.    }
  646.  
  647. /*
  648.  * invoc_grp - called when "invocable all" is encountered.
  649.  */
  650. novalue invoc_grp(grp)
  651. char *grp;
  652.    {
  653.    if (grp == spec_str("all"))
  654.       str_inv = 1; /* enable full string invocation */
  655.    else
  656.       tfatal("invalid operand to invocable", grp);
  657.    }
  658.  
  659. /*
  660.  * invocbl - indicate that the operator is needed for for string invocation.
  661.  */
  662. novalue invocbl(op, arity)
  663. nodeptr op;
  664. int arity;
  665.    {
  666.    struct strinv *si;
  667.    
  668.    si = NewStruct(strinv);
  669.    si->op = op;
  670.    si->arity = arity;
  671.    si->next = strinvlst;
  672.    strinvlst = si;  
  673.    }
  674.  
  675. /*
  676.  * chkstrinv - check to see what is needed for string invocation.
  677.  */
  678. novalue chkstrinv()
  679.    {
  680.    struct strinv *si;
  681.    struct gentry *gp;
  682.    struct implement *ip;
  683.    char *op_name;
  684.    int arity;
  685.    int i;
  686.  
  687.    /*
  688.     * A table of procedure blocks for operators is set up for use by
  689.     *  string invocation.
  690.     */
  691.    op_tbl_sz = 0;
  692.    fprintf(codefile, "\nstatic B_IProc(2) init_op_tbl[OpTblSz]");
  693.  
  694.    if (str_inv) {
  695.       /*
  696.        * All operations must be available for string invocation. Make sure all
  697.        *  built-in functions have either been hidden by global declarations
  698.        *  or are in global variables, make sure no global variables are
  699.        *  optimized away, and make sure all operations are in the table of
  700.        *  operations.
  701.        */
  702.       for (i = 0; i < IHSize; ++i)  /* built-in function table */
  703.          for (ip = bhash[i]; ip != NULL; ip = ip->blink)
  704.             try_gbl(ip->name);
  705.       for (i = 0; i < GHSize; i++)  /* global symbol table */
  706.          for (gp = ghash[i]; gp != NULL; gp = gp->blink)
  707.             gp->flag |= F_StrInv;
  708.       for (i = 0; i < IHSize; ++i)  /* operator table */
  709.          for (ip = ohash[i]; ip != NULL; ip = ip->blink)
  710.             opstrinv(ip);
  711.       }
  712.    else {
  713.       /*
  714.        * selected operations must be available for string invocation.
  715.        */
  716.       for (si = strinvlst; si != NULL; si = si->next) {
  717.          op_name = Str0(si->op);
  718.          if (isalpha(*op_name) || (*op_name == '_')) {
  719.              /*
  720.               * This needs to be something in a global variable: function,
  721.               *  procedure, or constructor.
  722.               */
  723.              gp = try_gbl(op_name);
  724.              if (gp == NULL)
  725.                 nfatal(si->op, "not available for string invocation", op_name);
  726.              else
  727.                 gp->flag |= F_StrInv;
  728.              }
  729.          else {
  730.              /*
  731.               * must be an operator.
  732.               */
  733.              arity = si->arity;
  734.              i = IHasher(op_name);
  735.              for (ip = ohash[i]; ip != NULL && ip->op != op_name;
  736.                  ip = ip->blink)
  737.                  ;
  738.              if (arity < 0) {
  739.                 /*
  740.                  * Operators of all arities with this symbol.
  741.                  */
  742.                 while (ip != NULL && ip->op == op_name) {
  743.                    opstrinv(ip);
  744.                    ip = ip->blink;
  745.                    }
  746.                 }
  747.              else {
  748.                 /*
  749.                  * Operator of a specific arity.
  750.                  */
  751.                 while (ip != NULL && ip->nargs != arity)
  752.                    ip = ip->blink;
  753.                 if (ip == NULL || ip->op != op_name)
  754.                    nfatal(si->op, "not available for string invocation",
  755.                       op_name);
  756.                 else
  757.                    opstrinv(ip);
  758.                 }
  759.              }
  760.          }
  761.       }
  762.  
  763.    /*
  764.     * Add definitions to the header file indicating the size of the operator
  765.     *  table and finish the declaration in the code file.
  766.     */
  767.    if (op_tbl_sz == 0) {
  768.       fprintf(inclfile, "#define OpTblSz 1\n");
  769.       fprintf(inclfile, "int op_tbl_sz = 0;\n");
  770.       fprintf(codefile, ";\n");
  771.       }
  772.    else {
  773.       fprintf(inclfile, "#define OpTblSz %d\n", op_tbl_sz);
  774.       fprintf(inclfile, "int op_tbl_sz = OpTblSz;\n");
  775.       fprintf(codefile, "\n   };\n");
  776.       }
  777.    }
  778.  
  779. /*
  780.  * opstrinv - set up string invocation for an operator.
  781.  */
  782. static novalue opstrinv(ip)
  783. struct implement *ip;
  784.    {
  785.    char c1, c2;
  786.    char *name;
  787.    char *op;
  788.    register char *s;
  789.    int nargs;
  790.    int n;
  791.  
  792.    if (ip == NULL || ip->iconc_flgs & InStrTbl) 
  793.       return;
  794.  
  795.    /*
  796.     * Keep track of the maximum number of argument symbols in any operation
  797.     *  so type inference can allocate enough storage for the worst case of
  798.     *  general invocation.
  799.     */
  800.    n = n_arg_sym(ip);
  801.    if (n > max_sym)
  802.       max_sym = n;
  803.  
  804.    name = ip->name;
  805.    c1 = ip->prefix[0];
  806.    c2 = ip->prefix[1];
  807.    op = ip->op;
  808.    nargs = ip->nargs;
  809.    if (ip->arg_flgs[nargs - 1] & VarPrm)
  810.       nargs = -nargs;   /* indicate varargs with negative number of params */
  811.  
  812.    if (op_tbl_sz++ == 0) {
  813.        fprintf(inclfile, "\n");
  814.        fprintf(codefile, " = {\n");
  815.        }
  816.    else
  817.        fprintf(codefile, ",\n");
  818.    implproto(ip);   /* output prototype */
  819.  
  820.    /*
  821.     * Output procedure block for this operator into table used by string
  822.     *  invocation.
  823.     */
  824.    fprintf(codefile, "   {T_Proc, 11, O%c%c_%s, %d, -1, 0, 0, {{%d, \"", c1, c2,
  825.       name, nargs, strlen(op));
  826.    for (s = op; *s != '\0'; ++s) {
  827.       if (*s == '\\')
  828.          fprintf(codefile, "\\");
  829.       fprintf(codefile, "%c", *s);
  830.       }
  831.    fprintf(codefile, "\"}}}");
  832.    ip->iconc_flgs |= InStrTbl;
  833.    }
  834.  
  835. /*
  836.  * n_arg_sym - determine the number of argument symbols (dereferenced
  837.  *  and undereferenced arguments are separate symbols) for an operation
  838.  *  in the data base.
  839.  */
  840. int n_arg_sym(ip)
  841. struct implement *ip;
  842.    {
  843.    int i;
  844.    int num;
  845.  
  846.    num = 0;
  847.    for (i = 0; i < ip->nargs; ++i) {
  848.       if (ip->arg_flgs[i] & RtParm)
  849.          ++num;
  850.       if (ip->arg_flgs[i] & DrfPrm)
  851.          ++num;
  852.       }
  853.    return num;
  854.    }
  855.