Attachment #7003 for bug #15471

View | Details | Raw Unified | Return to bug 15471
Collapse All | Expand All




.Os BSD 4.2
.Sh NAME
.Nm fsplit
.Nd split a multi-routine Fortran 77 file into individual files
.Sh SYNOPSIS
.Nm fsplit
.Op Fl e Ar efile

.Op Ar file
.Sh DESCRIPTION
.Nm Fsplit
takes as input either a file or standard input containing Fortran 77 source
code.  It attempts to split the input into separate routine files of the
form
.Ar name.f ,
where

.Fl e
for unnamed main programs and block data subprograms since you must
predict the created file name.
.Pp
.Nm
can be used with Fortran 77 and older source code.  It understands neither
Fortran 90/95 syntax nor free form source files.




#include <ctype.h>
#include <err.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
#include <sys/stat.h>


#define TRUE 1
#define FALSE 0

int extr = FALSE, extrknt = -1, *extrfnd;
char **extrnames;
char	extrbuf[1000],
	*extrnames[100];
struct stat sbuf;

#define trim(p)	while (*p == ' ' || *p == '\t') p++

void  get_name __P((char *, int));
char *functs __P((char *));
int   lend __P((void));
int   lname __P((char *, int));
char *look __P((char *, char *));
int   saveit __P((char *));
int   scan_name __P((char *, char *, int));
char *skiplab __P((char *));
static void usage __P((void));

int
main(argc, argv)
int argc;
char **argv;
{
	extern int optind;
	extern char *optarg;

	register FILE *ofp;	/* output file */
	register int rv;	/* 1 if got card in output file, 0 otherwise */
	register char *ptr;
	int nflag,		/* 1 if got name of subprog., 0 otherwise */
		retval,
		i;
	char name[20];
		*extrptr = extrbuf;

	if (argc > 2) {
	while ( argc > 1  && argv[1][0] == '-' && argv[1][1] == 'e') {
		extr = TRUE;

		extrfnd = (int *) malloc(argc * sizeof(int));
		if (extrfnd == NULL)
			errx(1, NULL);

		extrnames = (char **) malloc(argc * sizeof(char *));
		if (extrnames == NULL)
			errx(1, NULL);

		while ((i = getopt(argc, argv, "e:")) != -1) {
			switch (i) {
			case 'e':
				extrknt++;
				extrfnd[extrknt] = FALSE;
				extrnames[extrknt] = optarg;
				break;
			default:
				usage();
			}
		}

		argc -= optind;
		argv += optind;
	} else {
		*extrptr++ = 0;
		argc--;
		argv++;
	}

	if (argc > 1)
		usage();
	else if (argc == 1) {
		if ((ifp = fopen(*argv, "r")) == NULL)
			errx(1, "cannot open %s", argv[1]);
	}
	else
		ifp = stdin;

	for (;;) {
		/* look for a temp file that doesn't correspond to an existing file */
		get_name(x, 3);
		ofp = fopen(x, "w");
		if (ofp == NULL) 
			errx(1, "can not open %s", x);
		nflag = 0;
		rv = 0;
		while (getline() > 0) {
			rv = 1;
			fprintf(ofp, "%s", buf);
			if (lend())		/* look for an 'end' statement */
				break;
			if (nflag == 0)		/* if no name yet, try and find one */
				nflag = lname(name, 20);
		}
		fclose(ofp);
		if (rv == 0) {			/* no lines in file, forget the file */
			unlink(x);
			retval = 0;
			for ( i = 0; i <= extrknt; i++ )
				if(!extrfnd[i]) {
					retval = 1;
					warnx("%s not found", extrnames[i]);
				}
			exit( retval );
		}
		if (nflag) {			/* rename the file */
			if(saveit(name)) {
				if (stat(name, &sbuf) < 0 ) {
					link(x, name);
					unlink(x);
					printf("%s\n", name);
					continue;
				} else if (strcmp(name, x) == 0) {
					printf("%s\n", x);
					continue;
				}
				printf("%s already exists, put in %s\n", name, x);
				continue;
			} else
				unlink(x);
				continue;
		}
		if (!extr)
			printf("%s\n", x);
		else
			unlink(x);
    	}

	return 0;
		printf("%s\n", x);
	else
		unlink(x);
    }
}

