![[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|
Return to fsplit.c CVS log | Up to [local] / src / usr.bin / fsplit |
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: }