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