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