2.9BSD - /usr/src/cmd/f77/driver.c

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

Defined functions

Defined variables

Defined struct's

Defined macros