2 <DEFINE MULTI-SET-GEN (N:NODE W
3 "AUX" (K:<LIST [REST NODE]> <KIDS .N>) (SEG? <>)
4 (SIDE-E <>) (MX:FIX 0) (MN:FIX 0)
5 (VARS:<LIST [REST LIST]> <NODE-NAME .N>) TL:LIST
6 (VLN:FIX <LENGTH .VARS>)
7 (LV:<OR ATOM SYMTAB> <1 <NTH .VARS .VLN>>) (I:FIX 0))
9 <FUNCTION (N:NODE "AUX" RT)
10 <COND (<OR <==? <SET NT <NODE-TYPE .N>> ,SEG-CODE>
11 <==? .NT ,SEGMENT-CODE>>
13 <SET MX <MAX <+ <MAXL <SET RT <RESULT-TYPE <1 <KIDS .N>>>>> .MX>
15 <SET MN <+ <MINL .RT> .MN>>)
19 <SET MX <MAX <+ .MX 1> ,MAX-LENGTH>>)>
20 <COND (<AND <G=? <LENGTH .N> <INDEX ,SIDE-EFFECTS>>
26 <PROG ((SEGLABEL <MAKE-TAG>) COUNTMP (SEGCALLED <>) SEGTMP)
27 #DECL ((SEGLABEL COUNTMP SEGCALLED) <SPECIAL ANY>)
29 <FUNCTION (NN:NODE "AUX" (NT <NODE-TYPE .NN>) RES)
31 (<OR <==? .NT ,SEG-CODE> <==? .NT ,SEGMENT-CODE>>
32 <COND (<NOT <ASSIGNED? SEGTMP>>
33 <SET SEGTMP <GEN-TEMP <>>>
34 <SET COUNTMP <GEN-TEMP FIX>>
35 <SET-TEMP .COUNTMP .I '(`TYPE FIX)>)>
36 <SET RES <GEN <SET NN <1 <KIDS .NN>>> .SEGTMP>>
37 <SET SEGTYP <STRUCTYP-SEG <RESULT-TYPE .NN>>>
38 <COND (<AND <N==? .RES ,NO-DATUM> <N==? .SEGTYP MULTI>>
39 <SEGMENT-STACK .SEGTMP
42 <ISTYPE? <RESULT-TYPE .NN>>
44 <SET SEGLABEL <MAKE-TAG>>)
47 <SET SEGLABEL <MAKE-TAG>>)>)
49 <COND (.CNT <IEMIT `ADD .CNT 1 = .CNT>)>
50 <GEN .NN ,POP-STACK>)>>
52 <COND (<AND .CAREFUL <N==? .MX .MN>>
53 <IEMIT `VEQUAL? .COUNTMP .VLN - `COMPERR>)>
55 <IEMIT `POP = <TEMP-NAME-SYM <1 <NTH .VARS .VLN>>>>
56 <COND (<==? <SET VLN <- .VLN 1>> 0> <RETURN>)>>>)
60 <FUNCTION (NN:NODE SYP:<LIST <OR ATOM SYMTAB>>
61 "AUX" (TY <RESULT-TYPE .NN>) PT
62 (SY:<OR ATOM SYMTAB> <1 .SYP>))
63 <COND (<TYPE? .SY SYMTAB>
64 <SET TY <TYPE-AND <2 .SYP> .TY>>)>
65 <COND (<AND <SET TY <ISTYPE? .TY>>
66 <OR <==? <SET PT <TYPEPRIM .TY>> FIX>
69 <GEN .NN <GEN-TEMP .TY>>>
73 <FUNCTION (SYP:<LIST <OR ATOM SYMTAB>> TMP:TEMP
74 "AUX" (SY:<OR ATOM SYMTAB> <1 .SYP>) (LCL <>))
75 <COND (<AND <TYPE? .SY SYMTAB>
76 <N==? <CODE-SYM .SY> -1>
79 <IEMIT `SET <TEM-NAME-SYM .SY> .TMP>
82 <COND (<TYPE? .SY SYMTAB> <SET SY <NAME-SYM .SY>>)>
83 <SET-VALUE .SY .TMP <NOT .LCL>>
88 <PROG (NL-LATER:LIST SL-LATER:LIST ANY-DONE (MUCH-LATER:LIST ())
90 <SET NL-LATER <SET SL-LATER ()>>
94 "AUX" (SYP:<LIST <OR ATOM SYMTAB TEMP>> <1 .SL>) (LCL <>) TY
95 (N:NODE <1 .NL>) (SY:<OR ATOM SYMTAB TEMP> <1 .SYP>) TMP)
96 <COND (<OR <TYPE? .SY TEMP>
97 <AND <NOT <REF? .SY <REST .NL>>>
98 <NOT <REF? .SY .NL-LATER>>>>
100 <COND (<OR <AND <TYPE? .SY SYMTAB>
101 <N==? <CODE-SYM .SY> -1>
104 <SET TMP <TEMP-NAME-SYM .SY>>>
105 <AND <TYPE? .SY TEMP> <SET TMP .SY>>>
108 <COND (<TYPE? .SY SYMTAB>
109 <SET SY <NAME-SYM .SY>>)>
110 <SET-VALUE .SY <GEN .N DONT-CARE> <NOT .LCL>>)>)
112 <SET SL-LATER (.SYP !.SL-LATER)>
113 <SET NL-LATER (.N !.NL-LATER)>)>>
116 <COND (<AND .ANY-DONE <NOT <EMPTY? .SL-LATER>>>
120 (<NOT <EMPTY? .SL-LATER>>
122 ((<1 .SL-LATER> <SET TTMP <GEN-TEMP <>>>) !.MUCH-LATER)>
123 <SET VARS ((.TTMP) !<REST .SL-LATER>)>
128 "AUX" (SY:<OR ATOM SYMTAB> <1 <1 .L>>) (LCL <>)
130 <COND (<AND <TYPE? .SY SYMTAB>
131 <N==? <CODE-SYM .SY> -1>
133 <NOT <SPEC-SYM .SY>>>
134 <IEMIT `SET <TEMP-NAME-SYM .SY> .TMP>
137 <COND (<TYPE? .SY SYMTAB> <SET SY <NAME-SYM .SY>>)>
138 <SET-VALUE .SY .TMP <NOT .LCL>>
141 <COND (<N==? .W FLUSHED>
143 <COND (<AND <TYPE? .VL SYMTAB>
144 <N==? <CODE-SYM .VL> -1>
146 <NOT <SPEC-SYM .VL>>>
147 <TEMP-REFS .VL <+ <TEMP-REFS .VL> 1>>
150 <COND (<TYPE? .VL SYMTAB> <SET VL <NAME-SYM .VL>>)>
151 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
152 <GET-VALUE-X .VL .W <NOT .LCL>>)>)
155 <DEFINE REF? (SY:<OR ATOM SYMTAB> L:<LIST [REST NODE]>)
157 <FUNCTION (N:NODE "AUX" (NT:FIX <NODE-TYPE .N>))
159 <COND (<OR <==? .NT ,LVAL-CODE>
160 <==? .NT ,ASSIGNED?-CODE>
162 <COND (<==? <NODE-NAME .N> .SY> <MAPLEAVE>)>)
163 (<OR <==? .NT ,FLVAL-CODE> <==? .NT ,FSET-CODE>>
164 <COND (<OR <==? <NODE-NAME .N> .SY>
165 <COND (<==? <NODE-TYPE
166 <SET NN <1 <KIDS .N>>>>
168 <==? <NODE-NAME .NN> .SY>)
171 <==? <CODE-SYM .SY> -1>
174 (<AND <G? <LENGTH .N> <INDEX ,SIDE-EFFECTS>>
175 <MEMQ ALL <SIDE-EFFECTS .N>>
178 <==? <CODE-SYM .SY> -1>>>
181 <COND (<REF? .SY <KIDS .N>> <MAPLEAVE T>)>
182 <COND (<==? .NT ,BRANCH-CODE>
183 <SET NT <NODE-TYPE <SET N <PREDIC .N>>>>
187 <DEFINE GEN-DISPATCH (N W)
190 (,FORM-CODE <FORM-GEN .N .W>)
191 (,PROG-CODE <PROG-REP-GEN .N .W>)
192 (,SUBR-CODE <SUBR-GEN .N .W>)
193 (,COND-CODE <COND-GEN .N .W>)
194 (,LVAL-CODE <LVAL-GEN .N .W>)
195 (,SET-CODE <SET-GEN .N .W>)
196 (,OR-CODE <OR-GEN .N .W>)
197 (,AND-CODE <AND-GEN .N .W>)
198 (,RETURN-CODE <RETURN-GEN .N .W>)
199 (,COPY-CODE <COPY-GEN .N .W>)
200 (,AGAIN-CODE <AGAIN-GEN .N .W>)
201 (,ARITH-CODE <ARITH-GEN .N .W>)
202 (,RSUBR-CODE <SUBR-GEN .N .W>)
203 (,0-TST-CODE <0-TEST .N .W>)
204 (,NOT-CODE <NOT-GEN .N .W>)
205 (,1?-CODE <1?-GEN .N .W>)
206 (,TEST-CODE <TEST-GEN .N .W>)
207 (,EQ-CODE <==-GEN .N .W>)
208 (,TY?-CODE <TYPE?-GEN .N .W>)
209 (,LNTH-CODE <LNTH-GEN .N .W>)
210 (,MT-CODE <MT-GEN .N .W>)
211 (,REST-CODE <REST-GEN .N .W>)
212 (,NTH-CODE <NTH-GEN .N .W>)
213 (,PUT-CODE <PUT-GEN .N .W>)
214 (,PUTR-CODE <PUTREST-GEN .N .W>)
215 (,FLVAL-CODE <FLVAL-GEN .N .W>)
216 (,FSET-CODE <FSET-GEN .N .W>)
217 (,FGVAL-CODE <FGVAL-GEN .N .W>)
218 (,FSETG-CODE <FSETG-GEN .N .W>)
219 (,MIN-MAX-CODE <MIN-MAX .N .W>)
220 (,CHTYPE-CODE <CHTYPE-GEN .N .W>)
221 (,FIX-CODE <FIX-GEN .N .W>)
222 (,FLOAT-CODE <FLOAT-GEN .N .W>)
223 (,ABS-CODE <ABS-GEN .N .W>)
224 (,MOD-CODE <MOD-GEN .N .W>)
225 (,ID-CODE <ID-GEN .N .W>)
226 (,ASSIGNED?-CODE <ASSIGNED?-GEN .N .W>)
227 (,BITL-CODE <BITLOG-GEN .N .W>)
228 (,ISUBR-CODE <SUBR-GEN .N .W>)
229 (,EOF-CODE <ID-GEN .N .W>)
230 (,READ-EOF2-CODE <READ2-GEN .N .W>)
231 (,READ-EOF-CODE <SUBR-GEN .N .W>)
232 (,GET2-CODE <GET2-GEN .N .W>)
233 (,GET-CODE <GET-GEN .N .W>)
234 (,IPUT-CODE <SUBR-GEN .N .W>)
235 (,MAP-CODE <MAPFR-GEN .N .W>)
236 (,MARGS-CODE <MPARGS-GEN .N .W>)
237 (,MAPLEAVE-CODE <MAPLEAVE-GEN .N .W>)
238 (,MAPRET-STOP-CODE <MAPRET-STOP-GEN .N .W>)
239 (,UNWIND-CODE <UNWIND-GEN .N .W>)
240 (,GVAL-CODE <GVAL-GEN .N .W>)
241 (,SETG-CODE <SETG-GEN .N .W>)
242 (,MEMQ-CODE <MEMQ-GEN .N .W>)
243 (,LENGTH?-CODE <LENGTH?-GEN .N .W>)
244 (,FORM-F-CODE <FORM-F-GEN .N .W>)
245 (,ALL-REST-CODE <ALL-REST-GEN .N .W>)
246 (,COPY-LIST-CODE <LIST-BUILD .N .W>)
247 (,PUT-SAME-CODE <PUT-GEN .N .W>)
248 (,BACK-CODE <BACK-GEN .N .W>)
249 (,TOP-CODE <TOP-GEN .N .W>)
250 (,ROT-CODE <ROT-GEN .N .W>)
251 (,LSH-CODE <LSH-GEN .N .W>)
252 (,BIT-TEST-CODE <BIT-TEST-GEN .N .W>)
253 (,CALL-CODE <CALL-GEN .N .W>)
254 (,MONAD-CODE <MONAD?-GEN .N .W>)
255 (,GASSIGNED?-CODE <GASSIGNED?-GEN .N .W>)
256 (,APPLY-CODE <APPLY-GEN .N .W>)
257 (,ADECL-CODE <ADECL-GEN .N .W>)
258 (,MULTI-RETURN-CODE <MULTI-RETURN-GEN .N .W>)
259 (,VALID-CODE <VALID-TYPE?-GEN .N .W>)
260 (,TYPE-C-CODE <TYPE-C-GEN .N .W>)
261 (,=?-STRING-CODE <=?-STRING-GEN .N .W>)
262 (,CASE-CODE <CASE-GEN .N .W>)
263 (,FGETBITS-CODE <FGETBITS-GEN .N .W>)
264 (,FPUTBITS-CODE <FPUTBITS-GEN .N .W>)
265 (,ISTRUC-CODE <ISTRUC-GEN .N .W>)
266 (,ISTRUC2-CODE <ISTRUC-GEN .N .W>)
267 (,STACK-CODE <STACK-GEN .N .W>)
268 (,CHANNEL-OP-CODE <CHANNEL-OP-GEN .N .W>)
269 (,ATOM-PART-CODE <ATOM-PART-GEN .N .W>)
270 (,OFFSET-PART-CODE <OFFSET-PART-GEN .N .W>)
271 (,PUT-GET-DECL-CODE <PUT-GET-DECL-GEN .N .W>)
272 (,SUBSTRUC-CODE <SUBSTRUC-GEN .N .W>)
273 (,MULTI-SET-CODE <MULTI-SET-GEN .N .W>)
275 (<DEFAULT-GEN .N .W>)>>