diff options
| -rw-r--r-- | usr.bin/Makefile | 2 | ||||
| -rw-r--r-- | usr.bin/fpr/Makefile | 5 | ||||
| -rw-r--r-- | usr.bin/fpr/fpr.1 | 84 | ||||
| -rw-r--r-- | usr.bin/fpr/fpr.c | 410 | ||||
| -rw-r--r-- | usr.bin/fsplit/Makefile | 5 | ||||
| -rw-r--r-- | usr.bin/fsplit/fsplit.1 | 106 | ||||
| -rw-r--r-- | usr.bin/fsplit/fsplit.c | 429 |
7 files changed, 0 insertions, 1041 deletions
diff --git a/usr.bin/Makefile b/usr.bin/Makefile index 475f48d..b861a96 100644 --- a/usr.bin/Makefile +++ b/usr.bin/Makefile @@ -47,9 +47,7 @@ SUBDIR= apply \ finger \ fmt \ fold \ - fpr \ from \ - fsplit \ fstat \ ftp \ gencat \ diff --git a/usr.bin/fpr/Makefile b/usr.bin/fpr/Makefile deleted file mode 100644 index b5d12f0..0000000 --- a/usr.bin/fpr/Makefile +++ /dev/null @@ -1,5 +0,0 @@ -# @(#)Makefile 8.1 (Berkeley) 6/6/93 - -PROG= fpr - -.include <bsd.prog.mk> diff --git a/usr.bin/fpr/fpr.1 b/usr.bin/fpr/fpr.1 deleted file mode 100644 index 489885e..0000000 --- a/usr.bin/fpr/fpr.1 +++ /dev/null @@ -1,84 +0,0 @@ -.\" Copyright (c) 1989, 1990, 1993 -.\" The Regents of the University of California. All rights reserved. -.\" -.\" This code is derived from software contributed to Berkeley by -.\" Robert Corbett. -.\" 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. -.\" -.\" @(#)fpr.1 8.1 (Berkeley) 6/6/93 -.\" $FreeBSD$ -.\" -.Dd June 6, 1993 -.Dt FPR 1 -.Os BSD 4.2 -.Sh NAME -.Nm fpr -.Nd print Fortran file -.Sh SYNOPSIS -.Nm fpr -.Sh DESCRIPTION -.Nm Fpr -is a filter that transforms files formatted according to -Fortran's carriage control conventions into files formatted -according to -.Ux -line printer conventions. -.Pp -.Nm Fpr -copies its input onto its output, replacing the carriage -control characters with characters that will produce the intended -effects when printed using -.Xr lpr 1 . -The first character of each line determines the vertical spacing as follows: -.Bd -ragged -offset indent -compact -.Bl -column Character -.It Blank One line -.It 0 Two lines -.It 1 To first line of next page -.It + No advance -.El -.Ed -.Pp -A blank line is treated as if its first -character is a blank. A blank that appears as a carriage control -character is deleted. A zero is changed to a newline. A one is -changed to a form feed. The effects of a "+" are simulated using -backspaces. -.Sh EXAMPLES -.Dl a.out \&| fpr \&| lpr -.Pp -.Dl fpr \&< f77.output \&| lpr -.Sh HISTORY -The -.Nm fpr -command -appeared in -.Bx 4.2 . -.Sh BUGS -Results are undefined for input lines longer than 170 characters. diff --git a/usr.bin/fpr/fpr.c b/usr.bin/fpr/fpr.c deleted file mode 100644 index b8fdf9c..0000000 --- a/usr.bin/fpr/fpr.c +++ /dev/null @@ -1,410 +0,0 @@ -/* - * Copyright (c) 1989, 1993 - * The Regents of the University of California. All rights reserved. - * - * This code is derived from software contributed to Berkeley by - * Robert Corbett. - * - * 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 char copyright[] = -"@(#) Copyright (c) 1989, 1993\n\ - The Regents of the University of California. All rights reserved.\n"; -#endif /* not lint */ - -#ifndef lint -static char sccsid[] = "@(#)fpr.c 8.1 (Berkeley) 6/6/93"; -#endif /* not lint */ - -#include <stdio.h> - -#define BLANK ' ' -#define TAB '\t' -#define NUL '\000' -#define FF '\f' -#define BS '\b' -#define CR '\r' -#define VTAB '\013' -#define EOL '\n' - -#define TRUE 1 -#define FALSE 0 - -#define MAXCOL 170 -#define TABSIZE 8 -#define INITWIDTH 8 - -typedef - struct column - { - int count; - int width; - char *str; - } - COLUMN; - -char cc; -char saved; -int length; -char *text; -int highcol; -COLUMN *line; -int maxpos; -int maxcol; - -extern char *malloc(); -extern char *calloc(); -extern char *realloc(); - - - -main() -{ - register int ch; - register char ateof; - register int i; - register int errorcount; - - - init(); - errorcount = 0; - ateof = FALSE; - - ch = getchar(); - if (ch == EOF) - exit(0); - - if (ch == EOL) - { - cc = NUL; - ungetc((int) EOL, stdin); - } - else if (ch == BLANK) - cc = NUL; - else if (ch == '1') - cc = FF; - else if (ch == '0') - cc = EOL; - else if (ch == '+') - cc = CR; - else - { - errorcount = 1; - cc = NUL; - ungetc(ch, stdin); - } - - while ( ! ateof) - { - gettext(); - ch = getchar(); - if (ch == EOF) - { - flush(); - ateof = TRUE; - } - else if (ch == EOL) - { - flush(); - cc = NUL; - ungetc((int) EOL, stdin); - } - else if (ch == BLANK) - { - flush(); - cc = NUL; - } - else if (ch == '1') - { - flush(); - cc = FF; - } - else if (ch == '0') - { - flush(); - cc = EOL; - } - else if (ch == '+') - { - for (i = 0; i < length; i++) - savech(i); - } - else - { - errorcount++; - flush(); - cc = NUL; - ungetc(ch, stdin); - } - } - - if (errorcount == 1) - fprintf(stderr, "Illegal carriage control - 1 line.\n"); - else if (errorcount > 1) - fprintf(stderr, "Illegal carriage control - %d lines.\n", errorcount); - - exit(0); -} - - - -init() -{ - register COLUMN *cp; - register COLUMN *cend; - register char *sp; - - - length = 0; - maxpos = MAXCOL; - sp = malloc((unsigned) maxpos); - if (sp == NULL) - nospace(); - text = sp; - - highcol = -1; - maxcol = MAXCOL; - line = (COLUMN *) calloc(maxcol, (unsigned) sizeof(COLUMN)); - if (line == NULL) - nospace(); - cp = line; - cend = line + (maxcol-1); - while (cp <= cend) - { - cp->width = INITWIDTH; - sp = calloc(INITWIDTH, (unsigned) sizeof(char)); - if (sp == NULL) - nospace(); - cp->str = sp; - cp++; - } -} - - - -gettext() -{ - register int i; - register char ateol; - register int ch; - register int pos; - - - i = 0; - ateol = FALSE; - - while ( ! ateol) - { - ch = getchar(); - if (ch == EOL || ch == EOF) - ateol = TRUE; - else if (ch == TAB) - { - pos = (1 + i/TABSIZE) * TABSIZE; - if (pos > maxpos) - { - maxpos = pos + 10; - text = realloc(text, (unsigned) maxpos); - if (text == NULL) - nospace(); - } - while (i < pos) - { - text[i] = BLANK; - i++; - } - } - else if (ch == BS) - { - if (i > 0) - { - i--; - savech(i); - } - } - else if (ch == CR) - { - while (i > 0) - { - i--; - savech(i); - } - } - else if (ch == FF || ch == VTAB) - { - flush(); - cc = ch; - i = 0; - } - else - { - if (i >= maxpos) - { - maxpos = i + 10; - text = realloc(text, (unsigned) maxpos); - if (text == NULL) - nospace(); - } - text[i] = ch; - i++; - } - } - - length = i; -} - - - -savech(col) -int col; -{ - register char ch; - register int oldmax; - register COLUMN *cp; - register COLUMN *cend; - register char *sp; - register int newcount; - - - ch = text[col]; - if (ch == BLANK) - return; - - saved = TRUE; - - if (col >= highcol) - highcol = col; - - if (col >= maxcol) - { - oldmax = maxcol; - maxcol = col + 10; - line = (COLUMN *) realloc(line, (unsigned) maxcol*sizeof(COLUMN)); - if (line == NULL) - nospace(); - cp = line + oldmax; - cend = line + (maxcol - 1); - while (cp <= cend) - { - cp->width = INITWIDTH; - cp->count = 0; - sp = calloc(INITWIDTH, (unsigned) sizeof(char)); - if (sp == NULL) - nospace(); - cp->str = sp; - cp++; - } - } - - cp = line + col; - newcount = cp->count + 1; - if (newcount > cp->width) - { - cp->width = newcount; - sp = realloc(cp->str, (unsigned) newcount*sizeof(char)); - if (sp == NULL) - nospace(); - cp->str = sp; - } - cp->count = newcount; - cp->str[newcount-1] = ch; -} - - - -flush() -{ - register int i; - register int anchor; - register int height; - register int j; - - - if (cc != NUL) - putchar(cc); - - if ( ! saved) - { - i = length; - while (i > 0 && text[i-1] == BLANK) - i--; - length = i; - for (i = 0; i < length; i++) - putchar(text[i]); - putchar(EOL); - return; - } - - for (i =0; i < length; i++) - savech(i); - - anchor = 0; - while (anchor <= highcol) - { - height = line[anchor].count; - if (height == 0) - { - putchar(BLANK); - anchor++; - } - else if (height == 1) - { - putchar( *(line[anchor].str) ); - line[anchor].count = 0; - anchor++; - } - else - { - i = anchor; - while (i < highcol && line[i+1].count > 1) - i++; - for (j = anchor; j <= i; j++) - { - height = line[j].count - 1; - putchar(line[j].str[height]); - line[j].count = height; - } - for (j = anchor; j <= i; j++) - putchar(BS); - } - } - - putchar(EOL); - highcol = -1; -} - - - -nospace() -{ - fputs("Storage limit exceeded.\n", stderr); - exit(1); -} diff --git a/usr.bin/fsplit/Makefile b/usr.bin/fsplit/Makefile deleted file mode 100644 index f731a0d..0000000 --- a/usr.bin/fsplit/Makefile +++ /dev/null @@ -1,5 +0,0 @@ -# @(#)Makefile 8.1 (Berkeley) 6/6/93 - -PROG= fsplit - -.include <bsd.prog.mk> diff --git a/usr.bin/fsplit/fsplit.1 b/usr.bin/fsplit/fsplit.1 deleted file mode 100644 index 23a3ddf..0000000 --- a/usr.bin/fsplit/fsplit.1 +++ /dev/null @@ -1,106 +0,0 @@ -.\" Copyright (c) 1983, 1990, 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. -.\" -.\" @(#)fsplit.1 8.1 (Berkeley) 6/6/93 -.\" $FreeBSD$ -.\" -.Dd June 6, 1993 -.Dt FSPLIT 1 -.Os BSD 4.2 -.Sh NAME -.Nm fsplit -.Nd split a multi-routine Fortran 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 source code. -It attempts to split the input into separate routine files of the -form -.Ar name.f , -where -.Ar name -is the name of the program unit (e.g. function, subroutine, block data or -program). The name for unnamed block data subprograms has the form -.Ar blkdtaNNN.f -where NNN is three digits and a file of this name does not already exist. -For unnamed main programs the name has the form -.Ar mainNNN.f . -If there is an error in classifying a program unit, or if -.Ar name.f -already exists, -the program unit will be put in a file of the form -.Ar zzzNNN.f -where -.Ar zzzNNN.f -does not already exist. -.Pp -.Bl -tag -width Fl -.It Fl e Ar efile -Normally each subprogram unit is split into a separate file. When the -.Fl e -option is used, only the specified subprogram units are split into separate -files. E.g.: -.Pp -.Dl fsplit -e readit -e doit prog.f -.Pp -will split readit and doit into separate files. -.El -.Sh DIAGNOSTICS -If names specified via the -.Fl e -option are not found, a diagnostic is written to -standard error. -.Sh HISTORY -The -.Nm -command -appeared in -.Bx 4.2 . -.Sh AUTHORS -.An Asa Romberger -and -.An Jerry Berkman -.Sh BUGS -.Nm Fsplit -assumes the subprogram name is on the first noncomment line of the subprogram -unit. Nonstandard source formats may confuse -.Nm Ns . -.Pp -It is hard to use -.Fl e -for unnamed main programs and block data subprograms since you must -predict the created file name. diff --git a/usr.bin/fsplit/fsplit.c b/usr.bin/fsplit/fsplit.c deleted file mode 100644 index 7a297bc..0000000 --- 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); -} |
