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