Return to driver.c CVS log

Up to [Research Unix] / researchv10no / cmd / f77

Annotation of researchv10no/cmd/f77/driver.c, revision 1.1

1.1     ! root        1: char xxxvers[] = "\n@(#) FORTRAN 77 DRIVER, VERSION 2.03.7, 27 JUNE 1989\n";
        !             2: #include "stdio.h"
        !             3: #ifndef NULL
        !             4: #include "stddef.h"
        !             5: #endif
        !             6: #include "ctype.h"
        !             7: #include "defines"
        !             8: #include "machdefs"
        !             9: #include "drivedefs"
        !            10: #include "ftypes"
        !            11: #include "signal.h"
        !            12: 
        !            13: static FILEP diagfile  = {
        !            14:        stderr};
        !            15: static int pid;
        !            16: static int sigivalue   = 0;
        !            17: static int sigqvalue   = 0;
        !            18: static int sighvalue   = 0;
        !            19: static int sigtvalue   = 0;
        !            20: 
        !            21: static char *pass1name = PASS1NAME ;
        !            22: static char *pass2name = PASS2NAME ;
        !            23: static char *asmname   = ASMNAME ;
        !            24: static char *ldname    = LDNAME ;
        !            25: static char *footname  = FOOTNAME;
        !            26: static char *proffoot  = PROFFOOT;
        !            27: static char *macroname = "m4";
        !            28: static char *shellname = "/bin/sh";
        !            29: static char *aoutname  = "a.out" ;
        !            30: static char *temppref  = TEMPPREF;
        !            31: 
        !            32: static char *infname;
        !            33: static char textfname[44];
        !            34: static char asmfname[44];
        !            35: static char asmpass2[44];
        !            36: static char initfname[44];
        !            37: static char sortfname[44];
        !            38: static char prepfname[44];
        !            39: static char objfdefault[44];
        !            40: static char optzfname[44];
        !            41: static char setfname[44];
        !            42: 
        !            43: static char fflags[50] = "-";
        !            44: static char cflags[50] = "-c";
        !            45: #if TARGET == GCOS
        !            46: static char eflags[30] = "system=gcos ";
        !            47: #else
        !            48: static char eflags[30] = "system=unix ";
        !            49: #endif
        !            50: static char rflags[30] = "";
        !            51: static char lflag[3]   = "-x";
        !            52: static char *fflagp    = fflags+1;
        !            53: static char *eflagp    = eflags+12;
        !            54: static char *rflagp    = rflags;
        !            55: static char **loadargs;
        !            56: static char **loadp;
        !            57: 
        !            58: static flag erred      = NO;
        !            59: static flag loadflag   = YES;
        !            60: static flag saveasmflag        = NO;
        !            61: static flag profileflag        = NO;
        !            62: static flag optimflag  = NO;
        !            63: static flag debugflag  = NO;
        !            64: static flag verbose    = NO;
        !            65: static flag nofloating = NO;
        !            66: static flag fortonly   = NO;
        !            67: static flag macroflag  = NO;
        !            68: static flag sdbflag    = NO;
        !            69: 
        !            70: static int fatal(), fatali(), fatalstr(), fname();
        !            71: 
        !            72: 
        !            73: main(argc, argv)
        !            74: int argc;
        !            75: char **argv;
        !            76: {
        !            77:        int i, c, status;
        !            78:        char *setdoto(), *lastchar(), *lastfield(), *copys();
        !            79:        ptr ckalloc();
        !            80:        register char *s;
        !            81:        char fortfile[20], *t;
        !            82:        char buff[100];
        !            83:        int intrupt();
        !            84: 
        !            85:        sigivalue = (int) signal(SIGINT, SIG_IGN) & 01;
        !            86:        sigqvalue = (int) signal(SIGQUIT,SIG_IGN) & 01;
        !            87:        sighvalue = (int) signal(SIGHUP, SIG_IGN) & 01;
        !            88:        sigtvalue = (int) signal(SIGTERM,SIG_IGN) & 01;
        !            89:        enbint(intrupt);
        !            90: 
        !            91:        pid = getpid();
        !            92:        crfnames();
        !            93: 
        !            94:        loadargs = (char **) ckalloc( (argc+20) * sizeof(*loadargs) );
        !            95:        loadargs[1] = "-X";
        !            96:        loadargs[2] = "-u";
        !            97: #if HERE==PDP11 || HERE==VAX
        !            98:        loadargs[3] = "_MAIN__";
        !            99: #endif
        !           100: #if HERE == INTERDATA
        !           101:        loadargs[3] = "main";
        !           102: #endif
        !           103:        loadp = loadargs + 4;
        !           104: 
        !           105:        --argc;
        !           106:        ++argv;
        !           107: 
        !           108:        while(argc>0 && argv[0][0]=='-' && argv[0][1]!='\0')
        !           109:        {
        !           110:                for(s = argv[0]+1 ; *s ; ++s) switch(*s)
        !           111:                {
        !           112:                case 'T':  /* use special passes */
        !           113:                        switch(*++s)
        !           114:                        {
        !           115:                        case '1':
        !           116:                                pass1name = s+1; 
        !           117:                                goto endfor;
        !           118:                        case '2':
        !           119:                                pass2name = s+1; 
        !           120:                                goto endfor;
        !           121:                        case 'a':
        !           122:                                asmname = s+1; 
        !           123:                                goto endfor;
        !           124:                        case 'l':
        !           125:                                ldname = s+1; 
        !           126:                                goto endfor;
        !           127:                        case 'F':
        !           128:                                footname = s+1; 
        !           129:                                goto endfor;
        !           130:                        case 'm':
        !           131:                                macroname = s+1; 
        !           132:                                goto endfor;
        !           133:                        case 't':
        !           134:                                temppref = s+1; 
        !           135:                                goto endfor;
        !           136:                        default:
        !           137:                                fatali("bad option -T%c", *s);
        !           138:                        }
        !           139:                        break;
        !           140: 
        !           141:                case '6':
        !           142:                        if(s[1]=='6')
        !           143:                        {
        !           144:                                *fflagp++ = *s++;
        !           145:                                goto copyfflag;
        !           146:                        }
        !           147:                        else    {
        !           148:                                fprintf(diagfile, "invalid flag 6%c\n", s[1]);
        !           149:                                done(1);
        !           150:                        }
        !           151: 
        !           152:                case 'w':
        !           153:                        if(s[1]=='6' && s[2]=='6')
        !           154:                        {
        !           155:                                *fflagp++ = *s++;
        !           156:                                *fflagp++ = *s++;
        !           157:                        }
        !           158: 
        !           159: copyfflag:
        !           160:                case 'b':
        !           161:                case 'B':
        !           162:                case 'u':
        !           163:                case 'U':
        !           164:                case '1':
        !           165:                case 'C':
        !           166:                        *fflagp++ = *s;
        !           167:                        break;
        !           168: 
        !           169:                case 'O':
        !           170:                        optimflag = YES;
        !           171: #if TARGET == INTERDATA
        !           172:                        *loadp++ = "-r";
        !           173:                        *loadp++ = "-d";
        !           174: #endif
        !           175:                        *fflagp++ = 'O';
        !           176:                        if( isdigit(s[1]) )
        !           177:                                *fflagp++ = *++s;
        !           178:                        break;
        !           179: 
        !           180:                case 'N':
        !           181:                        *fflagp++ = 'N';
        !           182:                        if( oneof(*++s, "qxscn") )
        !           183:                                *fflagp++ = *s++;
        !           184:                        else    {
        !           185:                                fprintf(diagfile, "invalid flag -N%c\n", *s);
        !           186:                                done(1);
        !           187:                        }
        !           188:                        while( isdigit(*s) )
        !           189:                                *fflagp++ = *s++;
        !           190:                        *fflagp++ = 'X';
        !           191:                        goto endfor;
        !           192: 
        !           193:                case 'm':
        !           194:                        if(s[1] == '4')
        !           195:                                ++s;
        !           196:                        macroflag = YES;
        !           197:                        break;
        !           198: 
        !           199:                case 'S':
        !           200:                        strcat(cflags, " -S");
        !           201:                        saveasmflag = YES;
        !           202: 
        !           203:                case 'c':
        !           204:                        loadflag = NO;
        !           205:                        break;
        !           206: 
        !           207:                case 'v':
        !           208:                        verbose = YES;
        !           209:                        break;
        !           210: 
        !           211:                case 'd':
        !           212:                        debugflag = YES;
        !           213:                        goto copyfflag;
        !           214: 
        !           215:                case 'M':
        !           216:                        *loadp++ = "-M";
        !           217:                        break;
        !           218: 
        !           219:                case 'g':
        !           220:                        strcat(cflags," -g");
        !           221:                        sdbflag = YES;
        !           222:                        goto copyfflag;
        !           223: 
        !           224:                case 'p':
        !           225:                        profileflag = YES;
        !           226:                        strcat(cflags," -p");
        !           227:                        goto copyfflag;
        !           228: 
        !           229:                case 'o':
        !           230:                        if( ! strcmp(s, "onetrip") )
        !           231:                        {
        !           232:                                *fflagp++ = '1';
        !           233:                                goto endfor;
        !           234:                        }
        !           235:                        aoutname = *++argv;
        !           236:                        --argc;
        !           237:                        break;
        !           238: 
        !           239: #if TARGET == PDP11
        !           240:                case 'f':
        !           241:                        nofloating = YES;
        !           242:                        pass2name = NOFLPASS2;
        !           243:                        break;
        !           244: #endif
        !           245: 
        !           246:                case 'F':
        !           247:                        fortonly = YES;
        !           248:                        loadflag = NO;
        !           249:                        break;
        !           250: 
        !           251:                case 'I':
        !           252:                        if(s[1]=='2' || s[1]=='4' || s[1]=='s')
        !           253:                        {
        !           254:                                *fflagp++ = *s++;
        !           255:                                goto copyfflag;
        !           256:                        }
        !           257:                        fprintf(diagfile, "invalid flag -I%c\n", s[1]);
        !           258:                        done(1);
        !           259: 
        !           260:                case 'l':       /* letter ell--library */
        !           261:                        s[-1] = '-';
        !           262:                        *loadp++ = s-1;
        !           263:                        goto endfor;
        !           264: 
        !           265:                case 'E':       /* EFL flag argument */
        !           266:                        while( *eflagp++ = *++s)
        !           267:                                ;
        !           268:                        *eflagp++ = ' ';
        !           269:                        goto endfor;
        !           270:                case 'R':
        !           271:                        while( *rflagp++ = *++s )
        !           272:                                ;
        !           273:                        *rflagp++ = ' ';
        !           274:                        goto endfor;
        !           275:                default:
        !           276:                        lflag[1] = *s;
        !           277:                        *loadp++ = copys(lflag);
        !           278:                        break;
        !           279:                }
        !           280: endfor:
        !           281:                --argc;
        !           282:                ++argv;
        !           283:        }
        !           284: 
        !           285:        *fflagp = '\0';
        !           286: 
        !           287:        loadargs[0] = ldname;
        !           288: #if TARGET == PDP11
        !           289:        if(nofloating)
        !           290:                *loadp++ = (profileflag ? NOFLPROF : NOFLFOOT);
        !           291:        else
        !           292: #endif
        !           293:                *loadp++ = (profileflag ? proffoot : footname);
        !           294: 
        !           295:        for(i = 0 ; i<argc ; ++i)
        !           296:                switch(c =  dotchar(infname = argv[i]) )
        !           297:                {
        !           298:                case 'r':       /* Ratfor file */
        !           299:                case 'e':       /* EFL file */
        !           300:                        if( unreadable(argv[i]) )
        !           301:                        {
        !           302:                                erred = YES;
        !           303:                                break;
        !           304:                        }
        !           305:                        s = fortfile;
        !           306:                        t = lastfield(argv[i]);
        !           307:                        while( *s++ = *t++)
        !           308:                                ;
        !           309:                        s[-2] = 'f';
        !           310: 
        !           311:                        if(macroflag)
        !           312:                        {
        !           313:                                sprintf(buff, "%s %s >%s", macroname, infname, prepfname);
        !           314:                                if( sys(buff) )
        !           315:                                {
        !           316:                                        rmf(prepfname);
        !           317:                                        erred = YES;
        !           318:                                        break;
        !           319:                                }
        !           320:                                infname = prepfname;
        !           321:                        }
        !           322: 
        !           323:                        if(c == 'e')
        !           324:                                sprintf(buff, "efl %s %s >%s", eflags, infname, fortfile);
        !           325:                        else
        !           326:                                sprintf(buff, "ratfor %s %s >%s", rflags, infname, fortfile);
        !           327:                        status = sys(buff);
        !           328:                        if(macroflag)
        !           329:                                rmf(infname);
        !           330:                        if(status)
        !           331:                        {
        !           332:                                erred = YES;
        !           333:                                rmf(fortfile);
        !           334:                                break;
        !           335:                        }
        !           336: 
        !           337:                        if( ! fortonly )
        !           338:                        {
        !           339:                                infname = argv[i] = lastfield(argv[i]);
        !           340:                                *lastchar(infname) = 'f';
        !           341: 
        !           342:                                if( dofort(argv[i]) )
        !           343:                                        erred = YES;
        !           344:                                else    {
        !           345:                                        if( nodup(t = setdoto(argv[i])) )
        !           346:                                                *loadp++ = t;
        !           347:                                        rmf(fortfile);
        !           348:                                }
        !           349:                        }
        !           350:                        break;
        !           351: 
        !           352:                case 'f':       /* Fortran file */
        !           353:                case 'F':
        !           354:                        if( unreadable(argv[i]) )
        !           355:                                erred = YES;
        !           356:                        else if( dofort(argv[i]) )
        !           357:                                erred = YES;
        !           358:                        else if( nodup(t=setdoto(argv[i])) )
        !           359:                                *loadp++ = t;
        !           360:                        break;
        !           361: 
        !           362:                case 'c':       /* C file */
        !           363:                case 's':       /* Assembler file */
        !           364:                        if( unreadable(argv[i]) )
        !           365:                        {
        !           366:                                erred = YES;
        !           367:                                break;
        !           368:                        }
        !           369: #if HERE==PDP11 || HERE==VAX
        !           370:                        fprintf(diagfile, "%s:\n", argv[i]);
        !           371: #endif
        !           372:                        sprintf(buff, "cc %s %s", cflags, argv[i] );
        !           373:                        if( sys(buff) )
        !           374:                                erred = YES;
        !           375:                        else
        !           376:                                if( nodup(t = setdoto(argv[i])) )
        !           377:                                        *loadp++ = t;
        !           378:                        break;
        !           379: 
        !           380:                case 'o':
        !           381:                        if( nodup(argv[i]) )
        !           382:                                *loadp++ = argv[i];
        !           383:                        break;
        !           384: 
        !           385:                default:
        !           386:                        if( ! strcmp(argv[i], "-o") )
        !           387:                                aoutname = argv[++i];
        !           388:                        else
        !           389:                                *loadp++ = argv[i];
        !           390:                        break;
        !           391:                }
        !           392: 
        !           393:        if(loadflag && !erred)
        !           394:                doload(loadargs, loadp);
        !           395:        done(erred);
        !           396: }
        !           397: 
        !           398: dofort(s)
        !           399: char *s;
        !           400: {
        !           401:        int retcode;
        !           402:        char buff[200];
        !           403: 
        !           404:        infname = s;
        !           405:        sprintf(buff, "%s %s %s %s %s %s",
        !           406:            pass1name, fflags, s, asmfname, initfname, textfname);
        !           407:        switch( sys(buff) )
        !           408:        {
        !           409:        case 1:
        !           410:                goto error;
        !           411:        case 0:
        !           412:                break;
        !           413:        default:
        !           414:                goto comperror;
        !           415:        }
        !           416: 
        !           417:        if(content(initfname) > 0)
        !           418:                if( dodata() )
        !           419:                        goto error;
        !           420:        if( dopass2() )
        !           421:                goto comperror;
        !           422:        doasm(s);
        !           423:        retcode = 0;
        !           424: 
        !           425: ret:
        !           426:        rmf(asmfname);
        !           427:        rmf(initfname);
        !           428:        rmf(textfname);
        !           429:        return(retcode);
        !           430: 
        !           431: error:
        !           432:        fprintf(diagfile, "\nError.  No assembly.\n");
        !           433:        retcode = 1;
        !           434:        goto ret;
        !           435: 
        !           436: comperror:
        !           437:        fprintf(diagfile, "\ncompiler error.\n");
        !           438:        retcode = 2;
        !           439:        goto ret;
        !           440: }
        !           441: 
        !           442: 
        !           443: 
        !           444: 
        !           445: dopass2()
        !           446: {
        !           447:        char buff[100];
        !           448: 
        !           449:        if(verbose)
        !           450:                fprintf(diagfile, "PASS2.");
        !           451: 
        !           452: #if FAMILY==DMR
        !           453:        sprintf(buff, "%s %s - %s", pass2name, textfname, asmpass2);
        !           454:        return( sys(buff) );
        !           455: #endif
        !           456: 
        !           457: #if FAMILY == PCC
        !           458: #      if TARGET==INTERDATA
        !           459:        sprintf(buff, "%s -A%s <%s >%s", pass2name, setfname, textfname, asmpass2);
        !           460: #      else
        !           461:        sprintf(buff, "%s %s >%s", pass2name, textfname, asmpass2);
        !           462: #      endif
        !           463:        return( sys(buff) );
        !           464: #endif
        !           465: }
        !           466: 
        !           467: 
        !           468: 
        !           469: 
        !           470: doasm(s)
        !           471: char *s;
        !           472: {
        !           473:        register char *lastc;
        !           474:        char *obj;
        !           475:        char buff[200];
        !           476:        char *lastchar(), *setdoto();
        !           477: 
        !           478:        if(*s == '\0')
        !           479:                s = objfdefault;
        !           480:        lastc = lastchar(s);
        !           481:        obj = setdoto(s);
        !           482: 
        !           483: #if TARGET==PDP11 || TARGET==VAX
        !           484: #      ifdef PASS2OPT
        !           485:        if(optimflag)
        !           486:        {
        !           487:                sprintf(buff, "%s %s %s", PASS2OPT, asmpass2, optzfname);
        !           488:                if( sys(buff) )
        !           489:                        rmf(optzfname);
        !           490:                else
        !           491:                {
        !           492:                        sprintf(buff,"mv %s %s", optzfname, asmpass2);
        !           493:                        sys(buff);
        !           494:                }
        !           495:        }
        !           496: #      endif
        !           497: #endif
        !           498: 
        !           499:        if(saveasmflag)
        !           500:        {
        !           501:                *lastc = 's';
        !           502: #if TARGET == INTERDATA
        !           503:                sprintf(buff, "cat %s %s %s >%s",asmfname, setfname, asmpass2, obj);
        !           504: #else
        !           505:                sprintf(buff, "cat %s %s >%s", asmfname, asmpass2, obj);
        !           506: #endif
        !           507:                sys(buff);
        !           508:                *lastc = 'o';
        !           509:        }
        !           510:        else
        !           511:        {
        !           512:                if(verbose)
        !           513:                        fprintf(diagfile, "  ASM.");
        !           514: #if TARGET == INTERDATA
        !           515:                sprintf(buff, "%s -o %s %s %s %s", asmname, obj, asmfname, setfname, asmpass2);
        !           516: #endif
        !           517: 
        !           518: #if TARGET == VAX
        !           519:                /* vax assembler currently accepts only one input file */
        !           520:                sprintf(buff, "cat %s >>%s", asmpass2, asmfname);
        !           521:                sys(buff);
        !           522:                sprintf(buff, "%s -o %s %s", asmname, obj, asmfname);
        !           523: #endif
        !           524: 
        !           525: #if TARGET == PDP11
        !           526:                sprintf(buff, "%s -u -o %s %s %s", asmname, obj, asmfname, asmpass2);
        !           527: #endif
        !           528: 
        !           529: #if TARGET!=INTERDATA && TARGET!=PDP11 && TARGET!=VAX
        !           530:                sprintf(buff, "%s -o %s %s %s", asmname, obj, asmfname, asmpass2);
        !           531: #endif
        !           532: 
        !           533:                if( sys(buff) )
        !           534:                        fatal("assembler error");
        !           535:                if(verbose)
        !           536:                        fprintf(diagfile, "\n");
        !           537: #if HERE==PDP11 && TARGET!=PDP11
        !           538:                rmf(obj);
        !           539: #endif
        !           540:        }
        !           541: 
        !           542:        rmf(asmpass2);
        !           543: }
        !           544: 
        !           545: 
        !           546: 
        !           547: doload(v0, v)
        !           548: register char *v0[], *v[];
        !           549: {
        !           550:        char **p;
        !           551:        int waitpid;
        !           552: 
        !           553:        if(sdbflag)
        !           554:                *v++ = "-lsdb";
        !           555:        for(p = liblist ; *p ; *v++ = *p++)
        !           556:                ;
        !           557: 
        !           558:        *v++ = "-o";
        !           559:        *v++ = aoutname;
        !           560:        *v = NULL;
        !           561: 
        !           562:        if(verbose)
        !           563:                fprintf(diagfile, "LOAD.");
        !           564:        if(debugflag)
        !           565:        {
        !           566:                for(p = v0 ; p<v ; ++p)
        !           567:                        fprintf(diagfile, "%s ", *p);
        !           568:                fprintf(diagfile, "\n");
        !           569:        }
        !           570: 
        !           571: #if HERE==PDP11 || HERE==INTERDATA || HERE==VAX
        !           572:        if( (waitpid = fork()) == 0)
        !           573:        {
        !           574:                enbint(SIG_DFL);
        !           575:                execv(ldname, v0);
        !           576:                fatalstr("couldn't load %s", ldname);
        !           577:        }
        !           578:        await(waitpid);
        !           579: #endif
        !           580: 
        !           581: #if HERE==INTERDATA
        !           582:        if(optimflag)
        !           583:        {
        !           584:                char buff1[100], buff2[100];
        !           585:                sprintf(buff1, "nopt %s -o junk.%d", aoutname, pid);
        !           586:                sprintf(buff2, "mv junk.%d %s", pid, aoutname);
        !           587:                if( sys(buff1) || sys(buff2) )
        !           588:                        err("bad optimization");
        !           589:        }
        !           590: #endif
        !           591: 
        !           592:        if(verbose)
        !           593:                fprintf(diagfile, "\n");
        !           594: }
        !           595: 
        !           596: /* Process control and Shell-simulating routines */
        !           597: 
        !           598: sys(str)
        !           599: char *str;
        !           600: {
        !           601:        register char *s, *t;
        !           602:        char *argv[100], path[100];
        !           603:        char *inname, *outname;
        !           604:        int append;
        !           605:        int waitpid;
        !           606:        int argc;
        !           607: 
        !           608: 
        !           609:        if(debugflag)
        !           610:                fprintf(diagfile, "%s\n", str);
        !           611:        /* doug busted freopen, so let's try with system */
        !           612:        return(system(str) >> 8);
        !           613:        /* NOTREACHED (pjw) */
        !           614: #if 0
        !           615:        inname  = NULL;
        !           616:        outname = NULL;
        !           617:        argv[0] = shellname;
        !           618:        argc = 1;
        !           619: 
        !           620:        t = str;
        !           621:        while( isspace(*t) )
        !           622:                ++t;
        !           623:        while(*t)
        !           624:        {
        !           625:                if(*t == '<')
        !           626:                        inname = t+1;
        !           627:                else if(*t == '>')
        !           628:                {
        !           629:                        if(t[1] == '>')
        !           630:                        {
        !           631:                                append = YES;
        !           632:                                outname = t+2;
        !           633:                        }
        !           634:                        else    {
        !           635:                                append = NO;
        !           636:                                outname = t+1;
        !           637:                        }
        !           638:                }
        !           639:                else
        !           640:                        argv[argc++] = t;
        !           641:                while( !isspace(*t) && *t!='\0' )
        !           642:                        ++t;
        !           643:                if(*t)
        !           644:                {
        !           645:                        *t++ = '\0';
        !           646:                        while( isspace(*t) )
        !           647:                                ++t;
        !           648:                }
        !           649:        }
        !           650: 
        !           651:        if(argc == 1)   /* no command */
        !           652:                return(-1);
        !           653:        argv[argc] = 0;
        !           654: 
        !           655:        s = path;
        !           656:        t = "/usr/bin/";
        !           657:        while(*t)
        !           658:                *s++ = *t++;
        !           659:        for(t = argv[1] ; *s++ = *t++ ; )
        !           660:                ;
        !           661:        if((waitpid = fork()) == 0)
        !           662:        {
        !           663:                if(inname)
        !           664:                        freopen(inname, "r", stdin);
        !           665:                if(outname)
        !           666:                        freopen(outname, (append ? "a" : "w"), stdout);
        !           667:                enbint(SIG_DFL);
        !           668: 
        !           669:                texec(path+9, argv);  /* command */
        !           670:                texec(path+4, argv);  /*  /bin/command */
        !           671:                texec(path  , argv);  /* /usr/bin/command */
        !           672: 
        !           673:                fatalstr("Cannot load %s",path+9);
        !           674:        }
        !           675: 
        !           676:        return( await(waitpid) );
        !           677: #endif
        !           678: }
        !           679: 
        !           680: 
        !           681: 
        !           682: 
        !           683: 
        !           684: #include "errno.h"
        !           685: 
        !           686: /* modified version from the Shell */
        !           687: texec(f, av)
        !           688: char *f;
        !           689: char **av;
        !           690: {
        !           691:        extern int errno;
        !           692: 
        !           693:        execv(f, av+1);
        !           694: 
        !           695:        if (errno==ENOEXEC)
        !           696:        {
        !           697:                av[1] = f;
        !           698:                execv(shellname, av);
        !           699:                fatal("No shell!");
        !           700:        }
        !           701:        if (errno==ENOMEM)
        !           702:                fatalstr("%s: too large", f);
        !           703: }
        !           704: 
        !           705: 
        !           706: 
        !           707: 
        !           708: 
        !           709: 
        !           710: done(k)
        !           711: int k;
        !           712: {
        !           713:        static int recurs       = NO;
        !           714: 
        !           715:        if(recurs == NO)
        !           716:        {
        !           717:                recurs = YES;
        !           718:                rmfiles();
        !           719:        }
        !           720:        exit(k);
        !           721: }
        !           722: 
        !           723: 
        !           724: 
        !           725: 
        !           726: 
        !           727: 
        !           728: enbint(k)
        !           729: void (*k)();
        !           730: {
        !           731:        if(sigivalue == 0)
        !           732:                signal(SIGINT,k);
        !           733:        if(sigqvalue == 0)
        !           734:                signal(SIGQUIT,k);
        !           735:        if(sighvalue == 0)
        !           736:                signal(SIGHUP,k);
        !           737:        if(sigtvalue == 0)
        !           738:                signal(SIGTERM,k);
        !           739: }
        !           740: 
        !           741: 
        !           742: 
        !           743: 
        !           744: intrupt()
        !           745: {
        !           746:        done(2);
        !           747: }
        !           748: 
        !           749: 
        !           750: 
        !           751: await(waitpid)
        !           752: int waitpid;
        !           753: {
        !           754:        int w, status;
        !           755: 
        !           756:        enbint(SIG_IGN);
        !           757:        while ( (w = wait(&status)) != waitpid)
        !           758:                if(w == -1)
        !           759:                        fatal("bad wait code");
        !           760:        enbint(intrupt);
        !           761:        if(status & 0377)
        !           762:        {
        !           763:                if(status != SIGINT)
        !           764:                        fprintf(diagfile, "Termination code %d", status);
        !           765:                done(3);
        !           766:        }
        !           767:        return(status>>8);
        !           768: }
        !           769: 
        !           770: /* File Name and File Manipulation Routines */
        !           771: 
        !           772: unreadable(s)
        !           773: register char *s;
        !           774: {
        !           775:        register FILE *fp;
        !           776: 
        !           777:        if(fp = fopen(s, "r"))
        !           778:        {
        !           779:                fclose(fp);
        !           780:                return(NO);
        !           781:        }
        !           782: 
        !           783:        else
        !           784:        {
        !           785:                fprintf(diagfile, "Error: Cannot read file %s\n", s);
        !           786:                return(YES);
        !           787:        }
        !           788: }
        !           789: 
        !           790: 
        !           791: 
        !           792: clf(p)
        !           793: FILEP *p;
        !           794: {
        !           795:        if(p!=NULL && *p!=NULL && *p!=stdout)
        !           796:        {
        !           797:                if(ferror(*p))
        !           798:                        fatal("writing error");
        !           799:                fclose(*p);
        !           800:        }
        !           801:        *p = NULL;
        !           802: }
        !           803: 
        !           804: rmfiles()
        !           805: {
        !           806:        rmf(textfname);
        !           807:        rmf(asmfname);
        !           808:        rmf(initfname);
        !           809:        rmf(asmpass2);
        !           810: #if TARGET == INTERDATA
        !           811:        rmf(setfname);
        !           812: #endif
        !           813: }
        !           814: 
        !           815: 
        !           816: 
        !           817: 
        !           818: 
        !           819: 
        !           820: 
        !           821: 
        !           822: /* return -1 if file does not exist, 0 if it is of zero length
        !           823:    and 1 if of positive length
        !           824: */
        !           825: content(filename)
        !           826: char *filename;
        !           827: {
        !           828: #ifdef VERSION6
        !           829:        struct stat
        !           830:        {
        !           831:                char cjunk[9];
        !           832:                char size0;
        !           833:                int size1;
        !           834:                int ijunk[12];
        !           835:        } buf;
        !           836: #else
        !           837: #      include <sys/types.h>
        !           838: #      include <sys/stat.h>
        !           839:        struct stat buf;
        !           840: #endif
        !           841: 
        !           842:        if(stat(filename,&buf) < 0)
        !           843:                return(-1);
        !           844: #ifdef VERSION6
        !           845:        return(buf.size0 || buf.size1);
        !           846: #else
        !           847:        return( buf.st_size > 0 );
        !           848: #endif
        !           849: }
        !           850: 
        !           851: 
        !           852: 
        !           853: 
        !           854: crfnames()
        !           855: {
        !           856:        fname(textfname, "x");
        !           857:        fname(asmfname, "s");
        !           858:        fname(asmpass2, "a");
        !           859:        fname(initfname, "d");
        !           860:        fname(sortfname, "S");
        !           861:        fname(objfdefault, "o");
        !           862:        fname(prepfname, "p");
        !           863:        fname(optzfname, "z");
        !           864:        fname(setfname, "A");
        !           865: }
        !           866: 
        !           867: 
        !           868: 
        !           869: 
        !           870: rmf(fn)
        !           871: register char *fn;
        !           872: {
        !           873:        if(!debugflag && fn!=NULL && *fn!='\0')
        !           874:                unlink(fn);
        !           875: }
        !           876: 
        !           877: 
        !           878: 
        !           879: 
        !           880: 
        !           881: LOCAL fname(name, suff)
        !           882: char *name, *suff;
        !           883: {
        !           884:        sprintf(name, "/tmp/%s%d.%s", temppref, pid, suff);
        !           885: }
        !           886: 
        !           887: 
        !           888: 
        !           889: 
        !           890: dotchar(s)
        !           891: register char *s;
        !           892: {
        !           893:        for( ; *s ; ++s)
        !           894:                if(s[0]=='.' && s[1]!='\0' && s[2]=='\0')
        !           895:                        return( s[1] );
        !           896:        return(NO);
        !           897: }
        !           898: 
        !           899: 
        !           900: 
        !           901: char *lastfield(s)
        !           902: register char *s;
        !           903: {
        !           904:        register char *t;
        !           905:        for(t = s; *s ; ++s)
        !           906:                if(*s == '/')
        !           907:                        t = s+1;
        !           908:        return(t);
        !           909: }
        !           910: 
        !           911: 
        !           912: 
        !           913: char *lastchar(s)
        !           914: register char *s;
        !           915: {
        !           916:        while(*s)
        !           917:                ++s;
        !           918:        return(s-1);
        !           919: }
        !           920: 
        !           921: char *setdoto(s)
        !           922: register char *s;
        !           923: {
        !           924:        *lastchar(s) = 'o';
        !           925:        return( lastfield(s) );
        !           926: }
        !           927: 
        !           928: 
        !           929: 
        !           930: badfile(s)
        !           931: char *s;
        !           932: {
        !           933:        fatalstr("cannot open intermediate file %s", s);
        !           934: }
        !           935: 
        !           936: 
        !           937: 
        !           938: ptr ckalloc(n)
        !           939: int n;
        !           940: {
        !           941:        ptr p, calloc();
        !           942: 
        !           943:        if( p = calloc(1, (unsigned) n) )
        !           944:                return(p);
        !           945: 
        !           946:        fatal("out of memory");
        !           947:        /* NOTREACHED */
        !           948: }
        !           949: 
        !           950: 
        !           951: 
        !           952: 
        !           953: 
        !           954: char *copyn(n, s)
        !           955: register int n;
        !           956: register char *s;
        !           957: {
        !           958:        register char *p, *q;
        !           959: 
        !           960:        p = q = (char *) ckalloc(n);
        !           961:        while(n-- > 0)
        !           962:                *q++ = *s++;
        !           963:        return(p);
        !           964: }
        !           965: 
        !           966: 
        !           967: 
        !           968: char *copys(s)
        !           969: char *s;
        !           970: {
        !           971:        return( copyn( strlen(s)+1 , s) );
        !           972: }
        !           973: 
        !           974: 
        !           975: 
        !           976: 
        !           977: 
        !           978: oneof(c,s)
        !           979: register c;
        !           980: register char *s;
        !           981: {
        !           982:        while( *s )
        !           983:                if(*s++ == c)
        !           984:                        return(YES);
        !           985:        return(NO);
        !           986: }
        !           987: 
        !           988: 
        !           989: 
        !           990: nodup(s)
        !           991: char *s;
        !           992: {
        !           993:        register char **p;
        !           994: 
        !           995:        for(p = loadargs ; p < loadp ; ++p)
        !           996:                if( !strcmp(*p, s) )
        !           997:                        return(NO);
        !           998: 
        !           999:        return(YES);
        !          1000: }
        !          1001: 
        !          1002: 
        !          1003: 
        !          1004: static fatal(t)
        !          1005: char *t;
        !          1006: {
        !          1007:        fprintf(diagfile, "Compiler error in file %s: %s\n", infname, t);
        !          1008:        if(debugflag)
        !          1009:                abort();
        !          1010:        done(1);
        !          1011:        exit(1);
        !          1012: }
        !          1013: 
        !          1014: 
        !          1015: 
        !          1016: 
        !          1017: static fatali(t,d)
        !          1018: char *t;
        !          1019: int d;
        !          1020: {
        !          1021:        char buff[100];
        !          1022:        sprintf(buff, t, d);
        !          1023:        fatal(buff);
        !          1024: }
        !          1025: 
        !          1026: 
        !          1027: 
        !          1028: 
        !          1029: static fatalstr(t, s)
        !          1030: char *t, *s;
        !          1031: {
        !          1032:        char buff[100];
        !          1033:        sprintf(buff, t, s);
        !          1034:        fatal(buff);
        !          1035: }
        !          1036: err(s)
        !          1037: char *s;
        !          1038: {
        !          1039:        fprintf(diagfile, "Error in file %s: %s\n", infname, s);
        !          1040: }
        !          1041: 
        !          1042: /* Code to generate initializations for DATA statements */
        !          1043: 
        !          1044: LOCAL int nch  = 0;
        !          1045: LOCAL FILEP asmfile;
        !          1046: LOCAL FILEP sortfile;
        !          1047: 
        !          1048: #include "ftypes"
        !          1049: 
        !          1050: static ftnint typesize[NTYPES]
        !          1051: = { 
        !          1052:        1, SZADDR, SZSHORT, SZLONG, SZLONG, 2*SZLONG,
        !          1053:        2*SZLONG, 4*SZLONG, SZLONG, 1, 1, 1};
        !          1054: static int typealign[NTYPES]
        !          1055: = { 
        !          1056:        1, ALIADDR, ALISHORT, ALILONG, ALILONG, ALIDOUBLE,
        !          1057:        ALILONG, ALIDOUBLE, ALILONG, 1, 1, 1};
        !          1058: 
        !          1059: dodata()
        !          1060: {
        !          1061:        char buff[50];
        !          1062:        char varname[XL+1], ovarname[XL+1];
        !          1063:        int status;
        !          1064:        flag erred;
        !          1065:        ftnint offset, vlen, type;
        !          1066:        register ftnint ooffset, ovlen;
        !          1067:        ftnint nblank, vchar;
        !          1068:        int size, align;
        !          1069:        int vargroup;
        !          1070:        ftnint totlen, doeven();
        !          1071: 
        !          1072:        erred = NO;
        !          1073:        ovarname[0] = '\0';
        !          1074:        ooffset = 0;
        !          1075:        ovlen = 0;
        !          1076:        totlen = 0;
        !          1077:        nch = 0;
        !          1078: 
        !          1079:        sprintf(buff, "sort %s >%s", initfname, sortfname);
        !          1080:        if(status = sys(buff))
        !          1081:                fatali("call sort status = %d", status);
        !          1082:        if( (sortfile = fopen(sortfname, "r")) == NULL)
        !          1083:                badfile(sortfname);
        !          1084:        if( (asmfile = fopen(asmfname, "a")) == NULL)
        !          1085:                badfile(asmfname);
        !          1086:        pruse(asmfile, USEINIT);
        !          1087: 
        !          1088:        while( rdname(&vargroup, varname) && rdlong(&offset) && rdlong(&vlen) && rdlong(&type) )
        !          1089:        {
        !          1090:                size = typesize[type];
        !          1091:                if( strcmp(varname, ovarname) )
        !          1092:                {
        !          1093:                        prspace(ovlen-ooffset);
        !          1094:                        strcpy(ovarname, varname);
        !          1095:                        ooffset = 0;
        !          1096:                        totlen += ovlen;
        !          1097:                        ovlen = vlen;
        !          1098:                        if(vargroup == 0)
        !          1099:                                align = (type==TYCHAR || type==TYBLANK ?
        !          1100:                                    SZLONG : typealign[type]);
        !          1101:                        else    align = ALIDOUBLE;
        !          1102:                        totlen = doeven(totlen, align);
        !          1103:                        if(vargroup == 2)
        !          1104:                                prcomblock(asmfile, varname);
        !          1105:                        else
        !          1106:                                fprintf(asmfile, LABELFMT, varname);
        !          1107:                }
        !          1108:                if(offset < ooffset)
        !          1109:                {
        !          1110:                        erred = YES;
        !          1111:                        err("overlapping initializations");
        !          1112:                        ooffset = offset;
        !          1113:                }
        !          1114:                if(offset > ooffset)
        !          1115:                {
        !          1116:                        prspace(offset-ooffset);
        !          1117:                        ooffset = offset;
        !          1118:                }
        !          1119:                if(type == TYCHAR)
        !          1120:                {
        !          1121:                        if( rdlong(&vchar) )
        !          1122:                                prch( (int) vchar );
        !          1123:                        else
        !          1124:                                fatal("bad intermediate file format");
        !          1125:                }
        !          1126:                else if(type == TYBLANK)
        !          1127:                {
        !          1128:                        if( rdlong(&nblank) )
        !          1129:                        {
        !          1130:                                size = nblank;
        !          1131:                                while( --nblank >= 0)
        !          1132:                                        prch( ' ' );
        !          1133:                        }
        !          1134:                        else
        !          1135:                                fatal("bad intermediate file format");
        !          1136:                }
        !          1137:                else
        !          1138:                {
        !          1139:                        putc('\t', asmfile);
        !          1140:                        while   ( putc( getc(sortfile), asmfile)  != '\n')
        !          1141:                                ;
        !          1142:                }
        !          1143:                if( (ooffset += size) > ovlen)
        !          1144:                {
        !          1145:                        erred = YES;
        !          1146:                        err("initialization out of bounds");
        !          1147:                }
        !          1148:        }
        !          1149: 
        !          1150:        prspace(ovlen-ooffset);
        !          1151:        totlen = doeven(totlen+ovlen, (ALIDOUBLE>SZLONG ? ALIDOUBLE : SZLONG) );
        !          1152:        clf(&sortfile);
        !          1153:        clf(&asmfile);
        !          1154:        clf(&sortfile);
        !          1155:        rmf(sortfname);
        !          1156:        return(erred);
        !          1157: }
        !          1158: 
        !          1159: 
        !          1160: 
        !          1161: 
        !          1162: prspace(n)
        !          1163: register ftnint n;
        !          1164: {
        !          1165:        register ftnint m;
        !          1166: 
        !          1167:        while(nch>0 && n>0)
        !          1168:        {
        !          1169:                --n;
        !          1170:                prch(0);
        !          1171:        }
        !          1172:        m = SZSHORT * (n/SZSHORT);
        !          1173:        if(m > 0)
        !          1174:                prskip(asmfile, m);
        !          1175:        for(n -= m ; n>0 ; --n)
        !          1176:                prch(0);
        !          1177: }
        !          1178: 
        !          1179: 
        !          1180: 
        !          1181: 
        !          1182: ftnint doeven(tot, align)
        !          1183: register ftnint tot;
        !          1184: int align;
        !          1185: {
        !          1186:        ftnint new;
        !          1187:        new = roundup(tot, align);
        !          1188:        prspace(new - tot);
        !          1189:        return(new);
        !          1190: }
        !          1191: 
        !          1192: 
        !          1193: 
        !          1194: rdname(vargroupp, name)
        !          1195: int *vargroupp;
        !          1196: register char *name;
        !          1197: {
        !          1198:        register int i, c;
        !          1199: 
        !          1200:        if( (c = getc(sortfile)) == EOF)
        !          1201:                return(NO);
        !          1202:        *vargroupp = c - '0';
        !          1203: 
        !          1204:        for(i = 0 ; i<XL ; ++i)
        !          1205:        {
        !          1206:                if( (c = getc(sortfile)) == EOF)
        !          1207:                        return(NO);
        !          1208:                if(c != ' ')
        !          1209:                        *name++ = c;
        !          1210:        }
        !          1211:        *name = '\0';
        !          1212:        return(YES);
        !          1213: }
        !          1214: 
        !          1215: 
        !          1216: 
        !          1217: rdlong(n)
        !          1218: register ftnint *n;
        !          1219: {
        !          1220:        register int c;
        !          1221: 
        !          1222:        for(c = getc(sortfile) ; c!=EOF && isspace(c) ; c = getc(sortfile) );
        !          1223:        ;
        !          1224:        if(c == EOF)
        !          1225:                return(NO);
        !          1226: 
        !          1227:        for(*n = 0 ; isdigit(c) ; c = getc(sortfile) )
        !          1228:                *n = 10* (*n) + c - '0';
        !          1229:        return(YES);
        !          1230: }
        !          1231: 
        !          1232: 
        !          1233: 
        !          1234: 
        !          1235: prch(c)
        !          1236: register int c;
        !          1237: {
        !          1238:        static int buff[SZSHORT];
        !          1239: 
        !          1240:        buff[nch++] = c;
        !          1241:        if(nch == SZSHORT)
        !          1242:        {
        !          1243:                prchars(asmfile, buff);
        !          1244:                nch = 0;
        !          1245:        }
        !          1246: }

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