1 #include <ctype.h> 2 #include <stdio.h> 3 #include <sys/types.h> 4 #include <sys/stat.h> 5 6 /* 7 * usage: fsplit [-e efile] ... [file] 8 * 9 * split single file containing source for several fortran programs 10 * and/or subprograms into files each containing one 11 * subprogram unit. 12 * each separate file will be named using the corresponding subroutine, 13 * function, block data or program name if one is found; otherwise 14 * the name will be of the form mainNNN.f or blkdtaNNN.f . 15 * If a file of that name exists, it is saved in a name of the 16 * form zzz000.f . 17 * If -e option is used, then only those subprograms named in the -e 18 * option are split off; e.g.: 19 * fsplit -esub1 -e sub2 prog.f 20 * isolates sub1 and sub2 in sub1.f and sub2.f. The space 21 * after -e is optional. 22 * 23 * Modified Feb., 1983 by Jerry Berkman, Computing Services, U.C. Berkeley. 24 * - added comments 25 * - more function types: double complex, character*(*), etc. 26 * - fixed minor bugs 27 * - instead of all unnamed going into zNNN.f, put mains in 28 * mainNNN.f, block datas in blkdtaNNN.f, dups in zzzNNN.f . 29 */ 30 31 #define BSZ 512 32 char buf[BSZ]; 33 FILE *ifp; 34 char x[]="zzz000.f", 35 mainp[]="main000.f", 36 blkp[]="blkdta000.f"; 37 char *look(), *skiplab(), *functs(); 38 39 #define TRUE 1 40 #define FALSE 0 41 int extr = FALSE, 42 extrknt = -1, 43 extrfnd[100]; 44 char extrbuf[1000], 45 *extrnames[100]; 46 struct stat sbuf; 47 48 #define trim(p) while (*p == ' ' || *p == '\t') p++ 49 50 main(argc, argv) 51 char **argv; 52 { 53 register FILE *ofp; /* output file */ 54 register rv; /* 1 if got card in output file, 0 otherwise */ 55 register char *ptr; 56 int nflag, /* 1 if got name of subprog., 0 otherwise */ 57 retval, 58 i; 59 char name[20], 60 *extrptr = extrbuf; 61 62 /* scan -e options */ 63 while ( argc > 1 && argv[1][0] == '-' && argv[1][1] == 'e') { 64 extr = TRUE; 65 ptr = argv[1] + 2; 66 if(!*ptr) { 67 argc--; 68 argv++; 69 if(argc <= 1) badparms(); 70 ptr = argv[1]; 71 } 72 extrknt = extrknt + 1; 73 extrnames[extrknt] = extrptr; 74 extrfnd[extrknt] = FALSE; 75 while(*ptr) *extrptr++ = *ptr++; 76 *extrptr++ = 0; 77 argc--; 78 argv++; 79 } 80 81 if (argc > 2) 82 badparms(); 83 else if (argc == 2) { 84 if ((ifp = fopen(argv[1], "r")) == NULL) { 85 fprintf(stderr, "fsplit: cannot open %s\n", argv[1]); 86 exit(1); 87 } 88 } 89 else 90 ifp = stdin; 91 for(;;) { 92 /* look for a temp file that doesn't correspond to an existing file */ 93 get_name(x, 3); 94 ofp = fopen(x, "w"); 95 nflag = 0; 96 rv = 0; 97 while (getline() > 0) { 98 rv = 1; 99 fprintf(ofp, "%s", buf); 100 if (lend()) /* look for an 'end' statement */ 101 break; 102 if (nflag == 0) /* if no name yet, try and find one */ 103 nflag = lname(name); 104 } 105 fclose(ofp); 106 if (rv == 0) { /* no lines in file, forget the file */ 107 unlink(x); 108 retval = 0; 109 for ( i = 0; i <= extrknt; i++ ) 110 if(!extrfnd[i]) { 111 retval = 1; 112 fprintf( stderr, "fsplit: %s not found\n", 113 extrnames[i]); 114 } 115 exit( retval ); 116 } 117 if (nflag) { /* rename the file */ 118 if(saveit(name)) { 119 if (stat(name, &sbuf) < 0 ) { 120 link(x, name); 121 unlink(x); 122 printf("%s\n", name); 123 continue; 124 } else if (strcmp(name, x) == 0) { 125 printf("%s\n", x); 126 continue; 127 } 128 printf("%s already exists, put in %s\n", name, x); 129 continue; 130 } else 131 unlink(x); 132 continue; 133 } 134 if(!extr) 135 printf("%s\n", x); 136 else 137 unlink(x); 138 } 139 } 140 141 badparms() 142 { 143 fprintf(stderr, "fsplit: usage: fsplit [-e efile] ... [file] \n"); 144 exit(1); 145 } 146 147 saveit(name) 148 char *name; 149 { 150 int i; 151 char fname[50], 152 *fptr = fname; 153 154 if(!extr) return(1); 155 while(*name) *fptr++ = *name++; 156 *--fptr = 0; 157 *--fptr = 0; 158 for ( i=0 ; i<=extrknt; i++ ) 159 if( strcmp(fname, extrnames[i]) == 0 ) { 160 extrfnd[i] = TRUE; 161 return(1); 162 } 163 return(0); 164 } 165 166 get_name(name, letters) 167 char *name; 168 int letters; 169 { 170 register char *ptr; 171 172 while (stat(name, &sbuf) >= 0) { 173 for (ptr = name + letters + 2; ptr >= name + letters; ptr--) { 174 (*ptr)++; 175 if (*ptr <= '9') 176 break; 177 *ptr = '0'; 178 } 179 if(ptr < name + letters) { 180 fprintf( stderr, "fsplit: ran out of file names\n"); 181 exit(1); 182 } 183 } 184 } 185 186 getline() 187 { 188 register char *ptr; 189 190 for (ptr = buf; ptr < &buf[BSZ]; ) { 191 *ptr = getc(ifp); 192 if (feof(ifp)) 193 return (-1); 194 if (*ptr++ == '\n') { 195 *ptr = 0; 196 return (1); 197 } 198 } 199 while (getc(ifp) != '\n' && feof(ifp) == 0) ; 200 fprintf(stderr, "line truncated to %d characters\n", BSZ); 201 return (1); 202 } 203 204 /* return 1 for 'end' alone on card (up to col. 72), 0 otherwise */ 205 lend() 206 { 207 register char *p; 208 209 if ((p = skiplab(buf)) == 0) 210 return (0); 211 trim(p); 212 if (*p != 'e' && *p != 'E') return(0); 213 p++; 214 trim(p); 215 if (*p != 'n' && *p != 'N') return(0); 216 p++; 217 trim(p); 218 if (*p != 'd' && *p != 'D') return(0); 219 p++; 220 trim(p); 221 if (p - buf >= 72 || *p == '\n') 222 return (1); 223 return (0); 224 } 225 226 /* check for keywords for subprograms 227 return 0 if comment card, 1 if found 228 name and put in arg string. invent name for unnamed 229 block datas and main programs. */ 230 lname(s) 231 char *s; 232 { 233 # define LINESIZE 80 234 register char *ptr, *p, *sptr; 235 char line[LINESIZE], *iptr = line; 236 237 /* first check for comment cards */ 238 if(buf[0] == 'c' || buf[0] == 'C' || buf[0] == '*') return(0); 239 ptr = buf; 240 while (*ptr == ' ' || *ptr == '\t') ptr++; 241 if(*ptr == '\n') return(0); 242 243 244 ptr = skiplab(buf); 245 246 /* copy to buffer and converting to lower case */ 247 p = ptr; 248 while (*p && p <= &buf[71] ) { 249 *iptr = isupper(*p) ? tolower(*p) : *p; 250 iptr++; 251 p++; 252 } 253 *iptr = '\n'; 254 255 if ((ptr = look(line, "subroutine")) != 0 || 256 (ptr = look(line, "function")) != 0 || 257 (ptr = functs(line)) != 0) { 258 if(scan_name(s, ptr)) return(1); 259 strcpy( s, x); 260 } else if((ptr = look(line, "program")) != 0) { 261 if(scan_name(s, ptr)) return(1); 262 get_name( mainp, 4); 263 strcpy( s, mainp); 264 } else if((ptr = look(line, "blockdata")) != 0) { 265 if(scan_name(s, ptr)) return(1); 266 get_name( blkp, 6); 267 strcpy( s, blkp); 268 } else if((ptr = functs(line)) != 0) { 269 if(scan_name(s, ptr)) return(1); 270 strcpy( s, x); 271 } else { 272 get_name( mainp, 4); 273 strcpy( s, mainp); 274 } 275 return(1); 276 } 277 278 279 scan_name(s, ptr) 280 char *s, *ptr; 281 { 282 char *sptr; 283 284 /* scan off the name */ 285 trim(ptr); 286 sptr = s; 287 while (*ptr != '(' && *ptr != '\n') { 288 if (*ptr != ' ' && *ptr != '\t') 289 *sptr++ = *ptr; 290 ptr++; 291 } 292 293 if (sptr == s) return(0); 294 295 *sptr++ = '.'; 296 *sptr++ = 'f'; 297 *sptr++ = 0; 298 } 299 300 char *functs(p) 301 char *p; 302 { 303 register char *ptr; 304 305 /* look for typed functions such as: real*8 function, 306 character*16 function, character*(*) function */ 307 308 if((ptr = look(p,"character")) != 0 || 309 (ptr = look(p,"logical")) != 0 || 310 (ptr = look(p,"real")) != 0 || 311 (ptr = look(p,"integer")) != 0 || 312 (ptr = look(p,"doubleprecision")) != 0 || 313 (ptr = look(p,"complex")) != 0 || 314 (ptr = look(p,"doublecomplex")) != 0 ) { 315 while ( *ptr == ' ' || *ptr == '\t' || *ptr == '*' 316 || (*ptr >= '0' && *ptr <= '9') 317 || *ptr == '(' || *ptr == ')') ptr++; 318 ptr = look(ptr,"function"); 319 return(ptr); 320 } 321 else 322 return(0); 323 } 324 325 /* if first 6 col. blank, return ptr to col. 7, 326 if blanks and then tab, return ptr after tab, 327 else return 0 (labelled statement, comment or continuation */ 328 char *skiplab(p) 329 char *p; 330 { 331 register char *ptr; 332 333 for (ptr = p; ptr < &p[6]; ptr++) { 334 if (*ptr == ' ') 335 continue; 336 if (*ptr == '\t') { 337 ptr++; 338 break; 339 } 340 return (0); 341 } 342 return (ptr); 343 } 344 345 /* return 0 if m doesn't match initial part of s; 346 otherwise return ptr to next char after m in s */ 347 char *look(s, m) 348 char *s, *m; 349 { 350 register char *sp, *mp; 351 352 sp = s; mp = m; 353 while (*mp) { 354 trim(sp); 355 if (*sp++ != *mp++) 356 return (0); 357 } 358 return (sp); 359 } 360