Say goodbye to some crufty old fortran code.

Reviewed by:	current

1 files changed, 0 insertions, 429 deletions

diff --git a/usr.bin/fsplit/fsplit.c b/usr.bin/fsplit/fsplit.c
deleted file mode 100644
index 7a297bc91bbf..000000000000
--- a/usr.bin/fsplit/fsplit.c
+++ /dev/null
@@ -1,429 +0,0 @@
-/*
- * 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.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions
- * are met:
- * 1. Redistributions of source code must retain the above copyright
- *    notice, this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright
- *    notice, this list of conditions and the following disclaimer in the
- *    documentation and/or other materials provided with the distribution.
- * 3. All advertising materials mentioning features or use of this software
- *    must display the following acknowledgement:
- *	This product includes software developed by the University of
- *	California, Berkeley and its contributors.
- * 4. Neither the name of the University nor the names of its contributors
- *    may be used to endorse or promote products derived from this software
- *    without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
- * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
- * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
- * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
- * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
- * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
- * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
- * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
- * SUCH DAMAGE.
- */
-
-#ifndef lint
-static const char copyright[] =
-"@(#) Copyright (c) 1983, 1993\n\
-	The Regents of the University of California.  All rights reserved.\n";
-#endif /* not lint */
-
-#ifndef lint
-#if 0
-static char sccsid[] = "@(#)fsplit.c	8.1 (Berkeley) 6/6/93";
-#endif
-static const char rcsid[] =
-  "$FreeBSD$";
-#endif /* not lint */
-
-#include <ctype.h>
-#include <err.h>
-#include <stdio.h>
-#include <string.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <unistd.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";
-
-#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++
-
-int   getline __P((void));
-void  get_name __P((char *, int));
-char *functs __P((char *));
-int   lend __P((void));
-int   lname __P((char *));
-char *look __P((char *, char *));
-int   saveit __P((char *));
-int   scan_name __P((char *, char *));
-char *skiplab __P((char *));
-static void usage __P((void));
-
-int
-main(argc, argv)
-char **argv;
-{
-	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;
-
-	/*  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)
-				usage();
-			ptr = argv[1];
-		}
-		extrknt = extrknt + 1;
-		extrnames[extrknt] = extrptr;
-		extrfnd[extrknt] = FALSE;
-		while(*ptr) *extrptr++ = *ptr++;
-		*extrptr++ = 0;
-		argc--;
-		argv++;
-	}
-
-	if (argc > 2)
-		usage();
-	else if (argc == 2) {
-		if ((ifp = fopen(argv[1], "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");
-	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;
-				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);
-    }
-}
-
-static void
-usage()
-{
-	fprintf(stderr, "usage: fsplit [-e efile] ... [file]\n");
-	exit(1);
-}
-
-int
-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);
-}
-
-void
-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)
-			errx(1, "ran out of file names");
-	}
-}
-
-int
-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) ;
-	warnx("line truncated to %d characters", BSZ);
-	return (1);
-}
-
-/* return 1 for 'end' alone on card (up to col. 72),  0 otherwise */
-int
-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.		*/
-int
-lname(s)
-char *s;
-{
-#	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;
-	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);
-}
-
-int
-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);
-}