Return to fsplit.c CVS log

Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / fsplit

Annotation of 42BSD/usr.bin/f77/src/fsplit/fsplit.c, revision 1.1

1.1     ! root        1: #include <ctype.h>
        !             2: #include <stdio.h>
        !             3: #include <sys/types.h>
        !             4: #include <sys/stat.h>
        !             5: 
        !             6: /*
        !             7:  *     usage:          fsplit [-e efile] ... [file]
        !             8:  *
        !             9:  *     split single file containing source for several fortran programs
        !            10:  *             and/or subprograms into files each containing one
        !            11:  *             subprogram unit.
        !            12:  *     each separate file will be named using the corresponding subroutine,
        !            13:  *             function, block data or program name if one is found; otherwise
        !            14:  *             the name will be of the form mainNNN.f or blkdtaNNN.f .
        !            15:  *             If a file of that name exists, it is saved in a name of the
        !            16:  *             form zzz000.f .
        !            17:  *     If -e option is used, then only those subprograms named in the -e
        !            18:  *             option are split off; e.g.:
        !            19:  *                     fsplit -esub1 -e sub2 prog.f
        !            20:  *             isolates sub1 and sub2 in sub1.f and sub2.f.  The space 
        !            21:  *             after -e is optional.
        !            22:  *
        !            23:  *     Modified Feb., 1983 by Jerry Berkman, Computing Services, U.C. Berkeley.
        !            24:  *             - added comments
        !            25:  *             - more function types: double complex, character*(*), etc.
        !            26:  *             - fixed minor bugs
        !            27:  *             - instead of all unnamed going into zNNN.f, put mains in
        !            28:  *               mainNNN.f, block datas in blkdtaNNN.f, dups in zzzNNN.f .
        !            29:  */
        !            30: 
        !            31: #define BSZ 512
        !            32: char buf[BSZ];
        !            33: FILE *ifp;
        !            34: char   x[]="zzz000.f",
        !            35:        mainp[]="main000.f",
        !            36:        blkp[]="blkdta000.f";
        !            37: char *look(), *skiplab(), *functs();
        !            38: 
        !            39: #define TRUE 1
        !            40: #define FALSE 0
        !            41: int    extr = FALSE,
        !            42:        extrknt = -1,
        !            43:        extrfnd[100];
        !            44: char   extrbuf[1000],
        !            45:        *extrnames[100];
        !            46: struct stat sbuf;
        !            47: 
        !            48: #define trim(p)        while (*p == ' ' || *p == '\t') p++
        !            49: 
        !            50: main(argc, argv)
        !            51: char **argv;
        !            52: {
        !            53:        register FILE *ofp;     /* output file */
        !            54:        register rv;            /* 1 if got card in output file, 0 otherwise */
        !            55:        register char *ptr;
        !            56:        int nflag,              /* 1 if got name of subprog., 0 otherwise */
        !            57:                retval,
        !            58:                i;
        !            59:        char name[20],
        !            60:                *extrptr = extrbuf;
        !            61: 
        !            62:        /*  scan -e options */
        !            63:        while ( argc > 1  && argv[1][0] == '-' && argv[1][1] == 'e') {
        !            64:                extr = TRUE;
        !            65:                ptr = argv[1] + 2;
        !            66:                if(!*ptr) {
        !            67:                        argc--;
        !            68:                        argv++;
        !            69:                        if(argc <= 1) badparms();
        !            70:                        ptr = argv[1];
        !            71:                }
        !            72:                extrknt = extrknt + 1;
        !            73:                extrnames[extrknt] = extrptr;
        !            74:                extrfnd[extrknt] = FALSE;
        !            75:                while(*ptr) *extrptr++ = *ptr++;
        !            76:                *extrptr++ = 0;
        !            77:                argc--;
        !            78:                argv++;
        !            79:        }
        !            80: 
        !            81:        if (argc > 2)
        !            82:                badparms();
        !            83:        else if (argc == 2) {
        !            84:                if ((ifp = fopen(argv[1], "r")) == NULL) {
        !            85:                        fprintf(stderr, "fsplit: cannot open %s\n", argv[1]);
        !            86:                        exit(1);
        !            87:                }
        !            88:        }
        !            89:        else
        !            90:                ifp = stdin;
        !            91:     for(;;) {
        !            92:        /* look for a temp file that doesn't correspond to an existing file */
        !            93:        get_name(x, 3);
        !            94:        ofp = fopen(x, "w");
        !            95:        nflag = 0;
        !            96:        rv = 0;
        !            97:        while (getline() > 0) {
        !            98:                rv = 1;
        !            99:                fprintf(ofp, "%s", buf);
        !           100:                if (lend())             /* look for an 'end' statement */
        !           101:                        break;
        !           102:                if (nflag == 0)         /* if no name yet, try and find one */
        !           103:                        nflag = lname(name);
        !           104:        }
        !           105:        fclose(ofp);
        !           106:        if (rv == 0) {                  /* no lines in file, forget the file */
        !           107:                unlink(x);
        !           108:                retval = 0;
        !           109:                for ( i = 0; i <= extrknt; i++ )
        !           110:                        if(!extrfnd[i]) {
        !           111:                                retval = 1;
        !           112:                                fprintf( stderr, "fsplit: %s not found\n",
        !           113:                                        extrnames[i]);
        !           114:                        }
        !           115:                exit( retval );
        !           116:        }
        !           117:        if (nflag) {                    /* rename the file */
        !           118:                if(saveit(name)) {
        !           119:                        if (stat(name, &sbuf) < 0 ) {
        !           120:                                link(x, name);
        !           121:                                unlink(x);
        !           122:                                printf("%s\n", name);
        !           123:                                continue;
        !           124:                        } else if (strcmp(name, x) == 0) {
        !           125:                                printf("%s\n", x);
        !           126:                                continue;
        !           127:                        }
        !           128:                        printf("%s already exists, put in %s\n", name, x);
        !           129:                        continue;
        !           130:                } else
        !           131:                        unlink(x);
        !           132:                        continue;
        !           133:        }
        !           134:        if(!extr)
        !           135:                printf("%s\n", x);
        !           136:        else
        !           137:                unlink(x);
        !           138:     }
        !           139: }
        !           140: 
        !           141: badparms()
        !           142: {
        !           143:        fprintf(stderr, "fsplit: usage:  fsplit [-e efile] ... [file] \n");
        !           144:        exit(1);
        !           145: }
        !           146: 
        !           147: saveit(name)
        !           148: char *name;
        !           149: {
        !           150:        int i;
        !           151:        char    fname[50],
        !           152:                *fptr = fname;
        !           153: 
        !           154:        if(!extr) return(1);
        !           155:        while(*name) *fptr++ = *name++;
        !           156:        *--fptr = 0;
        !           157:        *--fptr = 0;
        !           158:        for ( i=0 ; i<=extrknt; i++ ) 
        !           159:                if( strcmp(fname, extrnames[i]) == 0 ) {
        !           160:                        extrfnd[i] = TRUE;
        !           161:                        return(1);
        !           162:                }
        !           163:        return(0);
        !           164: }
        !           165: 
        !           166: get_name(name, letters)
        !           167: char *name;
        !           168: int letters;
        !           169: {
        !           170:        register char *ptr;
        !           171: 
        !           172:        while (stat(name, &sbuf) >= 0) {
        !           173:                for (ptr = name + letters + 2; ptr >= name + letters; ptr--) {
        !           174:                        (*ptr)++;
        !           175:                        if (*ptr <= '9')
        !           176:                                break;
        !           177:                        *ptr = '0';
        !           178:                }
        !           179:                if(ptr < name + letters) {
        !           180:                        fprintf( stderr, "fsplit: ran out of file names\n");
        !           181:                        exit(1);
        !           182:                }
        !           183:        }
        !           184: }
        !           185: 
        !           186: getline()
        !           187: {
        !           188:        register char *ptr;
        !           189: 
        !           190:        for (ptr = buf; ptr < &buf[BSZ]; ) {
        !           191:                *ptr = getc(ifp);
        !           192:                if (feof(ifp))
        !           193:                        return (-1);
        !           194:                if (*ptr++ == '\n') {
        !           195:                        *ptr = 0;
        !           196:                        return (1);
        !           197:                }
        !           198:        }
        !           199:        while (getc(ifp) != '\n' && feof(ifp) == 0) ;
        !           200:        fprintf(stderr, "line truncated to %d characters\n", BSZ);
        !           201:        return (1);
        !           202: }
        !           203: 
        !           204: /* return 1 for 'end' alone on card (up to col. 72),  0 otherwise */
        !           205: lend()
        !           206: {
        !           207:        register char *p;
        !           208: 
        !           209:        if ((p = skiplab(buf)) == 0)
        !           210:                return (0);
        !           211:        trim(p);
        !           212:        if (*p != 'e' && *p != 'E') return(0);
        !           213:        p++;
        !           214:        trim(p);
        !           215:        if (*p != 'n' && *p != 'N') return(0);
        !           216:        p++;
        !           217:        trim(p);
        !           218:        if (*p != 'd' && *p != 'D') return(0);
        !           219:        p++;
        !           220:        trim(p);
        !           221:        if (p - buf >= 72 || *p == '\n')
        !           222:                return (1);
        !           223:        return (0);
        !           224: }
        !           225: 
        !           226: /*             check for keywords for subprograms      
        !           227:                return 0 if comment card, 1 if found
        !           228:                name and put in arg string. invent name for unnamed
        !           229:                block datas and main programs.          */
        !           230: lname(s)
        !           231: char *s;
        !           232: {
        !           233: #      define LINESIZE 80 
        !           234:        register char *ptr, *p, *sptr;
        !           235:        char    line[LINESIZE], *iptr = line;
        !           236: 
        !           237:        /* first check for comment cards */
        !           238:        if(buf[0] == 'c' || buf[0] == 'C' || buf[0] == '*') return(0);
        !           239:        ptr = buf;
        !           240:        while (*ptr == ' ' || *ptr == '\t') ptr++;
        !           241:        if(*ptr == '\n') return(0);
        !           242: 
        !           243: 
        !           244:        ptr = skiplab(buf);
        !           245: 
        !           246:        /*  copy to buffer and converting to lower case */
        !           247:        p = ptr;
        !           248:        while (*p && p <= &buf[71] ) {
        !           249:           *iptr = isupper(*p) ? tolower(*p) : *p;
        !           250:           iptr++;
        !           251:           p++;
        !           252:        }
        !           253:        *iptr = '\n';
        !           254: 
        !           255:        if ((ptr = look(line, "subroutine")) != 0 ||
        !           256:            (ptr = look(line, "function")) != 0 ||
        !           257:            (ptr = functs(line)) != 0) {
        !           258:                if(scan_name(s, ptr)) return(1);
        !           259:                strcpy( s, x);
        !           260:        } else if((ptr = look(line, "program")) != 0) {
        !           261:                if(scan_name(s, ptr)) return(1);
        !           262:                get_name( mainp, 4);
        !           263:                strcpy( s, mainp);
        !           264:        } else if((ptr = look(line, "blockdata")) != 0) {
        !           265:                if(scan_name(s, ptr)) return(1);
        !           266:                get_name( blkp, 6);
        !           267:                strcpy( s, blkp);
        !           268:        } else if((ptr = functs(line)) != 0) {
        !           269:                if(scan_name(s, ptr)) return(1);
        !           270:                strcpy( s, x);
        !           271:        } else {
        !           272:                get_name( mainp, 4);
        !           273:                strcpy( s, mainp);
        !           274:        }
        !           275:        return(1);
        !           276: }
        !           277: 
        !           278:                
        !           279: scan_name(s, ptr)
        !           280: char *s, *ptr;
        !           281: {
        !           282:        char *sptr;
        !           283: 
        !           284:        /* scan off the name */
        !           285:        trim(ptr);
        !           286:        sptr = s;
        !           287:        while (*ptr != '(' && *ptr != '\n') {
        !           288:                if (*ptr != ' ' && *ptr != '\t')
        !           289:                        *sptr++ = *ptr;
        !           290:                ptr++;
        !           291:        }
        !           292: 
        !           293:        if (sptr == s) return(0);
        !           294: 
        !           295:        *sptr++ = '.';
        !           296:        *sptr++ = 'f';
        !           297:        *sptr++ = 0;
        !           298: }
        !           299: 
        !           300: char *functs(p)
        !           301: char *p;
        !           302: {
        !           303:         register char *ptr;
        !           304: 
        !           305: /*      look for typed functions such as: real*8 function,
        !           306:                 character*16 function, character*(*) function  */
        !           307: 
        !           308:         if((ptr = look(p,"character")) != 0 ||
        !           309:            (ptr = look(p,"logical")) != 0 ||
        !           310:            (ptr = look(p,"real")) != 0 ||
        !           311:            (ptr = look(p,"integer")) != 0 ||
        !           312:            (ptr = look(p,"doubleprecision")) != 0 ||
        !           313:            (ptr = look(p,"complex")) != 0 ||
        !           314:            (ptr = look(p,"doublecomplex")) != 0 ) {
        !           315:                 while ( *ptr == ' ' || *ptr == '\t' || *ptr == '*'
        !           316:                        || (*ptr >= '0' && *ptr <= '9')
        !           317:                        || *ptr == '(' || *ptr == ')') ptr++;
        !           318:                ptr = look(ptr,"function");
        !           319:                return(ptr);
        !           320:        }
        !           321:         else
        !           322:                 return(0);
        !           323: }
        !           324: 
        !           325: /*     if first 6 col. blank, return ptr to col. 7,
        !           326:        if blanks and then tab, return ptr after tab,
        !           327:        else return 0 (labelled statement, comment or continuation */
        !           328: char *skiplab(p)
        !           329: char *p;
        !           330: {
        !           331:        register char *ptr;
        !           332: 
        !           333:        for (ptr = p; ptr < &p[6]; ptr++) {
        !           334:                if (*ptr == ' ')
        !           335:                        continue;
        !           336:                if (*ptr == '\t') {
        !           337:                        ptr++;
        !           338:                        break;
        !           339:                }
        !           340:                return (0);
        !           341:        }
        !           342:        return (ptr);
        !           343: }
        !           344: 
        !           345: /*     return 0 if m doesn't match initial part of s;
        !           346:        otherwise return ptr to next char after m in s */
        !           347: char *look(s, m)
        !           348: char *s, *m;
        !           349: {
        !           350:        register char *sp, *mp;
        !           351: 
        !           352:        sp = s; mp = m;
        !           353:        while (*mp) {
        !           354:                trim(sp);
        !           355:                if (*sp++ != *mp++)
        !           356:                        return (0);
        !           357:        }
        !           358:        return (sp);
        !           359: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.