diff options
Diffstat (limited to 'usr.bin')
| -rw-r--r-- | usr.bin/fsplit/Makefile | 5 | ||||
| -rw-r--r-- | usr.bin/fsplit/fsplit.1 | 109 | ||||
| -rw-r--r-- | usr.bin/fsplit/fsplit.c | 451 |
3 files changed, 0 insertions, 565 deletions
diff --git a/usr.bin/fsplit/Makefile b/usr.bin/fsplit/Makefile deleted file mode 100644 index 088ff0338eb..00000000000 --- a/usr.bin/fsplit/Makefile +++ /dev/null @@ -1,5 +0,0 @@ -# $OpenBSD: Makefile,v 1.2 1996/06/26 05:33:28 deraadt Exp $ - -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 79e26405d8b..00000000000 --- a/usr.bin/fsplit/fsplit.1 +++ /dev/null @@ -1,109 +0,0 @@ -.\" $OpenBSD: fsplit.1,v 1.14 2008/11/01 22:39:04 sobrado Exp $ -.\" $NetBSD: fsplit.1,v 1.3 1995/09/28 05:15:06 perry Exp $ -.\" -.\" 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. 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. -.\" -.\" from: @(#)fsplit.1 8.1 (Berkeley) 6/6/93 -.\" -.Dd $Mdocdate: November 1 2008 $ -.Dt FSPLIT 1 -.Os -.Sh NAME -.Nm fsplit -.Nd split a multi-routine Fortran file into individual files -.Sh SYNOPSIS -.Nm fsplit -.Op Fl e Ar efile -.Ar ... Op Ar file -.Sh DESCRIPTION -.Nm -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). -.Pp -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 -The options are as follows: -.Bl -tag -width Ds -.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 -.Dq readit -and -.Dq 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 -Asa Romberger and Jerry Berkman -.Sh BUGS -.Nm -assumes the subprogram name is on the first noncomment line of the subprogram -unit. -Non-standard source formats may confuse -.Nm fsplit . -.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 ab17b97f358..00000000000 --- a/usr.bin/fsplit/fsplit.c +++ /dev/null @@ -1,451 +0,0 @@ -/* $OpenBSD: fsplit.c,v 1.20 2013/11/26 13:18:55 deraadt Exp $ */ - -/* - * 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. 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. - */ - -#include <ctype.h> -#include <stdio.h> -#include <unistd.h> -#include <string.h> -#include <stdlib.h> -#include <sys/types.h> -#include <sys/stat.h> -#include <sys/fcntl.h> -#include <err.h> - -void badparms(void); -void get_name(char *, int); -int lname(char *, size_t); -int get_line(void); -int lend(void); -int scan_name(char *, char *); -int saveit(char *); - -/* - * 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(char *, char *), *skiplab(char *), *functs(char *); - -#define TRUE 1 -#define FALSE 0 -int extr = FALSE, extrknt = -1; -int maxextrknt; - -int *extrfnd; -char **extrnames; -struct stat sbuf; - -#define trim(p) while (*p == ' ' || *p == '\t') p++ - -int -main(int argc, char *argv[]) -{ - FILE *ofp; /* output file */ - int rv; /* 1 if got card in output file, 0 otherwise */ - char *ptr; - int nflag, /* 1 if got name of subprog., 0 otherwise */ - retval, i; - /* must be as large as max(sizeof(x), sizeof(mainp), sizeof(blockp)) */ - char name[20]; - - maxextrknt = 100; - extrnames = calloc(sizeof(char *), maxextrknt); - if (extrnames == NULL) - errx(1, "out of memory"); - /* 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; - if (extrknt >= maxextrknt) { - extrnames = realloc(extrnames, - sizeof(char *) * maxextrknt); - if (extrnames == NULL) - errx(1, "too many -e arguments"); - } - if ((extrnames[extrknt] = strdup(ptr)) == NULL) - errx(1, "out of memory"); - argc--; - argv++; - } - - extrfnd = calloc(extrknt+1, sizeof(int)); - if (extrfnd == NULL) - errx(1, "out of memory"); - - if (argc > 2) - badparms(); - else - if (argc == 2) { - if ((ifp = fopen(argv[1], "r")) == NULL) - err(1, "%s", argv[1]); - } else - ifp = stdin; - for (;;) { - int fd; - - /* look for a temp file that doesn't correspond to an existing - * file */ - get_name(x, 3); - - fd = open(x, O_CREAT|O_EXCL|O_RDWR, 0666); - if (fd == -1) - err(1, "%s", x); - ofp = fdopen(fd, "w"); - if (ofp == NULL) { - close(fd); - unlink(x); - err(1, "%s", x); - } - nflag = 0; - rv = 0; - while (get_line() > 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, sizeof 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); - } -} - -void -badparms(void) -{ - fprintf(stderr, "usage: fsplit [-e efile] ... [file]\n"); - exit(1); -} - -int -saveit(char *name) -{ - int i; - size_t n; - - if (!extr) - return (1); - - n = strlen(name); - if (n < 2) - return (0); - - for (i = 0; i <= extrknt; i++) - if (strncmp(name, extrnames[i], n - 2) == 0 && - extrnames[i][n-2] == '\0') { - extrfnd[i] = TRUE; - return (1); - } - return (0); -} - -void -get_name(char *name, int letters) -{ - 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 -get_line(void) -{ - int c; - char *ptr; - - for (ptr = buf; ptr < &buf[BSZ];) { - c = getc(ifp); - *ptr = c; - 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(void) -{ - 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(char *s, size_t len) -{ -#define LINESIZE 80 - 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 = tolower((unsigned char)*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); - strlcpy(s, x, len); - } else if ((ptr = look(line, "program")) != 0) { - if (scan_name(s, ptr)) - return (1); - get_name(mainp, 4); - strlcpy(s, mainp, len); - } else if ((ptr = look(line, "blockdata")) != 0) { - if (scan_name(s, ptr)) - return (1); - get_name(blkp, 6); - strlcpy(s, blkp, len); - } else if ((ptr = functs(line)) != 0) { - if (scan_name(s, ptr)) - return (1); - strlcpy(s, x, len); - } else { - get_name(mainp, 4); - strlcpy(s, mainp, len); - } - return (1); -} - -int -scan_name(char *s, char *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(char *p) -{ - 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(char *p) -{ - 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(char *s, char *m) -{ - char *sp, *mp; - - sp = s; - mp = m; - while (*mp) { - trim(sp); - if (*sp++ != *mp++) - return (0); - } - return (sp); -} |