home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / bsd_srcs / usr.bin / fsplit / fsplit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-04-12  |  9.6 KB  |  409 lines
  1. /*
  2.  * Copyright (c) 1983 The Regents of the University of California.
  3.  * All rights reserved.
  4.  *
  5.  * This code is derived from software contributed to Berkeley by
  6.  * Asa Romberger and Jerry Berkman.
  7.  *
  8.  * Redistribution and use in source and binary forms, with or without
  9.  * modification, are permitted provided that the following conditions
  10.  * are met:
  11.  * 1. Redistributions of source code must retain the above copyright
  12.  *    notice, this list of conditions and the following disclaimer.
  13.  * 2. Redistributions in binary form must reproduce the above copyright
  14.  *    notice, this list of conditions and the following disclaimer in the
  15.  *    documentation and/or other materials provided with the distribution.
  16.  * 3. All advertising materials mentioning features or use of this software
  17.  *    must display the following acknowledgement:
  18.  *    This product includes software developed by the University of
  19.  *    California, Berkeley and its contributors.
  20.  * 4. Neither the name of the University nor the names of its contributors
  21.  *    may be used to endorse or promote products derived from this software
  22.  *    without specific prior written permission.
  23.  *
  24.  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
  25.  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  26.  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  27.  * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  28.  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  29.  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  30.  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  31.  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  32.  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  33.  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  34.  * SUCH DAMAGE.
  35.  */
  36.  
  37. #ifndef lint
  38. char copyright[] =
  39. "@(#) Copyright (c) 1983 The Regents of the University of California.\n\
  40.  All rights reserved.\n";
  41. #endif /* not lint */
  42.  
  43. #ifndef lint
  44. static char sccsid[] = "@(#)fsplit.c    5.5 (Berkeley) 3/12/91";
  45. #endif /* not lint */
  46.  
  47. #include <ctype.h>
  48. #include <stdio.h>
  49. #include <sys/types.h>
  50. #include <sys/stat.h>
  51.  
  52. /*
  53.  *    usage:        fsplit [-e efile] ... [file]
  54.  *
  55.  *    split single file containing source for several fortran programs
  56.  *        and/or subprograms into files each containing one
  57.  *        subprogram unit.
  58.  *    each separate file will be named using the corresponding subroutine,
  59.  *        function, block data or program name if one is found; otherwise
  60.  *        the name will be of the form mainNNN.f or blkdtaNNN.f .
  61.  *        If a file of that name exists, it is saved in a name of the
  62.  *        form zzz000.f .
  63.  *    If -e option is used, then only those subprograms named in the -e
  64.  *        option are split off; e.g.:
  65.  *            fsplit -esub1 -e sub2 prog.f
  66.  *        isolates sub1 and sub2 in sub1.f and sub2.f.  The space 
  67.  *        after -e is optional.
  68.  *
  69.  *    Modified Feb., 1983 by Jerry Berkman, Computing Services, U.C. Berkeley.
  70.  *        - added comments
  71.  *        - more function types: double complex, character*(*), etc.
  72.  *        - fixed minor bugs
  73.  *        - instead of all unnamed going into zNNN.f, put mains in
  74.  *          mainNNN.f, block datas in blkdtaNNN.f, dups in zzzNNN.f .
  75.  */
  76.  
  77. #define BSZ 512
  78. char buf[BSZ];
  79. FILE *ifp;
  80. char     x[]="zzz000.f",
  81.     mainp[]="main000.f",
  82.     blkp[]="blkdta000.f";
  83. char *look(), *skiplab(), *functs();
  84.  
  85. #define TRUE 1
  86. #define FALSE 0
  87. int    extr = FALSE,
  88.     extrknt = -1,
  89.     extrfnd[100];
  90. char    extrbuf[1000],
  91.     *extrnames[100];
  92. struct stat sbuf;
  93.  
  94. #define trim(p)    while (*p == ' ' || *p == '\t') p++
  95.  
  96. main(argc, argv)
  97. char **argv;
  98. {
  99.     register FILE *ofp;    /* output file */
  100.     register rv;        /* 1 if got card in output file, 0 otherwise */
  101.     register char *ptr;
  102.     int nflag,        /* 1 if got name of subprog., 0 otherwise */
  103.         retval,
  104.         i;
  105.     char name[20],
  106.         *extrptr = extrbuf;
  107.  
  108.     /*  scan -e options */
  109.     while ( argc > 1  && argv[1][0] == '-' && argv[1][1] == 'e') {
  110.         extr = TRUE;
  111.         ptr = argv[1] + 2;
  112.         if(!*ptr) {
  113.             argc--;
  114.             argv++;
  115.             if(argc <= 1) badparms();
  116.             ptr = argv[1];
  117.         }
  118.         extrknt = extrknt + 1;
  119.         extrnames[extrknt] = extrptr;
  120.         extrfnd[extrknt] = FALSE;
  121.         while(*ptr) *extrptr++ = *ptr++;
  122.         *extrptr++ = 0;
  123.         argc--;
  124.         argv++;
  125.     }
  126.  
  127.     if (argc > 2)
  128.         badparms();
  129.     else if (argc == 2) {
  130.         if ((ifp = fopen(argv[1], "r")) == NULL) {
  131.             fprintf(stderr, "fsplit: cannot open %s\n", argv[1]);
  132.             exit(1);
  133.         }
  134.     }
  135.     else
  136.         ifp = stdin;
  137.     for(;;) {
  138.     /* look for a temp file that doesn't correspond to an existing file */
  139.     get_name(x, 3);
  140.     ofp = fopen(x, "w");
  141.     nflag = 0;
  142.     rv = 0;
  143.     while (getline() > 0) {
  144.         rv = 1;
  145.         fprintf(ofp, "%s", buf);
  146.         if (lend())        /* look for an 'end' statement */
  147.             break;
  148.         if (nflag == 0)        /* if no name yet, try and find one */
  149.             nflag = lname(name);
  150.     }
  151.     fclose(ofp);
  152.     if (rv == 0) {            /* no lines in file, forget the file */
  153.         unlink(x);
  154.         retval = 0;
  155.         for ( i = 0; i <= extrknt; i++ )
  156.             if(!extrfnd[i]) {
  157.                 retval = 1;
  158.                 fprintf( stderr, "fsplit: %s not found\n",
  159.                     extrnames[i]);
  160.             }
  161.         exit( retval );
  162.     }
  163.     if (nflag) {            /* rename the file */
  164.         if(saveit(name)) {
  165.             if (stat(name, &sbuf) < 0 ) {
  166.                 link(x, name);
  167.                 unlink(x);
  168.                 printf("%s\n", name);
  169.                 continue;
  170.             } else if (strcmp(name, x) == 0) {
  171.                 printf("%s\n", x);
  172.                 continue;
  173.             }
  174.             printf("%s already exists, put in %s\n", name, x);
  175.             continue;
  176.         } else
  177.             unlink(x);
  178.             continue;
  179.     }
  180.     if(!extr)
  181.         printf("%s\n", x);
  182.     else
  183.         unlink(x);
  184.     }
  185. }
  186.  
  187. badparms()
  188. {
  189.     fprintf(stderr, "fsplit: usage:  fsplit [-e efile] ... [file] \n");
  190.     exit(1);
  191. }
  192.  
  193. saveit(name)
  194. char *name;
  195. {
  196.     int i;
  197.     char    fname[50],
  198.         *fptr = fname;
  199.  
  200.     if(!extr) return(1);
  201.     while(*name) *fptr++ = *name++;
  202.     *--fptr = 0;
  203.     *--fptr = 0;
  204.     for ( i=0 ; i<=extrknt; i++ ) 
  205.         if( strcmp(fname, extrnames[i]) == 0 ) {
  206.             extrfnd[i] = TRUE;
  207.             return(1);
  208.         }
  209.     return(0);
  210. }
  211.  
  212. get_name(name, letters)
  213. char *name;
  214. int letters;
  215. {
  216.     register char *ptr;
  217.  
  218.     while (stat(name, &sbuf) >= 0) {
  219.         for (ptr = name + letters + 2; ptr >= name + letters; ptr--) {
  220.             (*ptr)++;
  221.             if (*ptr <= '9')
  222.                 break;
  223.             *ptr = '0';
  224.         }
  225.         if(ptr < name + letters) {
  226.             fprintf( stderr, "fsplit: ran out of file names\n");
  227.             exit(1);
  228.         }
  229.     }
  230. }
  231.  
  232. getline()
  233. {
  234.     register char *ptr;
  235.  
  236.     for (ptr = buf; ptr < &buf[BSZ]; ) {
  237.         *ptr = getc(ifp);
  238.         if (feof(ifp))
  239.             return (-1);
  240.         if (*ptr++ == '\n') {
  241.             *ptr = 0;
  242.             return (1);
  243.         }
  244.     }
  245.     while (getc(ifp) != '\n' && feof(ifp) == 0) ;
  246.     fprintf(stderr, "line truncated to %d characters\n", BSZ);
  247.     return (1);
  248. }
  249.  
  250. /* return 1 for 'end' alone on card (up to col. 72),  0 otherwise */
  251. lend()
  252. {
  253.     register char *p;
  254.  
  255.     if ((p = skiplab(buf)) == 0)
  256.         return (0);
  257.     trim(p);
  258.     if (*p != 'e' && *p != 'E') return(0);
  259.     p++;
  260.     trim(p);
  261.     if (*p != 'n' && *p != 'N') return(0);
  262.     p++;
  263.     trim(p);
  264.     if (*p != 'd' && *p != 'D') return(0);
  265.     p++;
  266.     trim(p);
  267.     if (p - buf >= 72 || *p == '\n')
  268.         return (1);
  269.     return (0);
  270. }
  271.  
  272. /*        check for keywords for subprograms    
  273.         return 0 if comment card, 1 if found
  274.         name and put in arg string. invent name for unnamed
  275.         block datas and main programs.        */
  276. lname(s)
  277. char *s;
  278. {
  279. #    define LINESIZE 80 
  280.     register char *ptr, *p, *sptr;
  281.     char    line[LINESIZE], *iptr = line;
  282.  
  283.     /* first check for comment cards */
  284.     if(buf[0] == 'c' || buf[0] == 'C' || buf[0] == '*') return(0);
  285.     ptr = buf;
  286.     while (*ptr == ' ' || *ptr == '\t') ptr++;
  287.     if(*ptr == '\n') return(0);
  288.  
  289.  
  290.     ptr = skiplab(buf);
  291.     if (ptr == 0)
  292.         return (0);
  293.  
  294.  
  295.     /*  copy to buffer and converting to lower case */
  296.     p = ptr;
  297.     while (*p && p <= &buf[71] ) {
  298.        *iptr = isupper(*p) ? tolower(*p) : *p;
  299.        iptr++;
  300.        p++;
  301.     }
  302.     *iptr = '\n';
  303.  
  304.     if ((ptr = look(line, "subroutine")) != 0 ||
  305.         (ptr = look(line, "function")) != 0 ||
  306.         (ptr = functs(line)) != 0) {
  307.         if(scan_name(s, ptr)) return(1);
  308.         strcpy( s, x);
  309.     } else if((ptr = look(line, "program")) != 0) {
  310.         if(scan_name(s, ptr)) return(1);
  311.         get_name( mainp, 4);
  312.         strcpy( s, mainp);
  313.     } else if((ptr = look(line, "blockdata")) != 0) {
  314.         if(scan_name(s, ptr)) return(1);
  315.         get_name( blkp, 6);
  316.         strcpy( s, blkp);
  317.     } else if((ptr = functs(line)) != 0) {
  318.         if(scan_name(s, ptr)) return(1);
  319.         strcpy( s, x);
  320.     } else {
  321.         get_name( mainp, 4);
  322.         strcpy( s, mainp);
  323.     }
  324.     return(1);
  325. }
  326.  
  327. scan_name(s, ptr)
  328. char *s, *ptr;
  329. {
  330.     char *sptr;
  331.  
  332.     /* scan off the name */
  333.     trim(ptr);
  334.     sptr = s;
  335.     while (*ptr != '(' && *ptr != '\n') {
  336.         if (*ptr != ' ' && *ptr != '\t')
  337.             *sptr++ = *ptr;
  338.         ptr++;
  339.     }
  340.  
  341.     if (sptr == s) return(0);
  342.  
  343.     *sptr++ = '.';
  344.     *sptr++ = 'f';
  345.     *sptr++ = 0;
  346.     return(1);
  347. }
  348.  
  349. char *functs(p)
  350. char *p;
  351. {
  352.         register char *ptr;
  353.  
  354. /*      look for typed functions such as: real*8 function,
  355.                 character*16 function, character*(*) function  */
  356.  
  357.         if((ptr = look(p,"character")) != 0 ||
  358.            (ptr = look(p,"logical")) != 0 ||
  359.            (ptr = look(p,"real")) != 0 ||
  360.            (ptr = look(p,"integer")) != 0 ||
  361.            (ptr = look(p,"doubleprecision")) != 0 ||
  362.            (ptr = look(p,"complex")) != 0 ||
  363.            (ptr = look(p,"doublecomplex")) != 0 ) {
  364.                 while ( *ptr == ' ' || *ptr == '\t' || *ptr == '*'
  365.             || (*ptr >= '0' && *ptr <= '9')
  366.             || *ptr == '(' || *ptr == ')') ptr++;
  367.         ptr = look(ptr,"function");
  368.         return(ptr);
  369.     }
  370.         else
  371.                 return(0);
  372. }
  373.  
  374. /*     if first 6 col. blank, return ptr to col. 7,
  375.     if blanks and then tab, return ptr after tab,
  376.     else return 0 (labelled statement, comment or continuation */
  377. char *skiplab(p)
  378. char *p;
  379. {
  380.     register char *ptr;
  381.  
  382.     for (ptr = p; ptr < &p[6]; ptr++) {
  383.         if (*ptr == ' ')
  384.             continue;
  385.         if (*ptr == '\t') {
  386.             ptr++;
  387.             break;
  388.         }
  389.         return (0);
  390.     }
  391.     return (ptr);
  392. }
  393.  
  394. /*     return 0 if m doesn't match initial part of s;
  395.     otherwise return ptr to next char after m in s */
  396. char *look(s, m)
  397. char *s, *m;
  398. {
  399.     register char *sp, *mp;
  400.  
  401.     sp = s; mp = m;
  402.     while (*mp) {
  403.         trim(sp);
  404.         if (*sp++ != *mp++)
  405.             return (0);
  406.     }
  407.     return (sp);
  408. }
  409.