From 97b7aef1ba7b36e79696a64baa75a5478719a7fc Mon Sep 17 00:00:00 2001 From: Thomas Cort Date: Sun, 27 Oct 2013 13:33:50 -0400 Subject: [PATCH] Importing usr.bin/fsplit No Minix-specific changes needed. Change-Id: I78021e6485b40a5b9f98b5d0e5ce0dc82b1ae46a --- distrib/sets/lists/minix/mi | 2 + releasetools/nbsd_ports | 1 + usr.bin/Makefile | 2 +- usr.bin/fsplit/Makefile | 6 + usr.bin/fsplit/fsplit.1 | 105 ++++++++ usr.bin/fsplit/fsplit.c | 501 ++++++++++++++++++++++++++++++++++++ 6 files changed, 616 insertions(+), 1 deletion(-) create mode 100644 usr.bin/fsplit/Makefile create mode 100644 usr.bin/fsplit/fsplit.1 create mode 100644 usr.bin/fsplit/fsplit.c diff --git a/distrib/sets/lists/minix/mi b/distrib/sets/lists/minix/mi index 78de0b77c..440c3e577 100644 --- a/distrib/sets/lists/minix/mi +++ b/distrib/sets/lists/minix/mi @@ -320,6 +320,7 @@ ./usr/bin/format minix-sys ./usr/bin/fortune minix-sys ./usr/bin/from minix-sys +./usr/bin/fsplit minix-sys ./usr/bin/fstat minix-sys ./usr/bin/ftp minix-sys ./usr/bin/g++ minix-sys gcccmds @@ -1889,6 +1890,7 @@ ./usr/man/man1/fortune.1 minix-sys ./usr/man/man1/from.1 minix-sys ./usr/man/man1/fsck.mfs.1 minix-sys +./usr/man/man1/fsplit.1 minix-sys ./usr/man/man1/ftp.1 minix-sys ./usr/man/man1/g++.1 minix-sys gcccmds ./usr/man/man1/gcc.1 minix-sys gcccmds diff --git a/releasetools/nbsd_ports b/releasetools/nbsd_ports index 87563d3a2..5ec43497c 100644 --- a/releasetools/nbsd_ports +++ b/releasetools/nbsd_ports @@ -164,6 +164,7 @@ 2013/10/17 12:00:00,usr.bin/env 2013/05/31 12:00:00,usr.bin/finger 2013/03/22 12:00:00,usr.bin/from +2012/10/17 12:00:00,usr.bin/fsplit 2013/04/05 12:00:00,usr.bin/ftp 2013/03/18 12:00:00,usr.bin/head 2012/10/17 12:00:00,usr.bin/genassym diff --git a/usr.bin/Makefile b/usr.bin/Makefile index c87c85e10..f3f61a9aa 100644 --- a/usr.bin/Makefile +++ b/usr.bin/Makefile @@ -11,7 +11,7 @@ SUBDIR= asa \ dirname du \ env expand \ finger from \ - ftp genassym getopt \ + fsplit ftp genassym getopt \ head indent infocmp join \ ldd leave \ login logname lorder m4 \ diff --git a/usr.bin/fsplit/Makefile b/usr.bin/fsplit/Makefile new file mode 100644 index 000000000..5e135ff31 --- /dev/null +++ b/usr.bin/fsplit/Makefile @@ -0,0 +1,6 @@ +# $NetBSD: Makefile,v 1.6 2009/04/14 22:15:20 lukem Exp $ +# from: @(#)Makefile 8.1 (Berkeley) 6/6/93 + +PROG= fsplit + +.include diff --git a/usr.bin/fsplit/fsplit.1 b/usr.bin/fsplit/fsplit.1 new file mode 100644 index 000000000..34e5eadb1 --- /dev/null +++ b/usr.bin/fsplit/fsplit.1 @@ -0,0 +1,105 @@ +.\" $NetBSD: fsplit.1,v 1.9 2003/08/07 11:13:50 agc 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 June 6, 1993 +.Dt FSPLIT 1 +.Os +.Sh NAME +.Nm fsplit +.Nd split a multi-routine Fortran file into individual files +.Sh SYNOPSIS +.Nm +.Op Fl e Ar efile +\&... +.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). +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 +Asa Romberger and Jerry Berkman +.Sh BUGS +.Nm +assumes the subprogram name is on the first noncomment line of the subprogram +unit. +Nonstandard source formats may confuse +.Nm . +.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 new file mode 100644 index 000000000..ce6cd93cd --- /dev/null +++ b/usr.bin/fsplit/fsplit.c @@ -0,0 +1,501 @@ +/* + * 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 +#ifndef lint +__COPYRIGHT("@(#) Copyright (c) 1983, 1993\ + The Regents of the University of California. All rights reserved."); +#endif /* not lint */ + +#ifndef lint +#if 0 +static char sccsid[] = "from: @(#)fsplit.c 8.1 (Berkeley) 6/6/93"; +#else +__RCSID("$NetBSD: fsplit.c,v 1.28 2011/09/16 15:39:26 joerg Exp $"); +#endif +#endif /* not lint */ + +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include + +/* + * 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 +static char buf[BSZ]; +static FILE *ifp; + +static char x[] = "zzz000.f"; +static char mainp[] = "main000.f"; +static char blkp[] = "blkdta000.f"; + +__dead static void badparms(void); +static const char *functs(const char *); +static int get_line(void); +static void get_name(char *, int); +static int lend(void); +static int lname(char *, size_t); +static const char *look(const char *, const char *); +static int saveit(const char *); +static int scan_name(char *, size_t, const char *); +static const char *skiplab(const char *); +static const char *skipws(const char *); + +struct extract { + bool found; + char *name; +}; + +#define MAXEXTONLY 100 +static struct extract extonly[MAXEXTONLY]; +static int numextonly = 0; + +int +main(int argc, char **argv) +{ + FILE *ofp; /* output file */ + int rv; /* 1 if got card in output file, 0 otherwise */ + int nflag; /* 1 if got name of subprog., 0 otherwise */ + int retval, i, ch; + char name[80]; + + while ((ch = getopt(argc, argv, "e:")) != -1) { + switch (ch) { + case 'e': + if (numextonly >= MAXEXTONLY) { + errx(1, "Too many -e options"); + } + extonly[numextonly].name = optarg; + extonly[numextonly].found = false; + numextonly++; + break; + default: + badparms(); + break; + } + } + + if (argc > 2) { + badparms(); + } else if (argc == 2) { + if ((ifp = fopen(argv[1], "r")) == NULL) { + err(1, "%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"); + if (ofp == NULL) { + err(1, "%s", x); + } + nflag = 0; + rv = 0; + while (get_line() > 0) { + rv = 1; + fprintf(ofp, "%s", buf); + /* look for an 'end' statement */ + if (lend()) { + break; + } + /* if no name yet, try and find one */ + if (nflag == 0) { + 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 < numextonly; i++) { + if (!extonly[i].found) { + retval = 1; + warnx("%s not found", extonly[i].name); + } + } + exit(retval); + } + if (nflag) { + /* rename the file */ + if (saveit(name)) { + struct stat sbuf; + + if (stat(name, &sbuf) < 0) { + if (rename(x, name) < 0) { + warn("%s: rename", x); + printf("%s left in %s\n", + name, x); + } else { + 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 (numextonly == 0) { + printf("%s\n", x); + } else { + unlink(x); + } + } +} + +static void +badparms(void) +{ + err(1, "Usage: fsplit [-e efile] ... [file]"); +} + +static int +saveit(const char *name) +{ + int i; + char fname[50]; + size_t fnamelen; + + if (numextonly == 0) { + return 1; + } + strlcpy(fname, name, sizeof(fname)); + fnamelen = strlen(fname); + assert(fnamelen > 2); + assert(fname[fnamelen-2] = '.'); + assert(fname[fnamelen-1] = 'f'); + fname[fnamelen-2] = '\0'; + + for (i = 0; i < numextonly; i++) { + if (strcmp(fname, extonly[i].name) == 0) { + extonly[i].found = true; + return 1; + } + } + return 0; +} + +static void +get_name(char *name, int letters) +{ + struct stat sbuf; + 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.\n"); + } + } +} + +static int +get_line(void) +{ + 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) { + /* nothing */ + } + warnx("Line truncated to %d characters.", BSZ); + return 1; +} + +/* + * Return 1 for 'end' alone on card (up to col. 72), 0 otherwise. + */ +static int +lend(void) +{ + const char *p; + + if ((p = skiplab(buf)) == 0) { + return 0; + } + p = skipws(p); + if (*p != 'e' && *p != 'E') { + return 0; + } + p++; + p = skipws(p); + if (*p != 'n' && *p != 'N') { + return 0; + } + p++; + p = skipws(p); + if (*p != 'd' && *p != 'D') { + return 0; + } + p++; + p = skipws(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. + */ +static int +lname(char *s, size_t l) +{ +#define LINESIZE 80 + const 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 = skipws(buf); + if (*ptr == '\n') { + return 0; + } + + ptr = skiplab(buf); + if (ptr == NULL) { + 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")) != NULL || + (ptr = look(line, "function")) != NULL || + (ptr = functs(line)) != NULL) { + if (scan_name(s, l, ptr)) { + return 1; + } + strlcpy(s, x, l); + } else if ((ptr = look(line, "program")) != NULL) { + if (scan_name(s, l, ptr)) { + return 1; + } + get_name(mainp, 4); + strlcpy(s, mainp, l); + } else if ((ptr = look(line, "blockdata")) != NULL) { + if (scan_name(s, l, ptr)) { + return 1; + } + get_name(blkp, 6); + strlcpy(s, blkp, l); + } else if ((ptr = functs(line)) != NULL) { + if (scan_name(s, l, ptr)) { + return 1; + } + strlcpy(s, x, l); + } else { + get_name(mainp, 4); + strlcpy(s, mainp, l); + } + return 1; +} + +static int +scan_name(char *s, size_t smax, const char *ptr) +{ + char *sptr; + size_t sptrmax; + + /* scan off the name */ + ptr = skipws(ptr); + sptr = s; + sptrmax = smax - 3; + while (*ptr != '(' && *ptr != '\n') { + if (*ptr != ' ' && *ptr != '\t' && *ptr != '/') { + if (sptrmax == 0) { + /* Not sure this is the right thing, so warn */ + warnx("Output name too long; truncated"); + break; + } + *sptr++ = *ptr; + sptrmax--; + } + ptr++; + } + + if (sptr == s) { + return 0; + } + + *sptr++ = '.'; + *sptr++ = 'f'; + *sptr++ = '\0'; + return 1; +} + +/* + * look for typed functions such as: real*8 function, + * character*16 function, character*(*) function + */ +static const char * +functs(const char *p) +{ + const char *ptr; + + if ((ptr = look(p, "character")) != NULL || + (ptr = look(p, "logical")) != NULL || + (ptr = look(p, "real")) != NULL || + (ptr = look(p, "integer")) != NULL || + (ptr = look(p, "doubleprecision")) != NULL || + (ptr = look(p, "complex")) != NULL || + (ptr = look(p, "doublecomplex")) != NULL) { + while (*ptr == ' ' || *ptr == '\t' || *ptr == '*' + || (*ptr >= '0' && *ptr <= '9') + || *ptr == '(' || *ptr == ')') { + ptr++; + } + ptr = look(ptr, "function"); + return ptr; + } + else { + return NULL; + } +} + +/* + * if first 6 col. blank, return ptr to col. 7, + * if blanks and then tab, return ptr after tab, + * else return NULL (labelled statement, comment or continuation) + */ +static const char * +skiplab(const char *p) +{ + const char *ptr; + + for (ptr = p; ptr < &p[6]; ptr++) { + if (*ptr == ' ') + continue; + if (*ptr == '\t') { + ptr++; + break; + } + return NULL; + } + return ptr; +} + +/* + * return NULL if m doesn't match initial part of s; + * otherwise return ptr to next char after m in s + */ +static const char * +look(const char *s, const char *m) +{ + const char *sp, *mp; + + sp = s; mp = m; + while (*mp) { + sp = skipws(sp); + if (*sp++ != *mp++) + return NULL; + } + return sp; +} + +static const char * +skipws(const char *p) +{ + while (*p == ' ' || *p == '\t') { + p++; + } + return p; +}