![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fsplit.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd|
Return to fsplit.c CVS log | Up to [Research Unix] / researchv10dc / cmd |
1.1 ! root 1: /* ! 2: Program to split file(s) containing Fortran, Ratfor, or Efl ! 3: procedures into separate files, one per procedure. ! 4: Procedure X is put in file X.f, X.r, or X.e depending on ! 5: the language option (-f, -r, -e); Fortran (-f) is default. ! 6: The -s option causes Fortran procedures to be stripped to 72 ! 7: or fewer characters, with trailing blanks removed. ! 8: The -i option forces filenames to lower case. ! 9: */ ! 10: ! 11: #include <stdio.h> ! 12: #include <ctype.h> ! 13: #define BIG 1000 ! 14: ! 15: #define NO 0 ! 16: #define YES 1 ! 17: ! 18: #define FORTRAN 0 ! 19: #define RATFOR 1 ! 20: #define EFL 2 ! 21: ! 22: int blkdatano = 0; ! 23: int language = FORTRAN; ! 24: char suffix = 'f'; ! 25: int strip = NO; ! 26: int iflag; ! 27: ! 28: #define SKIP while( isspace(*s) ) ++s; ! 29: ! 30: ! 31: main(argc, argv) ! 32: int argc; ! 33: char **argv; ! 34: { ! 35: FILE *fd; ! 36: int i; ! 37: register char *s; ! 38: ! 39: while(argc>1 && argv[1][0]=='-') ! 40: { ! 41: for(s = argv[1]+1 ; *s ; ++s) ! 42: switch(*s) ! 43: { ! 44: case 'y': ! 45: fprintf(stderr,"split: -y obsolete; -i assumed\n"); ! 46: case 'i': ! 47: iflag++; ! 48: break; ! 49: ! 50: case 's': ! 51: strip = YES; ! 52: break; ! 53: ! 54: case 'f': ! 55: language = FORTRAN; ! 56: suffix = 'f'; ! 57: break; ! 58: ! 59: case 'r': ! 60: language = RATFOR; ! 61: suffix = 'r'; ! 62: break; ! 63: ! 64: case 'e': ! 65: language = EFL; ! 66: suffix = 'e'; ! 67: break; ! 68: ! 69: default: ! 70: fprintf(stderr, "bad option %c\n", *s); ! 71: exit(1); ! 72: } ! 73: ! 74: --argc; ! 75: ++argv; ! 76: } ! 77: ! 78: if(strip && language!=FORTRAN) ! 79: fprintf(stderr, "implausible to strip non-Fortran programs\n"); ! 80: ! 81: ! 82: if(argc <= 1) ! 83: splitup(stdin); ! 84: ! 85: else for(i = 1 ; i < argc ; ++i) ! 86: { ! 87: if( (fd = fopen(argv[i], "r")) == NULL) ! 88: { ! 89: fprintf(stderr, "cannot open %s\n", argv[i]); ! 90: exit(1); ! 91: } ! 92: splitup(fd); ! 93: fclose(fd); ! 94: } ! 95: ! 96: exit(0); ! 97: } ! 98: ! 99: ! 100: ! 101: splitup(fin) ! 102: FILE *fin; ! 103: { ! 104: FILE *fout; ! 105: char in[BIG], fname[20], *s; ! 106: int i, c; ! 107: ! 108: while( fgets(in,BIG,fin) ) ! 109: { ! 110: if( *in=='c' || *in=='C' || *in=='*' ) ! 111: continue; ! 112: s = in; ! 113: SKIP ! 114: if (*s=='\0' || *s=='\n' ) ! 115: continue; ! 116: if(strip) ! 117: shorten(in); ! 118: ! 119: getname(s, fname); ! 120: if(iflag) ! 121: lowercase(fname); ! 122: if( (fout = fopen(fname, "w")) == NULL) ! 123: { ! 124: fprintf(stderr, "can't open %s", fname); ! 125: exit(1); ! 126: } ! 127: fputs(in,fout); ! 128: while( !endcard(in) && fgets(in, BIG, fin) ) ! 129: { ! 130: if(strip) ! 131: shorten(in); ! 132: fputs(in, fout); ! 133: } ! 134: fclose(fout); ! 135: } ! 136: } ! 137: ! 138: ! 139: ! 140: lowercase(s) ! 141: register char *s; ! 142: { ! 143: do ! 144: if(isupper(*s)) ! 145: *s=tolower(*s); ! 146: while(*s++); ! 147: } ! 148: ! 149: ! 150: getname(s,f) ! 151: char *s,*f; ! 152: { ! 153: int i,j,c; ! 154: loop: ! 155: if( compar(&s,"subroutine") ) goto bot; ! 156: else if( compar(&s,"function") ) goto bot; ! 157: else if( compar(&s,"procedure") ) goto bot; ! 158: else if( compar(&s,"program") ) goto bot; ! 159: else if( compar(&s,"real") ) goto loop; ! 160: else if( compar(&s,"integer") ) goto loop; ! 161: else if( compar(&s,"logical") ) goto loop; ! 162: else if( compar(&s,"double") ) goto loop; ! 163: else if( compar(&s,"precision") ) goto loop; ! 164: else if( compar(&s,"complex") ) goto loop; ! 165: else if( compar(&s,"character") ) goto loop; ! 166: else if( compar(&s,"*") ) /* complex *16 etc */ ! 167: { ! 168: for( ++s ; isdigit(*s) || isspace(*s) ; ++s) ! 169: ; ! 170: goto loop; ! 171: } ! 172: else if( compar(&s,"blockdata") ) ! 173: { ! 174: SKIP ! 175: if(*s == '\0') /* no block data name */ ! 176: { ! 177: sprintf(f, "BLOCKDATA%d.%c", ++blkdatano, suffix); ! 178: return; ! 179: } ! 180: goto bot; ! 181: } ! 182: else ! 183: s = ""; ! 184: ! 185: bot: ! 186: SKIP ! 187: for(i=0 ; isalpha(*s) || isdigit(*s) ; i++) ! 188: f[i] = *s++; ! 189: if(i > 0) ! 190: { ! 191: f[i++] = '.'; ! 192: f[i++] = suffix; ! 193: f[i++] = '\0'; ! 194: } ! 195: else ! 196: sprintf(f, "MAIN.%c", suffix); ! 197: } ! 198: ! 199: /* compare two strings for equality. assume that ! 200: t is all lower case. ignore blanks and decase s ! 201: during comparison. s0 points to next character after ! 202: successful comparison. ! 203: */ ! 204: compar(s0, t) ! 205: char **s0,*t; ! 206: { ! 207: register char *s; ! 208: register int s1; ! 209: s = *s0; ! 210: while( *t ) ! 211: { ! 212: SKIP ! 213: s1 = *s++; ! 214: if(isupper(s1)) ! 215: s1 = tolower(s1); ! 216: if(s1 != *t++) ! 217: return(NO); ! 218: } ! 219: *s0 = s; ! 220: return(YES); ! 221: } ! 222: ! 223: ! 224: endcard(s) ! 225: char *s; ! 226: { ! 227: register int i; ! 228: ! 229: if( *s==0 ) ! 230: return(YES); ! 231: SKIP ! 232: if( s[0]!='e' && s[0]!='E' ) ! 233: return(NO); ! 234: if( s[1]!='n' && s[1]!='N' ) ! 235: return(NO); ! 236: if( s[2]!='d' && s[2]!='D' ) ! 237: return(NO); ! 238: for(i = 3; i<66; ++i) ! 239: if(s[i] == '\n') ! 240: return(YES); ! 241: else if(s[i] != ' ') ! 242: return(NO); ! 243: return(YES); ! 244: } ! 245: ! 246: ! 247: ! 248: shorten(s0) ! 249: register char *s0; ! 250: { ! 251: register char *s, *s72; ! 252: s72 = s0 + 72; ! 253: ! 254: for(s=s0 ; s<s72; ++s) ! 255: if(*s=='\n' || *s=='\0') ! 256: break; ! 257: ! 258: while(s>s0 && s[-1]==' ') ! 259: --s; ! 260: s[0] = '\n'; ! 261: s[1] = '\0'; ! 262: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.