![[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] / researchv10no / cmd|
Return to fsplit.c CVS log | Up to [Research Unix] / researchv10no / 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.