static void

				break;
			*ptr = '0';
		}
		if (ptr < name + letters)
			errx(1, "ran out of file names");
	}
}

		name and put in arg string. invent name for unnamed
		block datas and main programs.		*/
int
lname(s, len)
char *s;
int len;
{
#	define LINESIZE 80
	register char *ptr, *p;
	char	line[LINESIZE], *iptr = line;

	/* first check for comment cards */
	if (buf[0] == 'c' || buf[0] == 'C' || buf[0] == '*') return(0);
	ptr = buf;
	trim(ptr);
	if (*ptr == '\n') return(0);


	ptr = skiplab(buf);

	if ((ptr = look(line, "subroutine")) != 0 ||
	    (ptr = look(line, "function")) != 0 ||
	    (ptr = functs(line)) != 0) {
		if (scan_name(s, ptr, len)) return(1);
		strcpy(s, x);
	} else if((ptr = look(line, "program")) != 0) {
		if(scan_name(s, ptr, len)) return(1);
		get_name(mainp, 4);
		strcpy(s, mainp);
	} else if((ptr = look(line, "blockdata")) != 0) {
		if(scan_name(s, ptr, len)) return(1);
		get_name(blkp, 6);
		strcpy(s, blkp);
	} else if((ptr = functs(line)) != 0) {
		if(scan_name(s, ptr, len)) return(1);
		strcpy(s, x);
	} else {
		get_name(mainp, 4);
		strcpy(s, mainp);
	}
	return(1);
}

