UNIX 6th Ed. - /usr/source/s1/fc.c

   1: /* Fortran command */
   2: 
   3: char    *tmp;
   4: char ts[1000];
   5: char *tsp ts;
   6: char *av[50];
   7: char *clist[50];
   8: char *llist[50];
   9: int instring;
  10: int pflag;
  11: int cflag;
  12: char    *complr;
  13: int *ibuf;
  14: int *ibuf1;
  15: int *ibuf2;
  16: int *obuf;
  17: char *lp;
  18: char *line;
  19: int lineno;
  20: int exfail;
  21: struct symtab {
  22:     char name[8];
  23:     char *value;
  24: } *symtab;
  25: int symsiz 200;
  26: struct symtab *defloc;
  27: struct symtab *incloc;
  28: char *stringbuf;
  29: 
  30: main(argc, argv)
  31: char *argv[]; {
  32:     char *t;
  33:     int nc, nl, i, j, c, nxo;
  34:     int dexit();
  35: 
  36:     complr = "/usr/fort/fc1";
  37:     i = nc = nl = nxo = 0;
  38:     while(++i < argc) {
  39:         if(*argv[i] == '-')
  40:             switch (argv[i][1]) {
  41:                 default:
  42:                     goto passa;
  43:                 case 'p':
  44:                     pflag++;
  45:                 case 'c':
  46:                     cflag++;
  47:                     break;
  48:                 case '2':
  49:                     complr = "/usr/fort/fc2";
  50:                     break;
  51:             }
  52:         else {
  53:         passa:
  54:             t = argv[i];
  55:             if(getsuf(t)=='f') {
  56:                 clist[nc++] = t;
  57:                 t = setsuf(copy(t), 'o');
  58:             }
  59:             if (nodup(llist, t)) {
  60:                 llist[nl++] = t;
  61:                 if (getsuf(t)=='o')
  62:                     nxo++;
  63:             }
  64:         }
  65:     }
  66:     if(nc==0)
  67:         goto nocom;
  68:     if ((signal(2, 1) & 01) == 0)
  69:         signal(2, &dexit);
  70:     for (i=0; i<nc; i++) {
  71:         if (nc>1)
  72:             printf("%s:\n", clist[i]);
  73:         tmp = 0;
  74:         av[0] = complr;
  75:         av[1] = expand(clist[i]);
  76:         if (pflag || exfail)
  77:             continue;
  78:         if (av[1] == 0) {
  79:             cflag++;
  80:             continue;
  81:         }
  82:         av[2] = 0;
  83:         t = callsys(complr, av);
  84:         if(tmp)
  85:             cunlink(tmp);
  86:         if(t) {
  87:             cflag++;
  88:             continue;
  89:         }
  90:         av[0] = "as";
  91:         av[1] = "-";
  92:         av[2] = "f.tmp1";
  93:         av[3] = 0;
  94:         callsys("/bin/as", av);
  95:         t = setsuf(clist[i], 'o');
  96:         cunlink(t);
  97:         if(link("a.out", t) || cunlink("a.out")) {
  98:             printf("move failed: %s\n", t);
  99:             cflag++;
 100:         }
 101:     }
 102: nocom:
 103:     if (cflag==0 && nl!=0) {
 104:         i = 0;
 105:         av[0] = "ld";
 106:         av[1] = "-x";
 107:         av[2] = "/lib/fr0.o";
 108:         j = 3;
 109:         while(i<nl)
 110:             av[j++] = llist[i++];
 111:         av[j++] = "-lf";
 112:         av[j++] = "/lib/filib.a";
 113:         av[j++] = "-l";
 114:         av[j++] = 0;
 115:         callsys("/bin/ld", av);
 116:         if (nc==1 && nxo==1)
 117:             cunlink(setsuf(clist[0], 'o'));
 118:     }
 119:     dexit();
 120: }
 121: 
 122: dexit()
 123: {
 124:     unlink("f.tmp1");
 125:     exit();
 126: }
 127: 
 128: expand(file)
 129: char *file;
 130: {
 131:     int ib1[259], ib2[259], ob[259];
 132:     struct symtab stab[200];
 133:     char ln[196], sbf[1024];
 134:     int c;
 135: 
 136:     exfail = 0;
 137:     ibuf = ibuf1 = ib1;
 138:     ibuf2 = ib2;
 139:     if (fopen(file, ibuf1)<0)
 140:         return(file);
 141:     if (getc(ibuf1) != '#') {
 142:         close(ibuf1[0]);
 143:         return(file);
 144:     }
 145:     ibuf1[1]++;
 146:     ibuf1[2]--;
 147:     obuf = ob;
 148:     symtab = stab;
 149:     for (c=0; c<200; c++) {
 150:         stab[c].name[0] = '\0';
 151:         stab[c].value = 0;
 152:     }
 153:     defloc = lookup("define", 1);
 154:     defloc->value = defloc->name;
 155:     incloc = lookup("include", 1);
 156:     incloc->value = incloc->name;
 157:     stringbuf = sbf;
 158:     line  = ln;
 159:     lineno = 0;
 160:     tmp = setsuf(copy(file), 'i');
 161:     if (fcreat(tmp, obuf) < 0) {
 162:         printf("Can't creat %s\n", tmp);
 163:         dexit();
 164:     }
 165:     while(getline()) {
 166: /*
 167: 		if (ibuf==ibuf2)
 168: 			putc(001, obuf);	/*SOH: insert */
 169:         if (ln[0] != '#')
 170:             for (lp=line; *lp!='\0'; lp++)
 171:                 putc(*lp, obuf);
 172:         putc('\n', obuf);
 173:     }
 174:     fflush(obuf);
 175:     close(obuf[0]);
 176:     close(ibuf1[0]);
 177:     return(tmp);
 178: }
 179: 
 180: getline()
 181: {
 182:     int c, sc, state;
 183:     struct symtab *np;
 184:     char *namep, *filname;
 185: 
 186:     if (ibuf==ibuf1)
 187:         lineno++;
 188:     lp = line;
 189:     *lp = '\0';
 190:     state = 0;
 191:     if ((c=getch()) == '#')
 192:         state = 1;
 193:     while (c!='\n' && c!='\0') {
 194:         if ('a'<=c && c<='z' || 'A'<=c && c<='Z' || c=='_') {
 195:             namep = lp;
 196:             sch(c);
 197:             while ('a'<=(c=getch()) && c<='z'
 198:                   ||'A'<=c && c<='Z'
 199:                   ||'0'<=c && c<='9'
 200:                   ||c=='_')
 201:                 sch(c);
 202:             sch('\0');
 203:             lp--;
 204:             np = lookup(namep, state);
 205:             if (state==1) {
 206:                 if (np==defloc)
 207:                     state = 2;
 208:                 else if (np==incloc)
 209:                     state = 3;
 210:                 else {
 211:                     error("Undefined control");
 212:                     while (c!='\n' && c!='\0')
 213:                         c = getch();
 214:                     return(c);
 215:                 }
 216:             } else if (state==2) {
 217:                 np->value = stringbuf;
 218:                 while ((c=getch())!='\n' && c!='\0')
 219:                     savch(c);
 220:                 savch('\0');
 221:                 return(1);
 222:             }
 223:             continue;
 224:         } else if ((sc=c)=='\'' || sc=='"') {
 225:             sch(sc);
 226:             filname = lp;
 227:             instring++;
 228:             while ((c=getch())!=sc && c!='\n' && c!='\0') {
 229:                 sch(c);
 230:                 if (c=='\\')
 231:                     sch(getch());
 232:             }
 233:             instring = 0;
 234:             if (state==3) {
 235:                 *lp = '\0';
 236:                 while ((c=getch())!='\n' && c!='\0');
 237:                 if (ibuf==ibuf2)
 238:                     error("Nested 'include'");
 239:                 if (fopen(filname, ibuf2)<0)
 240:                     error("Missing file %s", filname);
 241:                 else
 242:                     ibuf = ibuf2;
 243:                 return(c);
 244:             }
 245:         }
 246:         sch(c);
 247:         c = getch();
 248:     }
 249:     sch('\0');
 250:     if (state>1)
 251:         error("Control syntax");
 252:     return(c);
 253: }
 254: 
 255: error(s, x)
 256: {
 257:     printf("%d: ", lineno);
 258:     printf(s, x);
 259:     putchar('\n');
 260:     exfail++;
 261:     cflag++;
 262: }
 263: 
 264: sch(c)
 265: {
 266:     if (lp==line+194)
 267:         error("Line overflow");
 268:     *lp++ = c;
 269:     if (lp>line+195)
 270:         lp = line+195;
 271: }
 272: 
 273: savch(c)
 274: {
 275:     *stringbuf++ = c;
 276: }
 277: 
 278: getch()
 279: {
 280:     static peekc;
 281:     int c;
 282: 
 283:     if (peekc) {
 284:         c = peekc;
 285:         peekc = 0;
 286:         return(c);
 287:     }
 288: loop:
 289:     if ((c=getc1())=='/' && !instring) {
 290:         if ((peekc=getc1())!='*')
 291:             return('/');
 292:         peekc = 0;
 293:         for(;;) {
 294:             c = getc1();
 295:         cloop:
 296:             switch (c) {
 297: 
 298:             case '\0':
 299:                 return('\0');
 300: 
 301:             case '*':
 302:                 if ((c=getc1())=='/')
 303:                     goto loop;
 304:                 goto cloop;
 305: 
 306:             case '\n':
 307:                 if (ibuf==ibuf1) {
 308:                     putc('\n', obuf);
 309:                     lineno++;
 310:                 }
 311:                 continue;
 312:             }
 313:         }
 314:     }
 315:     return(c);
 316: }
 317: 
 318: getc1()
 319: {
 320:     int c;
 321: 
 322:     if ((c = getc(ibuf)) < 0 && ibuf==ibuf2) {
 323:         close(ibuf2[0]);
 324:         ibuf = ibuf1;
 325:         putc('\n', obuf);
 326:         c = getc1();
 327:     }
 328:     if (c<0)
 329:         return(0);
 330:     return(c);
 331: }
 332: 
 333: lookup(namep, enterf)
 334: char *namep;
 335: {
 336:     char *np, *snp;
 337:     struct symtab *sp;
 338:     int i, c;
 339: 
 340:     np = namep;
 341:     i = 0;
 342:     while (c = *np++)
 343:         i =+ c;
 344:     i =% symsiz;
 345:     sp = &symtab[i];
 346:     while (sp->name[0]) {
 347:         snp = sp;
 348:         np = namep;
 349:         while (*snp++ == *np)
 350:             if (*np++ == '\0' || np==namep+8) {
 351:                 if (!enterf)
 352:                     subst(namep, sp);
 353:                 return(sp);
 354:             }
 355:         if (sp++ > &symtab[symsiz])
 356:             sp = symtab;
 357:     }
 358:     if (enterf) {
 359:         for (i=0; i<8; i++)
 360:             if (sp->name[i] = *namep)
 361:                 namep++;
 362:         while (*namep)
 363:             namep++;
 364:     }
 365:     return(sp);
 366: }
 367: 
 368: subst(np, sp)
 369: char *np;
 370: struct symtab *sp;
 371: {
 372:     char *vp;
 373: 
 374:     lp = np;
 375:     if ((vp = sp->value) == 0)
 376:         return;
 377:     sch(' ');
 378:     while (*vp)
 379:         sch(*vp++);
 380:     sch(' ');
 381: }
 382: 
 383: getsuf(s)
 384: char s[];
 385: {
 386:     int c;
 387:     char t, *os;
 388: 
 389:     c = 0;
 390:     os = s;
 391:     while(t = *s++)
 392:         if (t=='/')
 393:             c = 0;
 394:         else
 395:             c++;
 396:     s =- 3;
 397:     if (c<=14 && c>2 && *s++=='.')
 398:         return(*s);
 399:     return(0);
 400: }
 401: 
 402: setsuf(s, ch)
 403: char s[];
 404: {
 405:     char *os;
 406: 
 407:     os = s;
 408:     while(*s++);
 409:     s[-2] = ch;
 410:     return(os);
 411: }
 412: 
 413: callsys(f, v)
 414: char f[], *v[]; {
 415:     int t, status;
 416: 
 417:     if ((t=fork())==0) {
 418:         execv(f, v);
 419:         printf("Can't find %s\n", f);
 420:         exit(1);
 421:     } else
 422:         if (t == -1) {
 423:             printf("Try again\n");
 424:             return(1);
 425:         }
 426:     while(t!=wait(&status));
 427:     if ((t=(status&0377)) != 0 && t!=14) {
 428:         if (t!=2)       /* interrupt */
 429:             printf("Fatal error in %s\n", f);
 430:         dexit();
 431:     }
 432:     return((status>>8) & 0377);
 433: }
 434: 
 435: copy(s)
 436: char s[]; {
 437:     char *otsp;
 438: 
 439:     otsp = tsp;
 440:     while(*tsp++ = *s++);
 441:     return(otsp);
 442: }
 443: 
 444: nodup(l, s)
 445: char **l, s[]; {
 446:     char *t, *os, c;
 447: 
 448:     if (getsuf(s) != 'o')
 449:         return(1);
 450:     os = s;
 451:     while(t = *l++) {
 452:         s = os;
 453:         while(c = *s++)
 454:             if (c != *t++)
 455:                 break;
 456:         if (*t++ == '\0')
 457:             return(0);
 458:     }
 459:     return(1);
 460: }
 461: 
 462: cunlink(f)
 463: char *f;
 464: {
 465:     if (f==0)
 466:         return(0);
 467:     return(unlink(f));
 468: }

Defined functions

Defined variables

Defined struct's