[unix-history] / usr / src / usr.bin / fsplit / fsplit.c

/*
 * Copyright (c) 1983, 1993
 *	The Regents of the University of California.  All rights reserved.
 *
 * This code is derived from software contributed to Berkeley by
 * Asa Romberger and Jerry Berkman.
 *
 * %sccs.include.redist.c%
 */

#ifndef lint
static char copyright[] =
"@(#) Copyright (c) 1983, 1993\n\
	The Regents of the University of California.  All rights reserved.\n";
#endif /* not lint */

#ifndef lint
static char sccsid[] = "@(#)fsplit.c	8.1 (Berkeley) %G%";
#endif /* not lint */

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

/*
 *	usage:		fsplit [-e efile] ... [file]
 *
 *	split single file containing source for several fortran programs
 *		and/or subprograms into files each containing one
 *		subprogram unit.
 *	each separate file will be named using the corresponding subroutine,
 *		function, block data or program name if one is found; otherwise
 *		the name will be of the form mainNNN.f or blkdtaNNN.f .
 *		If a file of that name exists, it is saved in a name of the
 *		form zzz000.f .
 *	If -e option is used, then only those subprograms named in the -e
 *		option are split off; e.g.:
 *			fsplit -esub1 -e sub2 prog.f
 *		isolates sub1 and sub2 in sub1.f and sub2.f.  The space 
 *		after -e is optional.
 *
 *	Modified Feb., 1983 by Jerry Berkman, Computing Services, U.C. Berkeley.
 *		- added comments
 *		- more function types: double complex, character*(*), etc.
 *		- fixed minor bugs
 *		- instead of all unnamed going into zNNN.f, put mains in
 *		  mainNNN.f, block datas in blkdtaNNN.f, dups in zzzNNN.f .
 */

#define BSZ 512
char buf[BSZ];
FILE *ifp;
char 	x[]="zzz000.f",
	mainp[]="main000.f",
	blkp[]="blkdta000.f";
char *look(), *skiplab(), *functs();

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

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

main(argc, argv)
char **argv;
{
	register FILE *ofp;	/* output file */
	register 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;

	/*  scan -e options */
	while ( argc > 1  && argv[1][0] == '-' && argv[1][1] == 'e') {
		extr = TRUE;
		ptr = argv[1] + 2;
		if(!*ptr) {
			argc--;
			argv++;
			if(argc <= 1) badparms();
			ptr = argv[1];
		}
		extrknt = extrknt + 1;
		extrnames[extrknt] = extrptr;
		extrfnd[extrknt] = FALSE;
		while(*ptr) *extrptr++ = *ptr++;
		*extrptr++ = 0;
		argc--;
		argv++;
	}

	if (argc > 2)
		badparms();
	else if (argc == 2) {
		if ((ifp = fopen(argv[1], "r")) == NULL) {
			fprintf(stderr, "fsplit: cannot open %s\n", argv[1]);
			exit(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");
	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);
	}
	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;
				fprintf( stderr, "fsplit: %s not found\n",
					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);
    }
}

badparms()
{
	fprintf(stderr, "fsplit: usage:  fsplit [-e efile] ... [file] \n");
	exit(1);
}

saveit(name)
char *name;
{
	int i;
	char	fname[50],
		*fptr = fname;

	if(!extr) return(1);
	while(*name) *fptr++ = *name++;
	*--fptr = 0;
	*--fptr = 0;
	for ( i=0 ; i<=extrknt; i++ ) 
		if( strcmp(fname, extrnames[i]) == 0 ) {
			extrfnd[i] = TRUE;
			return(1);
		}
	return(0);
}

get_name(name, letters)
char *name;
int letters;
{
	register char *ptr;

	while (stat(name, &sbuf) >= 0) {
		for (ptr = name + letters + 2; ptr >= name + letters; ptr--) {
			(*ptr)++;
			if (*ptr <= '9')
				break;
			*ptr = '0';
		}
		if(ptr < name + letters) {
			fprintf( stderr, "fsplit: ran out of file names\n");
			exit(1);
		}
	}
}

getline()
{
	register char *ptr;

	for (ptr = buf; ptr < &buf[BSZ]; ) {
		*ptr = getc(ifp);
		if (feof(ifp))
			return (-1);
		if (*ptr++ == '\n') {
			*ptr = 0;
			return (1);
		}
	}
	while (getc(ifp) != '\n' && feof(ifp) == 0) ;
	fprintf(stderr, "line truncated to %d characters\n", BSZ);
	return (1);
}

/* return 1 for 'end' alone on card (up to col. 72),  0 otherwise */
lend()
{
	register char *p;

	if ((p = skiplab(buf)) == 0)
		return (0);
	trim(p);
	if (*p != 'e' && *p != 'E') return(0);
	p++;
	trim(p);
	if (*p != 'n' && *p != 'N') return(0);
	p++;
	trim(p);
	if (*p != 'd' && *p != 'D') return(0);
	p++;
	trim(p);
	if (p - buf >= 72 || *p == '\n')
		return (1);
	return (0);
}

/*		check for keywords for subprograms	
		return 0 if comment card, 1 if found
		name and put in arg string. invent name for unnamed
		block datas and main programs.		*/
lname(s)
char *s;
{
#	define LINESIZE 80 
	register char *ptr, *p, *sptr;
	char	line[LINESIZE], *iptr = line;

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


	ptr = skiplab(buf);
	if (ptr == 0)
		return (0);


	/*  copy to buffer and converting to lower case */
	p = ptr;
	while (*p && p <= &buf[71] ) {
	   *iptr = isupper(*p) ? tolower(*p) : *p;
	   iptr++;
	   p++;
	}
	*iptr = '\n';

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

scan_name(s, ptr)
char *s, *ptr;
{
	char *sptr;

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

	if (sptr == s) return(0);

	*sptr++ = '.';
	*sptr++ = 'f';
	*sptr++ = 0;
	return(1);
}

char *functs(p)
char *p;
{
        register char *ptr;

/*      look for typed functions such as: real*8 function,
                character*16 function, character*(*) function  */

        if((ptr = look(p,"character")) != 0 ||
           (ptr = look(p,"logical")) != 0 ||
           (ptr = look(p,"real")) != 0 ||
           (ptr = look(p,"integer")) != 0 ||
           (ptr = look(p,"doubleprecision")) != 0 ||
           (ptr = look(p,"complex")) != 0 ||
           (ptr = look(p,"doublecomplex")) != 0 ) {
                while ( *ptr == ' ' || *ptr == '\t' || *ptr == '*'
			|| (*ptr >= '0' && *ptr <= '9')
			|| *ptr == '(' || *ptr == ')') ptr++;
		ptr = look(ptr,"function");
		return(ptr);
	}
        else
                return(0);
}

/* 	if first 6 col. blank, return ptr to col. 7,
	if blanks and then tab, return ptr after tab,
	else return 0 (labelled statement, comment or continuation */
char *skiplab(p)
char *p;
{
	register char *ptr;

	for (ptr = p; ptr < &p[6]; ptr++) {
		if (*ptr == ' ')
			continue;
		if (*ptr == '\t') {
			ptr++;
			break;
		}
		return (0);
	}
	return (ptr);
}

/* 	return 0 if m doesn't match initial part of s;
	otherwise return ptr to next char after m in s */
char *look(s, m)
char *s, *m;
{
	register char *sp, *mp;

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