Commit | Line | Data |
---|---|---|
e8ac74a8 BB |
1 | #include <stdio.h> |
2 | #include "def.h" | |
3 | #include "4.def.h" | |
4 | #include "3.def.h" | |
5 | ||
6 | outrat(v,tab,tabfirst) | |
7 | VERT v; | |
8 | int tab; /* number of tabs to indent */ | |
9 | LOGICAL tabfirst; /* FALSE if doing IF of ELSE IF */ | |
10 | { | |
11 | LOGICAL ndcomma; | |
12 | VERT w; | |
13 | int type,i; | |
14 | type = NTYPE(v); | |
15 | if (hascom[type]) | |
16 | prcom(v); | |
17 | if (!LABEL(v) && type == FMTVX) | |
18 | { | |
19 | OUTSTR("#following unreferenced format statement commented out\n"); | |
20 | OUTSTR("#"); | |
21 | } | |
22 | if (LABEL(v) && type != ITERVX) | |
23 | { | |
24 | ASSERT(tabfirst, outrat); | |
25 | prlab(LABEL(v),tab); | |
26 | } | |
27 | else if (tabfirst && type != DUMVX && type != ITERVX) | |
28 | TABOVER(tab); | |
29 | ||
30 | switch(type) | |
31 | { | |
32 | case DUMVX: | |
33 | newlevel(v,0,tab,YESTAB); | |
34 | break; | |
35 | case GOVX: | |
36 | OUTSTR("go to "); | |
37 | OUTNUM(LABEL(ARC(v,0))); | |
38 | OUTSTR("\n"); | |
39 | break; | |
40 | case STOPVX: | |
41 | if (progtype != blockdata) | |
42 | OUTSTR("stop\n"); | |
43 | break; | |
44 | case RETVX: | |
45 | OUTSTR("return\n"); | |
46 | break; | |
47 | case BRKVX: | |
48 | if (!levbrk) | |
49 | { | |
50 | ASSERT(LEVEL(v) == 1,outrat); | |
51 | OUTSTR("break\n"); | |
52 | } | |
53 | else | |
54 | { | |
55 | OUTSTR("break "); | |
56 | OUTNUM(LEVEL(v)); | |
57 | OUTSTR("\n"); | |
58 | } | |
59 | break; | |
60 | case NXTVX: | |
61 | if (!levnxt) | |
62 | { | |
63 | ASSERT(LEVEL(v) == 1,outrat); | |
64 | OUTSTR("next\n"); | |
65 | } | |
66 | else | |
67 | { | |
68 | OUTSTR("next "); | |
69 | OUTNUM(LEVEL(v)); | |
70 | OUTSTR("\n"); | |
71 | } | |
72 | break; | |
73 | case ASGOVX: | |
74 | case COMPVX: | |
75 | OUTSTR("goto "); | |
76 | if (type == ASGOVX) | |
77 | { | |
78 | OUTSTR(EXP(v)); | |
79 | OUTSTR(","); | |
80 | } | |
81 | OUTSTR("("); | |
82 | for (i = ARCNUM(v)-1; i >=0; --i) /* arcs were stored backward */ | |
83 | { | |
84 | OUTNUM(LABEL(ARC(v,i))); | |
85 | if (i > 0) OUTSTR(","); | |
86 | } | |
87 | OUTSTR(")"); | |
88 | if (type == COMPVX) | |
89 | { | |
90 | OUTSTR(","); | |
91 | OUTSTR(EXP(v)); | |
92 | } | |
93 | OUTSTR("\n"); | |
94 | break; | |
95 | case ASVX: | |
96 | OUTSTR("assign "); | |
97 | OUTNUM(LABEL(LABREF(v))); | |
98 | OUTSTR(" to "); | |
99 | OUTSTR(EXP(v)); | |
100 | OUTSTR("\n"); | |
101 | break; | |
102 | case IFVX: | |
103 | OUTSTR("IF"); | |
104 | prpred(v,TRUE); | |
105 | if (IFTHEN(v)) | |
106 | newlevel(v,THEN,tab+1,YESTAB); | |
107 | else | |
108 | { | |
109 | newlevel(v,THEN,tab+1,YESTAB); | |
110 | TABOVER(tab); | |
111 | OUTSTR("ELSE "); | |
112 | w = LCHILD(v,ELSE); | |
113 | ASSERT(DEFINED(w),outrat); | |
114 | if (NTYPE(w) == IFVX && !LABEL(w) && !DEFINED(RSIB(w)) && | |
115 | !HASBRACE(v,ELSE) ) | |
116 | newlevel(v,ELSE,tab,NOTAB); | |
117 | else | |
118 | newlevel(v,ELSE,tab+1,YESTAB); | |
119 | } | |
120 | break; | |
121 | case ITERVX: | |
122 | newlevel(v,0,tab,YESTAB); | |
123 | ASSERT(DEFINED(NXT(v)),outrat); | |
124 | if (LABEL(NXT(v))) | |
125 | { | |
126 | prlab(LABEL(NXT(v)),tab); | |
127 | OUTSTR("continue\n"); | |
128 | } | |
129 | break; | |
130 | case DOVX: | |
131 | OUTSTR("DO "); | |
132 | OUTSTR(INC(v)); | |
133 | newlevel(v,0,tab+1,YESTAB); | |
134 | break; | |
135 | case LOOPVX: | |
136 | case UNTVX: | |
137 | OUTSTR("REPEAT"); | |
138 | newlevel(v,0,tab+1,YESTAB); | |
139 | if (type == UNTVX) | |
140 | { | |
141 | TABOVER(tab+1); | |
142 | OUTSTR("UNTIL"); | |
143 | ASSERT(DEFINED(ARC(v,0)),outrat); | |
144 | prpred(LPRED(ARC(v,0)),TRUE); | |
145 | OUTSTR("\n"); | |
146 | } | |
147 | break; | |
148 | case WHIVX: | |
149 | OUTSTR("WHILE"); | |
150 | ASSERT(DEFINED(ARC(v,0)),outrat); | |
151 | ASSERT(DEFINED(LPRED(ARC(v,0))),outrat); | |
152 | prpred(LPRED(ARC(v,0)),TRUE); | |
153 | newlevel(v,0,tab+1,YESTAB); | |
154 | break; | |
155 | case STLNVX: | |
156 | case FMTVX: | |
157 | prstln(v,tab); | |
158 | break; | |
159 | case SWCHVX: | |
160 | OUTSTR("SWITCH"); | |
161 | if (DEFINED(EXP(v))) | |
162 | { | |
163 | OUTSTR("("); | |
164 | OUTSTR(EXP(v)); | |
165 | OUTSTR(")"); | |
166 | } | |
167 | newlevel(v,0,tab+1,YESTAB); | |
168 | break; | |
169 | case ICASVX: | |
170 | case ACASVX: | |
171 | OUTSTR("CASE "); | |
172 | if (type == ACASVX) | |
173 | prpred(v,FALSE); | |
174 | else | |
175 | OUTSTR(EXP(v)); | |
176 | OUTSTR(":\n"); | |
177 | newlevel(v,0,tab+1,YESTAB); | |
178 | if (type == ACASVX &&DEFINED(LCHILD(v,ELSE))) | |
179 | { | |
180 | TABOVER(tab); | |
181 | OUTSTR("DEFAULT:\n"); | |
182 | newlevel(v,1,tab+1,YESTAB); | |
183 | } | |
184 | break; | |
185 | case IOVX: | |
186 | OUTSTR(PRERW(v)); | |
187 | ndcomma = FALSE; | |
188 | if (DEFINED(FMTREF(v))) | |
189 | { | |
190 | OUTNUM(LABEL(FMTREF(v))); | |
191 | ndcomma = TRUE; | |
192 | } | |
193 | if (DEFINED(ARC(v,ENDEQ))) | |
194 | { | |
195 | if (ndcomma) | |
196 | OUTSTR(","); | |
197 | OUTSTR("end = "); | |
198 | OUTNUM(LABEL(ARC(v,ENDEQ))); | |
199 | ndcomma = TRUE; | |
200 | } | |
201 | if (DEFINED(ARC(v,ERREQ))) | |
202 | { | |
203 | if (ndcomma) | |
204 | OUTSTR(","); | |
205 | OUTSTR("err = "); | |
206 | OUTNUM(LABEL(ARC(v,ERREQ))); | |
207 | ndcomma = TRUE; | |
208 | } | |
209 | OUTSTR(POSTRW(v)); | |
210 | OUTSTR("\n"); | |
211 | break; | |
212 | } | |
213 | } | |
214 | ||
215 | ||
216 | newlevel(v,ch,tab,tabfirst) | |
217 | VERT v; | |
218 | int ch; /* number of lchild of v being processed */ | |
219 | int tab; /* number of tabs to indent */ | |
220 | LOGICAL tabfirst; /* same as for outrat */ | |
221 | { | |
222 | LOGICAL addbrace; | |
223 | VERT w; | |
224 | if (NTYPE(v) == ACASVX || NTYPE(v) == ICASVX) | |
225 | addbrace = FALSE; | |
226 | else if (NTYPE(v) == SWCHVX) | |
227 | addbrace = TRUE; | |
228 | else | |
229 | addbrace = HASBRACE(v,ch); | |
230 | ASSERT(tabfirst || !addbrace,newlevel); | |
231 | if (addbrace) | |
232 | OUTSTR(" {"); | |
233 | if(tabfirst && NTYPE(v)!=ITERVX && NTYPE(v)!=DUMVX) OUTSTR("\n"); | |
234 | for (w = LCHILD(v,ch); DEFINED(w); w = RSIB(w)) | |
235 | outrat(w,tab,tabfirst); | |
236 | if (addbrace) | |
237 | { | |
238 | TABOVER(tab); | |
239 | OUTSTR("}\n"); | |
240 | } | |
241 | } | |
242 | ||
243 | ||
244 | ||
245 | ||
246 | ||
247 | prpred(v,addpar) | |
248 | VERT v; | |
249 | LOGICAL addpar; | |
250 | { | |
251 | if (addpar) | |
252 | OUTSTR("("); | |
253 | if (NEG(v)) OUTSTR("!("); | |
254 | OUTSTR(PRED(v)); | |
255 | if (NEG(v)) OUTSTR(")"); | |
256 | if (addpar) | |
257 | OUTSTR(")"); | |
258 | } | |
259 | ||
260 | prlab(n,tab) | |
261 | int n,tab; | |
262 | { | |
263 | TABOVER(tab); | |
264 | OUTSTR("~"); | |
265 | OUTNUM(n); | |
266 | OUTSTR(" "); | |
267 | } | |
268 | ||
269 | prstln(v,tab) | |
270 | VERT v; | |
271 | int tab; | |
272 | { | |
273 | ASSERT(NTYPE(v) == STLNVX || NTYPE(v) == FMTVX,prstln); | |
274 | if (!ONDISK(v)) | |
275 | { | |
276 | OUTSTR(BEGCODE(v)); | |
277 | OUTSTR("\n"); | |
278 | } | |
279 | else | |
280 | { | |
281 | empseek(BEGCODE(v)); | |
282 | prcode(ONDISK(v),tab); | |
283 | } | |
284 | } | |
285 | ||
286 | prcom(v) | |
287 | VERT v; | |
288 | { | |
289 | if (DEFINED(BEGCOM(v))) | |
290 | { | |
291 | empseek(BEGCOM(v)); | |
292 | comprint(); | |
293 | } | |
294 | } |