UNIX 6th Ed. - /usr/source/s2/rc.c

   1: /* Ratfor-Fortran command */
   2: 
   3: extern int fin, fout;
   4: char    ts[1000];
   5: char    *tsp    ts;
   6: char    *av[50];
   7: char    *rlist[50];
   8: int nr  0;
   9: char    *llist[50];
  10: int nl  0;
  11: int nxo 0;
  12: int bdcount 0;  /* count block data files generated */
  13: int rflag;
  14: int dflag   0;
  15: int vflag   1;
  16: int fflag;
  17: int cflag;
  18: char    *complr "/usr/fort/fc1";
  19: char    *ratfor "/usr/lib/ratfor";
  20: 
  21: main(argc, argv)
  22: char *argv[]; {
  23:     char *t;
  24:     int i, j, c;
  25:     int dexit();
  26: 
  27:     for(i=0; ++i < argc; ) {
  28:         if(*argv[i] == '-')
  29:             switch (argv[i][1]) {
  30:                 default:
  31:                     goto passa;
  32:                 case 'd':
  33:                     dflag = 1;
  34:                     break;
  35:                 case 'v':
  36:                     vflag = 0;
  37:                     break;
  38:                 case 'r':
  39:                     rflag = fflag = cflag = 1;
  40:                     break;
  41:                 case 'f':
  42:                     fflag = 1;
  43:                     break;
  44:                 case 'c':
  45:                     cflag = 1;
  46:                     break;
  47:                 case '2':
  48:                     complr = "/usr/fort/fc2";
  49:                     break;
  50:             }
  51:         else {
  52:        passa:
  53:             t = argv[i];
  54:             if( (c=getsuf(t))=='r' )
  55:                 ratcomp(t);
  56:             else if( c=='f')  {
  57:                 fortcomp(t);
  58:                 llenter(setsuf(copy(t),'o'));
  59:             }
  60:             else
  61:                 llenter(copy(t));
  62:         }
  63:     }
  64:     if(rflag)
  65:         dexit();
  66:     if ((signal(2, 1) & 01) == 0)
  67:         signal(2, &dexit);
  68:     if(dflag)
  69:         printf("cflag=%d, nl=%d\n", cflag, nl);
  70:     if (cflag==0 && nl!=0) {
  71:         i = 0;
  72:         av[0] = "ld";
  73:         av[1] = "-x";
  74:         av[2] = "/lib/fr0.o";
  75:         j = 3;
  76:         while(i<nl)
  77:             av[j++] = llist[i++];
  78:         av[j++] = "-lf";
  79:         av[j++] = "/lib/filib.a";
  80:         av[j++] = "-l";
  81:         av[j++] = 0;
  82:         callsys("/bin/ld", av);
  83:     }
  84:     dexit();
  85: }
  86: 
  87: dexit()
  88: {
  89:     int i;
  90:     cunlink("ratjunk");
  91:     cunlink("f.tmp1");
  92:     exit(0);
  93: }
  94: 
  95: 
  96: ratcomp(s) char *s; {
  97:     int i,j,t,nerr,status;
  98:     nr = 0;
  99:     if(vflag)
 100:         printf("%s:\n",s);
 101:     av[0] = ratfor;
 102:     av[1] = s;
 103:     av[2] = 0;
 104:     if( (t=fork())==0 ){
 105:         close(1);
 106:         fout = creat("ratjunk", 0666);
 107:         execv(ratfor, av);
 108:         fout = 2;
 109:         error("can't ratfor\n");
 110:         exit(1);
 111:     }
 112:     while( t!=wait(&status) );
 113:     if( (t=(status&0377)) != 0 && t!=14 )
 114:         dexit(1);
 115:     t = (status>>8) & 0377;
 116:     if( t )
 117:         return(++cflag);
 118:     splitup();
 119:     nerr=0;
 120:     for(i=0; i<nr; i++){
 121:         if( vflag ) printf("   ");
 122:         if( fortcomp(rlist[i]) )
 123:             nerr++;
 124:     }
 125:     if( nerr )
 126:         return(1);
 127:     av[0] = "ld";
 128:     av[1] = "-r";
 129:     av[2] = "-x";
 130:     j = 3;
 131:     for(i=0; i<nr; i++)
 132:         av[j++] = rlist[i];
 133:     av[j] = 0;
 134:     callsys("/bin/ld", av);
 135:     t = setsuf(copy(s),'o');
 136:     if( move("a.out", t) )
 137:         cflag++;
 138:     llenter(t);
 139:     for(i=0; i<nr; i++) {
 140:         if( nodup(llist,rlist[i]) )
 141:             cunlink(rlist[i]);
 142:         if( fflag==0 )
 143:             cunlink(setsuf(rlist[i],'f'));
 144:     }
 145: }
 146: 
 147: fortcomp(s) char *s; {
 148:     int t;
 149:     if( vflag ) printf("%s:\n", s);
 150:     av[0] = complr;
 151:     av[1] = s;
 152:     av[2] = 0;
 153:     if( callsys(complr, av) )
 154:         return(++cflag);
 155:     av[0] = "as";
 156:     av[1] = "-";
 157:     av[2] = "f.tmp1";
 158:     av[3] = 0;
 159:     callsys("/bin/as", av);
 160:     t = setsuf(s, 'o');
 161:     if( move("a.out", t) )
 162:         return(++cflag);
 163:     return(0);
 164: }
 165: 
 166: getsuf(s)
 167: char s[];
 168: {
 169:     int c;
 170:     char t, *os;
 171: 
 172:     c = 0;
 173:     os = s;
 174:     while(t = *s++)
 175:         if (t=='/')
 176:             c = 0;
 177:         else
 178:             c++;
 179:     s =- 3;
 180:     if (c<=14 && c>2 && *s++=='.')
 181:         return(*s);
 182:     return(0);
 183: }
 184: 
 185: setsuf(s, ch)
 186: char s[];
 187: {
 188:     char *os;
 189: 
 190:     os = s;
 191:     while(*s++);
 192:     s[-2] = ch;
 193:     return(os);
 194: }
 195: 
 196: move(s,t) char *s, *t; {
 197:     cunlink(t);
 198:     if(link(s, t) || cunlink(s)) {
 199:         printf("move failed: %s\n", t);
 200:         return(1);
 201:     }
 202:     return(0);
 203: }
 204: 
 205: callsys(f, v)
 206: char f[], *v[]; {
 207:     int i, t, status;
 208: 
 209:     if(dflag){
 210:         for(i=0; v[i]; i++)
 211:             printf("%s ", v[i]);
 212:         putchar('\n');
 213:     }
 214:     if ((t=fork())==0) {
 215:         execv(f, v);
 216:         printf("Can't find %s\n", f);
 217:         exit(1);
 218:     } else
 219:         if (t == -1) {
 220:             printf("Try again\n");
 221:             return(1);
 222:         }
 223:     while(t!=wait(&status));
 224:     if ((t=(status&0377)) != 0 && t!=14) {
 225:         if (t!=2)       /* interrupt */
 226:             printf("Fatal error in %s\n", f);
 227:         dexit();
 228:     }
 229:     t = (status>>8) & 0377;
 230:     if(dflag && status != 0)
 231:         printf("status = %d\n", t);
 232:     return(t);
 233: }
 234: 
 235: copy(s)
 236: char s[]; {
 237:     char *otsp;
 238: 
 239:     otsp = tsp;
 240:     while(*tsp++ = *s++);
 241:     return(otsp);
 242: }
 243: 
 244: nodup(l, s)
 245: char **l, s[]; {
 246:     char *t, *os, c;
 247: 
 248:     if (getsuf(s) != 'o')
 249:         return(1);
 250:     os = s;
 251:     while(t = *l++) {
 252:         s = os;
 253:         while(c = *s++)
 254:             if (c != *t++)
 255:                 break;
 256:         if (*t++ == '\0')
 257:             return(0);
 258:     }
 259:     return(1);
 260: }
 261: 
 262: llenter(t) char *t; {
 263:     if (nodup(llist, t)) {
 264:         llist[nl++] = t;
 265:         if (getsuf(t)=='o')
 266:             nxo++;
 267:     }
 268: }
 269: 
 270: cunlink(f)
 271: char *f;
 272: {
 273:     if( dflag )
 274:         printf("unlink %s\n", f);
 275:     if (f==0)
 276:         return(0);
 277:     return(unlink(f));
 278: }
 279: 
 280: splitup(){
 281:     char in[200], fname[20];
 282:     int buf[259];
 283:     int i,fd,c;
 284:     if( (fin=open("ratjunk", 0)) < 0)
 285:         error("can't open ratjunk\n");
 286:     while( gets(in) ){
 287:         getname(in, fname);
 288:         savename(fname);
 289:         if( (fd = fcreat(fname, buf)) < 0)
 290:             error("can't open %s", fname);
 291:         puts(in,buf);
 292:         while( ! endcard(in) ){
 293:             gets(in);
 294:             puts(in,buf);
 295:         }
 296:         fflush(buf);
 297:         close(fd);
 298:     }
 299:     close(fin);
 300: }
 301: 
 302: gets(s) char *s; {
 303:     int c;
 304:     while( (*s++=c=getchar()) != '\n' && c != '\0' );
 305:     *s = '\0';
 306:     return(c);
 307: }
 308: 
 309: puts(s,b) char *s; int *b; {
 310:     while( *s )
 311:         putc(*s++, b);
 312: }
 313: 
 314: savename(s) char *s; {
 315:     rlist[nr++] = copy(s);
 316: }
 317: 
 318: getname(s,f) char *s,*f; {
 319:     int i,j,c;
 320:    loop:
 321:     while( *s == ' ' || *s == '\t' )
 322:         s++;
 323:     if( compar(s,"subroutine") ){ s =+ 10; goto bot; }
 324:     else if( compar( s,"function") ){ s =+ 8; goto bot; }
 325:     else if( compar(s,"real") ){ s =+ 4; goto loop; }
 326:     else if( compar(s,"integer") ){ s =+ 7; goto loop; }
 327:     else if( compar(s,"logical") ){ s =+ 7; goto loop; }
 328:     else if( compar(s,"double") ){ s =+ 6; goto loop; }
 329:     else if( compar(s,"precision") ){ s =+ 9; goto loop; }
 330:     else if( compar(s,"complex") ){ s =+ 7; goto loop; }
 331:     else if( compar(s,"block") ){
 332:         s = "blockdata ";
 333:         s[9] = (bdcount++) + '0';
 334:         goto bot;
 335:     }
 336:     else {
 337:         for(i=0; f[i]="MAIN.f"[i]; i++);
 338:         return;
 339:     }
 340:    bot:
 341:     while( *s == ' ' || *s == '\t' )
 342:         s++;
 343:     for(i=0; alphanum(s[i]); i++)
 344:         f[i] = s[i];
 345:     f[i++] = '.';
 346:     f[i++] = 'f';
 347:     f[i++] = '\0';
 348: }
 349: 
 350: compar(s,t) char *s,*t; {
 351:     while( *t )
 352:         if( *s++ != *t++ )
 353:             return(0);
 354:     return(1);
 355: }
 356: 
 357: alphanum(c) int c; {
 358:     return( (c>='a' && c<='z')
 359:         || (c>='A' && c<='Z')
 360:         || (c>='0' && c<='9') );
 361: }
 362: 
 363: endcard(s) char *s; {
 364:     if( *s==0 )
 365:         return(1);
 366:     while( *s==' ' || *s=='\t' )
 367:         s++;
 368:     if( *s!='e' || *(s+1)!='n' || *(s+2)!='d' || *(s+3)!='\n' )
 369:         return(0);
 370:     return(1);
 371: }
 372: 
 373: error(s1, s2){
 374:     fout = 1;
 375:     printf(s1,s2);
 376:     putchar('\n');
 377:     flush(1);
 378:     cflag++;
 379: }

Defined functions

Defined variables