Return to sym.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / tran

Annotation of 43BSD/contrib/icon/tran/sym.c, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.