/*	Copyright (c) 1984 AT&T	*/
/*	  All Rights Reserved  	*/

/*	THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T	*/
/*	The copyright notice above does not evidence any   	*/
/*	actual or intended publication of such source code.	*/

#ident	"$Header: fsplit.c 1.4 89/05/13 $@(#)fsplit:fsplit.c	1.3"

/*
 *	Program to split file(s) containing Fortran, Ratfor, or Efl
 *	procedures into separate files, one per procedure.
 *	Procedure X is put in file X.f, X.r, or X.e depending on
 *	the language option (-f, -r, -e); Fortran (-f) is default.
 *	The -s option causes Fortran procedures to be stripped to 72
 *	or fewer characters, with trailing blanks removed.
 */

/*
 * Rewritten (95%) to deal with Sequent Fortran.
 *
 * Options:
 *     -f, -r, -e : specify language as Fortran, Ratfor, Efl
 *     -s         : strip lines to 72 columns
 *     -d         : collect directives and place in each file
 */

/* 
 * $Copyright:	$
 * Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990 
 * Sequent Computer Systems, Inc.   All rights reserved.
 *  
 * This software is furnished under a license and may be used
 * only in accordance with the terms of that license and with the
 * inclusion of the above copyright notice.   This software may not
 * be provided or otherwise made available to, or used by, any
 * other person.  No title to or ownership of the software is
 * hereby transferred.
 *
 */

#include <stdio.h>
#include <ctype.h>
#include <string.h>
#include <sys/types.h>
#include <sys/param.h>

#define NO	0
#define YES	1

#define FORTRAN	0		/* language definitions */
#define RATFOR	1
#define EFL	2

#define MAX_LINE	512	/* max characters in a line */
#define MAX_DIRECTIVES	100	/* max directive lines that will be saved */

/* #define DEBUG	1	/* to compile for debugging */

#ifdef DEBUG
int debug;
# define dprintf	if (debug != 0) printf
#else
# define dprintf	if (0) printf
#endif

int blkdatano 	= 0;		/* to generate sequence of block data names */
int mainno      = 0;		/* to generate sequence of main unit names */
int language	= FORTRAN;	/* default language is Fortran */
char suffix	= 'f';		/* default suffix for Fortran */
int strip	= NO;
int collect	= NO;
int collect_state;
int have_line;
int at_eof;
int n_directives;
char *directives[MAX_DIRECTIVES];


FILE *fin;			/* input file */
FILE *fout;			/* output file */

char cur_name[DYNIX_MAXNAMLEN + 1];	/* current output file name */
char new_name[DYNIX_MAXNAMLEN + 1];	/* new output file name */
char in_line[MAX_LINE + 2];		/* input line buffer */


#define SKIP	while( isspace(*s) ) ++s;
#define trim(p)	while (*p == ' ' || *p == '\t') p++

/* Routine definitions. */

void splitup();	
void open_out();
void copy1();
void copy2();
void do_collect();
void do_rename();
void get_line();
void trim_line();
void put_line();

/* externs */

char *malloc();


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

#ifdef DEBUG
	opts = "defrsD";
#else
	opts = "defrs";
#endif

	/* Process options. */

	opterr = 0;
	while ((c = getopt(argc, argv, opts)) != -1)
		switch (c) {
		case 'd':
			collect = YES;
			break;
		case 'e':
			language = EFL;
			suffix = 'e';
			break;
		case 'f':
			language = FORTRAN;
			suffix = 'f';
			break;
		case 'r':
			language = RATFOR;
			suffix = 'r';
			break;
		case 's':
			strip = YES;
			break;
#ifdef DEBUG
		case 'D':
			debug = 1;
			break;
#endif
		case '?':
			error("usage: fsplit [-defrs] [file]\n");
			exit(1);
		}
	
	if (strip && (language != FORTRAN))
		error("WARNING: Implausible to strip non-Fortran prograns.\n");


	if (optind >= argc) {
		fin = stdin;
		splitup();
	} else {
		for ( ; optind < argc; optind++) {
			if ((fin = fopen(argv[optind], "r")) == NULL) {
				error("cannot open %s\n", argv[optind]);
				exit(1);
			}
			splitup();
			(void) fclose(fin);
		}
	}

	exit(0);
	/* NOTREACHED */
}

/*
 * splitup
 *
 * This breaks the input file provided into files.
 * Name taken from program/function name.
 */

void
splitup()
{
	int i;

	collect_state = 0;
	at_eof = 0;
	have_line = 0;

	get_line();

	while (at_eof == 0) {

		/* Open output file (temporary name for now). */

		open_out();

		/* Copy lines until name of module is found. */

		copy1();

		/* Rename file. */

		do_rename();

		/* Copy until "end" is found. */

		copy2();

		/* Close output file. */

		if (fclose(fout) != 0) {
			perror("close");
			error("fsplit: close of output file fails\n");
			exit(1);
		}

		/* Read next line in case at EOF. */

		get_line();
	}

	if (collect) {
		for (i=0; i < n_directives; i++)
			(void) free(directives[i]);
		n_directives = 0;
	}
}

