![[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] / 3BSD / cmd / ratfor|
Return to r1.c CVS log | Up to [CSRG BSD Unix] / 3BSD / 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[10];
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: outgoto(p1);
255: indent--;
256: putcom("endfor");
257: outcont(p1+2);
258: for (q=bp; *q++;);
259: free(bp);
260: brkptr--;
261: }
262:
263: retcode() {
264: register c;
265: if ((c = gnbtok(scrat)) != '\n' && c != ';' && c != '}') {
266: pbstr(scrat);
267: outtab();
268: outcode(fcname);
269: outcode(" = ");
270: eatup();
271: outdon();
272: }
273: else if (c == '}')
274: pbstr(scrat);
275: outtab();
276: outcode("return");
277: outdon();
278: transfer = 1;
279: }
280:
281: docode() {
282: transfer = 0;
283: outtab();
284: outcode("do ");
285: yyval = genlab(2);
286: brkstk[++brkptr] = yyval;
287: typestk[brkptr] = DO;
288: brkused[brkptr] = 0;
289: outnum(yyval);
290: eatup();
291: outdon();
292: indent++;
293: }
294:
295: dostat(p1) int p1; {
296: outcont(p1);
297: indent--;
298: if (wasbreak)
299: outcont(p1+1);
300: brkptr--;
301: }
302:
303: #ifdef gcos
304: #define atoi(s) (*s-'0') /* crude!!! */
305: #endif
306:
307: breakcode() {
308: int level, t;
309:
310: level = 0;
311: if ((t=gnbtok(scrat)) == DIG)
312: level = atoi(scrat) - 1;
313: else if (t != ';')
314: pbstr(scrat);
315: if (brkptr-level < 0)
316: error("illegal BREAK");
317: else {
318: outgoto(brkstk[brkptr-level]+1);
319: brkused[brkptr-level] |= 1;
320: }
321: transfer = 1;
322: }
323:
324: nextcode() {
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 NEXT");
334: else {
335: outgoto(brkstk[brkptr-level]);
336: brkused[brkptr-level] |= 2;
337: }
338: transfer = 1;
339: }
340:
341: nonblank(s) char *s; {
342: int c;
343: while (c = *s++)
344: if (c!=' ' && c!='\t' && c!='\n')
345: return(1);
346: return(0);
347: }
348:
349: int errorflag = 0;
350:
351: error(s1) char *s1; {
352: if (errorflag == 0)
353: fprintf(stderr, "ratfor:");
354: fprintf(stderr, "error at line %d, file %s: ",linect[infptr],curfile[infptr]);
355: fprintf(stderr, s1);
356: fprintf(stderr, "\n");
357: errorflag = 1;
358: }
359:
360: errcode() {
361: int c;
362: if (errorflag == 0)
363: fprintf(stderr, "******\n");
364: fprintf(stderr, "*****F ratfor:");
365: fprintf(stderr, "syntax error, line %d, file %s\n", linect[infptr], curfile[infptr]);
366: while ((c=getchr())!=';' && c!='}' && c!='\n' && c!=EOF && c!='\0')
367: ;
368: if (c == EOF || c == '\0')
369: putbak(c);
370: errorflag = 1;
371: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.