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