# 2.11BSD#431 - /usr/src/usr.bin/f77/driver.c

##### Functions

    await             X
    badfile           X
    ckalloc           X
    clf               X
    content           X
    copyn             X
    copys             X
    crfnames          X
    doasm             X
    dodata            X
    doeven            X
    dofort            X
    doload            X
    done              X
    dopass2           X
    dotchar           X
    enbint            X
    err               X
    fname             X
    intrupt           X
    lastchar          X
    lastfield         X
    main              X
    nodup             X
    prch              X
    prspace           X
    rdlong            X
    rdname            X
    rmf               X
    rmfiles           X
    setdoto           X
    sys               X
    texec             X
    unreadable        X

##### Variables

    nch               X
    xxxvers           X

##### struct's

    stat              X

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

#### Defined functions

await defined in line 707; used 2 times

- in line 539, 633

badfile defined in line 892; used 2 times

- in line 1021-1023(2)

ckalloc defined in line 900; used 3 times

- in line 76, 91, 922

clf defined in line 751; used 4 times

- in line 1076-1078(3)
- in /usr/src/usr.bin/f77/lex.c line 146

content defined in line 784; used 1 times

- in line 377

copyn defined in line 916; used 1 times

- in line 933

copys defined in line 930; used 1 times

- in line 237

crfnames defined in line 813; used 1 times

- in line 89

doasm defined in line 430; used 1 times

- in line 382

dodata defined in line 997; used 1 times

- in line 378

doeven defined in line 1106; used 3 times

- in line 1008, 1039, 1075

dofort defined in line 356; used 2 times

- in line 300, 314

doload defined in line 508; used 1 times

- in line 352

done defined in line 666; used 8 times

- in line 216, 353, 702, 724, 960
- in /usr/src/usr.bin/f77/error.c line 54, 110
- in /usr/src/usr.bin/f77/lex.c line 132

dopass2 defined in line 405; used 1 times

- in line 380

dotchar defined in line 852; used 1 times

- in line 254

enbint defined in line 684; used 5 times

- in line 86, 535, 624, 713-717(2)

err defined in line 978; used 3 times

- in line 549, 1048, 1070

fatal defined in line 954; used 7 times

- in line 495, 655, 716, 757, 908, 972, 1058

fatal1 defined in line 967; used 6 times

- in line 125, 537, 630, 658, 895, 1019

fname defined in line 840; used 9 times

- in line 815-823(9)

intrupt defined in line 700; used 3 times

- in line 80, 86, 717

lastchar defined in line 875; used 4 times

- in line 75, 298, 439, 886

lastfield defined in line 863; used 4 times

- in line 75, 264, 297, 887

main defined in line 70; never used
nodup defined in line 940; used 4 times

- in line 303, 316, 334-339(2)

prch defined in line 1159; used 3 times

- in line 1059, 1094, 1100

prspace defined in line 1086; used 4 times

- in line 1031, 1052, 1074, 1112

rdlong defined in line 1141; used 4 times

- in line 1026(3), 1057

rdname defined in line 1118; used 1 times

- in line 1026

rmf defined in line 829; used 16 times

- in line 274, 287-291(2), 305, 386-388(3), 448, 499-503(2), 765-770(5), 1079

rmfiles defined in line 763; used 1 times

- in line 674

setdoto defined in line 883; used 6 times

- in line 75, 303, 316, 334, 440
- in /usr/src/usr.bin/f77/defs line 434

sys defined in line 559; used 15 times

- in line 272, 285, 331, 367, 414, 423, 447-452(2), 463-466(2), 481, 494, 548(2), 1018

texec defined in line 643; used 3 times

- in line 626-628(3)

unreadable defined in line 731; used 3 times

- in line 258, 312, 322

#### Defined variables

aflagp defined in line 51; never used
aflags defined in line 43; used 2 times

- in line 51, 486

aoutname defined in line 26; used 5 times

- in line 193, 345, 518, 546-547(2)

asmfname defined in line 31; used 13 times

- in line 366, 386, 462-465(2), 475-491(5), 766, 816, 1022-1023(2)

