![[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] / researchv8dc / cmd|
Return to fsplit.c CVS log | Up to [Research Unix] / researchv8dc / 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 -y 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 yflag; ! 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: yflag++; ! 46: break; ! 47: ! 48: case 's': ! 49: strip = YES; ! 50: break; ! 51: ! 52: case 'f': ! 53: language = FORTRAN; ! 54: suffix = 'f'; ! 55: break; ! 56: ! 57: case 'r': ! 58: language = RATFOR; ! 59: suffix = 'r'; ! 60: break; ! 61: ! 62: case 'e': ! 63: language = EFL; ! 64: suffix = 'e'; ! 65: break; ! 66: ! 67: default: ! 68: fprintf(stderr, "bad option %c\n", *s); ! 69: exit(1); ! 70: } ! 71: ! 72: --argc; ! 73: ++argv; ! 74: } ! 75: ! 76: if(strip && language!=FORTRAN) ! 77: fprintf(stderr, "implausible to strip non-Fortran programs\n"); ! 78: ! 79: ! 80: if(argc <= 1) ! 81: splitup(stdin); ! 82: ! 83: else for(i = 1 ; i < argc ; ++i) ! 84: { ! 85: if( (fd = fopen(argv[i], "r")) == NULL) ! 86: { ! 87: fprintf(stderr, "cannot open %s\n", argv[i]); ! 88: exit(1); ! 89: } ! 90: splitup(fd); ! 91: fclose(fd); ! 92: } ! 93: ! 94: exit(0); ! 95: } ! 96: ! 97: ! 98: ! 99: splitup(fin) ! 100: FILE *fin; ! 101: { ! 102: FILE *fout; ! 103: char in[BIG], fname[20]; ! 104: int i, c; ! 105: ! 106: while( fgets(in,BIG,fin) ) ! 107: { ! 108: if( *in=='c' || *in=='C' || *in=='\0' || *in=='\n' ) continue; ! 109: if(strip) ! 110: shorten(in); ! 111: getname(in, fname); ! 112: if(yflag) ! 113: lowercase(fname); ! 114: if( (fout = fopen(fname, "w")) == NULL) ! 115: { ! 116: fprintf(stderr, "can't open %s", fname); ! 117: exit(1); ! 118: } ! 119: fputs(in,fout); ! 120: while( !endcard(in) && fgets(in, BIG, fin) ) ! 121: { ! 122: if(strip) ! 123: shorten(in); ! 124: fputs(in, fout); ! 125: } ! 126: fclose(fout); ! 127: } ! 128: } ! 129: ! 130: ! 131: ! 132: lowercase(s) ! 133: register char *s; ! 134: { ! 135: do ! 136: if(isupper(*s)) ! 137: *s=tolower(*s); ! 138: while(*s++); ! 139: } ! 140: ! 141: ! 142: getname(s,f) ! 143: char *s,*f; ! 144: { ! 145: int i,j,c; ! 146: loop: ! 147: if( compar(&s,"subroutine") ) goto bot; ! 148: else if( compar(&s,"function") ) goto bot; ! 149: else if( compar(&s,"procedure") ) goto bot; ! 150: else if( compar(&s,"program") ) goto bot; ! 151: else if( compar(&s,"real") ) goto loop; ! 152: else if( compar(&s,"integer") ) goto loop; ! 153: else if( compar(&s,"logical") ) goto loop; ! 154: else if( compar(&s,"double") ) goto loop; ! 155: else if( compar(&s,"precision") ) goto loop; ! 156: else if( compar(&s,"complex") ) goto loop; ! 157: else if( compar(&s,"character") ) goto loop; ! 158: else if( compar(&s,"*") ) /* complex *16 etc */ ! 159: { ! 160: for( ++s ; isdigit(*s) || isspace(*s) ; ++s) ! 161: ; ! 162: goto loop; ! 163: } ! 164: else if( compar(&s,"blockdata") ) ! 165: { ! 166: SKIP ! 167: if(*s == '\0') /* no block data name */ ! 168: { ! 169: sprintf(f, "BLOCKDATA%d.%c", ++blkdatano, suffix); ! 170: return; ! 171: } ! 172: goto bot; ! 173: } ! 174: else ! 175: s = ""; ! 176: ! 177: bot: ! 178: SKIP ! 179: for(i=0 ; isalpha(*s) || isdigit(*s) ; i++) ! 180: f[i] = *s++; ! 181: if(i > 0) ! 182: { ! 183: f[i++] = '.'; ! 184: f[i++] = suffix; ! 185: f[i++] = '\0'; ! 186: } ! 187: else ! 188: sprintf(f, "MAIN.%c", suffix); ! 189: } ! 190: ! 191: /* compare two strings for equality. assume that ! 192: t is all lower case. ignore blanks and decase s ! 193: during comparison. s0 points to next character after ! 194: successful comparison. ! 195: */ ! 196: compar(s0, t) ! 197: char **s0,*t; ! 198: { ! 199: register char *s; ! 200: register int s1; ! 201: s = *s0; ! 202: while( *t ) ! 203: { ! 204: SKIP ! 205: s1 = *s++; ! 206: if(isupper(s1)) ! 207: s1 = tolower(s1); ! 208: if(s1 != *t++) ! 209: return(NO); ! 210: } ! 211: *s0 = s; ! 212: return(YES); ! 213: } ! 214: ! 215: ! 216: endcard(s) ! 217: char *s; ! 218: { ! 219: register int i; ! 220: ! 221: if( *s==0 ) ! 222: return(YES); ! 223: SKIP ! 224: if( s[0]!='e' && s[0]!='E' ) ! 225: return(NO); ! 226: if( s[1]!='n' && s[1]!='N' ) ! 227: return(NO); ! 228: if( s[2]!='d' && s[2]!='D' ) ! 229: return(NO); ! 230: for(i = 3; i<66; ++i) ! 231: if(s[i] == '\n') ! 232: return(YES); ! 233: else if(s[i] != ' ') ! 234: return(NO); ! 235: return(YES); ! 236: } ! 237: ! 238: ! 239: ! 240: shorten(s0) ! 241: register char *s0; ! 242: { ! 243: register char *s, *s72; ! 244: s72 = s0 + 72; ! 245: ! 246: for(s=s0 ; s<s72; ++s) ! 247: if(*s=='\n' || *s=='\0') ! 248: break; ! 249: ! 250: while(s>s0 && s[-1]==' ') ! 251: --s; ! 252: s[0] = '\n'; ! 253: s[1] = '\0'; ! 254: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.