Return to fsplit.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / fsplit

Annotation of 43BSDReno/pgrm/fsplit/fsplit.c, revision 1.1

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

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