NetBSD/usr.bin/fsplit/fsplit.c

503 lines
11 KiB
C

/*
* 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 <sys/cdefs.h>
#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.30 2015/06/16 22:54:10 christos Exp $");
#endif
#endif /* not lint */
#include <sys/types.h>
#include <sys/stat.h>
#include <assert.h>
#include <ctype.h>
#include <err.h>
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.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
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);
/* Guaranteed by scan_name. */
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.");
}
}
}
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;
}