home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / icon / dos / src / icont / tsym.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-10  |  14.0 KB  |  545 lines
  1. /*
  2.  * tsym.c -- functions for symbol table management.
  3.  */
  4.  
  5. #include "../h/gsupport.h"
  6. #include "tproto.h"
  7. #include "globals.h"
  8. #include "trans.h"
  9. #include "token.h"
  10. #include "tsym.h"
  11.  
  12. #ifndef VarTran
  13. #include "lfile.h"
  14. #endif                    /* VarTran */
  15.  
  16. /*
  17.  * Prototypes.
  18.  */
  19.  
  20. hidden struct    tgentry *alcglob
  21.    Params((struct tgentry *blink, char *name,int flag,int nargs));
  22. hidden struct    tientry *alcid        Params((char *nam,int len));
  23. hidden struct    tcentry *alclit    
  24.    Params((struct tcentry *blink, char *name, int len,int flag));
  25. hidden struct    tlentry *alcloc    
  26.    Params((struct tlentry *blink, char *name,int flag));
  27. hidden struct    tcentry *clookup    Params((char *id,int flag));
  28. hidden struct    tgentry *glookup    Params((char *id));
  29. hidden struct    tlentry *llookup    Params((char *id));
  30. hidden novalue    putglob
  31.    Params((char *id,int id_type, int n_args));
  32. hidden int    streq            Params((int len,char *s1,char *s2));
  33.  
  34. #ifdef DeBugTrans
  35. novalue    cdump    Params((noargs));
  36. novalue    gdump    Params((noargs));
  37. novalue    ldump    Params((noargs));
  38. #endif                    /* DeBugTrans */
  39.  
  40.  
  41. /*
  42.  * putid - install the identifier named by the string starting at strf
  43.  *  and extending for len bytes.  The installation entails making an
  44.  *  entry in the identifier hash table and then making an identifier
  45.  *  table entry for it with alcid.  A side effect of installation
  46.  *  is the incrementing of strf by the length of the string, thus
  47.  *  "saving" it.
  48.  *
  49.  * Nothing is changed if the identifier has already been installed.
  50.  */
  51. char *putid(len)
  52. int len;
  53.    {
  54.    register int hash;
  55.    register char *s;
  56.    register struct tientry *ip;
  57.    int l;
  58.  
  59.    /*
  60.     * Compute hash value by adding bytes and masking result with imask.
  61.     *  (Recall that imask is ihsize-1.)
  62.     */
  63.    s = strf;
  64.    hash = 0;
  65.    l = len;
  66.    while (l--)
  67.       hash += *s++ & 0377;
  68.    s = strf;
  69.    l = len;
  70.    hash &= imask;
  71.    /*
  72.     * If the identifier hasn't been installed, install it.
  73.     */
  74.    if ((ip = ihash[hash]) != NULL) {    /* collision */
  75.       for (;;) {    /* work down i_blink chain until id is found or the
  76.                             end of the chain is reached */
  77.          if (l == ip->i_length && streq(l, s, ip->i_name))
  78.             return (ip->i_name);    /* id is already installed */
  79.          if (ip->i_blink == NULL) {    /* end of chain */
  80.             ip->i_blink = alcid(s,l);
  81.             strf += l;
  82.             return s;
  83.             }
  84.          ip = ip->i_blink;
  85.          }
  86.       }
  87.    /*
  88.     * Hashed to an empty slot.
  89.     */
  90.    ihash[hash] = alcid(s,l);
  91.    strf += l;
  92.    return s;
  93.    }
  94.  
  95. /*
  96.  * streq - compare s1 with s2 for len bytes, and return 1 for equal,
  97.  *  0 for not equal.
  98.  */
  99. static int streq(len, s1, s2)
  100. register int len;
  101. register char *s1, *s2;
  102.    {
  103.    while (len--)
  104.       if (*s1++ != *s2++)
  105.          return 0;
  106.    return 1;
  107.    }
  108.  
  109. /*
  110.  * alcid - get the next free identifier table entry, and fill it in with
  111.  *  the specified values.
  112.  */
  113. static struct tientry *alcid(nam, len)
  114. char *nam;
  115. int len;
  116.    {
  117.    register struct tientry *ip;
  118.  
  119.    if (ifree >= &itable[isize])
  120.       tsyserr("out of identifier table space");
  121.    ip = ifree++;
  122.    ip->i_blink = NULL;
  123.    ip->i_name = nam;
  124.    ip->i_length = len;
  125.    return ip;
  126.    }
  127.  
  128. #ifndef VarTran
  129.  
  130. /*
  131.  * loc_init - clear the local symbol table.
  132.  */
  133.  
  134. novalue loc_init()
  135.    {
  136.    register struct tlentry **lp;
  137.    register struct tcentry **cp;
  138.    static int maxlfree = 0;
  139.    static int maxcfree = 0;
  140.                     /* clear local table */
  141.    maxlfree = (maxlfree > lfree-ltable) ? maxlfree : lfree-ltable;
  142.    for (lp = lhash; lp < &lhash[lhsize]; lp++)
  143.       *lp = NULL;
  144.    lfree = ltable;
  145.                     /* clear constant table */
  146.    maxcfree = (maxcfree > ctfree-ctable) ? maxcfree : ctfree-ctable;
  147.    for (cp = chash; cp < &chash[chsize]; cp++)
  148.       *cp = NULL;
  149.    ctfree = ctable;
  150.    }
  151.  
  152. /*
  153.  * install - put an identifier into the global or local symbol table.
  154.  *  The basic idea here is to look in the right table and install
  155.  *  the identifier if it isn't already there.  Some semantic checks
  156.  *  are performed.
  157.  */
  158. novalue install(name, flag, argcnt)
  159. char *name;
  160. int flag, argcnt;
  161.    {
  162.    union {
  163.       struct tgentry *gp;
  164.       struct tlentry *lp;
  165.       } p;
  166.  
  167.    switch (flag) {
  168.       case F_Global:    /* a variable in a global declaration */
  169.          if ((p.gp = glookup(name)) == NULL)
  170.             putglob(name, flag, argcnt);
  171.          else
  172.             p.gp->g_flag |= flag;
  173.          break;
  174.  
  175.       case F_Proc|F_Global:    /* procedure declaration */
  176.       case F_Record|F_Global:    /* record declaration */
  177.       case F_Builtin|F_Global:    /* external declaration */
  178.          if ((p.gp = glookup(name)) == NULL)
  179.             putglob(name, flag, argcnt);
  180.          else if ((p.gp->g_flag & (~F_Global)) == 0) { /* superfluous global
  181.                                declaration for
  182.                                record or proc */
  183.             p.gp->g_flag |= flag;
  184.             p.gp->g_nargs = argcnt;
  185.             }
  186.          else            /* the user can't make up his mind */
  187.             tfatal("inconsistent redeclaration", name);
  188.          break;
  189.  
  190.       case F_Static:    /* static declaration */
  191.       case F_Dynamic:    /* local declaration (possibly implicit?) */
  192.       case F_Argument:    /* formal parameter */
  193.          if ((p.lp = llookup(name)) == NULL)
  194.             putloc(name,flag);
  195.          else if (p.lp->l_flag == flag) /* previously declared as same type */
  196.             tfatal("redeclared identifier", name);
  197.          else        /* previously declared as different type */
  198.             tfatal("inconsistent redeclaration", name);
  199.          break;
  200.  
  201.       default:
  202.          tsyserr("install: unrecognized symbol table flag.");
  203.       }
  204.    }
  205.  
  206. /*
  207.  * putloc - make a local symbol table entry and return the index
  208.  *  of the entry in lhash.  alcloc does the work if there is a collision.
  209.  */
  210. int putloc(id,id_type)
  211. char *id;
  212. int id_type;
  213.    {
  214.    register struct tlentry *ptr;
  215.  
  216.    if ((ptr = llookup(id)) == NULL) {    /* add to head of hash chain */
  217.       ptr = lhash[lhasher(id)];
  218.       lhash[lhasher(id)] = alcloc(ptr, id, id_type);
  219.       return (lhash[lhasher(id)] - ltable);
  220.       }
  221.    return (ptr - ltable);
  222.    }
  223.  
  224. /*
  225.  * putglob makes a global symbol table entry. alcglob does the work if there
  226.  *  is a collision.
  227.  */
  228.  
  229. static novalue putglob(id, id_type, n_args)
  230. char *id;
  231. int id_type, n_args;
  232.    {
  233.    register struct tgentry *ptr;
  234.  
  235.    if ((ptr = glookup(id)) == NULL) {     /* add to head of hash chain */
  236.       ptr = ghash[ghasher(id)];
  237.       ghash[ghasher(id)] = alcglob(ptr, id, id_type, n_args);
  238.       }
  239.    }
  240.  
  241. /*
  242.  * putlit makes a constant symbol table entry and returns the index
  243.  *  of the entry in chash.  alclit does the work if there is a collision.
  244.  */
  245. int putlit(id, idtype, len)
  246. char *id;
  247. int len, idtype;
  248.    {
  249.    register struct tcentry *ptr;
  250.  
  251.    if ((ptr = clookup(id,idtype)) == NULL) {   /* add to head of hash chain */
  252.       ptr = chash[chasher(id)];
  253.       chash[chasher(id)] = alclit(ptr, id, len, idtype);
  254.       return (chash[chasher(id)] - ctable);
  255.       }
  256.    return (ptr - ctable);
  257.    }
  258.  
  259. /*
  260.  * llookup looks up id in local symbol table and returns pointer to
  261.  *  to it if found or NULL if not present.
  262.  */
  263.  
  264. static struct tlentry *llookup(id)
  265. char *id;
  266.    {
  267.    register struct tlentry *ptr;
  268.  
  269.    ptr = lhash[lhasher(id)];
  270.    while (ptr != NULL && ptr->l_name != id)
  271.       ptr = ptr->l_blink;
  272.    return ptr;
  273.    }
  274.  
  275. /*
  276.  * glookup looks up id in global symbol table and returns pointer to
  277.  *  to it if found or NULL if not present.
  278.  */
  279. static struct tgentry *glookup(id)
  280. char *id;
  281.    {
  282.    register struct tgentry *ptr;
  283.  
  284.    ptr = ghash[ghasher(id)];
  285.    while (ptr != NULL && ptr->g_name != id) {
  286.       ptr = ptr->g_blink;
  287.       }
  288.    return ptr;
  289.    }
  290.  
  291. /*
  292.  * clookup looks up id in constant symbol table and returns pointer to
  293.  *  to it if found or NULL if not present.
  294.  */
  295. static struct tcentry *clookup(id,flag)
  296. char *id;
  297. int flag;
  298.    {
  299.    register struct tcentry *ptr;
  300.  
  301.    ptr = chash[chasher(id)];
  302.    while (ptr != NULL && (ptr->c_name != id || ptr->c_flag != flag))
  303.       ptr = ptr->c_blink;
  304.  
  305.    return ptr;
  306.    }
  307.  
  308. /*
  309.  * klookup looks up keyword named by id in keyword table and returns
  310.  *  its number (keyid).
  311.  */
  312. int klookup(id)
  313. register char *id;
  314.    {
  315.    register struct keyent *kp;
  316.  
  317.    for (kp = keytab; kp->keyid >= 0; kp++)
  318.       if (strcmp(kp->keyname,id) == 0)
  319.          return (kp->keyid);
  320.  
  321.    return 0;
  322.    }
  323.  
  324. #ifdef DeBugTrans
  325. /*
  326.  * ldump displays local symbol table to stdout.
  327.  */
  328.  
  329. novalue ldump()
  330.    {
  331.    register int i;
  332.    register struct tlentry *lptr;
  333.  
  334.    fprintf(stderr,"Dump of local symbol table (%d entries)\n",lfree-ltable);
  335.    fprintf(stderr," loc   blink   id          (name)      flags\n");
  336.    for (i = 0; i < lhsize; i++)
  337.       for (lptr = lhash[i]; lptr != NULL; lptr = lptr->l_blink)
  338.          fprintf(stderr,"%5d  %5d  %5d    %20s  %7o\n", lptr-ltable,
  339.         lptr->l_blink, lptr->l_name, lptr->l_name, lptr->l_flag);
  340.    fflush(stderr);
  341.  
  342.    }
  343.  
  344. /*
  345.  * gdump displays global symbol table to stdout.
  346.  */
  347.  
  348. novalue gdump()
  349.    {
  350.    register int i;
  351.    register struct tgentry *gptr;
  352.  
  353.    fprintf(stderr,"Dump of global symbol table (%d entries)\n",
  354.       (int)(gfree-gtable));
  355.    fprintf(stderr," loc   blink   id          (name)      flags      nargs\n");
  356.    for (i = 0; i < ghsize; i++)
  357.       for (gptr = ghash[i]; gptr != NULL; gptr = gptr->g_blink)
  358.          fprintf(stderr,"%5d  %5d  %5d    %20s  %7o   %8d\n", gptr-gtable,
  359.         gptr->g_blink, gptr->g_name, gptr->g_name,
  360.         gptr->g_flag, gptr->g_nargs);
  361.    fflush(stderr);
  362.    }
  363.  
  364. /*
  365.  * cdump displays constant symbol table to stdout.
  366.  */
  367.  
  368. novalue cdump()
  369.    {
  370.    register int i;
  371.    register struct tcentry *cptr;
  372.  
  373.    fprintf(stderr,"Dump of constant symbol table (%d entries)\n",ctfree-ctable);
  374.    fprintf(stderr," loc   blink   id          (name)      flags\n");
  375.    for (i = 0; i < chsize; i++)
  376.       for (cptr = chash[i]; cptr != NULL; cptr = cptr->c_blink)
  377.          fprintf(stderr,"%5d  %5d  %5d    %20s  %7o\n", cptr-ctable,
  378.         cptr->c_blink, cptr->c_name, cptr->c_name, cptr->c_flag);
  379.    fflush(stderr);
  380.    }
  381. #endif                    /* DeBugTrans */
  382.  
  383. /*
  384.  * alcloc allocates a local symbol table entry, fills in fields with
  385.  *  specified values and returns offset of new entry.  
  386.  */
  387. static struct tlentry *alcloc(blink, name, flag)
  388. struct tlentry *blink;
  389. char *name;
  390. int flag;
  391.    {
  392.    register struct tlentry *lp;
  393.  
  394.    if (lfree >= <able[lsize])
  395.       tsyserr("out of local symbol table space");
  396.    lp = lfree++;
  397.    lp->l_blink = blink;
  398.    lp->l_name = name;
  399.    lp->l_flag = flag;
  400.    return lp;
  401.    }
  402.  
  403. /*
  404.  * alcglob allocates a global symbol table entry, fills in fields with
  405.  *  specified values and returns offset of new entry.  
  406.  */
  407. static struct tgentry *alcglob(blink, name, flag, nargs)
  408. struct tgentry *blink;
  409. char *name;
  410. int flag, nargs;
  411.    {
  412.    register struct tgentry *gp;
  413.  
  414.    if (gfree >= >able[gsize])
  415.       tsyserr("out of global symbol table space");
  416.    gp = gfree++;
  417.    gp->g_blink = blink;
  418.    gp->g_name = name;
  419.    gp->g_flag = flag;
  420.    gp->g_nargs = nargs;
  421.    return gp;
  422.    }
  423.  
  424. /*
  425.  * alclit allocates a constant symbol table entry, fills in fields with
  426.  *  specified values and returns offset of new entry.  
  427.  */
  428. static struct tcentry *alclit(blink, name, len, flag)
  429. struct tcentry *blink;
  430. char *name;
  431. int len, flag;
  432.    {
  433.    register struct tcentry *cp;
  434.  
  435.    if (ctfree >= &ctable[csize])
  436.       tsyserr("out of constant table space");
  437.    cp = ctfree++;
  438.    cp->c_blink = blink;
  439.    cp->c_name = name;
  440.    cp->c_length = len;
  441.    cp->c_flag = flag;
  442.    return cp;
  443.    }
  444.  
  445. /*
  446.  * lout dumps local symbol table to fd, which is a .u1 file.
  447.  */
  448. novalue lout(fd)
  449. FILE *fd;
  450.    {
  451.    register int i;
  452.    register struct tlentry *lp;
  453.  
  454.    i = 0;
  455.    for (lp = ltable; lp < lfree; lp++)
  456.       writecheck(fprintf(fd, "\tlocal\t%d,%06o,%s\n",
  457.          i++, lp->l_flag, lp->l_name));
  458.    }
  459.  
  460. /*
  461.  * cout dumps constant symbol table to fd, which is a .u1 file.
  462.  */
  463. novalue cout(fd)
  464. FILE *fd;
  465.    {
  466.    register int l;
  467.    register char *c;
  468.    register struct tcentry *cp;
  469.    int i;
  470.  
  471.    i = 0;
  472.    for (cp = ctable; cp < ctfree; cp++) {
  473.       writecheck(fprintf(fd, "\tcon\t%d,%06o", i++, cp->c_flag));
  474.       if (cp->c_flag & F_IntLit)
  475.          writecheck(fprintf(fd, ",%d,%s\n", strlen(cp->c_name), cp->c_name));
  476.       else if (cp->c_flag & F_RealLit)
  477.          writecheck(fprintf(fd, ",%s\n", cp->c_name));
  478.       else {
  479.          c = cp->c_name;
  480.          l = cp->c_length - 1;
  481.          writecheck(fprintf(fd, ",%d", l));
  482.          while (l--)
  483.             writecheck(fprintf(fd, ",%03o", *c++ & 0377));
  484.          writecheck(putc('\n', fd));
  485.          }
  486.       }
  487.    }
  488.  
  489. /*
  490.  * rout dumps a record declaration for name to file fd, which is a .u2 file.
  491.  */
  492. novalue rout(fd,name)
  493. FILE *fd;
  494. char *name;
  495.    {
  496.    register int i;
  497.    register struct tlentry *lp;
  498.  
  499.    writecheck(fprintf(fd, "record\t%s,%d\n", name, (int)(lfree-ltable)));
  500.    i = 0;
  501.    for (lp = ltable; lp < lfree; lp++)
  502.       writecheck(fprintf(fd, "\t%d,%s\n", i++, lp->l_name));
  503.    }
  504.  
  505. /*
  506.  * gout writes various items to fd, which is a .u2 file.  These items
  507.  *  include: implicit status, tracing activation, link directives,
  508.  *  and the global table.
  509.  */
  510. novalue gout(fd)
  511. FILE *fd;
  512.    {
  513.    register int i;
  514.    register char *name;
  515.    register struct tgentry *gp;
  516.    struct lfile *lfl;
  517.    
  518.    if (uwarn)
  519.       name = "error";
  520.    else
  521.       name = "local";
  522.    writecheck(fprintf(fd, "impl\t%s\n", name));
  523.    if (trace)
  524.       writecheck(fprintf(fd, "trace\n"));
  525.    
  526.    lfl = lfiles;
  527.    while (lfl) {
  528.  
  529. #if MVS
  530.       writecheck(fprintf(fd,"link\t%s\n",lfl->lf_name));
  531. #else                    /* MVS */
  532.       writecheck(fprintf(fd,"link\t%s.u1\n",lfl->lf_name));
  533. #endif                    /* MVS */
  534.  
  535.       lfl = lfl->lf_link;
  536.       }
  537.    lfiles = 0;
  538.    writecheck(fprintf(fd, "global\t%d\n", (int)(gfree-gtable)));
  539.    i = 0;
  540.    for (gp = gtable; gp < gfree; gp++)
  541.       writecheck(fprintf(fd, "\t%d,%06o,%s,%d\n", i++, gp->g_flag,
  542.          gp->g_name, gp->g_nargs));
  543.    }
  544. #endif                    /* VarTran */
  545.