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

   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

Defined variables

Defined struct's