int
scan_name(s, ptr, len)
char *s, *ptr;
int len;
{
	int cnt = 0;
	char *sptr;

	/* scan off the name */
	trim(ptr);
	sptr = s;
	while (*ptr != '(' && *ptr != '\n') {
		if (*ptr != ' ' && *ptr != '\t') {
			*sptr++ = *ptr;
			cnt++;
			if (cnt == len - 3) break;
		}
		ptr++;
	}

Return to bug 15471

Lines 39-45 Link Here

(-)fsplit/fsplit.1 (-3 / +7 lines)
39	.Os BSD 4.2	39	.Os BSD 4.2
40	.Sh NAME	40	.Sh NAME
41	.Nm fsplit	41	.Nm fsplit
42	.Nd split a multi-routine Fortran file into individual files	42	.Nd split a multi-routine Fortran 77 file into individual files
43	.Sh SYNOPSIS	43	.Sh SYNOPSIS
44	.Nm fsplit	44	.Nm fsplit
45	.Op Fl e Ar efile	45	.Op Fl e Ar efile
Lines 47-54 Link Here
47	.Op Ar file	47	.Op Ar file
48	.Sh DESCRIPTION	48	.Sh DESCRIPTION
49	.Nm Fsplit	49	.Nm Fsplit
50	takes as input either a file or standard input containing Fortran source code.	50	takes as input either a file or standard input containing Fortran 77 source
51	It attempts to split the input into separate routine files of the	51	code. It attempts to split the input into separate routine files of the
52	form	52	form
53	.Ar name.f ,	53	.Ar name.f ,
54	where	54	where
Lines 104-106 Link Here
104	.Fl e	104	.Fl e
105	for unnamed main programs and block data subprograms since you must	105	for unnamed main programs and block data subprograms since you must
106	predict the created file name.	106	predict the created file name.
		107	.Pp
		108	.Nm
		109	can be used with Fortran 77 and older source code. It understands neither
		110	Fortran 90/95 syntax nor free form source files.

Lines 51-56 Link Here

(-)fsplit/fsplit.c (-88 / +111 lines)
51	#include <ctype.h>	51	#include <ctype.h>
52	#include <err.h>	52	#include <err.h>
53	#include <stdio.h>	53	#include <stdio.h>
		54	#include <stdlib.h>
54	#include <string.h>	55	#include <string.h>
55	#include <sys/types.h>	56	#include <sys/types.h>
56	#include <sys/stat.h>	57	#include <sys/stat.h>
Lines 90-100 Link Here
90		91
91	#define TRUE 1	92	#define TRUE 1
92	#define FALSE 0	93	#define FALSE 0
93	int extr = FALSE,	94
94	extrknt = -1,	95	int extr = FALSE, extrknt = -1, *extrfnd;
95	extrfnd[100];	96	char **extrnames;
96	char extrbuf[1000],
97	*extrnames[100];
98	struct stat sbuf;	97	struct stat sbuf;
99		98
100	#define trim(p) while (p == ' ' \|\| p == '\t') p++	99	#define trim(p) while (p == ' ' \|\| p == '\t') p++
Lines 103-203 Link Here
103	void get_name __P((char *, int));	102	void get_name __P((char *, int));
104	char functs __P((char ));	103	char functs __P((char ));
105	int lend __P((void));	104	int lend __P((void));
106	int lname __P((char *));	105	int lname __P((char *, int));
107	char look __P((char , char *));	106	char look __P((char , char *));
108	int saveit __P((char *));	107	int saveit __P((char *));
109	int scan_name __P((char , char ));	108	int scan_name __P((char , char , int));
110	char skiplab __P((char ));	109	char skiplab __P((char ));
111	static void usage __P((void));	110	static void usage __P((void));
112		111
113	int	112	int
114	main(argc, argv)	113	main(argc, argv)
		114	int argc;
115	char **argv;	115	char **argv;
116	{	116	{
		117	extern int optind;
		118	extern char *optarg;
		119
117	register FILE ofp; / output file */	120	register FILE ofp; / output file */
118	register int rv; /* 1 if got card in output file, 0 otherwise */	121	register int rv; /* 1 if got card in output file, 0 otherwise */
119	register char *ptr;	122	register char *ptr;
120	int nflag, /* 1 if got name of subprog., 0 otherwise */	123	int nflag, /* 1 if got name of subprog., 0 otherwise */
121	retval,	124	retval,
122	i;	125	i;
123	char name[20],	126	char name[20];
124	*extrptr = extrbuf;
125		127
126	/* scan -e options */	128	if (argc > 2) {
127	while ( argc > 1 && argv[1][0] == '-' && argv[1][1] == 'e') {
128	extr = TRUE;	129	extr = TRUE;
129	ptr = argv[1] + 2;	130
130	if(!*ptr) {	131	extrfnd = (int ) malloc(argc sizeof(int));
131	argc--;	132	if (extrfnd == NULL)
132	argv++;	133	errx(1, NULL);
133	if(argc <= 1)	134
		135	extrnames = (char *) malloc(argc sizeof(char *));
		136	if (extrnames == NULL)
		137	errx(1, NULL);
		138
		139	while ((i = getopt(argc, argv, "e:")) != -1) {
		140	switch (i) {
		141	case 'e':
		142	extrknt++;
		143	extrfnd[extrknt] = FALSE;
		144	extrnames[extrknt] = optarg;
		145	break;
		146	default:
134	usage();	147	usage();
135	ptr = argv[1];	148	}
136	}	149	}
137	extrknt = extrknt + 1;	150
138	extrnames[extrknt] = extrptr;	151	argc -= optind;
139	extrfnd[extrknt] = FALSE;	152	argv += optind;
140	while(ptr) extrptr++ = *ptr++;	153	} else {
141	*extrptr++ = 0;
142	argc--;	154	argc--;
143	argv++;	155	argv++;
144	}	156	}
145		157
146	if (argc > 2)	158	if (argc > 1)
147	usage();	159	usage();
148	else if (argc == 2) {	160	else if (argc == 1) {
149	if ((ifp = fopen(argv[1], "r")) == NULL)	161	if ((ifp = fopen(*argv, "r")) == NULL)
150	errx(1, "cannot open %s", argv[1]);	162	errx(1, "cannot open %s", argv[1]);
151	}	163	}
152	else	164	else
153	ifp = stdin;	165	ifp = stdin;
154	for(;;) {	166
155	/* look for a temp file that doesn't correspond to an existing file */	167	for (;;) {
156	get_name(x, 3);	168	/* look for a temp file that doesn't correspond to an existing file */
157	ofp = fopen(x, "w");	169	get_name(x, 3);
158	nflag = 0;	170	ofp = fopen(x, "w");
159	rv = 0;	171	if (ofp == NULL)
160	while (getline() > 0) {	172	errx(1, "can not open %s", x);
161	rv = 1;	173	nflag = 0;
162	fprintf(ofp, "%s", buf);	174	rv = 0;
163	if (lend()) /* look for an 'end' statement */	175	while (getline() > 0) {
164	break;	176	rv = 1;
165	if (nflag == 0) /* if no name yet, try and find one */	177	fprintf(ofp, "%s", buf);
166	nflag = lname(name);	178	if (lend()) /* look for an 'end' statement */
167	}	179	break;
168	fclose(ofp);	180	if (nflag == 0) /* if no name yet, try and find one */
169	if (rv == 0) { /* no lines in file, forget the file */	181	nflag = lname(name, 20);
170	unlink(x);	182	}
171	retval = 0;	183	fclose(ofp);
172	for ( i = 0; i <= extrknt; i++ )	184	if (rv == 0) { /* no lines in file, forget the file */
173	if(!extrfnd[i]) {	185	unlink(x);
174	retval = 1;	186	retval = 0;
175	warnx("%s not found", extrnames[i]);	187	for ( i = 0; i <= extrknt; i++ )
176	}	188	if(!extrfnd[i]) {
177	exit( retval );	189	retval = 1;
178	}	190	warnx("%s not found", extrnames[i]);
179	if (nflag) { /* rename the file */	191	}
180	if(saveit(name)) {	192	exit( retval );
181	if (stat(name, &sbuf) < 0 ) {	193	}
182	link(x, name);	194	if (nflag) { /* rename the file */
183	unlink(x);	195	if(saveit(name)) {
184	printf("%s\n", name);	196	if (stat(name, &sbuf) < 0 ) {
		197	link(x, name);
		198	unlink(x);
		199	printf("%s\n", name);
		200	continue;
		201	} else if (strcmp(name, x) == 0) {
		202	printf("%s\n", x);
		203	continue;
		204	}
		205	printf("%s already exists, put in %s\n", name, x);
185	continue;	206	continue;
186	} else if (strcmp(name, x) == 0) {	207	} else
187	printf("%s\n", x);	208	unlink(x);
188	continue;	209	continue;
189	}	210	}
190	printf("%s already exists, put in %s\n", name, x);	211	if (!extr)
191	continue;	212	printf("%s\n", x);
192	} else	213	else
193	unlink(x);	214	unlink(x);
194	continue;	215	}
195	}	216
196	if(!extr)	217	return 0;
197	printf("%s\n", x);
198	else
199	unlink(x);
200	}
201	}	218	}
202		219
203	static void	220	static void
Lines 241-247 Link Here
241	break;	258	break;
242	*ptr = '0';	259	*ptr = '0';
243	}	260	}
244	if(ptr < name + letters)	261	if (ptr < name + letters)
245	errx(1, "ran out of file names");	262	errx(1, "ran out of file names");
246	}	263	}
247	}	264	}
Lines 293-310 Link Here
293	name and put in arg string. invent name for unnamed	310	name and put in arg string. invent name for unnamed
294	block datas and main programs. */	311	block datas and main programs. */
295	int	312	int
296	lname(s)	313	lname(s, len)
297	char *s;	314	char *s;
		315	int len;