/*
 * open_out
 *
 * Open a file in current directory.  Insure a unique name.
 * This will be renamed later.
 */

void
open_out()
{
	int i;

	(void) sprintf(cur_name, "fsplit.%d", (int) getpid());
	if (access(cur_name, 00)  == 0) {
		for (i=0; i < 100; i++) {
			(void) sprintf(cur_name, "fsplit%d.%d", i, (int) getpid());
			if (access(cur_name, 00) != 0)
				break;
		}
		if (i == 100) {
			error("fsplit: cannot create temporary file\n");
			exit(1);
		}
	}

	if ((fout = fopen(cur_name, "w")) == NULL) {
		error("fsplit: cannot create temporary file\n");
		exit(1);
	}

	dprintf("open_out: opened file '%s' as temporary file\n", cur_name);
}

/*
 * do_collect
 *
 * Process directives at the head of a file.  First time we
 * collect them, after that we write them to the output file.
 */

void
do_collect()
{
	int i;

	dprintf("do_collect: collect_state = %d\n", collect_state);

	if (collect_state == 1) {
		for (i = 0; i < n_directives; i++)
			(void) fprintf(fout, "%s", directives[i]);
		return;
	}

	collect_state = 1;


	for(;;) {
		if (have_line == 0)
			get_line();
		if (have_line == 0)
			break;
		if (is_comment())
			put_line();
		if (in_line[0] == '$') {
			if (n_directives >= MAX_DIRECTIVES) {
				error("fsplit: maximum of %d directives reached\n",
					MAX_DIRECTIVES);
				(void) unlink(cur_name);
				exit(1);
			}
			directives[n_directives] = malloc((unsigned)strlen(in_line) + 1);
			(void) strcpy(directives[n_directives], in_line);
			n_directives++;
			put_line();
		} else
			break;
	}
}

/*
 * copy1
 *
 * Copy lines until a module name is found.
 */

void
copy1()
{
	/* Take care of $ directives. */

	if (collect == YES)
		do_collect();

	/* Now copy lines. */

	if (have_line == 0)
		get_line();
	
	dprintf("copy1: entering loop, at_eof= %d, have_line= %d\n",
		at_eof, have_line);

	for (;;) {
		if (have_line == 0)
			return;
		if (is_comment())
			put_line();
		else if (is_option())
			put_line();
		else if (in_line[0] == '$')
			put_line();
		else {
			put_line();
			getname();
			return;
		}
		get_line();
	}
}

/*
 * copy2
 *
 * Copy lines until end is found.
 */

void
copy2()
{
	dprintf("copy2: at_eof= %d, have_line= %d\n", at_eof, have_line);

	for(;;) {
		get_line();
		if (have_line == 0)
			return;
		put_line();
		if (endcard())
			return;
	}
}

/*
 * do_rename
 *
 * Change name of temporary file.
 */

void
do_rename()
{
	dprintf("do_rename: cur_name= '%s', new_name= '%s'\n",
		cur_name, new_name);

	if (rename(cur_name, new_name) != 0) {
		perror("rename");
		error("Cannot rename temp file '%s' to '%s'\n",
			cur_name, new_name);
		(void) unlink(cur_name);
		exit(1);
	}
}

/*
 * is_comment
 *
 * See if a line contains a comment.
 * Return 1 if yes, 0 if not.
 */

is_comment()
{
	if ( (in_line[0] == 'c')  || (in_line[0] == 'C') ||
	     (in_line[0] == 'd')  || (in_line[0] == 'D') ||
	     (in_line[0] == '!')  || (in_line[0] == '*') ||
	     (in_line[0] == '\0') || (in_line[0] == '\n')   )
		return(1);
	else
		return(0);
}

/*
 * is_option
 *
 * See if this is an options statement.
 */

is_option()
{
	char *p;

	p = in_line;

	trim(p);
	if (*p != 'o' && *p != 'O') return(0);
	p++;
	trim(p);
	if (*p != 'p' && *p != 'P') return(0);
	p++;
	trim(p);
	if (*p != 't' && *p != 'T') return(0);
	p++;
	trim(p);
	if (*p != 'i' && *p != 'I') return(0);
	p++;
	trim(p);
	if (*p != 'o' && *p != 'O') return(0);
	p++;
	trim(p);
	if (*p != 'n' && *p != 'N') return(0);
	p++;
	trim(p);
	if (*p != 's' && *p != 'S') return(0);
	return(1);
}


/*
 * getname
 *
 * Create a name for current output file.  Should be able tro create
 * it based on present subroutine/function name.
 */

