1 /* 2 * Copyright (c) 1983, 1993 3 * The Regents of the University of California. All rights reserved. 4 * 5 * This code is derived from software contributed to Berkeley by 6 * Asa Romberger and Jerry Berkman. 7 * 8 * Redistribution and use in source and binary forms, with or without 9 * modification, are permitted provided that the following conditions 10 * are met: 11 * 1. Redistributions of source code must retain the above copyright 12 * notice, this list of conditions and the following disclaimer. 13 * 2. Redistributions in binary form must reproduce the above copyright 14 * notice, this list of conditions and the following disclaimer in the 15 * documentation and/or other materials provided with the distribution. 16 * 3. Neither the name of the University nor the names of its contributors 17 * may be used to endorse or promote products derived from this software 18 * without specific prior written permission. 19 * 20 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 21 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 23 * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE 24 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 26 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 27 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 28 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 29 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 30 * SUCH DAMAGE. 31 */ 32 33 #include <sys/cdefs.h> 34 #ifndef lint 35 __COPYRIGHT("@(#) Copyright (c) 1983, 1993\ 36 The Regents of the University of California. All rights reserved."); 37 #endif /* not lint */ 38 39 #ifndef lint 40 #if 0 41 static char sccsid[] = "from: @(#)fsplit.c 8.1 (Berkeley) 6/6/93"; 42 #else 43 __RCSID("$NetBSD: fsplit.c,v 1.28 2011/09/16 15:39:26 joerg Exp $"); 44 #endif 45 #endif /* not lint */ 46 47 #include <sys/types.h> 48 #include <sys/stat.h> 49 50 #include <assert.h> 51 #include <ctype.h> 52 #include <err.h> 53 #include <stdbool.h> 54 #include <stdio.h> 55 #include <stdlib.h> 56 #include <string.h> 57 #include <unistd.h> 58 59 /* 60 * usage: fsplit [-e efile] ... [file] 61 * 62 * split single file containing source for several fortran programs 63 * and/or subprograms into files each containing one 64 * subprogram unit. 65 * each separate file will be named using the corresponding subroutine, 66 * function, block data or program name if one is found; otherwise 67 * the name will be of the form mainNNN.f or blkdtaNNN.f . 68 * If a file of that name exists, it is saved in a name of the 69 * form zzz000.f . 70 * If -e option is used, then only those subprograms named in the -e 71 * option are split off; e.g.: 72 * fsplit -esub1 -e sub2 prog.f 73 * isolates sub1 and sub2 in sub1.f and sub2.f. The space 74 * after -e is optional. 75 * 76 * Modified Feb., 1983 by Jerry Berkman, Computing Services, U.C. Berkeley. 77 * - added comments 78 * - more function types: double complex, character*(*), etc. 79 * - fixed minor bugs 80 * - instead of all unnamed going into zNNN.f, put mains in 81 * mainNNN.f, block datas in blkdtaNNN.f, dups in zzzNNN.f . 82 */ 83 84 #define BSZ 512 85 static char buf[BSZ]; 86 static FILE *ifp; 87 88 static char x[] = "zzz000.f"; 89 static char mainp[] = "main000.f"; 90 static char blkp[] = "blkdta000.f"; 91 92 __dead static void badparms(void); 93 static const char *functs(const char *); 94 static int get_line(void); 95 static void get_name(char *, int); 96 static int lend(void); 97 static int lname(char *, size_t); 98 static const char *look(const char *, const char *); 99 static int saveit(const char *); 100 static int scan_name(char *, size_t, const char *); 101 static const char *skiplab(const char *); 102 static const char *skipws(const char *); 103 104 struct extract { 105 bool found; 106 char *name; 107 }; 108 109 #define MAXEXTONLY 100 110 static struct extract extonly[MAXEXTONLY]; 111 static int numextonly = 0; 112 113 int 114 main(int argc, char **argv) 115 { 116 FILE *ofp; /* output file */ 117 int rv; /* 1 if got card in output file, 0 otherwise */ 118 int nflag; /* 1 if got name of subprog., 0 otherwise */ 119 int retval, i, ch; 120 char name[80]; 121 122 while ((ch = getopt(argc, argv, "e:")) != -1) { 123 switch (ch) { 124 case 'e': 125 if (numextonly >= MAXEXTONLY) { 126 errx(1, "Too many -e options"); 127 } 128 extonly[numextonly].name = optarg; 129 extonly[numextonly].found = false; 130 numextonly++; 131 break; 132 default: 133 badparms(); 134 break; 135 } 136 } 137 138 if (argc > 2) { 139 badparms(); 140 } else if (argc == 2) { 141 if ((ifp = fopen(argv[1], "r")) == NULL) { 142 err(1, "%s", argv[1]); 143 } 144 } else { 145 ifp = stdin; 146 } 147 148 for (;;) { 149 /* 150 * Look for a temp file that doesn't correspond to an 151 * existing file. 152 */ 153 154 get_name(x, 3); 155 ofp = fopen(x, "w"); 156 if (ofp == NULL) { 157 err(1, "%s", x); 158 } 159 nflag = 0; 160 rv = 0; 161 while (get_line() > 0) { 162 rv = 1; 163 fprintf(ofp, "%s", buf); 164 /* look for an 'end' statement */ 165 if (lend()) { 166 break; 167 } 168 /* if no name yet, try and find one */ 169 if (nflag == 0) { 170 nflag = lname(name, sizeof(name)); 171 } 172 } 173 fclose(ofp); 174 if (rv == 0) { 175 /* no lines in file, forget the file */ 176 unlink(x); 177 retval = 0; 178 for (i = 0; i < numextonly; i++) { 179 if (!extonly[i].found) { 180 retval = 1; 181 warnx("%s not found", extonly[i].name); 182 } 183 } 184 exit(retval); 185 } 186 if (nflag) { 187 /* rename the file */ 188 if (saveit(name)) { 189 struct stat sbuf; 190 191 if (stat(name, &sbuf) < 0) { 192 if (rename(x, name) < 0) { 193 warn("%s: rename", x); 194 printf("%s left in %s\n", 195 name, x); 196 } else { 197 printf("%s\n", name); 198 } 199 continue; 200 } else if (strcmp(name, x) == 0) { 201 printf("%s\n", x); 202 continue; 203 } 204 printf("%s already exists, put in %s\n", 205 name, x); 206 continue; 207 } else { 208 unlink(x); 209 continue; 210 } 211 } 212 if (numextonly == 0) { 213 printf("%s\n", x); 214 } else { 215 unlink(x); 216 } 217 } 218 } 219 220 static void 221 badparms(void) 222 { 223 err(1, "Usage: fsplit [-e efile] ... [file]"); 224 } 225 226 static int 227 saveit(const char *name) 228 { 229 int i; 230 char fname[50]; 231 size_t fnamelen; 232 233 if (numextonly == 0) { 234 return 1; 235 } 236 strlcpy(fname, name, sizeof(fname)); 237 fnamelen = strlen(fname); 238 assert(fnamelen > 2); 239 assert(fname[fnamelen-2] = '.'); 240 assert(fname[fnamelen-1] = 'f'); 241 fname[fnamelen-2] = '\0'; 242 243 for (i = 0; i < numextonly; i++) { 244 if (strcmp(fname, extonly[i].name) == 0) { 245 extonly[i].found = true; 246 return 1; 247 } 248 } 249 return 0; 250 } 251 252 static void 253 get_name(char *name, int letters) 254 { 255 struct stat sbuf; 256 char *ptr; 257 258 while (stat(name, &sbuf) >= 0) { 259 for (ptr = name + letters + 2; ptr >= name + letters; ptr--) { 260 (*ptr)++; 261 if (*ptr <= '9') 262 break; 263 *ptr = '0'; 264 } 265 if (ptr < name + letters) { 266 errx(1, "Ran out of file names.\n"); 267 } 268 } 269 } 270 271 static int 272 get_line(void) 273 { 274 char *ptr; 275 276 for (ptr = buf; ptr < &buf[BSZ]; ) { 277 *ptr = getc(ifp); 278 if (feof(ifp)) 279 return -1; 280 if (*ptr++ == '\n') { 281 *ptr = '\0'; 282 return 1; 283 } 284 } 285 while (getc(ifp) != '\n' && feof(ifp) == 0) { 286 /* nothing */ 287 } 288 warnx("Line truncated to %d characters.", BSZ); 289 return 1; 290 } 291 292 /* 293 * Return 1 for 'end' alone on card (up to col. 72), 0 otherwise. 294 */ 295 static int 296 lend(void) 297 { 298 const char *p; 299 300 if ((p = skiplab(buf)) == 0) { 301 return 0; 302 } 303 p = skipws(p); 304 if (*p != 'e' && *p != 'E') { 305 return 0; 306 } 307 p++; 308 p = skipws(p); 309 if (*p != 'n' && *p != 'N') { 310 return 0; 311 } 312 p++; 313 p = skipws(p); 314 if (*p != 'd' && *p != 'D') { 315 return 0; 316 } 317 p++; 318 p = skipws(p); 319 if (p - buf >= 72 || *p == '\n') { 320 return 1; 321 } 322 return 0; 323 } 324 325 /* 326 * check for keywords for subprograms 327 * return 0 if comment card, 1 if found 328 * name and put in arg string. invent name for unnamed 329 * block datas and main programs. 330 */ 331 static int 332 lname(char *s, size_t l) 333 { 334 #define LINESIZE 80 335 const char *ptr, *p; 336 char line[LINESIZE], *iptr = line; 337 338 /* first check for comment cards */ 339 if (buf[0] == 'c' || buf[0] == 'C' || buf[0] == '*') { 340 return 0; 341 } 342 ptr = skipws(buf); 343 if (*ptr == '\n') { 344 return 0; 345 } 346 347 ptr = skiplab(buf); 348 if (ptr == NULL) { 349 return 0; 350 } 351 352 /* copy to buffer and converting to lower case */ 353 p = ptr; 354 while (*p && p <= &buf[71] ) { 355 *iptr = tolower((unsigned char)*p); 356 iptr++; 357 p++; 358 } 359 *iptr = '\n'; 360 361 if ((ptr = look(line, "subroutine")) != NULL || 362 (ptr = look(line, "function")) != NULL || 363 (ptr = functs(line)) != NULL) { 364 if (scan_name(s, l, ptr)) { 365 return 1; 366 } 367 strlcpy(s, x, l); 368 } else if ((ptr = look(line, "program")) != NULL) { 369 if (scan_name(s, l, ptr)) { 370 return 1; 371 } 372 get_name(mainp, 4); 373 strlcpy(s, mainp, l); 374 } else if ((ptr = look(line, "blockdata")) != NULL) { 375 if (scan_name(s, l, ptr)) { 376 return 1; 377 } 378 get_name(blkp, 6); 379 strlcpy(s, blkp, l); 380 } else if ((ptr = functs(line)) != NULL) { 381 if (scan_name(s, l, ptr)) { 382 return 1; 383 } 384 strlcpy(s, x, l); 385 } else { 386 get_name(mainp, 4); 387 strlcpy(s, mainp, l); 388 } 389 return 1; 390 } 391 392 static int 393 scan_name(char *s, size_t smax, const char *ptr) 394 { 395 char *sptr; 396 size_t sptrmax; 397 398 /* scan off the name */ 399 ptr = skipws(ptr); 400 sptr = s; 401 sptrmax = smax - 3; 402 while (*ptr != '(' && *ptr != '\n') { 403 if (*ptr != ' ' && *ptr != '\t' && *ptr != '/') { 404 if (sptrmax == 0) { 405 /* Not sure this is the right thing, so warn */ 406 warnx("Output name too long; truncated"); 407 break; 408 } 409 *sptr++ = *ptr; 410 sptrmax--; 411 } 412 ptr++; 413 } 414 415 if (sptr == s) { 416 return 0; 417 } 418 419 *sptr++ = '.'; 420 *sptr++ = 'f'; 421 *sptr++ = '\0'; 422 return 1; 423 } 424 425 /* 426 * look for typed functions such as: real*8 function, 427 * character*16 function, character*(*) function 428 */ 429 static const char * 430 functs(const char *p) 431 { 432 const char *ptr; 433 434 if ((ptr = look(p, "character")) != NULL || 435 (ptr = look(p, "logical")) != NULL || 436 (ptr = look(p, "real")) != NULL || 437 (ptr = look(p, "integer")) != NULL || 438 (ptr = look(p, "doubleprecision")) != NULL || 439 (ptr = look(p, "complex")) != NULL || 440 (ptr = look(p, "doublecomplex")) != NULL) { 441 while (*ptr == ' ' || *ptr == '\t' || *ptr == '*' 442 || (*ptr >= '0' && *ptr <= '9') 443 || *ptr == '(' || *ptr == ')') { 444 ptr++; 445 } 446 ptr = look(ptr, "function"); 447 return ptr; 448 } 449 else { 450 return NULL; 451 } 452 } 453 454 /* 455 * if first 6 col. blank, return ptr to col. 7, 456 * if blanks and then tab, return ptr after tab, 457 * else return NULL (labelled statement, comment or continuation) 458 */ 459 static const char * 460 skiplab(const char *p) 461 { 462 const char *ptr; 463 464 for (ptr = p; ptr < &p[6]; ptr++) { 465 if (*ptr == ' ') 466 continue; 467 if (*ptr == '\t') { 468 ptr++; 469 break; 470 } 471 return NULL; 472 } 473 return ptr; 474 } 475 476 /* 477 * return NULL if m doesn't match initial part of s; 478 * otherwise return ptr to next char after m in s 479 */ 480 static const char * 481 look(const char *s, const char *m) 482 { 483 const char *sp, *mp; 484 485 sp = s; mp = m; 486 while (*mp) { 487 sp = skipws(sp); 488 if (*sp++ != *mp++) 489 return NULL; 490 } 491 return sp; 492 } 493 494 static const char * 495 skipws(const char *p) 496 { 497 while (*p == ' ' || *p == '\t') { 498 p++; 499 } 500 return p; 501 } 502