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