![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fsplit.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / pgrm / fsplit|
Return to fsplit.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / pgrm / fsplit |
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.