Return to main.c CVS log

Up to [Research Unix] / researchv10dc / cmd / efl

Annotation of researchv10dc/cmd/efl/main.c, revision 1.1

1.1     ! root        1: static char xxxvers[ ] = "\n@(#)EFL VERSION 1.15,  19 DECEMBER 1980";
        !             2: 
        !             3: /* Compiler for the EFL Programming Language.  Written by:
        !             4:                Stuart I. Feldman
        !             5:                Bell Laboratories
        !             6:                Murray Hill, New Jersey
        !             7: */
        !             8: 
        !             9: 
        !            10: /* Flags:
        !            11:        -d      EFL debugging output
        !            12:        -v      verbose (print out Pass numbers and memory limits)
        !            13:        -w      supress warning messages
        !            14:        -f      put Fortran output on appropriate .f files
        !            15:        -F      put Fortran code for input file x onto x.F
        !            16:        -e      divert diagnostic output to next argument
        !            17:        -#      do not pass comments through to output
        !            18: */
        !            19: 
        !            20: 
        !            21: #include "defs"
        !            22: 
        !            23: int sysflag;
        !            24: 
        !            25: int nerrs      = 0;
        !            26: int nbad       = 0;
        !            27: int nwarns     = 0;
        !            28: int stnos[MAXSTNO];
        !            29: int nxtstno    = 0;
        !            30: int constno    = 0;
        !            31: int labno      = 0;
        !            32: 
        !            33: int dumpic     = NO;
        !            34: int memdump    = NO;
        !            35: int dbgflag    = NO;
        !            36: int nowarnflag = NO;
        !            37: int nocommentflag      = NO;
        !            38: int verbose    = NO;
        !            39: int dumpcore   = NO;
        !            40: char msg[200];
        !            41: 
        !            42: struct fileblock fcb[4];
        !            43: struct fileblock *iifilep;
        !            44: struct fileblock *ibfile       = &fcb[0];
        !            45: struct fileblock *icfile       = &fcb[1];
        !            46: struct fileblock *idfile       = &fcb[2];
        !            47: struct fileblock *iefile       = &fcb[3];
        !            48: 
        !            49: FILE *diagfile = {stderr};
        !            50: FILE *codefile = {stdout};
        !            51: FILE *fileptrs[MAXINCLUDEDEPTH];
        !            52: char *filenames[MAXINCLUDEDEPTH];
        !            53: char *basefile;
        !            54: int filelines[MAXINCLUDEDEPTH];
        !            55: int filedepth  = 0;
        !            56: char *efmacp   = NULL;
        !            57: char *filemacs[MAXINCLUDEDEPTH];
        !            58: int pushchars[MAXINCLUDEDEPTH];
        !            59: int ateof      = NO;
        !            60: 
        !            61: int igeol      = NO;
        !            62: int pushlex    = NO;
        !            63: int eofneed    = NO;
        !            64: int forcerr     = NO;
        !            65: int defneed     = NO;
        !            66: int prevbg      = NO;
        !            67: int comneed     = NO;
        !            68: int optneed     = NO;
        !            69: int lettneed   = NO;
        !            70: int iobrlevel  = 0;
        !            71: 
        !            72: ptr comments   = NULL;
        !            73: ptr prevcomments       = NULL;
        !            74: ptr genequivs  = NULL;
        !            75: ptr arrays     = NULL;
        !            76: ptr generlist  = NULL;
        !            77: ptr knownlist  = NULL;
        !            78: 
        !            79: ptr thisexec;
        !            80: ptr thisctl;
        !            81: chainp tempvarlist     = CHNULL;
        !            82: chainp temptypelist    = CHNULL;
        !            83: chainp hidlist = CHNULL;
        !            84: chainp commonlist      = CHNULL;
        !            85: chainp gonelist        = CHNULL;
        !            86: int blklevel   = 0;
        !            87: int ctllevel   = 0;
        !            88: int dclsect    = 0;
        !            89: int instruct   = 0;
        !            90: int inbound    = 0;
        !            91: int inproc     = 0;
        !            92: int ncases     = 0;
        !            93: 
        !            94: int graal      = 0;
        !            95: ptr procname   = NULL;
        !            96: int procclass  = 0;
        !            97: ptr thisargs   = NULL;
        !            98: 
        !            99: int nhid[MAXBLOCKDEPTH];
        !           100: int ndecl[MAXBLOCKDEPTH];
        !           101: 
        !           102: char ftnames[MAXFTNAMES][7];
        !           103: 
        !           104: 
        !           105: int neflnames  = 0;
        !           106: 
        !           107: int nftnames;
        !           108: int nftnm0;
        !           109: int impltype[26];
        !           110: 
        !           111: int ftnefl[NFTNTYPES]  = { TYINT, TYREAL, TYLOG, TYCOMPLEX, TYLREAL,
        !           112:                                TYCHAR, TYLCOMPLEX };
        !           113: int eflftn[NEFLTYPES];
        !           114: int ftnmask[NFTNTYPES]         = { 1, 2, 4, 8, 16, 32, 64 };
        !           115: struct tailoring tailor;
        !           116: struct system systab[] =
        !           117:        {
        !           118:                { "portable", 0,        1, 10, 7, 15},
        !           119:                { "unix", UNIX, 4, 10, 7, 15 },
        !           120:                { "gcos", GCOS, 4, 10, 7, 15 },
        !           121:                { "gcosbcd", GCOSBCD,   6, 10, 7, 15},
        !           122:                { "cray", CRAY, 8, 10, 7, 15},
        !           123:                { "ibm", IBM,   4, 10, 7, 15 },
        !           124:                { NULL }
        !           125:        };
        !           126: 
        !           127: double fieldmax        = FIELDMAX;
        !           128: 
        !           129: int langopt    = 2;
        !           130: int dotsopt    = 0;
        !           131: int dbgopt     = 0;
        !           132: int dbglevel   = 0;
        !           133: 
        !           134: int nftnch;
        !           135: int nftncont;
        !           136: int indifs[MAXINDIFS];
        !           137: int nxtindif;
        !           138: int afterif    = 0;
        !           139: 
        !           140: #ifdef gcos
        !           141: #      define BIT(n)   (1 << (36 - 1 - n) )
        !           142: #      define FORTRAN  BIT(1)
        !           143: #      define FDS      BIT(4)
        !           144: #      define EXEC     BIT(5)
        !           145: #      define FORM     BIT(14)
        !           146: #      define LNO      BIT(15)
        !           147: #      define BCD      BIT(16)
        !           148: #      define OPTZ     BIT(17)
        !           149:        int     compile = FORTRAN | FDS;
        !           150: #endif
        !           151: 
        !           152: 
        !           153: main(argc,argv)
        !           154: register int argc;
        !           155: register char **argv;
        !           156: {
        !           157: FILE *fd;
        !           158: register char *p;
        !           159: int neflnm0;
        !           160: 
        !           161: #ifdef unix
        !           162:        int intrupt();
        !           163:        static char errbuf[BUFSIZ];
        !           164: 
        !           165:        setbuf(stderr, errbuf);
        !           166: 
        !           167:        sysflag = UNIX;
        !           168: 
        !           169: /*
        !           170:        meter();
        !           171: */
        !           172:        if( (signal(2,1) & 01) == 0)
        !           173:                signal(2, intrupt);
        !           174: #endif
        !           175: 
        !           176: #ifdef gcos
        !           177: /*
        !           178:        meter();
        !           179: */
        !           180:        sysflag = (intss() ? GCOS : GCOSBCD);
        !           181: #endif
        !           182: 
        !           183: 
        !           184: crii();
        !           185: --argc;
        !           186: ++argv;
        !           187: tailinit(systab + sysflag);
        !           188: 
        !           189: while(argc>0 && ( (argv[0][0]=='-' && argv[0][1]!='\0') || eqlstrng(argv[0]) ))
        !           190:        {
        !           191:        if(argv[0][0] == '-')
        !           192:            for(p = argv[0]+1 ; *p ; ++p) switch(*p)
        !           193:                {
        !           194:                case ' ':
        !           195:                        break;
        !           196: 
        !           197:                case 'd':
        !           198:                case 'D':
        !           199:                        switch( *++p)
        !           200:                                {
        !           201:                                case '1':
        !           202:                                        dbgflag = YES;
        !           203:                                        break;
        !           204:                                case '2':
        !           205:                                        setyydeb();
        !           206:                                        break;
        !           207:                                case '3':
        !           208:                                        dumpcore = YES;
        !           209:                                        break;
        !           210:                                case '4':
        !           211:                                        dumpic = YES;
        !           212:                                        break;
        !           213:                                case 'm':
        !           214:                                case 'M':
        !           215:                                        memdump = YES;
        !           216:                                        break;
        !           217: 
        !           218:                                default:
        !           219:                                        dbgflag = YES;
        !           220:                                        --p;
        !           221:                                        break;
        !           222:                                }
        !           223:                        break;
        !           224: 
        !           225:                case 'w':
        !           226:                case 'W':
        !           227:                        nowarnflag = YES;
        !           228:                        break;
        !           229: 
        !           230:                case 'v':
        !           231:                case 'V':
        !           232:                        verbose = YES;
        !           233:                        break;
        !           234: 
        !           235:                case '#':
        !           236:                        nocommentflag = YES;
        !           237:                        break;
        !           238: 
        !           239:                case 'C':
        !           240:                case 'c':
        !           241:                        nocommentflag = NO;
        !           242:                        break;
        !           243: 
        !           244: #ifdef gcos
        !           245:                case 'O':
        !           246:                case 'o':
        !           247:                        compile |= OPTZ;
        !           248:                        break;
        !           249: 
        !           250:                case 'E':
        !           251:                case 'e':
        !           252:                        compile = 0;
        !           253:                        break;
        !           254: #endif
        !           255: 
        !           256:                default:
        !           257:                        fprintf(diagfile, "Illegal EFL flag %c\n", *p);
        !           258:                        exit(1);
        !           259:                }
        !           260:        --argc;
        !           261:        ++argv;
        !           262:        }
        !           263: 
        !           264: kwinit();
        !           265: geninit();
        !           266: knowninit();
        !           267: init();
        !           268: implinit();
        !           269: neflnm0 = neflnames;
        !           270: 
        !           271: #ifdef gcos
        !           272:        if( intss() )
        !           273:                compile = 0;
        !           274:        else
        !           275:                gcoutf();
        !           276: #endif
        !           277: 
        !           278: /*     fprintf(diagfile, "EFL 1.10\n");        */
        !           279: 
        !           280: if(argc==0)
        !           281:        {
        !           282:        filenames[0] = "-";
        !           283:        dofile(stdin);
        !           284:        }
        !           285: else
        !           286:        while(argc>0)
        !           287:                {
        !           288:                if( eqlstrng(argv[0]) )
        !           289:                        {
        !           290:                        --argc;
        !           291:                        ++argv;
        !           292:                        continue;
        !           293:                        }
        !           294:                if(argv[0][0]=='-' && argv[0][1]=='\0')
        !           295:                        {
        !           296:                        basefile = "";
        !           297:                        fd = stdin;
        !           298:                        }
        !           299:                else    {
        !           300:                        basefile = argv[0];
        !           301:                        fd = fopen(argv[0], "r");
        !           302:                        }
        !           303:                if(fd == NULL)
        !           304:                        {
        !           305:                        sprintf(msg, "Cannot open file %s", argv[0]);
        !           306:                        fprintf(diagfile, "%s.  Stop\n", msg);
        !           307:                        done(2);
        !           308:                        }
        !           309:                filenames[0] = argv[0];
        !           310:                filedepth = 0;
        !           311: 
        !           312:                nftnames = 0;
        !           313:                nftnm0 = 0;
        !           314:                neflnames = neflnm0;
        !           315: 
        !           316:                dofile(fd);
        !           317:                if(fd != stdin)
        !           318:                        fclose(fd);
        !           319:                --argc;
        !           320:                ++argv;
        !           321:                }
        !           322: p2flush();
        !           323: if(verbose)
        !           324:        fprintf(diagfile, "End of compilation\n");
        !           325: /*
        !           326: prhisto();
        !           327: /* */
        !           328: rmiis();
        !           329: 
        !           330: #ifdef gcos
        !           331:        gccomp();
        !           332: #endif
        !           333: 
        !           334: done(nbad);
        !           335: }
        !           336: 
        !           337: 
        !           338: dofile(fd)
        !           339: FILE *fd;
        !           340: {
        !           341: int k;
        !           342: 
        !           343: fprintf(diagfile, "File %s:\n", filenames[0]);
        !           344: 
        !           345: #ifdef gcos
        !           346:        if( fd==stdin && intss() && inquire(stdin, _TTY) )
        !           347:                freopen("*src", "rt", stdin);
        !           348: #endif
        !           349: 
        !           350: yyin = fileptrs[0] = fd;
        !           351: yylineno = filelines[0] = 1;
        !           352: filedepth = 0;
        !           353: ateof = 0;
        !           354: 
        !           355: do     {
        !           356:        nerrs = 0;
        !           357:        nwarns = 0;
        !           358:        eofneed = 0;
        !           359:        forcerr = 0;
        !           360:        comneed = 0;
        !           361:        optneed = 0;
        !           362:        defneed = 0;
        !           363:        lettneed = 0;
        !           364:        iobrlevel = 0;
        !           365:        prevbg = 0;
        !           366: 
        !           367:        constno = 0;
        !           368:        labno = 0;
        !           369:        nxtstno = 0;
        !           370:        afterif = 0;
        !           371:        thisexec = 0;
        !           372:        thisctl = 0;
        !           373:        nxtindif = 0;
        !           374:        inproc = 0;
        !           375:        blklevel = 0;
        !           376: 
        !           377:        implinit();
        !           378: 
        !           379:        opiis();
        !           380:        swii(icfile);
        !           381: 
        !           382:        if(k = yyparse())
        !           383:                fprintf(diagfile, "Error in source file.\n");
        !           384:        else  switch(graal)
        !           385:                {
        !           386:                case PARSERR:
        !           387:                        /*
        !           388:                        fprintf(diagfile, "error\n");
        !           389:                        */
        !           390:                        break;
        !           391: 
        !           392:                case PARSEOF:
        !           393:                        break;
        !           394: 
        !           395:                case PARSOPT:
        !           396:                        propts();
        !           397:                        break;
        !           398: 
        !           399:                case PARSDCL:
        !           400:                        fprintf(diagfile, "external declaration\n");
        !           401:                        break;
        !           402: 
        !           403:                case PARSPROC:
        !           404:                        /* work already done in endproc */
        !           405:                        break;
        !           406: 
        !           407:                case PARSDEF:
        !           408:                        break;
        !           409:                }
        !           410: 
        !           411:        cliis();
        !           412:        if(nerrs) ++nbad;
        !           413: 
        !           414:        } while(graal!=PARSEOF && !ateof);
        !           415: }
        !           416: 
        !           417: ptr bgnproc()
        !           418: {
        !           419: ptr bgnexec();
        !           420: 
        !           421: if(blklevel > 0)
        !           422:        {
        !           423:        execerr("procedure %s terminated prematurely", procnm() );
        !           424:        endproc();
        !           425:        }
        !           426: ctllevel = 0;
        !           427: procname = 0;
        !           428: procclass = 0;
        !           429: thisargs = 0;
        !           430: dclsect = 0;
        !           431: blklevel = 1;
        !           432: nftnm0 = nftnames;
        !           433: dclsect = 1;
        !           434: ndecl[1] = 0;
        !           435: nhid[1] = 0;
        !           436: 
        !           437: thisctl = allexcblock();
        !           438: thisctl->tag = TCONTROL;
        !           439: thisctl->subtype = STPROC;
        !           440: inproc = 1;
        !           441: return( bgnexec() );
        !           442: }
        !           443: 
        !           444: 
        !           445: endproc()
        !           446: {
        !           447: char comline[50], *concat();
        !           448: ptr p;
        !           449: 
        !           450: inproc = 0;
        !           451: 
        !           452: if(nerrs == 0)
        !           453:        {
        !           454:        pass2();
        !           455:        unhide();
        !           456:        cleanst();
        !           457:        if(dumpic)
        !           458:                system( concat("od ", icfile->filename, comline) );
        !           459:        if(memdump)
        !           460:                prmem();
        !           461:        }
        !           462: else   {
        !           463:        fprintf(diagfile, "**Procedure %s not generated\n", procnm());
        !           464:        for( ; blklevel > 0 ; --blklevel)
        !           465:                unhide();
        !           466:        cleanst();
        !           467:        }
        !           468: 
        !           469: if(nerrs==0 && nwarns>0)
        !           470:        if(nwarns == 1)
        !           471:                fprintf(diagfile,"*1 warning\n");
        !           472:        else    fprintf(diagfile, "*%d warnings\n", nwarns);
        !           473: 
        !           474: blklevel = 0;
        !           475: thisargs = 0;
        !           476: procname = 0;
        !           477: procclass = 0;
        !           478: while(thisctl)
        !           479:        {
        !           480:        p = thisctl;
        !           481:        thisctl = thisctl->prevctl;
        !           482:        frexcblock(p);
        !           483:        }
        !           484: 
        !           485: while(thisexec)
        !           486:        {
        !           487:        p = thisexec;
        !           488:        thisexec = thisexec->prevexec;
        !           489:        frexcblock(p);
        !           490:        }
        !           491: 
        !           492: nftnames = nftnm0;
        !           493: #if SIF_ALLOC
        !           494: if(verbose)
        !           495:        {
        !           496:        fprintf(diagfile, "Highwater mark %d words. ", nmemused);
        !           497:        fprintf(diagfile, "%ld words left over\n", totalloc-totfreed);
        !           498:        }
        !           499: #endif
        !           500: }
        !           501: 
        !           502: 
        !           503: 
        !           504: 
        !           505: implinit()
        !           506: {
        !           507: setimpl(TYREAL, 'a', 'z');
        !           508: setimpl(TYINT,  'i', 'n');
        !           509: }
        !           510: 
        !           511: 
        !           512: 
        !           513: init()
        !           514: {
        !           515: eflftn[TYINT] = FTNINT;
        !           516: eflftn[TYREAL] = FTNREAL;
        !           517: eflftn[TYLREAL] = FTNDOUBLE;
        !           518: eflftn[TYLOG] = FTNLOG;
        !           519: eflftn[TYCOMPLEX] = FTNCOMPLEX;
        !           520: eflftn[TYCHAR] = FTNINT;
        !           521: eflftn[TYFIELD] = FTNINT;
        !           522: eflftn[TYLCOMPLEX] = FTNDOUBLE;
        !           523: }
        !           524: 
        !           525: 
        !           526: 
        !           527: 
        !           528: #ifdef gcos
        !           529: meter()
        !           530: {
        !           531: FILE *mout;
        !           532: char *cuserid(), *datime(), *s;
        !           533: if(equals(s = cuserid(), "efl")) return;
        !           534: mout = fopen("efl/eflmeter", "a");
        !           535: if(mout == NULL)
        !           536:        fprintf(diagfile,"cannot open meter file");
        !           537: 
        !           538: else   {
        !           539:        fprintf(mout, "%s user %s at %s\n",
        !           540:                ( rutss()? "tss  " : "batch"), s, datime() );
        !           541:        fclose(mout);
        !           542:        }
        !           543: }
        !           544: #endif
        !           545: 
        !           546: 
        !           547: 
        !           548: #ifdef unix
        !           549: meter()        /* temporary metering of non-SIF usage */
        !           550: {
        !           551: FILE *mout;
        !           552: int tvec[2];
        !           553: int uid;
        !           554: char *ctime(), *p;
        !           555: 
        !           556: uid = getuid() & 0377;
        !           557: if(uid == 91) return;  /* ignore sif uses */
        !           558: mout = fopen("/usr/sif/efl/Meter", "a");
        !           559: if(mout == NULL)
        !           560:        fprintf(diagfile, "cannot open meter file");
        !           561: else   {
        !           562:        time(tvec);
        !           563:        p = ctime(tvec);
        !           564:        p[16] = '\0';
        !           565:        fprintf(mout,"User %d, %s\n",  uid, p+4);
        !           566:        fclose(mout);
        !           567:        }
        !           568: }
        !           569: 
        !           570: intrupt()
        !           571: {
        !           572: done(0);
        !           573: }
        !           574: #endif
        !           575: 
        !           576: 
        !           577: done(k)
        !           578: int k;
        !           579: {
        !           580: rmiis();
        !           581: exit(k);
        !           582: }
        !           583: 
        !           584: 
        !           585: 
        !           586: 
        !           587: 
        !           588: /* if string has an embedded equal sign, set option with it*/
        !           589: eqlstrng(s)
        !           590: char *s;
        !           591: {
        !           592: register char *t;
        !           593: 
        !           594: for(t = s; *t; ++t)
        !           595:        if(*t == '=')
        !           596:                {
        !           597:                *t = '\0';
        !           598:                while( *++t == ' ' )
        !           599:                        ;
        !           600:                if(*t == '\0')
        !           601:                        t = NULL;
        !           602:                setopt(s, t);
        !           603:                return(YES);
        !           604:                }
        !           605: 
        !           606: return(NO);
        !           607: }
        !           608: 
        !           609: #ifdef gcos
        !           610: 
        !           611: /* redirect output unit */
        !           612: 
        !           613: gcoutf()
        !           614: {
        !           615: if (!intss())
        !           616:        {
        !           617:        fputs("\t\t    Version 2.10 : read INFO/EFL (03/27/80)\n", stderr);
        !           618:        if (compile)
        !           619:                {
        !           620:                static char name[80] = "s*", opts[20] = "yw";
        !           621:                char *opt = (char *)inquire(stdout, _OPTIONS);
        !           622:                if (!strchr(opt, 't'))
        !           623:                        { /* if stdout is diverted */
        !           624:                        sprintf(name, "%s\"s*\"",
        !           625:                                (char *)inquire(stdout, _FILENAME));
        !           626:                        strcpy(&opts[1], opt);
        !           627:                        }
        !           628:                if (freopen(name, opts, stdout) == NULL)
        !           629:                        cant(name);
        !           630:                }
        !           631:        }
        !           632: }
        !           633: 
        !           634: 
        !           635: 
        !           636: /* call in fortran compiler if necessary */
        !           637: 
        !           638: gccomp()
        !           639: {
        !           640: if (compile)
        !           641:        {
        !           642:        if (nbad > 0)   /* abort */
        !           643:                cretsw(EXEC);
        !           644: 
        !           645:        else    { /* good: call forty */
        !           646:                FILE *dstar; /* to intercept "gosys" action */
        !           647: 
        !           648:                if ((dstar = fopen("d*", "wv")) == NULL)
        !           649:                        cant("d*");
        !           650:                fputs("$\tforty\tascii", dstar);
        !           651:                if (fopen("*1", "o") == NULL)
        !           652:                        cant("*1");
        !           653:                fclose(stdout, "rl");
        !           654:                cretsw(FORM | LNO | BCD);
        !           655:                if (! tailor.ftncontnu)
        !           656:                        compile |= FORM;
        !           657:                csetsw(compile);
        !           658:                gosys("forty");
        !           659:                }
        !           660:        }
        !           661: }
        !           662: 
        !           663: 
        !           664: cant(s)
        !           665: char *s;
        !           666: {
        !           667: ffiler(s);
        !           668: done(1);
        !           669: }
        !           670: #endif

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