asmname defined in line 20; used 5 times

- in line 117, 475, 482-491(3)

asmpass2 defined in line 32; used 14 times

- in line 413, 419-421(2), 446-451(2), 462-465(2), 475-480(2), 487-491(2), 503, 768, 817

cflagp defined in line 49; used 2 times

- in line 155, 183

cflags defined in line 41; used 2 times

- in line 49, 330

debugflag defined in line 63; used 5 times

- in line 177, 525, 570, 832, 958

eflagp defined in line 53; used 2 times

- in line 224-226(2)

eflags defined in line 45; used 2 times

- in line 53, 282

erred defined in line 58; used 15 times

- in line 260, 275, 290, 301, 313-315(2), 324, 332, 351-353(2), 1002, 1010, 1047, 1069, 1080

fflagp defined in line 48; used 7 times

- in line 132-133(2), 142, 151-153(2), 190, 212

fflags defined in line 40; used 2 times

- in line 48, 366

footname defined in line 22; used 2 times

- in line 121, 251

fortonly defined in line 66; used 2 times

- in line 205, 295

infname defined in line 29; used 11 times

- in line 254, 271, 278-287(4), 297-298(2), 362, 957, 981

initfname defined in line 33; used 6 times

- in line 366, 377, 387, 767, 818, 1017

ldname defined in line 21; used 5 times

- in line 119, 245, 536-539(3)

lflag defined in line 47; used 2 times

- in line 236-237(2)

loadargs defined in line 55; used 10 times

- in line 91-100(7), 245, 352, 945

loadflag defined in line 59; used 3 times

- in line 169, 206, 351

loadp defined in line 56; used 14 times

- in line 100, 148-149(2), 220, 237, 248-251(2), 304, 317, 335-340(2), 347-352(2), 945

macroflag defined in line 67; used 3 times

- in line 162, 269, 286

macroname defined in line 24; used 2 times

- in line 123, 271

nch defined in line 984; used 5 times

- in line 1015, 1091, 1164-1168(3)

nofloating defined in line 65; used 2 times

- in line 199, 247

objfdefault defined in line 36; used 2 times

- in line 438, 820

optimflag defined in line 62; used 3 times

- in line 146, 444, 543

optzfname defined in line 37; used 4 times

- in line 446-451(3), 822

pass1name defined in line 18; used 2 times

- in line 113, 366

pass2name defined in line 19; used 5 times

- in line 115, 200, 413, 419-421(2)

pid defined in line 12; used 4 times

- in line 88, 546-547(2), 843

prepfname defined in line 35; used 4 times

- in line 271-278(3), 821

proffoot defined in line 23; used 1 times

- in line 251

profileflag defined in line 61; used 3 times

- in line 181, 248-251(2)

rflagp defined in line 54; used 2 times

- in line 229-231(2)

rflags defined in line 46; used 2 times

- in line 54, 284

saveasmflag defined in line 60; used 2 times

- in line 166, 458

setfname defined in line 38; used 5 times

- in line 419, 462, 475, 770, 823

shellname defined in line 25; used 2 times

- in line 574, 654

sighvalue defined in line 15; used 2 times

- in line 84, 691

sigivalue defined in line 13; used 2 times

- in line 82, 687

sigqvalue defined in line 14; used 2 times

- in line 83, 689

sigtvalue defined in line 16; used 2 times

- in line 85, 693

sortfname defined in line 34; used 5 times

- in line 819, 1017-1021(3), 1079

textfname defined in line 30; used 7 times

- in line 366, 388, 413, 419-421(2), 765, 815

tmpfiles defined in line 27; used 1 times

- in line 843

typealign defined in line 993; used 1 times

- in line 1037

typesize defined in line 990; used 1 times

- in line 1028

verbose defined in line 64; used 6 times

- in line 173, 363, 409, 472, 496, 553

xxxvers defined in line 1; never used

#### Defined struct's

stat defined in line 788; used 2 times

- in line 798(2)

Last modified: 1995-06-10 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 2936 |