getname()
{
	char *s, *f;
	int i;

	f = new_name;
	s = in_line;
	dprintf("getname: line=%s", in_line);

loop:
	if( compar(&s,"subroutine") )	goto bot;
	else if( compar(&s,"function") )	goto bot;
	else if( compar(&s,"procedure") )	goto bot;
	else if( compar(&s,"program") )	goto bot;
	else if( compar(&s,"real") )	goto loop;
	else if( compar(&s,"integer") )	goto loop;
	else if( compar(&s,"logical") )	goto loop;
	else if( compar(&s,"byte") )	goto loop;
	else if( compar(&s,"double") )	goto loop;
	else if( compar(&s,"precision") )	goto loop;
	else if( compar(&s,"complex") )	goto loop;
	else if( compar(&s,"character") ) goto loop;
	else if( compar(&s,"*") ) {	/* complex *16  etc */
		for( ++s ; isdigit(*s) || isspace(*s)  ; ++s)
			;
		goto loop;
	} else if( compar(&s,"blockdata") ) {
		SKIP
		if(*s == '\0') {	/* no block data name */
			(void) sprintf(f, "BLOCKDATA%d.%c", ++blkdatano, suffix);
			dprintf("getname: created name '%s'\n", new_name);
			return;
		}
		goto bot;
	} else {
		s = "";
		dprintf("getname: unable to locate keyword\n");
	}

bot:
	SKIP
	for(i=0 ; isalpha(*s) || isdigit(*s) ||
		  (*s == '$') || (*s == '_')    ; i++)
		f[i] = *s++;
	if(i > 0) {
		f[i++] = '.';
		f[i++] = suffix;
		f[i++] = '\0';
	} else {
		mainno++;
		if (mainno == 1)
			(void) sprintf(f, "MAIN.%c", suffix);
		else
			(void) sprintf(f, "MAIN%d.%c", mainno, suffix);
	}
	dprintf("getname: created name '%s'\n", new_name);
}

/*
 * compar
 *
 * Compare two strings for equality.  Assume that "t" is all lower case.
 * Ignore blanks and decase "s" during comparison.  "s0" points to next
 * character after successful comparison.
 */

compar(s0, t)
	char **s0, *t;
{
	register char *s;
	register int s1;
	s = *s0;
	while (*t) {
		SKIP
		s1 = *s++;
		if (isupper(s1))
			s1 = tolower(s1);
		if (s1 != *t++)
			return(NO);
	}
	*s0 = s;
	return(YES);
}

/*
 * endcard
 *
 * Check for end statement.
 * Return 1 if yes, 0 if not.
 */

endcard()
{
	register char *p;

	p = in_line;
	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 - in_line) >= 72) || (*p == '\n'))
		return (1);
	return (0);
}


/*
 * get_line()
 *
 * Read a line from input file.  Line is expected to be '\n' terminated.
 * Truncate it if too long for buffer and discard remainder of line.
 * Trim to 72 columns if this option was selected.
 */

void
get_line()
{
	int c;
	static did_warn = 0;
	char *p;

	have_line = 0;
	if (at_eof)		/* check for at eof */
		return;

	for (p = in_line; p < &in_line[MAX_LINE]; ) {
		c = getc(fin);
		if (c == EOF) {
			at_eof = 1;
			if (p == in_line)
				return;
			*p++ = '\n';
			*p = '\0';
			have_line = 1;
			if (strip)
				trim_line();
			return;
		}
		*p = c;
		if (*p++ == '\n') {
			*p = '\0';
			have_line = 1;
			if (strip)
				trim_line();
			return;
		}
	}

	/* Truncate long lines. */

	do {
		c = getc(fin);
	} while ((c != EOF) && (c != '\n'));

	if (! did_warn) {
		error("fsplit: truncated long line to %d characters.\n", MAX_LINE);
		did_warn++;
	}
	if (strip)
		trim_line();
	have_line = 1;
}

/*
 * trim_line
 *
 * Truncate line if greater than 72 columns.
 */

void
trim_line()
{
	char *s, *s72;

	s72 = &in_line[72];

	for (s=in_line; s < s72; ++s)
		if ((*s == '\n') || (*s == '\0'))
			break;
		
	while ((s > in_line) && (s[-1] == ' '))
		--s;
	s[0] = '\n';
	s[1] = '\0';
}

/*
 * put_line
 *
 * Write line buffer to output file.
 */

void
put_line()
{
	if (have_line) {
		(void) fprintf(fout, "%s", in_line);
		have_line = 0;
	}
}

/*
 * error
 *
 * Write error message to stderr.
 */

/* VARARGS */
error(a, b, c, d, e, f, g, h, i, j)
{
	(void) fprintf(stderr, a, b, c, d, e, f, g, h, i, j);
}