298	{	316	{
299	# define LINESIZE 80	317	# define LINESIZE 80
300	register char ptr, p;	318	register char ptr, p;
301	char line[LINESIZE], *iptr = line;	319	char line[LINESIZE], *iptr = line;
302		320
303	/* first check for comment cards */	321	/* first check for comment cards */
304	if(buf[0] == 'c' \|\| buf[0] == 'C' \|\| buf[0] == '*') return(0);	322	if (buf[0] == 'c' \|\| buf[0] == 'C' \|\| buf[0] == '*') return(0);
305	ptr = buf;	323	ptr = buf;
306	while (ptr == ' ' \|\| ptr == '\t') ptr++;	324	trim(ptr);
307	if(*ptr == '\n') return(0);	325	if (*ptr == '\n') return(0);
308		326
309		327
310	ptr = skiplab(buf);	328	ptr = skiplab(buf);
Lines 324-361 Link Here
324	if ((ptr = look(line, "subroutine")) != 0 \|\|	342	if ((ptr = look(line, "subroutine")) != 0 \|\|
325	(ptr = look(line, "function")) != 0 \|\|	343	(ptr = look(line, "function")) != 0 \|\|
326	(ptr = functs(line)) != 0) {	344	(ptr = functs(line)) != 0) {
327	if(scan_name(s, ptr)) return(1);	345	if (scan_name(s, ptr, len)) return(1);
328	strcpy( s, x);	346	strcpy(s, x);
329	} else if((ptr = look(line, "program")) != 0) {	347	} else if((ptr = look(line, "program")) != 0) {
330	if(scan_name(s, ptr)) return(1);	348	if(scan_name(s, ptr, len)) return(1);
331	get_name( mainp, 4);	349	get_name(mainp, 4);
332	strcpy( s, mainp);	350	strcpy(s, mainp);
333	} else if((ptr = look(line, "blockdata")) != 0) {	351	} else if((ptr = look(line, "blockdata")) != 0) {
334	if(scan_name(s, ptr)) return(1);	352	if(scan_name(s, ptr, len)) return(1);
335	get_name( blkp, 6);	353	get_name(blkp, 6);
336	strcpy( s, blkp);	354	strcpy(s, blkp);
337	} else if((ptr = functs(line)) != 0) {	355	} else if((ptr = functs(line)) != 0) {
338	if(scan_name(s, ptr)) return(1);	356	if(scan_name(s, ptr, len)) return(1);
339	strcpy( s, x);	357	strcpy(s, x);
340	} else {	358	} else {
341	get_name( mainp, 4);	359	get_name(mainp, 4);
342	strcpy( s, mainp);	360	strcpy(s, mainp);
343	}	361	}
344	return(1);	362	return(1);
345	}	363	}
346		364
347	int	365	int
348	scan_name(s, ptr)	366	scan_name(s, ptr, len)
349	char s, ptr;	367	char s, ptr;
		368	int len;
350	{	369	{
		370	int cnt = 0;
351	char *sptr;	371	char *sptr;
352		372
353	/* scan off the name */	373	/* scan off the name */
354	trim(ptr);	374	trim(ptr);
355	sptr = s;	375	sptr = s;
356	while (ptr != '(' && ptr != '\n') {	376	while (ptr != '(' && ptr != '\n') {
357	if (ptr != ' ' && ptr != '\t')	377	if (ptr != ' ' && ptr != '\t') {
358	sptr++ = ptr;	378	sptr++ = ptr;
		379	cnt++;
		380	if (cnt == len - 3) break;
		381	}
359	ptr++;	382	ptr++;
360	}	383	}