home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V6 / usr / source / s1 / fc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1975-05-13  |  6.7 KB  |  469 lines
  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. }
  469.