![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to r1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / ratfor|
Return to r1.c CVS log | Up to [Research Unix] / researchv10no / cmd / ratfor |
1.1 root 1: #include "r.h"
2:
3: #define wasbreak brkused[brkptr]==1 || brkused[brkptr]==3
4: #define wasnext brkused[brkptr]==2 || brkused[brkptr]==3
5:
6: int transfer = 0; /* 1 if just finished retrun, break, next */
7:
8: char fcname[200];
9: char scrat[500];
10:
11: int brkptr = -1;
12: int brkstk[50]; /* break label */
13: int typestk[50]; /* type of loop construct */
14: int brkused[50]; /* loop contains BREAK or NEXT */
15:
16: int forptr = 0;
17: char *forstk[50];
18:
19: repcode() {
20: transfer = 0;
21: outcont(0);
22: putcom("repeat");
23: yyval = genlab(3);
24: indent++;
25: outcont(yyval);
26: brkstk[++brkptr] = yyval+1;
27: typestk[brkptr] = REPEAT;
28: brkused[brkptr] = 0;
29: }
30:
31: untils(p1,un) int p1,un; {
32: outnum(p1+1);
33: outtab();
34: if (un > 0) {
35: outcode("if(.not.");
36: balpar();
37: outcode(")");
38: }
39: transfer = 0;
40: outgoto(p1);
41: indent--;
42: if (wasbreak)
43: outcont(p1+2);
44: brkptr--;
45: }
46:
47: ifcode() {
48: transfer = 0;
49: outtab();
50: if (f77) {
51: outtab();
52: outcode("if");
53: balpar();
54: outcode("then");
55: outdon();
56: } else {
57: outcode("if(.not.");
58: balpar();
59: outcode(")");
60: outgoto(yyval=genlab(2));
61: }
62: indent++;
63: }
64:
65: elsecode(p1) {
66: if (f77) {
67: outtab();
68: outcode("else");
69: outdon();
70: } else {
71: outgoto(p1+1);
72: indent--;
73: putcom("else");
74: indent++;
75: outcont(p1);
76: }
77: }
78:
79: endif(s) char *s; {
80: outtab();
81: outcode("endif");
82: outdon();
83: }
84:
85: whilecode() {
86: transfer = 0;
87: outcont(0);
88: putcom("while");
89: brkstk[++brkptr] = yyval = genlab(2);
90: typestk[brkptr] = WHILE;
91: brkused[brkptr] = 0;
92: outnum(yyval);
93: outtab();
94: outcode("if(.not.");
95: balpar();
96: outcode(")");
97: outgoto(yyval+1);
98: indent++;
99: }
100:
101: whilestat(p1) int p1; {
102: outgoto(p1);
103: indent--;
104: putcom("endwhile");
105: outcont(p1+1);
106: brkptr--;
107: }
108:
109: balpar() {
110: register c, lpar;
111: while ((c=gtok(scrat)) == ' ' || c == '\t')
112: ;
113: if (c != '(') {
114: error("missing left paren");
115: return;
116: }
117: outcode(scrat);
118: lpar = 1;
119: do {
120: c = gtok(scrat);
121: if (c==';' || c=='{' || c=='}' || c==EOF) {
122: pbstr(scrat);
123: break;
124: }
125: if (c=='(')
126: lpar++;
127: else if (c==')')
128: lpar--;
129: else if (c == '\n') {
130: while ((c = gtok(scrat)) == ' ' || c=='\t' || c=='\n')
131: ;
132: pbstr(scrat);
133: continue;
134: }
135: else if (c == '=' && scrat[1] == '\0')
136: error("assigment inside conditional");
137: outcode(scrat);
138: } while (lpar > 0);
139: if (lpar != 0)
140: error("missing parenthesis");
141: }
142:
143: int labval = 23000;
144:
145: genlab(n){
146: labval += n;
147: return(labval-n);
148: }
149:
150: gokcode(p1) {
151: transfer = 0;
152: outtab();
153: outcode(p1);
154: eatup();
155: outdon();
156: }
157:
158: eatup() {
159: int t, lpar;
160: char temp[100];
161: lpar = 0;
162: do {
163: if ((t = gtok(scrat)) == ';' || t == '\n')
164: break;
165: if (t == '{' || t == '}' || t == EOF) {
166: pbstr(scrat);
167: break;
168: }
169: if (t == ',' || t == '+' || t == '-' || t == '*' || t == '('
170: || t == '&' || t == '|' || t == '=') {
171: while (gtok(temp) == '\n')
172: ;
173: pbstr(temp);
174: }
175: if (t == '(')
176: lpar++;
177: else if (t==')') {
178: lpar--;
179: if (lpar < 0) {
180: error("missing left paren");
181: return(1);
182: }
183: }
184: outcode(scrat);
185: } while (lpar >= 0);
186: if (lpar > 0) {
187: error("missing right paren");
188: return(1);
189: }
190: return(0);
191: }
192:
193: forcode(){
194: int lpar, t;
195: char *ps, *qs;
196:
197: transfer = 0;
198: outcont(0);
199: putcom("for");
200: yyval = genlab(3);
201: brkstk[++brkptr] = yyval+1;
202: typestk[brkptr] = FOR;
203: brkused[brkptr] = 0;
204: forstk[forptr++] = malloc(1);
205: if ((t = gnbtok(scrat)) != '(') {
206: error("missing left paren in FOR");
207: pbstr(scrat);
208: return;
209: }
210: if (gnbtok(scrat) != ';') { /* real init clause */
211: pbstr(scrat);
212: outtab();
213: if (eatup() > 0) {
214: error("illegal FOR clause");
215: return;
216: }
217: outdon();
218: }
219: if (gnbtok(scrat) == ';') /* empty condition */
220: outcont(yyval);
221: else { /* non-empty condition */
222: pbstr(scrat);
223: outnum(yyval);
224: outtab();
225: outcode("if(.not.(");
226: for (lpar=0; lpar >= 0;) {
227: if ((t = gnbtok(scrat)) == ';')
228: break;
229: if (t == '(')
230: lpar++;
231: else if (t == ')') {
232: lpar--;
233: if (lpar < 0) {
234: error("missing left paren in FOR clause");
235: return;
236: }
237: }
238: if (t != '\n')
239: outcode(scrat);
240: }
241: outcode("))");
242: outgoto(yyval+2);
243: if (lpar < 0)
244: error("invalid FOR clause");
245: }
246: ps = scrat;
247: for (lpar=0; lpar >= 0;) {
248: if ((t = gtok(ps)) == '(')
249: lpar++;
250: else if (t == ')')
251: lpar--;
252: if (lpar >= 0 && t != '\n')
253: while(*ps)
254: ps++;
255: }
256: *ps = '\0';
257: qs = forstk[forptr-1] = malloc((unsigned)(ps-scrat+1));
258: ps = scrat;
259: while (*qs++ = *ps++)
260: ;
261: indent++;
262: }
263:
264: forstat(p1) int p1; {
265: char *bp, *q;
266: bp = forstk[--forptr];
267: if (wasnext)
268: outnum(p1+1);
269: if (nonblank(bp)){
270: outtab();
271: outcode(bp);
272: outdon();
273: }
274: transfer = 0;
275: outgoto(p1);
276: indent--;
277: putcom("endfor");
278: outcont(p1+2);
279: for (q=bp; *q++;);
280: free(bp);
281: brkptr--;
282: }
283:
284: retcode() {
285: register c;
286: if ((c = gnbtok(scrat)) != '\n' && c != ';' && c != '}') {
287: pbstr(scrat);
288: outtab();
289: outcode(fcname);
290: outcode(" = ");
291: eatup();
292: outdon();
293: }
294: else if (c == '}')
295: pbstr(scrat);
296: outtab();
297: outcode("return");
298: outdon();
299: transfer = 1;
300: }
301:
302: docode() {
303: transfer = 0;
304: outtab();
305: outcode("do ");
306: yyval = genlab(2);
307: brkstk[++brkptr] = yyval;
308: typestk[brkptr] = DO;
309: brkused[brkptr] = 0;
310: outnum(yyval);
311: eatup();
312: outdon();
313: indent++;
314: }
315:
316: dostat(p1) int p1; {
317: outcont(p1);
318: indent--;
319: if (wasbreak)
320: outcont(p1+1);
321: brkptr--;
322: }
323:
324: breakcode() {
325: int level, t;
326:
327: level = 0;
328: if ((t=gnbtok(scrat)) == DIG)
329: level = atoi(scrat) - 1;
330: else if (t != ';')
331: pbstr(scrat);
332: if (brkptr-level < 0)
333: error("illegal BREAK");
334: else {
335: outgoto(brkstk[brkptr-level]+1);
336: brkused[brkptr-level] |= 1;
337: }
338: transfer = 1;
339: }
340:
341: nextcode() {
342: int level, t;
343:
344: level = 0;
345: if ((t=gnbtok(scrat)) == DIG)
346: level = atoi(scrat) - 1;
347: else if (t != ';')
348: pbstr(scrat);
349: if (brkptr-level < 0)
350: error("illegal NEXT");
351: else {
352: outgoto(brkstk[brkptr-level]);
353: brkused[brkptr-level] |= 2;
354: }
355: transfer = 1;
356: }
357:
358: nonblank(s) char *s; {
359: int c;
360: while (c = *s++)
361: if (c!=' ' && c!='\t' && c!='\n')
362: return(1);
363: return(0);
364: }
365:
366: int errorflag = 0;
367:
368: error(s1) char *s1; {
369: if (errorflag == 0)
370: fprintf(stderr, "ratfor:");
371: fprintf(stderr, "error at line %d, file %s: ",linect[infptr],curfile[infptr]);
372: fprintf(stderr, s1);
373: fprintf(stderr, "\n");
374: errorflag = 1;
375: }
376:
377: errcode() {
378: int c;
379: if (errorflag == 0)
380: fprintf(stderr, "******\n");
381: fprintf(stderr, "*****F ratfor:");
382: fprintf(stderr, "syntax error, line %d, file %s\n", linect[infptr], curfile[infptr]);
383: while ((c=getchr())!=';' && c!='}' && c!='\n' && c!=EOF && c!='\0')
384: ;
385: if (c == EOF || c == '\0')
386: putbak(c);
387: errorflag = 1;
388: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.