Return to pepy.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / isode-beta / pepy

Annotation of 43BSDReno/contrib/isode-beta/pepy/pepy.c, revision 1.1

1.1     ! root        1: /* pepy.c - PE parser (yacc-based) */
        !             2: 
        !             3: #ifndef        lint
        !             4: static char *rcsid = "$Header: /f/osi/pepy/RCS/pepy.c,v 7.0 89/11/23 22:11:44 mrose Rel $";
        !             5: #endif
        !             6: 
        !             7: /*
        !             8:  * $Header: /f/osi/pepy/RCS/pepy.c,v 7.0 89/11/23 22:11:44 mrose Rel $
        !             9:  *
        !            10:  *
        !            11:  * $Log:       pepy.c,v $
        !            12:  * Revision 7.0  89/11/23  22:11:44  mrose
        !            13:  * Release 6.0
        !            14:  * 
        !            15:  */
        !            16: 
        !            17: /*
        !            18:  *                               NOTICE
        !            19:  *
        !            20:  *    Acquisition, use, and distribution of this module and related
        !            21:  *    materials are subject to the restrictions of a license agreement.
        !            22:  *    Consult the Preface in the User's Manual for the full terms of
        !            23:  *    this agreement.
        !            24:  *
        !            25:  */
        !            26: 
        !            27: 
        !            28: #include <ctype.h>
        !            29: #include <stdio.h>
        !            30: #include <varargs.h>
        !            31: #include "pepy.h"
        !            32: 
        !            33: /*    DATA */
        !            34: 
        !            35: static char *aflag = NULL;
        !            36: int    Cflag = 1;              /* pepy */
        !            37: int    dflag = 0;
        !            38: int    hflag = 0;
        !            39: int    Pflag = 0;
        !            40: int    rflag = 0;
        !            41: char   *bflag = NULLCP;
        !            42: static int bwidth = 1;
        !            43: char   *module_actions = NULLCP;
        !            44: int    pepydebug = 0;
        !            45: int    doexternals = 1;
        !            46: static int linepos = 0;
        !            47: static int mflag = 0;
        !            48: static int pflag = 0;
        !            49: static int sflag = 0;
        !            50: 
        !            51: static  char *eval = NULLCP;
        !            52: 
        !            53: char   *mymodule = "";
        !            54: OID    mymoduleid = NULLOID;
        !            55: 
        !            56: int yysection = YP_DECODER;
        !            57: char *yyencpref = "build";
        !            58: char *yydecpref = "parse";
        !            59: char *yyprfpref = "print";
        !            60: char *yyencdflt = "build";
        !            61: char *yydecdflt = "parse";
        !            62: char *yyprfdflt = "print";
        !            63: static char *yyprefix;
        !            64: 
        !            65: static struct section {
        !            66:     char   *s_name;
        !            67:     int            s_mode;
        !            68: }      sections[] = {
        !            69:     "ENCODE", YP_ENCODER,
        !            70:     "DECODE", YP_DECODER,
        !            71:     "PRINT", YP_PRINTER,
        !            72: 
        !            73:     NULL
        !            74: };
        !            75:     
        !            76: char   *sysin = NULLCP;
        !            77: static char sysout[BUFSIZ];
        !            78: 
        !            79: typedef struct modlist {
        !            80:     char   *md_module;
        !            81:     OID           md_oid;
        !            82: 
        !            83:     struct modlist *md_next;
        !            84: }              modlist, *MD;
        !            85: #define        NULLMD  ((MD) 0)
        !            86: 
        !            87: static  MD     mymodules = NULLMD;
        !            88: 
        !            89: typedef struct symlist {
        !            90:     char   *sy_encpref;
        !            91:     char   *sy_decpref;
        !            92:     char   *sy_prfpref;
        !            93:     char   *sy_module;
        !            94:     char   *sy_name;
        !            95: 
        !            96:     YP     sy_type;
        !            97: 
        !            98:     struct symlist *sy_next;
        !            99: }              symlist, *SY;
        !           100: #define        NULLSY  ((SY) 0)
        !           101: 
        !           102: static SY      mysymbols = NULLSY;
        !           103: 
        !           104: 
        !           105: char   *gensym (), *modsym ();
        !           106: MD     lookup_module ();
        !           107: FILE   *open_ph_file ();
        !           108: SY     new_symbol (), add_symbol ();
        !           109: 
        !           110: YP     lookup_type (), lookup_binding ();
        !           111: YT     lookup_tag ();
        !           112: 
        !           113: /*    MAIN */
        !           114: 
        !           115: /* ARGSUSED */
        !           116: 
        !           117: main (argc, argv, envp)
        !           118: int    argc;
        !           119: char  **argv,
        !           120:       **envp;
        !           121: {
        !           122:     register char  *cp,
        !           123:                   *sp;
        !           124:     register struct section *sectp;
        !           125: 
        !           126:     fprintf (stderr, "%s\n", pepyversion);
        !           127: 
        !           128:     sysout[0] = NULL;
        !           129:     for (argc--, argv++; argc > 0; argc--, argv++) {
        !           130:        cp = *argv;
        !           131: 
        !           132:        if (strcmp (cp, "-a") == 0) {
        !           133:            argc--, argv++;
        !           134:            if ((aflag = *argv) == NULL || *aflag == '-')
        !           135:                goto usage;
        !           136:            continue;
        !           137:        }
        !           138:        if (strcmp (cp, "-A") == 0) {
        !           139:            yysection = YP_ENCODER | YP_DECODER | YP_PRINTER;
        !           140:            continue;
        !           141:        }
        !           142:        if (strcmp (cp, "-d") == 0) {
        !           143:            dflag++;
        !           144:            continue;
        !           145:        }
        !           146:        if (strcmp (cp, "-h") == 0) {
        !           147:            hflag++;
        !           148:            continue;
        !           149:        }
        !           150:        if (strcmp (cp, "-m") == 0) {
        !           151:            mflag++;
        !           152:            continue;
        !           153:        }
        !           154:        if (strcmp (cp, "-P") == 0) {
        !           155:            Pflag++;
        !           156:            continue;
        !           157:        }
        !           158:        if (strcmp (cp, "-p") == 0) {
        !           159:            pflag++;
        !           160:            continue;
        !           161:        }
        !           162:        if (strcmp (cp, "-o") == 0) {
        !           163:            if (sysout[0]) {
        !           164:                fprintf (stderr, "too many output files\n");
        !           165:                exit (1);
        !           166:            }
        !           167:            if (bflag) {
        !           168: not_practical: ;
        !           169:                fprintf (stderr, "-b & -o together is not practical\n");
        !           170:                exit (1);
        !           171:            }
        !           172:            argc--, argv++;
        !           173:            if ((cp = *argv) == NULL || (*cp == '-' && cp[1] != NULL))
        !           174:                goto usage;
        !           175:            (void) strcpy (sysout, cp);
        !           176: 
        !           177:            continue;
        !           178:        }
        !           179:        if (strcmp (cp, "-r") == 0) {
        !           180:            rflag++;
        !           181:            continue;
        !           182:        }
        !           183:        if (strcmp (cp, "-s") == 0) {
        !           184:            sflag++;
        !           185:            continue;
        !           186:        }
        !           187:        if (strcmp (cp, "-S") == 0) {
        !           188:            
        !           189:            argc--, argv++;
        !           190:            if ((cp = *argv) == NULL || *cp == '-')
        !           191:                goto usage;
        !           192: 
        !           193:            for (sectp = sections; sectp -> s_name; sectp++)
        !           194:                if (strcmp (sectp -> s_name, cp) == 0) {
        !           195:                    yysection = sectp -> s_mode;
        !           196:                    break;
        !           197:                }
        !           198:            if (!sectp -> s_name) {
        !           199:                fprintf (stderr, "unknown section name \"%s\"\n", cp);
        !           200:                exit (1);
        !           201:            }
        !           202:            continue;
        !           203:        }
        !           204:        if (strcmp (cp, "-b") == 0) {
        !           205:            if (bflag) {
        !           206:                fprintf (stderr, "too many prefixes\n");
        !           207:                exit (1);
        !           208:            }
        !           209:            if (sysout[0])
        !           210:                goto not_practical;
        !           211:            argc--, argv++;
        !           212:            if ((bflag = *argv) == NULL || *bflag == '-')
        !           213:                goto usage;
        !           214:            continue;
        !           215:        }
        !           216: 
        !           217:        if (sysin) {
        !           218: usage: ;
        !           219:            fprintf (stderr,
        !           220:                "usage: pepy [-d] [-h] [-p] [-o module.c] [-r] [-s] [-S section] [-b prefix] module.py\n");
        !           221:            exit (1);
        !           222:        }
        !           223: 
        !           224:        if (*cp == '-') {
        !           225:            if (*++cp != NULL)
        !           226:                goto usage;
        !           227:            sysin = "";
        !           228:        }
        !           229:        sysin = cp;
        !           230: 
        !           231:        if (sysout[0] || bflag)
        !           232:            continue;
        !           233:        if (sp = rindex (cp, '/'))
        !           234:            sp++;
        !           235:        if (sp == NULL || *sp == NULL)
        !           236:            sp = cp;
        !           237:        sp += strlen (cp = sp) - 3;
        !           238:        if (sp > cp && strcmp (sp, ".py") == 0)
        !           239:            (void) sprintf (sysout, "%.*s.c", sp - cp, cp);
        !           240:        else
        !           241:            (void) sprintf (sysout, "%s.c", cp);
        !           242:     }
        !           243: 
        !           244:     switch (pepydebug = (cp = getenv ("PEPYTEST")) && *cp ? atoi (cp) : 0) {
        !           245:        case 2:
        !           246:            yydebug++;          /* fall */
        !           247:        case 1:
        !           248:            sflag++;            /*   .. */
        !           249:        case 0:
        !           250:            break;
        !           251:     }
        !           252: 
        !           253:     if (sysin == NULLCP)
        !           254:        sysin = "";
        !           255: 
        !           256:     if (*sysin && freopen (sysin, "r", stdin) == NULL) {
        !           257:        fprintf (stderr, "unable to read "), perror (sysin);
        !           258:        exit (1);
        !           259:     }
        !           260: 
        !           261:     if (pflag)
        !           262:        exit (pp ());
        !           263: 
        !           264:     if (strcmp (sysout, "-") == 0)
        !           265:        sysout[0] = NULL;
        !           266:     if (!bflag && *sysout && freopen (sysout, "w", stdout) == NULL) {
        !           267:        fprintf (stderr, "unable to write "), perror (sysout);
        !           268:        exit (1);
        !           269:     }
        !           270: 
        !           271:     if (!bflag)
        !           272:        prologue ();
        !           273: 
        !           274:     initoidtbl ();
        !           275: 
        !           276:     exit (yyparse ());         /* NOTREACHED */
        !           277: }
        !           278: 
        !           279: static prologue ()
        !           280: {
        !           281:     char *cp;
        !           282: 
        !           283:     if (cp = index (pepyversion, ')'))
        !           284:        for (cp++; *cp != ' '; cp++)
        !           285:            if (*cp == NULL) {
        !           286:                cp = NULL;
        !           287:                break;
        !           288:            }
        !           289:     if (cp == NULL)
        !           290:        cp = pepyversion + strlen (pepyversion);
        !           291:     printf ("/* automatically generated by %*.*s, do not edit! */\n\n",
        !           292:            cp - pepyversion, cp - pepyversion, pepyversion);
        !           293:     printf ("#include %s\n\n", mflag ? "\"psap.h\"" : "<isode/psap.h>");
        !           294:     if (!bflag)
        !           295:        printf ("static char *pepyid = \"%s\";\n\n", pepyversion);
        !           296:     if (aflag)
        !           297:        printf ("#define\tadvise\t%s\n\n", aflag);
        !           298:     printf ("void\tadvise ();\n");
        !           299: }
        !           300: /*    ERRORS */
        !           301: 
        !           302: yyerror (s)
        !           303: register char   *s;
        !           304: {
        !           305:     yyerror_aux (s);
        !           306: 
        !           307:     if (*sysout)
        !           308:        (void) unlink (sysout);
        !           309: 
        !           310:     exit (1);
        !           311: }
        !           312: 
        !           313: #ifndef lint
        !           314: warning (va_alist)
        !           315: va_dcl
        !           316: {
        !           317:     char       buffer[BUFSIZ];
        !           318:     char       buffer2[BUFSIZ];
        !           319:     char       *cp;
        !           320:     va_list    ap;
        !           321: 
        !           322:     va_start (ap);
        !           323: 
        !           324:     _asprintf (buffer, NULLCP, ap);
        !           325: 
        !           326:     va_end (ap);
        !           327: 
        !           328:     (void) sprintf (buffer2, "Warning: %s", buffer);
        !           329:     yyerror_aux (buffer2);
        !           330: }
        !           331: 
        !           332: #else
        !           333: 
        !           334: /* VARARGS1 */
        !           335: warning (fmt)
        !           336: char   *fmt;
        !           337: {
        !           338:     warning (fmt);
        !           339: }
        !           340: #endif
        !           341: 
        !           342: yyerror_aux (s)
        !           343: register char   *s;
        !           344: {
        !           345:     if (linepos)
        !           346:        fprintf (stderr, "\n"), linepos = 0;
        !           347: 
        !           348:     if (eval)
        !           349:        fprintf (stderr, "type %s: ", eval);
        !           350:     else
        !           351:        fprintf (stderr, "line %d: ", yylineno);
        !           352:     fprintf (stderr, "%s\n", s);
        !           353:     if (!eval)
        !           354:        fprintf (stderr, "last token read was \"%s\"\n", yytext);
        !           355: }
        !           356: 
        !           357: /*  */
        !           358: 
        !           359: 
        !           360: #ifndef        lint
        !           361: myyerror (va_alist)
        !           362: va_dcl
        !           363: {
        !           364:     char    buffer[BUFSIZ];
        !           365:     va_list ap;
        !           366: 
        !           367:     va_start (ap);
        !           368: 
        !           369:     _asprintf (buffer, NULLCP, ap);
        !           370: 
        !           371:     va_end (ap);
        !           372: 
        !           373:     yyerror (buffer);
        !           374: }
        !           375: #else
        !           376: /* VARARGS */
        !           377: 
        !           378: myyerror (fmt)
        !           379: char   *fmt;
        !           380: {
        !           381:     myyerror (fmt);
        !           382: }
        !           383: #endif
        !           384: 
        !           385: 
        !           386: #ifndef        lint
        !           387: pyyerror (va_alist)
        !           388: va_dcl
        !           389: {
        !           390:     char    buffer[BUFSIZ];
        !           391:     register YP        yp;
        !           392:     va_list    ap;
        !           393: 
        !           394:     va_start (ap);
        !           395: 
        !           396:     yp = va_arg (ap, YP);
        !           397: 
        !           398:     _asprintf (buffer, NULLCP, ap);
        !           399: 
        !           400:     va_end (ap);
        !           401: 
        !           402:     yyerror_aux (buffer);
        !           403:     print_type (yp, 0);
        !           404: 
        !           405:     if (*sysout)
        !           406:        (void) unlink (sysout);
        !           407: 
        !           408:     exit (1);
        !           409: }
        !           410: #else
        !           411: /* VARARGS */
        !           412: pyyerror (yp, fmt)
        !           413: YP     yp;
        !           414: char   *fmt;
        !           415: {
        !           416:     pyyerror (yp, fmt);
        !           417: }
        !           418: #endif
        !           419: 
        !           420: /*  */
        !           421: 
        !           422: yywrap () {
        !           423:     if (linepos)
        !           424:        fprintf (stderr, "\n"), linepos = 0;
        !           425: 
        !           426:     return 1;
        !           427: }
        !           428: 
        !           429: /*  */
        !           430: 
        !           431: yyprint (s, f, top)
        !           432: char    *s;
        !           433: int    f;
        !           434: int    top;
        !           435: {
        !           436:     int            len;
        !           437:     static int didf = 0;
        !           438:     static int nameoutput = 0;
        !           439:     static int outputlinelen = 79;
        !           440: 
        !           441:     if (sflag)
        !           442:        return;
        !           443: 
        !           444:     if (f && didf == 0) {
        !           445:        if (linepos)
        !           446:            fprintf (stderr, "\n\n");
        !           447: 
        !           448:        fprintf (stderr, "%s:", mymodule);
        !           449:        linepos = (nameoutput = strlen (mymodule) + 1) + 1;
        !           450: 
        !           451:        didf = 1;       
        !           452:     }
        !           453: 
        !           454:     if (!nameoutput || top) {
        !           455:        if (linepos)
        !           456:            fprintf (stderr, "\n\n");
        !           457: 
        !           458:        fprintf (stderr, "%s", mymodule);
        !           459:        nameoutput = (linepos = strlen (mymodule)) + 1;
        !           460:            
        !           461: #define        section(flag,prefix) \
        !           462:        if (yysection & (flag)) { \
        !           463:            fprintf (stderr, " %s", (prefix)); \
        !           464:            linepos += strlen (prefix) + 1; \
        !           465:        } \
        !           466:        else \
        !           467:            fprintf (stderr, " none"), linepos += 5
        !           468:        section (YP_ENCODER, yyencpref);
        !           469:        section (YP_DECODER, yydecpref);
        !           470:        section (YP_PRINTER, yyprfpref);
        !           471: 
        !           472:        fprintf (stderr, ":");
        !           473:        linepos += 2;
        !           474: 
        !           475:        if (top)
        !           476:            return;
        !           477:     }
        !           478: 
        !           479:     len = strlen (s) + (f ? 2 : 0);
        !           480:     if (linepos != nameoutput)
        !           481:        if (len + linepos + 1 > outputlinelen)
        !           482:            fprintf (stderr, "\n%*s", linepos = nameoutput, "");
        !           483:        else
        !           484:            fprintf (stderr, " "), linepos++;
        !           485:     fprintf (stderr, f ? "(%s)" : "%s", s);
        !           486:     linepos += len;
        !           487: }
        !           488: 
        !           489: /*    PASS1 */
        !           490: 
        !           491: pass1 ()
        !           492: {
        !           493:     if (!bflag)
        !           494:        prologue3 ();
        !           495: }
        !           496: 
        !           497: static prologue3 ()
        !           498: {
        !           499:     printf ("\n/* Generated from module %s", mymodule);
        !           500:     if (mymoduleid)
        !           501:        printf (", Object Identifier %s", sprintoid (mymoduleid));
        !           502:     printf (" */\n");
        !           503: }
        !           504: /*  */
        !           505: 
        !           506: pass1_type (encpref, decpref, prfpref, mod, id, yp)
        !           507: register char  *encpref,
        !           508:               *decpref,
        !           509:               *prfpref,
        !           510:               *mod,
        !           511:               *id;
        !           512: register YP    yp;
        !           513: {
        !           514:     register SY            sy;
        !           515: 
        !           516:     if (pepydebug) {
        !           517:        if (linepos)
        !           518:            fprintf (stderr, "\n"), linepos = 0;
        !           519: 
        !           520:        fprintf (stderr, "%s.%s\n", mod ? mod : mymodule, id);
        !           521:        print_type (yp, 0);
        !           522:        fprintf (stderr, "--------\n");
        !           523:     }
        !           524:     else
        !           525:        if (!(yp -> yp_flags & YP_IMPORTED))
        !           526:            yyprint (id, 0, 0);
        !           527: 
        !           528:     sy = new_symbol (encpref, decpref, prfpref, mod, id, yp);
        !           529:     mysymbols = add_symbol (mysymbols, sy);
        !           530: }
        !           531: 
        !           532: /*    PASS2 */
        !           533: 
        !           534: pass2 () {
        !           535:     register SY            sy;
        !           536:     register YP            yp;
        !           537: 
        !           538:     if (!sflag)
        !           539:        (void) fflush (stderr);
        !           540: 
        !           541:     if (bflag) {
        !           542:        register int    i,
        !           543:                        j;
        !           544: 
        !           545:        i = 2, j = 10;
        !           546:        for (sy = mysymbols; sy; sy = sy -> sy_next)
        !           547:            if (!(sy -> sy_type -> yp_flags & YP_IMPORTED))
        !           548:                if (++i >= j)
        !           549:                    bwidth++, j *= 10;
        !           550:     }
        !           551:     else
        !           552:        prologue2 ();
        !           553: 
        !           554:     if (strcmp (mymodule, "UNIV"))
        !           555:        (void) lookup_module ("UNIV", NULLOID);
        !           556: 
        !           557:     for (sy = mysymbols; sy; sy = sy -> sy_next) {
        !           558:        eval = sy -> sy_name;
        !           559:        yp = sy -> sy_type;
        !           560:        if (sy -> sy_module == NULLCP)
        !           561:            yyerror ("no module name associated with symbol");
        !           562:        if (yp -> yp_flags & YP_IMPORTED)
        !           563:            continue;
        !           564: 
        !           565:        if (yp -> yp_direction & YP_ENCODER) {
        !           566:            if (bflag)
        !           567:                init_new_file ();
        !           568:            yyprefix = sy -> sy_encpref;
        !           569:            printf ("\n/* ARGSUSED */\n\n%sint\t%s ",
        !           570:                    !doexternals && (yp -> yp_flags & YP_EXPORTED) ?
        !           571:                    "static " : "",
        !           572:                    modsym (sy -> sy_module,
        !           573:                    sy -> sy_name, YP_ENCODER));
        !           574:            do_type (yp, 1, eval, "(*pe)");
        !           575:            printf ("\n    return OK;\n}\n");
        !           576:            if (bflag)
        !           577:                end_file ();
        !           578:        }
        !           579:        if (yp -> yp_direction & YP_DECODER) {
        !           580:            if (bflag)
        !           581:                init_new_file ();
        !           582:            yyprefix = sy -> sy_decpref;
        !           583:            printf ("\n/* ARGSUSED */\n\n%sint\t%s ",
        !           584:                    !doexternals && (yp -> yp_flags & YP_EXPORTED) ?
        !           585:                    "static " : "",
        !           586:                    modsym (sy -> sy_module,
        !           587:                    sy -> sy_name, YP_DECODER));
        !           588:            undo_type (yp, 1, eval, "pe", 0);
        !           589:            printf ("\n    return OK;\n}\n");
        !           590:            if (bflag)
        !           591:                end_file ();
        !           592:        }
        !           593:        if (yp -> yp_direction & YP_PRINTER) {
        !           594:            if (bflag)
        !           595:                init_new_file ();
        !           596:            yyprefix = sy -> sy_prfpref;
        !           597:            printf ("\n/* ARGSUSED */\n\n%sint\t%s ",
        !           598:                    !doexternals && (yp -> yp_flags & YP_EXPORTED) ?
        !           599:                    "static " : "",
        !           600:                    modsym (sy -> sy_module,
        !           601:                    sy -> sy_name, YP_PRINTER));
        !           602:            undo_type (yp, 1, eval, "pe", 1);
        !           603:            printf ("\n    return OK;\n}\n");
        !           604:            if (bflag)
        !           605:                end_file ();
        !           606:        }
        !           607:        if (!bflag && ferror (stdout))
        !           608:            myyerror ("write error - %s", sys_errname (errno));
        !           609:     }
        !           610: 
        !           611:     write_ph_file ();
        !           612: }
        !           613: 
        !           614: static prologue2 ()
        !           615: {
        !           616:     printf("\n#ifndef PEPYPARM\n#define PEPYPARM char *\n");
        !           617:     printf ("#endif /* PEPYPARM */\n"); /* keep ansi happy ... */
        !           618:     printf("extern PEPYPARM NullParm;\n");
        !           619: }
        !           620: 
        !           621: /*  */
        !           622: 
        !           623: struct tuple tuples[] = {
        !           624:        YP_BOOL, "PE_CLASS_UNIV", "PE_FORM_PRIM", "PE_PRIM_BOOL",
        !           625:                PE_CLASS_UNIV, PE_PRIM_BOOL,
        !           626:        YP_INT, "PE_CLASS_UNIV", "PE_FORM_PRIM", "PE_PRIM_INT",
        !           627:                PE_CLASS_UNIV, PE_PRIM_INT,
        !           628:        YP_INTLIST, "PE_CLASS_UNIV", "PE_FORM_PRIM", "PE_PRIM_INT",
        !           629:                PE_CLASS_UNIV, PE_PRIM_INT,
        !           630:        YP_BIT, "PE_CLASS_UNIV", NULLCP, "PE_PRIM_BITS",
        !           631:                PE_CLASS_UNIV, PE_PRIM_BITS,
        !           632:        YP_BITLIST, "PE_CLASS_UNIV", NULLCP, "PE_PRIM_BITS",
        !           633:                PE_CLASS_UNIV, PE_PRIM_BITS,
        !           634:        YP_OCT, "PE_CLASS_UNIV", NULLCP, "PE_PRIM_OCTS",
        !           635:                PE_CLASS_UNIV, PE_PRIM_OCTS,
        !           636:        YP_NULL, "PE_CLASS_UNIV", NULLCP, "PE_PRIM_NULL",
        !           637:                PE_CLASS_UNIV, PE_PRIM_NULL,
        !           638:        YP_OID, "PE_CLASS_UNIV", "PE_FORM_PRIM", "PE_PRIM_OID",
        !           639:                PE_CLASS_UNIV, PE_PRIM_OID,
        !           640:        YP_SEQ, "PE_CLASS_UNIV", "PE_FORM_CONS", "PE_CONS_SEQ",
        !           641:                PE_CLASS_UNIV, PE_CONS_SEQ,
        !           642:        YP_SEQTYPE, "PE_CLASS_UNIV", "PE_FORM_CONS", "PE_CONS_SEQ",
        !           643:                PE_CLASS_UNIV, PE_CONS_SEQ,
        !           644:        YP_SEQLIST, "PE_CLASS_UNIV", "PE_FORM_CONS", "PE_CONS_SEQ",
        !           645:                PE_CLASS_UNIV, PE_CONS_SEQ,
        !           646:        YP_SET, "PE_CLASS_UNIV", "PE_FORM_CONS", "PE_CONS_SET",
        !           647:                PE_CLASS_UNIV, PE_CONS_SET,
        !           648:        YP_SETTYPE, "PE_CLASS_UNIV", "PE_FORM_CONS", "PE_CONS_SET",
        !           649:                PE_CLASS_UNIV, PE_CONS_SET,
        !           650:        YP_SETLIST, "PE_CLASS_UNIV", "PE_FORM_CONS", "PE_CONS_SET",
        !           651:                PE_CLASS_UNIV, PE_CONS_SET,
        !           652:        YP_ENUMLIST, "PE_CLASS_UNIV", "PE_FORM_PRIM", "PE_PRIM_ENUM",
        !           653:                PE_CLASS_UNIV, PE_PRIM_ENUM,
        !           654:        YP_REAL,     "PE_CLASS_UNIV", "PE_FORM_PRIM", "PE_PRIM_REAL",
        !           655:                PE_CLASS_UNIV, PE_PRIM_REAL,
        !           656: 
        !           657:        YP_UNDF
        !           658: };
        !           659: 
        !           660: /*    PULLUP */
        !           661: 
        !           662: choice_pullup (yp, partial)
        !           663: register YP    yp;
        !           664: int    partial;        /* pullup fully, or just enough? */
        !           665: {
        !           666:     register YP           *x,
        !           667:                    y,
        !           668:                    z,
        !           669:                   *z1,
        !           670:                    z2,
        !           671:                    z3;
        !           672: 
        !           673:     for (x = &yp -> yp_type; y = *x; x = &y -> yp_next) {
        !           674:        if (y -> yp_flags & (YP_TAG | YP_BOUND))
        !           675:            continue;
        !           676: 
        !           677:        switch (y -> yp_code) {
        !           678:            case YP_IDEFINED:
        !           679:                if (partial)
        !           680:                    continue;
        !           681:                if ((z = lookup_type (y -> yp_module, y -> yp_identifier))
        !           682:                        == NULLYP
        !           683:                        || z -> yp_code != YP_CHOICE)
        !           684:                    continue;
        !           685: 
        !           686:                choice_pullup (z2 = copy_type (z), partial);
        !           687:                break;
        !           688: 
        !           689:            case YP_CHOICE:
        !           690:                choice_pullup (z2 = copy_type (y), partial);
        !           691:                break;
        !           692: 
        !           693:            default:
        !           694:                continue;
        !           695:        }
        !           696:        z = z3 = z2 -> yp_type;
        !           697:        for (z1 = &z -> yp_next; z2 = *z1; z1 = &z2 -> yp_next)
        !           698:            z3 = z2;
        !           699:        *z1 = y -> yp_next;
        !           700:        *x = z;
        !           701:        y = z3;
        !           702:     }
        !           703: }
        !           704: 
        !           705: /*  */
        !           706: 
        !           707: tag_pullup (yp, level, arg, whatsit)
        !           708: register YP    yp;
        !           709: register int   level;
        !           710: char   *arg,
        !           711:        *whatsit;
        !           712: {
        !           713:     char   *narg;
        !           714:     char   *id = yp -> yp_flags & YP_ID ? yp -> yp_id : "member";
        !           715: 
        !           716:     printf ("%*s{\t/* %s TAG PULLUP */\n%*sregister PE %s;\n\n",
        !           717:            level * 4, "", whatsit, (level + 1) * 4, "", narg = gensym ());
        !           718:     level++;
        !           719: 
        !           720:     printf ("%*sif ((%s = prim2set (%s)) == NULLPE) {\n",
        !           721:            level * 4, "", narg, arg);
        !           722:     printf ("%*sadvise (NULLCP, \"%s %%s%s: %%s\", PEPY_ERR_BAD,\n",
        !           723:            (level + 1) * 4, "", id, whatsit);
        !           724:     printf ("%*spe_error (%s -> pe_errno));\n",
        !           725:            (level + 3) * 4, "", arg);
        !           726:     printf ("%*sreturn NOTOK;\n%*s}\n",
        !           727:            (level + 1) * 4, "", level * 4, "");
        !           728:     printf ("%*sif (%s -> pe_cardinal != 1) {\n",
        !           729:            level * 4, "", narg);
        !           730:     printf ("%*sadvise (NULLCP, \"%s %%s %s: %%d\", PEPY_ERR_TOO_MANY_TAGGED,\n",
        !           731:            (level + 1) * 4, "", id, whatsit);
        !           732:     printf ("%*s%s -> pe_cardinal);\n", (level + 3) * 4, "", narg);
        !           733:     printf ("%*sreturn NOTOK;\n%*s}\n",
        !           734:            (level + 1) * 4, "", level * 4, "");
        !           735:     printf ("%*s%s = first_member (%s);\n%*s}\n",
        !           736:            level * 4, "", arg, narg, (level - 1) * 4, "");
        !           737: }
        !           738: 
        !           739: 
        !           740: tag_pushdown (yp, level, arg, whatsit)
        !           741: register YP     yp;
        !           742: register int    level;
        !           743: char   *arg,
        !           744:        *whatsit;
        !           745: {
        !           746:     char   *narg;
        !           747: 
        !           748:     printf ("%*s{\t/* %s TAG PUSHDOWN */\n%*sPE %s_z;\n",
        !           749:            level * 4, "", whatsit, (level + 1) * 4, "", narg = gensym ());
        !           750:     level++;
        !           751:     printf ("%*sregister PE *%s = &%s_z;\n\n", level * 4, "", narg, narg);
        !           752: 
        !           753:     printf ("%*sif ((*%s = pe_alloc (PE_CLASS_%s, PE_FORM_CONS, %d)) == NULLPE) {\n",
        !           754:            level * 4, "", narg, pe_classlist[yp -> yp_tag -> yt_class],
        !           755:            val2int (yp -> yp_tag -> yt_value));
        !           756:     printf ("%*sadvise (NULLCP, \"%s: %%s\", PEPY_ERR_NOMEM);\n",
        !           757:            (level + 1) * 4, "", whatsit);
        !           758:     printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "", level * 4, "");
        !           759:     printf ("%*s(*%s) -> pe_cons = %s;\n", level * 4, "", narg, arg);
        !           760:     printf ("%*s%s = *%s;\n", level * 4, "", arg, narg);
        !           761: 
        !           762:     level--;
        !           763:     printf ("%*s}\n", level * 4, "");
        !           764: }
        !           765: 
        !           766: /*    TYPE HANDLING */
        !           767: 
        !           768: tag_type (yp)
        !           769: register YP    yp;
        !           770: {
        !           771:     register struct tuple *t;
        !           772:     register YT            yt;
        !           773:     register YP            y;
        !           774: 
        !           775:     switch (yp -> yp_code) {
        !           776:        case YP_IDEFINED:
        !           777:            if (yp -> yp_flags & YP_BOUND) {
        !           778:                if ((y = lookup_binding (yp -> yp_module, yp -> yp_identifier,
        !           779:                            yp -> yp_bound)) == NULLYP)
        !           780:                    myyerror ("type \"%s\" isn't defined for binding",
        !           781:                            yp -> yp_identifier);
        !           782:                if (!(y -> yp_flags & YP_TAG))
        !           783:                    myyerror ("type \"%s\" isn't tagged for binding",
        !           784:                            yp -> yp_identifier);
        !           785:                yp -> yp_flags |= YP_TAG;
        !           786:                yp -> yp_tag = copy_tag (y -> yp_tag);
        !           787:                return;
        !           788:            }
        !           789: 
        !           790:            if (yt = lookup_tag (yp)) {
        !           791:                yp -> yp_flags |= YP_TAG | YP_IMPLICIT;
        !           792:                yp -> yp_tag = copy_tag (yt);
        !           793:                return;
        !           794:            }
        !           795:            if (!lookup_type (yp -> yp_module, yp -> yp_identifier))
        !           796:                pyyerror (yp, "don't know how to tag an undefined type");
        !           797:            break;
        !           798: 
        !           799:        default:
        !           800:            for (t = tuples; t ->t_type != YP_UNDF; t++)
        !           801:                if (t -> t_type == yp -> yp_code) {
        !           802:                    yp -> yp_flags |= YP_TAG | YP_IMPLICIT;
        !           803:                    yp -> yp_tag = new_tag (t -> t_classnum);
        !           804:                    yp -> yp_tag -> yt_value = new_value (YV_NUMBER);
        !           805:                    yp -> yp_tag -> yt_value -> yv_number = t -> t_idnum;
        !           806:                    return;
        !           807:                }
        !           808:            break;
        !           809:     }
        !           810: 
        !           811:     pyyerror (yp, "don't know how to do a set/choice member that isn't tagged or bound");
        !           812: }
        !           813: 
        !           814: /*  */
        !           815: 
        !           816: YP  lookup_type (mod, id)
        !           817: register char *mod,
        !           818:              *id;
        !           819: {
        !           820:     register SY            sy;
        !           821: 
        !           822:     for (sy = mysymbols; sy; sy = sy -> sy_next) {
        !           823:        if (mod) {
        !           824:            if (strcmp (sy -> sy_module, mod))
        !           825:                continue;
        !           826:        }
        !           827:        else
        !           828:            if (strcmp (sy -> sy_module, mymodule)
        !           829:                    && strcmp (sy -> sy_module, "UNIV"))
        !           830:                continue;
        !           831: 
        !           832:        if (strcmp (sy -> sy_name, id) == 0)
        !           833:            return sy -> sy_type;
        !           834:     }
        !           835: 
        !           836:     return NULLYP;
        !           837: }
        !           838: 
        !           839: /*  */
        !           840: 
        !           841: static YP  lookup_binding (mod, id, binding)
        !           842: register char  *mod,
        !           843:               *id,
        !           844:               *binding;
        !           845: {
        !           846:     register YP            yp,
        !           847:                    z;
        !           848: 
        !           849:     if ((yp = lookup_type (mod, id)) == NULLYP)
        !           850:        return NULLYP;
        !           851: 
        !           852:     if (yp -> yp_code != YP_CHOICE)
        !           853:        myyerror ("type \"%s\" isn't a CHOICE type", id);
        !           854:     for (z = yp -> yp_type; z; z = z -> yp_next)
        !           855:        if ((z -> yp_flags & YP_ID)
        !           856:                && strcmp (z -> yp_id, binding) == 0)
        !           857:            return z;
        !           858: 
        !           859:     myyerror ("type \"%s\" doesn't bind \"%s\"", id, binding);
        !           860: /* NOTREACHED */
        !           861: }
        !           862: 
        !           863: /*  */
        !           864: 
        !           865: check_type (type, level, class, form, id, arg)
        !           866: register char  *type,
        !           867:               *class,
        !           868:               *form,
        !           869:               *id,
        !           870:               *arg;
        !           871: register int   level;
        !           872: {
        !           873:     int            explicit;
        !           874: 
        !           875:     if (level == 1) {
        !           876:        printf ("%*sif (explicit) {\n", level * 4, ""), level++;
        !           877:        explicit = 1;
        !           878:     }
        !           879:     else
        !           880:        explicit = 0;
        !           881: 
        !           882:     printf ("%*sif (%s -> pe_class != %s", level * 4, "", arg, class);
        !           883:     if (form)
        !           884:        printf ("\n%*s|| %s -> pe_form != %s\n%*s",
        !           885:                (level + 2) * 4, "", arg, form, (level + 2) * 4 - 1, "");
        !           886:     printf (" || %s -> pe_id != %s) {\n", arg, id);
        !           887:     printf ("%*sadvise (NULLCP, \"%s bad class/form/id: %%s/%%d/0x%%x\",\n",
        !           888:            (level + 1) * 4, "", type);
        !           889:     printf ("%*spe_classlist[%s -> pe_class], %s -> pe_form, %s -> pe_id);\n",
        !           890:            (level + 3) * 4, "", arg, arg, arg);
        !           891:     printf ("%*sreturn NOTOK;\n%*s}\n",
        !           892:            (level + 1) * 4, "", level * 4, "");
        !           893: 
        !           894:     if (explicit) {
        !           895:        level--, printf ("%*s}\n", level * 4, "");
        !           896:        if (form) {
        !           897:            printf ("%*selse\n%*sif (%s -> pe_form != %s) {\n",
        !           898:                    level * 4, "", (level + 1) * 4, "", arg, form);
        !           899:            printf ("%*sadvise (NULLCP, \"%s bad form: %%d\", %s -> pe_form);\n",
        !           900:                    (level + 2) * 4, "", type, arg);
        !           901:            printf ("%*sreturn NOTOK;\n%*s}\n",
        !           902:                    (level + 2) * 4, "", (level + 1) * 4, "");
        !           903:        }
        !           904:     }
        !           905: 
        !           906:     printf ("\n");
        !           907: }
        !           908: 
        !           909: /*  */
        !           910: 
        !           911: int  is_any_type (yp)
        !           912: register YP    yp;
        !           913: {
        !           914:     register    YP z;
        !           915: 
        !           916:     while (yp -> yp_code == YP_IDEFINED) {
        !           917:        if (yp -> yp_flags & YP_TAG)
        !           918:            return 0;
        !           919: 
        !           920:        if (yp -> yp_module && strcmp (yp -> yp_module, mymodule))
        !           921:            (void) lookup_module (yp -> yp_module, yp -> yp_modid);
        !           922: 
        !           923:        if (z = lookup_type (yp -> yp_module, yp -> yp_identifier)) {
        !           924:            yp = z;
        !           925: 
        !           926:            continue;
        !           927:        }
        !           928: 
        !           929:        break;
        !           930:     }
        !           931: 
        !           932:     return (yp -> yp_code == YP_ANY && !(yp -> yp_flags & YP_TAG));
        !           933: }
        !           934: 
        !           935: int  is_nonimplicit_type (yp)
        !           936: register YP    yp;
        !           937: {
        !           938:     register    YP z;
        !           939: 
        !           940:     while (yp -> yp_code == YP_IDEFINED) {
        !           941:        if ((yp -> yp_flags & (YP_TAG | YP_IMPLICIT)) ==
        !           942:            (YP_TAG))
        !           943:            return 0;
        !           944: 
        !           945:        if (yp -> yp_module && strcmp (yp -> yp_module, mymodule))
        !           946:            (void) lookup_module (yp -> yp_module, yp -> yp_modid);
        !           947: 
        !           948:        if (z = lookup_type (yp -> yp_module, yp -> yp_identifier)) {
        !           949:            yp = z;
        !           950: 
        !           951:            continue;
        !           952:        }
        !           953: 
        !           954:        break;
        !           955:     }
        !           956: 
        !           957:     if (yp -> yp_code == YP_CHOICE || yp -> yp_code == YP_ANY) {
        !           958:        if ((yp -> yp_flags & (YP_TAG | YP_IMPLICIT)) ==
        !           959:            YP_TAG)
        !           960:            return 0;
        !           961:        return 1;
        !           962:     }
        !           963:     return 0;
        !           964: }
        !           965: 
        !           966: /*  */
        !           967: 
        !           968: uniqint (yv)
        !           969: register YV    yv;
        !           970: {
        !           971:     register int    i;
        !           972:     register YV            y;
        !           973: 
        !           974:     for (; yv; yv = yv -> yv_next) {
        !           975:        i = val2int (yv);
        !           976: 
        !           977:        for (y = yv -> yv_next; y; y = y -> yv_next)
        !           978:            if (i == val2int (y)) {
        !           979:                warning ("non-unique values in list");
        !           980:                fprintf (stderr, "\tvalue=%d", i);
        !           981:                if (yv -> yv_flags & YV_NAMED)
        !           982:                    fprintf (stderr, " name1=%s", yv -> yv_named);
        !           983:                if (y -> yv_flags & YV_NAMED)
        !           984:                    fprintf (stderr, " name2=%s", y -> yv_named);
        !           985:                fprintf (stderr, "\n");
        !           986:            }
        !           987:     }
        !           988: }
        !           989: 
        !           990: /*  */
        !           991: 
        !           992: uniqtag (y, z)
        !           993: register YP    y,
        !           994:                z;
        !           995: {
        !           996:     int     i;
        !           997:     register int    id;
        !           998:     register    YT yt;
        !           999:     register    YP yp;
        !          1000: 
        !          1001:     for (; y != z; y = y -> yp_next) {
        !          1002:        if ((yt = lookup_tag (y)) == NULLYT)
        !          1003:            continue;
        !          1004: 
        !          1005:        id = PE_ID (yt -> yt_class, i = val2int (yt -> yt_value));
        !          1006: 
        !          1007:        for (yp = y -> yp_next; yp != z; yp = yp -> yp_next) {
        !          1008:            if ((yt = lookup_tag (yp)) == NULLYT)
        !          1009:                continue;
        !          1010: 
        !          1011:            if (id == PE_ID (yt -> yt_class, val2int (yt -> yt_value))) {
        !          1012:                warning ("non-unique tags in list");
        !          1013:                fprintf (stderr, "\ttag=%s/%d", pe_classlist[yt -> yt_class],
        !          1014:                        i);
        !          1015:                if (y -> yp_code == YP_IDEFINED)
        !          1016:                    fprintf (stderr, " id1=%s", y -> yp_identifier);
        !          1017:                if (yp -> yp_code == YP_IDEFINED)
        !          1018:                    fprintf (stderr, " id2=%s", yp -> yp_identifier);
        !          1019:                fprintf (stderr, "\n");
        !          1020:            }
        !          1021:        }
        !          1022:     }
        !          1023: }
        !          1024: 
        !          1025: /*  */
        !          1026: 
        !          1027: int  val2int (yv)
        !          1028: register YV    yv;
        !          1029: {
        !          1030:     switch (yv -> yv_code) {
        !          1031:        case YV_BOOL:
        !          1032:        case YV_NUMBER:
        !          1033:            return yv -> yv_number;
        !          1034: 
        !          1035:        case YV_STRING:
        !          1036:            yyerror ("need an integer, not a string");
        !          1037: 
        !          1038:        case YV_IDEFINED:
        !          1039:        case YV_IDLIST:
        !          1040:            yyerror ("haven't written symbol table for values yet");
        !          1041: 
        !          1042:        case YV_VALIST:
        !          1043:            yyerror ("need an integer, not a list of values");
        !          1044: 
        !          1045:        case YV_NULL:
        !          1046:            yyerror ("need an integer, not NULL");
        !          1047: 
        !          1048:        default:
        !          1049:            myyerror ("unknown value: %d", yv -> yv_code);
        !          1050:     }
        !          1051: /* NOTREACHED */
        !          1052: }
        !          1053: 
        !          1054: /*    PH FILES */
        !          1055: 
        !          1056: /* really need much more information in the .ph file... */
        !          1057: 
        !          1058: static read_ph_file (module, oid)
        !          1059: register char *module;
        !          1060: OID    oid;
        !          1061: {
        !          1062:     int     class,
        !          1063:            value,
        !          1064:            direction;
        !          1065:     char    buffer[BUFSIZ],
        !          1066:            file[BUFSIZ],
        !          1067:            id[BUFSIZ],
        !          1068:            encpref[BUFSIZ],
        !          1069:            decpref[BUFSIZ],
        !          1070:            printpref[BUFSIZ];
        !          1071:     char    *p, *ep, *dp, *ppp;
        !          1072:     register FILE  *fp;
        !          1073:     register YP            yp;
        !          1074:     register YT            yt;
        !          1075:     register YV            yv;
        !          1076: 
        !          1077:     (void) sprintf (file, "%s.ph", module);
        !          1078:     if (oid)
        !          1079:        (void) sprintf (p = buffer, "%s.ph", sprintoid(oid));
        !          1080:     else
        !          1081:        p = NULLCP;
        !          1082:     if ((fp = open_ph_file (file, p, "r")) == NULL)
        !          1083:     {
        !          1084:        warning ("Can't find file %s%s%s failed\n",
        !          1085:                     file, p ? "/" : "", p ? p : "");
        !          1086:        return;
        !          1087:     }
        !          1088: 
        !          1089:     if (strcmp (module, "UNIV"))
        !          1090:        yyprint (module, 1, 0);
        !          1091: 
        !          1092:     while (fgets (buffer, sizeof buffer, fp)) {
        !          1093:        if (sscanf (buffer, "%d/%d/%d: %s",
        !          1094:                    &class, &value, &direction, id) !=4) {
        !          1095:            myyerror ("bad external definition in %s: %s",
        !          1096:                    file, buffer);
        !          1097:            continue;
        !          1098:        }
        !          1099:        ppp = dp = ep = NULLCP;
        !          1100:        if (p = index(buffer, '|')) {
        !          1101:            if( sscanf (p+1, "%s %s %s\n", encpref, decpref, printpref) == 3) {
        !          1102:                ppp = new_string (printpref);
        !          1103:                dp = new_string (decpref);
        !          1104:                ep = new_string (encpref);
        !          1105:            }
        !          1106:        }
        !          1107:                
        !          1108:        yp = new_type (YP_ANY);
        !          1109:        yp -> yp_flags = YP_IMPORTED;
        !          1110:        if (class >= 0) {
        !          1111:            yp -> yp_flags |= YP_TAG;
        !          1112:            yp -> yp_tag = yt = new_tag ((PElementClass) class);
        !          1113:            yt -> yt_value = yv = new_value (YV_NUMBER);
        !          1114:            yv -> yv_number = value;
        !          1115:        }
        !          1116:        yp -> yp_direction = direction;
        !          1117:        pass1_type (ep, dp, ppp, new_string (module),
        !          1118:                new_string (id), yp);
        !          1119:     }
        !          1120: 
        !          1121:     (void) fclose (fp);
        !          1122: }
        !          1123: 
        !          1124: /*  */
        !          1125: 
        !          1126: static write_ph_file () {
        !          1127:     int            msave;
        !          1128:     char    file[BUFSIZ];
        !          1129:     char    fileoid[BUFSIZ];
        !          1130:     char       *cp;
        !          1131:     register FILE  *fp;
        !          1132:     register SY            sy;
        !          1133:     register YT            yt;
        !          1134:     register YP            yp;
        !          1135: 
        !          1136:     (void) sprintf (file, "%s.ph", mymodule);
        !          1137:     if (mymoduleid)
        !          1138:        (void) sprintf (cp = fileoid, "%s.ph", sprintoid(mymoduleid));
        !          1139:     else
        !          1140:        cp = NULLCP;
        !          1141:     msave = mflag, mflag = 0;
        !          1142:     if ((fp = open_ph_file (file, cp, "w")) == NULL)
        !          1143:        myyerror ("unable to write %s", file);
        !          1144:     mflag = msave;
        !          1145: 
        !          1146:     for (sy = mysymbols; sy; sy = sy -> sy_next) {
        !          1147:        yp = sy -> sy_type;
        !          1148:        if (yp -> yp_flags & YP_IMPORTED)
        !          1149:            continue;
        !          1150:        if (doexternals == 0 && (yp->yp_flags & YP_EXPORTED) == 0)
        !          1151:            continue;
        !          1152: 
        !          1153:        if (is_any_type (yp)) {
        !          1154:            fprintf (fp, "-1/0/%d: %s", yp -> yp_direction, sy -> sy_name);
        !          1155:            fprintf (fp, " |%s %s %s\n", yyencpref, yydecpref, yyprfpref);
        !          1156:        }
        !          1157:        else
        !          1158:            if ((yt = lookup_tag (yp)) && yt -> yt_class != PE_CLASS_CONT) {
        !          1159:                fprintf (fp, "%d/%d/%d: %s", yt -> yt_class,
        !          1160:                            val2int (yt -> yt_value), yp -> yp_direction,
        !          1161:                            sy -> sy_name);
        !          1162:                fprintf (fp, " |%s %s %s\n", yyencpref, yydecpref, yyprfpref);
        !          1163:            }
        !          1164:     }
        !          1165: 
        !          1166:     (void) fclose (fp);
        !          1167: }
        !          1168: 
        !          1169: /*  */
        !          1170: 
        !          1171: #ifndef        PEPYPATH
        !          1172: #define        PEPYPATH        ""
        !          1173: #endif
        !          1174: 
        !          1175: 
        !          1176: static FILE *open_ph_file (fn, fnoid, mode)
        !          1177: char *fn,
        !          1178:      *fnoid,
        !          1179:      *mode;
        !          1180: {
        !          1181:     register char  *dst,
        !          1182:                   *path;
        !          1183:     char    fnb[BUFSIZ];
        !          1184:     register FILE  *fp;
        !          1185:     static char *pepypath = NULL;
        !          1186: 
        !          1187:     if (*fn == '/')
        !          1188:        return fopen (fn, mode);
        !          1189: 
        !          1190:     if (mflag) {       /* MOBY HACK */
        !          1191:        if (fnoid && (fp = fopen (fnoid, mode)) != NULL)
        !          1192:            return fp;
        !          1193:        if ((fp = fopen (fn, mode)) != NULL)
        !          1194:            return fp;
        !          1195: 
        !          1196:        if (fnoid) {
        !          1197:            (void) sprintf (fnb, "../pepy/%s", fnoid);
        !          1198:            if ((fp = fopen (fnb, mode)) != NULL)
        !          1199:                return fp;
        !          1200:        }
        !          1201:        (void) sprintf (fnb, "../pepy/%s", fn);
        !          1202:        if ((fp = fopen (fnb, mode)) != NULL)
        !          1203:            return fp;
        !          1204: 
        !          1205:        if (fnoid) {
        !          1206:            (void) sprintf (fnb, "../../pepy/%s", fnoid);
        !          1207:            if ((fp = fopen (fnb, mode)) != NULL)
        !          1208:                return fp;
        !          1209:        }
        !          1210:        (void) sprintf (fnb, "../../pepy/%s", fn);
        !          1211:        return fopen (fnb, mode);
        !          1212:     }
        !          1213: 
        !          1214:     if (pepypath == NULL && (pepypath = getenv ("PEPYPATH")) == NULL)
        !          1215:        pepypath = PEPYPATH;
        !          1216:     path = pepypath;
        !          1217: 
        !          1218:     do {
        !          1219:        dst = fnb;
        !          1220:        while (*path && *path != ':')
        !          1221:            *dst++ = *path++;
        !          1222:        if (dst != fnb)
        !          1223:            *dst++ = '/';
        !          1224:        if (fnoid) {
        !          1225:            (void) strcpy (dst, fnoid);
        !          1226:            if ((fp = fopen (fnb, mode)) != NULL)
        !          1227:                break;
        !          1228:        }
        !          1229:        (void) strcpy (dst, fn);
        !          1230:        if ((fp = fopen (fnb, mode)) != NULL)
        !          1231:            break;
        !          1232:     } while (*path++);
        !          1233: 
        !          1234:     return fp;
        !          1235: }
        !          1236: 
        !          1237: /*    PRETTY-PRINTING */
        !          1238: 
        !          1239: #define        S0      0
        !          1240: #define        S1      1
        !          1241: #define        S2      2
        !          1242: #define        S3      3
        !          1243: #define S4     4
        !          1244: #define S5     5
        !          1245: #define S6     6
        !          1246: #define S7     7
        !          1247: #define S8     8
        !          1248: #define S9     9
        !          1249: 
        !          1250: static int  pp () {
        !          1251:     register int    c,
        !          1252:                    s;
        !          1253:     register char  *bp,
        !          1254:                   *wp;
        !          1255:     char    buffer[BUFSIZ];
        !          1256: 
        !          1257:     for (s = S0, bp = buffer; (c = getchar ()) != EOF;)
        !          1258:        switch (s) {
        !          1259:            case S0:
        !          1260:                if (c == '%')
        !          1261:                    s = S1;
        !          1262:                else if (c == '<')
        !          1263:                    s = S4;
        !          1264:                else if (c == '[')
        !          1265:                    s = S7;
        !          1266:                else
        !          1267:                    if (isspace (c))
        !          1268:                        *bp++ = c;
        !          1269:                    else {
        !          1270: flush:         ;
        !          1271:                        if (bp != buffer) {
        !          1272:                            for (wp = buffer; wp < bp; wp++)
        !          1273:                                putchar (*wp);
        !          1274:                            bp = buffer;
        !          1275:                        }
        !          1276:                        putchar (c);
        !          1277:                    }
        !          1278:                break;
        !          1279: 
        !          1280:            case S1:
        !          1281:                if (c == '{') {
        !          1282:                    bp = buffer;
        !          1283:                    s = S2;
        !          1284:                    break;
        !          1285:                }
        !          1286:                *bp++ = '%';
        !          1287:                s = S0;
        !          1288:                goto flush;
        !          1289: 
        !          1290:            case S2:
        !          1291:                if (c == '%')
        !          1292:                    s = S3;
        !          1293:                break;
        !          1294: 
        !          1295:            case S3:
        !          1296:                s = c == '}' ? S0 : S2;
        !          1297:                break;
        !          1298: 
        !          1299:            case S4:
        !          1300:                if ( c == '<') {
        !          1301:                    bp = buffer;
        !          1302:                    s = S5;
        !          1303:                    break;
        !          1304:                }
        !          1305:                *bp++ = '<';
        !          1306:                s = S0;
        !          1307:                goto flush;
        !          1308: 
        !          1309:            case S5:
        !          1310:                if (c == '>')
        !          1311:                    s = S6;
        !          1312:                break;
        !          1313: 
        !          1314:            case S6:
        !          1315:                s = c == '>' ? S0 : S5;
        !          1316:                break;
        !          1317: 
        !          1318:            case S7:
        !          1319:                if ( c == '[') {
        !          1320:                    bp = buffer;
        !          1321:                    s = S8;
        !          1322:                    break;
        !          1323:                }
        !          1324:                *bp ++ = '[';
        !          1325:                s = S0;
        !          1326:                goto flush;
        !          1327: 
        !          1328:            case S8:
        !          1329:                if (c == ']')
        !          1330:                    s = S9;
        !          1331:                break;
        !          1332: 
        !          1333:            case S9:
        !          1334:                s = c == ']' ? S0 : S8;
        !          1335:                break;
        !          1336: 
        !          1337:            default:
        !          1338:                printf ("s=%d\n", s);
        !          1339:                break;
        !          1340:        }
        !          1341: 
        !          1342:     if (bp != buffer)
        !          1343:        for (wp = buffer; wp < bp; wp++)
        !          1344:            putchar (*wp);
        !          1345: 
        !          1346:     return 0;
        !          1347: }
        !          1348: 
        !          1349: /*    DEBUG */
        !          1350: 
        !          1351: print_type (yp, level)
        !          1352: register YP    yp;
        !          1353: register int   level;
        !          1354: {
        !          1355:     register YP            y;
        !          1356:     register YV            yv;
        !          1357: 
        !          1358:     if (yp == NULLYP)
        !          1359:        return;
        !          1360: 
        !          1361:     fprintf (stderr, "%*scode=0x%x flags=%s direction=0x%x\n", level * 4, "",
        !          1362:            yp -> yp_code, sprintb (yp -> yp_flags, YPBITS),
        !          1363:            yp -> yp_direction);
        !          1364:     fprintf (stderr,
        !          1365:            "%*sintexp=\"%s\" strexp=\"%s\" prfexp=%c declexp=\"%s\" varexp=\"%s\"\n",
        !          1366:            level * 4, "", yp -> yp_intexp, yp -> yp_strexp, yp -> yp_prfexp,
        !          1367:            yp -> yp_declexp, yp -> yp_varexp);
        !          1368:     if (yp -> yp_param_type)
        !          1369:        fprintf (stderr, "%*sparameter type=\"%s\"\n", level * 4, "",
        !          1370:                 yp -> yp_param_type);
        !          1371:     if (yp -> yp_action0)
        !          1372:        fprintf (stderr, "%*saction0 at line %d=\"%s\"\n", level * 4, "",
        !          1373:                yp -> yp_act0_lineno, yp -> yp_action0);
        !          1374:     if (yp -> yp_action05)
        !          1375:        fprintf (stderr, "%*saction05 at line %d=\"%s\"\n", level * 4, "",
        !          1376:                yp -> yp_act05_lineno, yp -> yp_action05);
        !          1377:     if (yp -> yp_action1)
        !          1378:        fprintf (stderr, "%*saction1 at line %d=\"%s\"\n", level * 4, "",
        !          1379:                yp -> yp_act1_lineno, yp -> yp_action1);
        !          1380:     if (yp -> yp_action2)
        !          1381:        fprintf (stderr, "%*saction2 at line %d=\"%s\"\n", level * 4, "",
        !          1382:                yp -> yp_act2_lineno, yp -> yp_action2);
        !          1383:     if (yp -> yp_action3)
        !          1384:        fprintf (stderr, "%*saction3 at line %d=\"%s\"\n", level * 4, "",
        !          1385:                yp -> yp_act3_lineno, yp -> yp_action3);
        !          1386: 
        !          1387:     if (yp -> yp_flags & YP_TAG) {
        !          1388:        fprintf (stderr, "%*stag class=0x%x value=0x%x\n", level * 4, "",
        !          1389:                yp -> yp_tag -> yt_class, yp -> yp_tag -> yt_value);
        !          1390:        print_value (yp -> yp_tag -> yt_value, level + 1);
        !          1391:     }
        !          1392: 
        !          1393:     if (yp -> yp_flags & YP_DEFAULT) {
        !          1394:        fprintf (stderr, "%*sdefault=0x%x\n", level * 4, "", yp -> yp_default);
        !          1395:        print_value (yp -> yp_default, level + 1);
        !          1396:     }
        !          1397: 
        !          1398:     if (yp -> yp_flags & YP_ID)
        !          1399:        fprintf (stderr, "%*sid=\"%s\"\n", level * 4, "", yp -> yp_id);
        !          1400: 
        !          1401:     if (yp -> yp_flags & YP_BOUND)
        !          1402:        fprintf (stderr, "%*sbound=\"%s\"\n", level * 4, "", yp -> yp_bound);
        !          1403: 
        !          1404:     if (yp -> yp_offset)
        !          1405:        fprintf (stderr, "%*soffset=\"%s\"\n", level * 4, "", yp -> yp_offset);
        !          1406: 
        !          1407:     switch (yp -> yp_code) {
        !          1408:        case YP_INTLIST:
        !          1409:        case YP_BITLIST:
        !          1410:            fprintf (stderr, "%*svalue=0x%x\n", level * 4, "", yp -> yp_value);
        !          1411:            for (yv = yp -> yp_value; yv; yv = yv -> yv_next) {
        !          1412:                print_value (yv, level + 1);
        !          1413:                fprintf (stderr, "%*s----\n", (level + 1) * 4, "");
        !          1414:            }
        !          1415:            break;
        !          1416: 
        !          1417:        case YP_SEQTYPE:
        !          1418:        case YP_SEQLIST:
        !          1419:        case YP_SETTYPE:
        !          1420:        case YP_SETLIST:
        !          1421:        case YP_CHOICE:
        !          1422:            fprintf (stderr, "%*stype=0x%x\n", level * 4, "", yp -> yp_type);
        !          1423:            for (y = yp -> yp_type; y; y = y -> yp_next) {
        !          1424:                print_type (y, level + 1);
        !          1425:                fprintf (stderr, "%*s----\n", (level + 1) * 4, "");
        !          1426:            }
        !          1427:            break;
        !          1428: 
        !          1429:        case YP_IDEFINED:
        !          1430:            fprintf (stderr, "%*smodule=\"%s\" identifier=\"%s\"\n",
        !          1431:                    level * 4, "", yp -> yp_module ? yp -> yp_module : "",
        !          1432:                    yp -> yp_identifier);
        !          1433:            break;
        !          1434: 
        !          1435:        default:
        !          1436:            break;
        !          1437:     }
        !          1438: }
        !          1439: 
        !          1440: /*  */
        !          1441: 
        !          1442: static print_value (yv, level)
        !          1443: register YV    yv;
        !          1444: register int   level;
        !          1445: {
        !          1446:     register YV            y;
        !          1447: 
        !          1448:     if (yv == NULLYV)
        !          1449:        return;
        !          1450: 
        !          1451:     fprintf (stderr, "%*scode=0x%x flags=%s\n", level * 4, "",
        !          1452:            yv -> yv_code, sprintb (yv -> yv_flags, YVBITS));
        !          1453: 
        !          1454:     if (yv -> yv_action)
        !          1455:        fprintf (stderr, "%*saction at line %d=\"%s\"\n", level * 4, "",
        !          1456:                yv -> yv_act_lineno, yv -> yv_action);
        !          1457: 
        !          1458:     if (yv -> yv_flags & YV_ID)
        !          1459:        fprintf (stderr, "%*sid=\"%s\"\n", level * 4, "", yv -> yv_id);
        !          1460: 
        !          1461:     if (yv -> yv_flags & YV_NAMED)
        !          1462:        fprintf (stderr, "%*snamed=\"%s\"\n", level * 4, "", yv -> yv_named);
        !          1463: 
        !          1464:     if (yv -> yv_flags & YV_TYPE) {
        !          1465:        fprintf (stderr, "%*stype=0x%x\n", level * 4, "", yv -> yv_type);
        !          1466:        print_type (yv -> yv_type, level + 1);
        !          1467:     }
        !          1468: 
        !          1469:     switch (yv -> yv_code) {
        !          1470:        case YV_NUMBER:
        !          1471:        case YV_BOOL:
        !          1472:            fprintf (stderr, "%*snumber=0x%x\n", level * 4, "",
        !          1473:                    yv -> yv_number);
        !          1474:            break;
        !          1475: 
        !          1476:        case YV_STRING:
        !          1477:            fprintf (stderr, "%*sstring=0x%x\n", level * 4, "",
        !          1478:                    yv -> yv_string);
        !          1479:            break;
        !          1480: 
        !          1481:        case YV_IDEFINED:
        !          1482:            if (yv -> yv_flags & YV_BOUND)
        !          1483:                fprintf (stderr, "%*smodule=\"%s\" identifier=\"%s\"\n",
        !          1484:                        level * 4, "", yv -> yv_module, yv -> yv_identifier);
        !          1485:            else
        !          1486:                fprintf (stderr, "%*sbound identifier=\"%s\"\n",
        !          1487:                        level * 4, "", yv -> yv_identifier);
        !          1488:            break;
        !          1489: 
        !          1490:        case YV_IDLIST:
        !          1491:        case YV_VALIST:
        !          1492:            for (y = yv -> yv_idlist; y; y = y -> yv_next) {
        !          1493:                print_value (y, level + 1);
        !          1494:                fprintf (stderr, "%*s----\n", (level + 1) * 4, "");
        !          1495:            }
        !          1496:            break;
        !          1497: 
        !          1498:        default:
        !          1499:            break;
        !          1500:     }
        !          1501: }
        !          1502: 
        !          1503: /*    SYMBOLS */
        !          1504: 
        !          1505: static SY  new_symbol (encpref, decpref, prfpref, mod, id, type)
        !          1506: register char  *encpref,
        !          1507:               *decpref,
        !          1508:               *prfpref,
        !          1509:               *mod,
        !          1510:               *id;
        !          1511: register YP    type;
        !          1512: {
        !          1513:     register SY    sy;
        !          1514: 
        !          1515:     if ((sy = (SY) calloc (1, sizeof *sy)) == NULLSY)
        !          1516:        yyerror ("out of memory");
        !          1517:     sy -> sy_encpref = encpref;
        !          1518:     sy -> sy_decpref = decpref;
        !          1519:     sy -> sy_prfpref = prfpref;
        !          1520:     sy -> sy_module = mod;
        !          1521:     sy -> sy_name = id;
        !          1522:     sy -> sy_type = type;
        !          1523: 
        !          1524:     return sy;
        !          1525: }
        !          1526: 
        !          1527: 
        !          1528: static SY  add_symbol (s1, s2)
        !          1529: register SY    s1,
        !          1530:                s2;
        !          1531: {
        !          1532:     register SY            sy;
        !          1533: 
        !          1534:     if (s1 == NULLSY)
        !          1535:        return s2;
        !          1536: 
        !          1537:     for (sy = s1; sy -> sy_next; sy = sy -> sy_next)
        !          1538:        continue;
        !          1539:     sy -> sy_next = s2;
        !          1540: 
        !          1541:     return s1;
        !          1542: }
        !          1543: 
        !          1544: /*    MODULES */
        !          1545: 
        !          1546: static MD  lookup_module (module, oid)
        !          1547: char   *module;
        !          1548: OID    oid;
        !          1549: {
        !          1550:     register MD            md;
        !          1551: 
        !          1552:     for (md = mymodules; md; md = md -> md_next) {
        !          1553:        if (module && md -> md_module && strcmp (md -> md_module, module) == 0)
        !          1554:            return md;
        !          1555:        if (oid && md -> md_oid && oid_cmp(oid, md->md_oid) == 0)
        !          1556:            return md;
        !          1557:     }
        !          1558: 
        !          1559:     read_ph_file (module, oid);
        !          1560: 
        !          1561:     if ((md = (MD) calloc (1, sizeof *md)) == NULLMD)
        !          1562:        yyerror ("out of memory");
        !          1563:     md -> md_module = new_string (module);
        !          1564:     if (oid)
        !          1565:        md -> md_oid = oid_cpy(oid);
        !          1566:     else
        !          1567:        md -> md_oid = NULLOID;
        !          1568: 
        !          1569:     if (mymodules != NULLMD)
        !          1570:        md -> md_next = mymodules;
        !          1571: 
        !          1572:     return (mymodules = md);
        !          1573: }
        !          1574: 
        !          1575: /*    TYPES */
        !          1576: 
        !          1577: YP     new_type (code)
        !          1578: int    code;
        !          1579: {
        !          1580:     register YP    yp;
        !          1581: 
        !          1582:     if ((yp = (YP) calloc (1, sizeof *yp)) == NULLYP)
        !          1583:        yyerror ("out of memory");
        !          1584:     yp -> yp_code = code;
        !          1585: 
        !          1586:     return yp;
        !          1587: }
        !          1588: 
        !          1589: 
        !          1590: YP     add_type (y, z)
        !          1591: register YP    y,
        !          1592:                z;
        !          1593: {
        !          1594:     register YP            yp;
        !          1595: 
        !          1596:     for (yp = y; yp -> yp_next; yp = yp -> yp_next)
        !          1597:        continue;
        !          1598:     yp -> yp_next = z;
        !          1599: 
        !          1600:     return y;
        !          1601: }
        !          1602: 
        !          1603: /*  */
        !          1604: 
        !          1605: YP     copy_type (yp)
        !          1606: register YP    yp;
        !          1607: {
        !          1608:     register YP            y;
        !          1609: 
        !          1610:     if (yp == NULLYP)
        !          1611:        return NULLYP;
        !          1612: 
        !          1613:     y = new_type (yp -> yp_code);
        !          1614:     y -> yp_direction = yp -> yp_direction;
        !          1615: 
        !          1616:     switch (yp -> yp_code) {
        !          1617:        case YP_IDEFINED:
        !          1618:            if (yp -> yp_module)
        !          1619:                y -> yp_module = new_string (yp -> yp_module);
        !          1620:            y -> yp_identifier = new_string (yp -> yp_identifier);
        !          1621:            y -> yp_modid = oid_cpy (yp -> yp_modid);
        !          1622:            break;
        !          1623: 
        !          1624:        case YP_SEQTYPE:
        !          1625:        case YP_SEQLIST:
        !          1626:        case YP_SETTYPE:
        !          1627:        case YP_SETLIST:
        !          1628:        case YP_CHOICE:
        !          1629:            y -> yp_type = copy_type (yp -> yp_type);
        !          1630:            break;
        !          1631: 
        !          1632:        case YP_INTLIST:
        !          1633:        case YP_BITLIST:
        !          1634:            y -> yp_value = copy_value (yp -> yp_value);
        !          1635:            break;
        !          1636: 
        !          1637:        default:
        !          1638:            break;
        !          1639:     }
        !          1640: 
        !          1641:     y -> yp_intexp = yp -> yp_intexp;
        !          1642:     y -> yp_strexp = yp -> yp_strexp;
        !          1643:     y -> yp_prfexp = yp -> yp_prfexp;
        !          1644: 
        !          1645:     y -> yp_declexp = yp -> yp_declexp;
        !          1646:     y -> yp_varexp = yp -> yp_varexp;
        !          1647: 
        !          1648:     if (yp -> yp_structname)
        !          1649:        y -> yp_structname = new_string (yp -> yp_structname);
        !          1650:     if (yp -> yp_ptrname)
        !          1651:        y -> yp_ptrname = new_string (yp -> yp_ptrname);
        !          1652: 
        !          1653:     if (yp -> yp_param_type)
        !          1654:        y -> yp_param_type = new_string (yp -> yp_param_type);
        !          1655: 
        !          1656:     if (yp -> yp_action0) {
        !          1657:        y -> yp_action0 = new_string (yp -> yp_action0);
        !          1658:        y -> yp_act0_lineno = yp -> yp_act0_lineno;
        !          1659:     }
        !          1660: 
        !          1661:     if (yp -> yp_action05) {
        !          1662:        y -> yp_action05 = new_string (yp -> yp_action05);
        !          1663:        y -> yp_act05_lineno = yp -> yp_act05_lineno;
        !          1664:     }
        !          1665: 
        !          1666:     if (yp -> yp_action1) {
        !          1667:        y -> yp_action1 = new_string (yp -> yp_action1);
        !          1668:        y -> yp_act1_lineno = yp -> yp_act1_lineno;
        !          1669:     }
        !          1670: 
        !          1671:     if (yp -> yp_action2) {
        !          1672:        y -> yp_action2 = new_string (yp -> yp_action2);
        !          1673:        y -> yp_act2_lineno = yp -> yp_act2_lineno;
        !          1674:     }
        !          1675: 
        !          1676:     if (yp -> yp_action3) {
        !          1677:        y -> yp_action3 = new_string (yp -> yp_action3);
        !          1678:        y -> yp_act3_lineno = yp -> yp_act3_lineno;
        !          1679:     }
        !          1680: 
        !          1681:     y -> yp_flags = yp -> yp_flags;
        !          1682: 
        !          1683:     if (yp -> yp_flags & YP_DEFAULT)
        !          1684:        y -> yp_default = copy_value (yp -> yp_default);
        !          1685: 
        !          1686:     if (yp -> yp_flags & YP_ID)
        !          1687:        y -> yp_id = new_string (yp -> yp_id);
        !          1688: 
        !          1689:     if (yp -> yp_flags & YP_TAG)
        !          1690:        y -> yp_tag = copy_tag (yp -> yp_tag);
        !          1691: 
        !          1692:     if (yp -> yp_flags & YP_BOUND)
        !          1693:        y -> yp_bound = new_string (yp -> yp_bound);
        !          1694: 
        !          1695:     if (yp -> yp_flags & YP_PARMVAL)
        !          1696:        y -> yp_parm = new_string (yp -> yp_parm);
        !          1697: 
        !          1698:     if (yp -> yp_flags & YP_CONTROLLED)
        !          1699:         y -> yp_control = new_string (yp -> yp_control);
        !          1700: 
        !          1701:     if (yp -> yp_flags & YP_OPTCONTROL)
        !          1702:         y -> yp_optcontrol = new_string (yp -> yp_optcontrol);
        !          1703: 
        !          1704:     if (yp -> yp_offset)
        !          1705:        y -> yp_offset = new_string (yp -> yp_offset);
        !          1706: 
        !          1707:     if (yp -> yp_next)
        !          1708:        y -> yp_next = copy_type (yp -> yp_next);
        !          1709: 
        !          1710:     return y;
        !          1711: }
        !          1712: 
        !          1713: /*    VALUES */
        !          1714: 
        !          1715: YV     new_value (code)
        !          1716: int    code;
        !          1717: {
        !          1718:     register YV    yv;
        !          1719: 
        !          1720:     if ((yv = (YV) calloc (1, sizeof *yv)) == NULLYV)
        !          1721:        yyerror ("out of memory");
        !          1722:     yv -> yv_code = code;
        !          1723: 
        !          1724:     return yv;
        !          1725: }
        !          1726: 
        !          1727: 
        !          1728: YV     add_value (y, z)
        !          1729: register YV    y,
        !          1730:                z;
        !          1731: {
        !          1732:     register YV            yv;
        !          1733: 
        !          1734:     if (y == NULLYV)
        !          1735:        return z;
        !          1736: 
        !          1737:     if (z == NULLYV)
        !          1738:        return y;
        !          1739: 
        !          1740:     for (yv = y; yv -> yv_next; yv = yv -> yv_next)
        !          1741:        continue;
        !          1742:     yv -> yv_next = z;
        !          1743: 
        !          1744:     return y;
        !          1745: }
        !          1746: 
        !          1747: /*  */
        !          1748: 
        !          1749: YV     copy_value (yv)
        !          1750: register YV    yv;
        !          1751: {
        !          1752:     register YV            y;
        !          1753: 
        !          1754:     if (yv == NULLYV)
        !          1755:        return NULLYV;
        !          1756: 
        !          1757:     y = new_value (yv -> yv_code);
        !          1758:     y -> yv_flags = yv -> yv_flags;
        !          1759: 
        !          1760:     if (yv -> yv_action) {
        !          1761:        y -> yv_action = new_string (yv -> yv_action);
        !          1762:        y -> yv_act_lineno = yv -> yv_act_lineno;
        !          1763:     }
        !          1764: 
        !          1765:     if (yv -> yv_flags & YV_ID)
        !          1766:        y -> yv_id = new_string (yv -> yv_id);
        !          1767: 
        !          1768:     if (yv -> yv_flags & YV_NAMED)
        !          1769:        y -> yv_named = new_string (yv -> yv_named);
        !          1770: 
        !          1771:     if (yv -> yv_flags & YV_TYPE)
        !          1772:        y -> yv_type = copy_type (yv -> yv_type);
        !          1773: 
        !          1774:     switch (yv -> yv_code) {
        !          1775:        case YV_NUMBER:
        !          1776:        case YV_BOOL:
        !          1777:            y -> yv_number = yv -> yv_number;
        !          1778:            break;
        !          1779: 
        !          1780:        case YV_STRING:
        !          1781:            y -> yv_string = new_string (yv -> yv_string);
        !          1782:            break;
        !          1783: 
        !          1784:        case YV_IDEFINED:
        !          1785:            if (yv -> yv_module)
        !          1786:                y -> yv_module = new_string (yv -> yv_module);
        !          1787:            y -> yv_identifier = new_string (yv -> yv_identifier);
        !          1788:            break;
        !          1789: 
        !          1790:        case YV_IDLIST:
        !          1791:        case YV_VALIST:
        !          1792:            y -> yv_idlist = copy_value (yv -> yv_idlist);
        !          1793:            break;
        !          1794: 
        !          1795:        default:
        !          1796:            break;
        !          1797:     }
        !          1798: 
        !          1799:     if (yv -> yv_next)
        !          1800:        y -> yv_next = copy_value (yv -> yv_next);
        !          1801: 
        !          1802:     return y;
        !          1803: }
        !          1804: 
        !          1805: /*    TAGS */
        !          1806: 
        !          1807: YT     new_tag (class)
        !          1808: PElementClass  class;
        !          1809: {
        !          1810:     register YT    yt;
        !          1811: 
        !          1812:     if ((yt = (YT) calloc (1, sizeof *yt)) == NULLYT)
        !          1813:        yyerror ("out of memory");
        !          1814:     yt -> yt_class = class;
        !          1815: 
        !          1816:     return yt;
        !          1817: }
        !          1818: 
        !          1819: /*  */
        !          1820: 
        !          1821: YT     copy_tag (yt)
        !          1822: register YT    yt;
        !          1823: {
        !          1824:     register YT            y;
        !          1825: 
        !          1826:     if (yt == NULLYT)
        !          1827:        return NULLYT;
        !          1828: 
        !          1829:     y = new_tag (yt -> yt_class);
        !          1830: 
        !          1831:     y -> yt_value = copy_value (yt -> yt_value);
        !          1832: 
        !          1833:     return y;
        !          1834: }
        !          1835: 
        !          1836: /*  */
        !          1837: 
        !          1838: YT  lookup_tag (yp)
        !          1839: register YP    yp;
        !          1840: {
        !          1841:     register struct tuple *t;
        !          1842:     static struct ypt ypts;
        !          1843:     register YT            yt = &ypts;
        !          1844:     static struct ypv ypvs;
        !          1845:     register YV            yv = &ypvs;
        !          1846:     register YP            z;
        !          1847: 
        !          1848:     if (yp -> yp_flags & YP_TAG)
        !          1849:        return yp -> yp_tag;
        !          1850: 
        !          1851:     while (yp -> yp_code == YP_IDEFINED) {
        !          1852:        if (yp -> yp_module && strcmp (yp -> yp_module, mymodule))
        !          1853:            (void) lookup_module (yp -> yp_module, yp -> yp_modid);
        !          1854: 
        !          1855:        if (z = lookup_type (yp -> yp_module, yp -> yp_identifier)) {
        !          1856:            yp = z;
        !          1857: 
        !          1858:            if (yp -> yp_flags & YP_TAG)
        !          1859:                return yp -> yp_tag;
        !          1860: 
        !          1861:            continue;
        !          1862:        }
        !          1863: 
        !          1864:        break;
        !          1865:     }
        !          1866: 
        !          1867:     for (t = tuples; t -> t_type != YP_UNDF; t++)
        !          1868:        if (t -> t_type == yp -> yp_code) {
        !          1869:            yt -> yt_class = t -> t_classnum;
        !          1870:            yt -> yt_value = yv;
        !          1871:            yv -> yv_code = YV_NUMBER;
        !          1872:            yv -> yv_number = t -> t_idnum;
        !          1873: 
        !          1874:            return yt;
        !          1875:        }
        !          1876: 
        !          1877:     return NULLYT;
        !          1878: }
        !          1879: 
        !          1880: /*    STRINGS */
        !          1881: 
        !          1882: char   *new_string (s)
        !          1883: register char  *s;
        !          1884: {
        !          1885:     register char  *p;
        !          1886: 
        !          1887:     if ((p = malloc ((unsigned) (strlen (s) + 1))) == NULLCP)
        !          1888:        yyerror ("out of memory");
        !          1889: 
        !          1890:     (void) strcpy (p, s);
        !          1891:     return p;
        !          1892: }
        !          1893: 
        !          1894: /*    SYMBOLS */
        !          1895: 
        !          1896: static struct triple {
        !          1897:     char          *t_name;
        !          1898:     PElementClass   t_class;
        !          1899:     PElementID     t_id;
        !          1900: }              triples[] = {
        !          1901:     "IA5String", PE_CLASS_UNIV,        PE_DEFN_IA5S,
        !          1902:     "ISO646String", PE_CLASS_UNIV, PE_DEFN_IA5S,
        !          1903:     "NumericString", PE_CLASS_UNIV, PE_DEFN_NUMS,
        !          1904:     "PrintableString", PE_CLASS_UNIV, PE_DEFN_PRTS,
        !          1905:     "T61String", PE_CLASS_UNIV, PE_DEFN_T61S,
        !          1906:     "TeletexString", PE_CLASS_UNIV, PE_DEFN_T61S,
        !          1907:     "VideotexString", PE_CLASS_UNIV, PE_DEFN_VTXS,
        !          1908:     "GeneralizedTime", PE_CLASS_UNIV, PE_DEFN_GENT,
        !          1909:     "GeneralisedTime", PE_CLASS_UNIV, PE_DEFN_GENT,
        !          1910:     "UTCTime", PE_CLASS_UNIV, PE_DEFN_UTCT,
        !          1911:     "UniversalTime", PE_CLASS_UNIV, PE_DEFN_UTCT,
        !          1912:     "GraphicString", PE_CLASS_UNIV, PE_DEFN_GFXS,
        !          1913:     "VisibleString", PE_CLASS_UNIV, PE_DEFN_VISS,
        !          1914:     "GeneralString", PE_CLASS_UNIV, PE_DEFN_GENS,
        !          1915:     "EXTERNAL", PE_CLASS_UNIV, PE_CONS_EXTN,
        !          1916:     "ObjectDescriptor", PE_CLASS_UNIV, PE_PRIM_ODE,
        !          1917: 
        !          1918:     NULL
        !          1919: };
        !          1920: 
        !          1921: /*  */
        !          1922: 
        !          1923: char *modsym (module, id, direct)
        !          1924: register char  *module,
        !          1925:               *id;
        !          1926: int direct;
        !          1927: {
        !          1928:     char    buf1[BUFSIZ],
        !          1929:            buf2[BUFSIZ],
        !          1930:            buf3[BUFSIZ];
        !          1931:     char   *pref;
        !          1932:     register struct triple *t;
        !          1933:     static char buffer[BUFSIZ];
        !          1934: 
        !          1935:     pref = NULLCP;
        !          1936:     if (module == NULLCP)
        !          1937:        for (t = triples; t -> t_name; t++)
        !          1938:            if (strcmp (t -> t_name, id) == 0) {
        !          1939:                module = "UNIV";
        !          1940:                break;
        !          1941:            }
        !          1942: 
        !          1943:     if (module && strcmp (module, mymodule))
        !          1944:        switch (direct) {
        !          1945:            case YP_DECODER:
        !          1946:                pref = yydecdflt;
        !          1947:                break;
        !          1948: 
        !          1949:            case YP_ENCODER:
        !          1950:                pref = yyencdflt;
        !          1951:                break;
        !          1952: 
        !          1953:            case YP_PRINTER:
        !          1954:                pref = yyprfdflt;
        !          1955:                break;
        !          1956:        }
        !          1957: 
        !          1958:     modsym_aux (pref ? pref : yyprefix, buf1);
        !          1959:     modsym_aux (module ? module : mymodule, buf2);
        !          1960:     modsym_aux (id, buf3);
        !          1961:     (void) sprintf (buffer, "%s_%s_%s", buf1, buf2, buf3);
        !          1962: 
        !          1963:     return buffer;
        !          1964: }
        !          1965: 
        !          1966: 
        !          1967: static modsym_aux (name, bp)
        !          1968: register char  *name,
        !          1969:               *bp;
        !          1970: {
        !          1971:     register char   c;
        !          1972: 
        !          1973:     while (c = *name++)
        !          1974:        switch (c) {
        !          1975:            case '-':
        !          1976:                *bp++ = '_';
        !          1977:                *bp++ = '_';
        !          1978:                break;
        !          1979: 
        !          1980:            default:
        !          1981:                *bp++ = c;
        !          1982:                break;
        !          1983:        }
        !          1984: 
        !          1985:     *bp = NULL;
        !          1986: }
        !          1987: 
        !          1988: /*  */
        !          1989: 
        !          1990: char *gensym () {
        !          1991:     char    buffer[BUFSIZ];
        !          1992:     static int  i = 0;
        !          1993: 
        !          1994:     (void) sprintf (buffer, "p%d", i++);
        !          1995:     return new_string (buffer);
        !          1996: }
        !          1997: 
        !          1998: init_new_file ()
        !          1999: {
        !          2000:     static int file_no = 0;
        !          2001:     char       buffer[BUFSIZ];
        !          2002: 
        !          2003:     (void) sprintf (buffer, "%s-%.*d.c", bflag, bwidth, ++file_no);
        !          2004:     if (freopen (buffer, "w", stdout) == NULL) {
        !          2005:        fprintf (stderr, "unable to write "), perror (buffer);
        !          2006:        exit (1);
        !          2007:     }
        !          2008: 
        !          2009:     prologue ();
        !          2010:     prologue3 ();
        !          2011: 
        !          2012:     if (module_actions)
        !          2013:        fputs (module_actions, stdout);
        !          2014: 
        !          2015:     prologue2 ();
        !          2016: }
        !          2017: 
        !          2018: end_file ()
        !          2019: {
        !          2020:     (void) fflush (stdout);
        !          2021:     if (ferror (stdout))
        !          2022:        myyerror ("write error - %s", sys_errname (errno));
        !          2023:     
        !          2024: }

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