1 <SETG LB-DOPE <+ <CHTYPE <LSH 18 16> FIX> *40* 770>>
8 <MANIFEST LB-DOPE LB-OBJ LB-ATOM LB-DECL LB-PREV LB-LAST LB-BID>
10 <DEFINE GEN-BBIND (ATM DECL FIXUP? "OPT" INIT "AUX" AC ATMADDR)
11 #DECL ((ATM) ATOM (FIXUP?) <OR ATOM FALSE>)
12 <EMIT-PUSH <MA-IMM ,LB-DOPE> LONG> ;"Push the dope word"
13 <COND (<ASSIGNED? INIT>
16 <EMIT-PUSH <MA-IMM 0> DOUBLE>)> ; "Push the value"
17 <SET AC <GET-AC PREF-VAL T>>
18 <EMIT-MOVE <ADDR-VALUE-MQUOTE .ATM>
19 <SET ATMADDR <MA-REG .AC>> LONG> ; "load the atom"
20 <EMIT-MOVE .ATMADDR <MA-AINC ,AC-TP> LONG> ; "stuff it in the binding"
21 <PUSH-GEN .DECL> ;"PUSH THE DECL"
22 <EMIT-PUSH <MA-ABS ,SPSTO-LOC> LONG> ;"PUSH THE PREVIOUS BINDING"
23 <EMIT-PUSH <MA-DISP .AC 4> LONG> ;"PUSH THE ATOM'S OLD BINDING"
24 <EMIT-PUSH <MA-ABS ,BINDID-LOC> LONG> ;"PUSH BINDID"
25 <EMIT ,INST-MOVAL <MA-DISP ,AC-TP -32> <MA-ABS ,SPSTO-LOC>>
26 <COND (.FIXUP? ;"IF FIXUP, STUFF BINDING INTO ATOM"
27 <EMIT ,INST-MOVAL <MA-DISP ,AC-TP -32>
31 <DEFINE GEN-ASSIGNED? (FROB DIR LABEL)
32 <CALL-RTE ,IASSQ!-MIMOP CALL <> <> .FROB>
33 <EMIT ,INST-TSTL <MA-REG ,AC-1>>
35 <GEN-BRANCH ,INST-BEQL .LABEL CONDITIONAL-BRANCH>)
37 <GEN-BRANCH ,INST-BNEQ .LABEL CONDITIONAL-BRANCH>)>
40 <DEFINE GEN-LVAL (ATM RES)
41 #DECL ((ATM) <OR ATOM VARTBL>)
42 <CALL-RTE ,ILVAL!-MIMOP CALL .RES <> .ATM>
45 <DEFINE GEN-SET (ATM VAL)
46 <CALL-RTE ,ISET!-MIMOP CALL <> <> .ATM .VAL>
49 <DEFINE MOVSTK-GEN (AMT "OPTIONAL" (RES <>) HINT TYP)
50 <CALL-RTE ,IMOVSTK!-MIMOP CALL .RES <> .AMT>
53 <DEFINE GETSTK-GEN (UV "OPTIONAL" (RES <>) HINT TYP)
54 <CALL-RTE ,IGETSTK!-MIMOP CALL .RES <> .UV>
57 <DEFINE GETTTY-GEN (FROB "OPTIONAL" (RES <>) HINT TYP)
58 <CALL-RTE ,IGETTTY!-MIMOP CALL .RES <> .FROB>
61 <DEFINE SAVTTY-GEN (OLD NEW "OPTIONAL" (RES <>) HINT TYP)
62 <CALL-RTE ,ISAVTTY!-MIMOP CALL .RES <> .OLD .NEW>
65 <DEFINE SETZONE-GEN (ZONE "OPT" (RES <>) HINT TYP)
66 <CALL-RTE ,ISETZONE!-MIMOP CALL .RES <> .ZONE>
69 <DEFINE LEGAL-GEN (OBJ "OPT" (RES <>) HINT TYP)
70 <CALL-RTE ,ILEGAL?!-MIMOP CALL .RES <> .OBJ>
73 <DEFINE TEMPLATE-TABLE-GEN (OFFS TBL "OPTIONAL" HINT)
74 <CALL-RTE ,ITTABLE!-MIMOP CALL <> <> .OFFS .TBL>
77 <DEFINE FATAL-GEN ("OPTIONAL" (STR <>) HINT)
78 <CALL-RTE ,IFATAL!-MIMOP CALL <> <> .STR>
81 <DEFINE QUIT-GEN ("OPTIONAL" (ARG -1) HINT)
82 <CALL-RTE ,IQUIT!-MIMOP CALL <> <> .ARG>
85 <DEFINE CONS-GEN (NEARG LARG RES "OPTIONAL" HINT)
86 #DECL ((LARG) <OR VARTBL LIST> (NEARG) ANY (RES) <OR VARTBL ATOM>)
87 <CALL-RTE ,ICONS!-MIMOP CALL .RES LIST .LARG .NEARG>
90 <DEFINE UBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
91 #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
93 <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
94 <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
95 (ELSE <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
96 <CALL-RTE ,IBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
99 <DEFINE UUBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
100 #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
102 <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
103 <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
105 <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
106 <CALL-RTE ,UIBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
109 <DEFINE CHTYPE-GEN (VAR TYP RES "OPTIONAL" HINT "AUX" VAC CAC TYVAR LV)
110 #DECL ((VAR) ANY (TYVAR) VARTBL (TYP) <OR ATOM FORM VARTBL>
111 (RES) <OR ATOM VARTBL>)
115 (<AND <==? .RES .VAR> <VAR-COUNT-STORED? .VAR>>
116 <EMIT ,INST-MOVW <COND (<TYPE? .TYP ATOM> <TYPE-CODE .TYP>)
117 (<TYPE? .TYP VARTBL> <VAR-VALUE-ADDRESS .TYP>)
118 (ELSE <VAR-TYPE-ADDRESS <2 .TYP>>)>
119 <VAR-TYPE-ADDRESS .VAR TYPE-WORD>>
120 <COND (<SET LV <FIND-CACHE-VAR .VAR>>
121 ;<PUT .LV ,LINKVAR-TYPE-AC <>>
122 ;<PUT .LV ,LINKVAR-TYPE-WORD-AC <>>
123 <COND (<LINKVAR-TYPE-WORD-AC .LV>
124 <PUT .LV ,LINKVAR-TYPE-STORED <>>)>)>)
125 (<OR <NOT <TYPE? .TYP ATOM>> <COUNT-NEEDED? .TYP>>
126 <COND (<==? .RES STACK>
127 <EMIT-PUSH <VAR-TYPE-ADDRESS .VAR TYPE-WORD> LONG>
128 <COND (<TYPE? .TYP VARTBL>
129 <EMIT ,INST-MOVW <VAR-VALUE-ADDRESS .TYP>
130 <MA-DISP ,AC-TP -4>>)
132 <EMIT ,INST-MOVW <VAR-TYPE-ADDRESS <2 .TYP>>
133 <MA-DISP ,AC-TP -4>>)
134 (ELSE <EMIT ,INST-MOVW <TYPE-CODE .TYP>
135 <MA-DISP ,AC-TP -4>>)>
136 <EMIT-PUSH <VAR-VALUE-ADDRESS .VAR> LONG>)
138 <SET VAC <LOAD-VAR .VAR VALUE <> PREF-VAL>>
140 <COND (<AND <TYPE? .TYP ATOM>
141 <VAR-TYPE-WORD-IN-AC? .VAR>>
142 <SET CAC <LOAD-VAR .VAR TYPE-WORD T PREF-TYPE>>
143 <EMIT ,INST-MOVW <TYPE-CODE .TYP> <MA-REG .CAC>>
144 <DEST-PAIR .VAC .CAC .RES>)
146 <SET CAC <LOAD-VAR .VAR COUNT <> PREF-TYPE>>
147 <DEST-COUNT-DECL .VAC .CAC .RES .TYP>)
149 <SET CAC <LOAD-VAR .VAR TYPE-WORD T PREF-TYPE>>
151 <VAR-TYPE-ADDRESS <2 .TYP> TYPE>
153 <DEST-PAIR .VAC .CAC .RES>)
155 <SET CAC <LOAD-VAR .VAR TYPE-WORD T PREF-TYPE>>
157 <VAR-VALUE-ADDRESS .TYP>
159 <DEST-PAIR .VAC .CAC .RES>)>)>)
161 <COND (<==? .RES STACK>
162 <EMIT-PUSH <TYPE-WORD .TYP> LONG>
163 <EMIT-PUSH <VAR-VALUE-ADDRESS .VAR> LONG>)
165 <SET VAC <LOAD-VAR-APP .VAR <>>>
166 <DEST-DECL .VAC .RES .TYP>)>)>)
167 (<COUNT-NEEDED? <TYPE .VAR>>
168 ; "Some structured thing"
169 <COND (<==? .RES STACK>
170 <EMIT-PUSH <ADDR-TYPE-M <ADD-MVEC .VAR>>>
171 <COND (<TYPE? .TYP VARTBL>
172 <EMIT ,INST-MOVW <VAR-VALUE-ADDRESS .TYP>
173 <MA-DISP ,AC-TP -4>>)
175 <EMIT ,INST-MOVW <VAR-TYPE-ADDRESS <2 .TYP>>
176 <MA-DISP ,AC-TP -4>>)
178 <EMIT ,INST-MOVW <TYPE-CODE .TYP>
179 <MA-DISP ,AC-TP -4>>)>
180 <EMIT-PUSH <ADDR-VAL-M .VAR> LONG>)
183 <CHTYPE-GEN .RES .TYP .RES>)>)
185 <COND (<==? .RES STACK>
186 <COND (<TYPE? .TYP VARTBL>
187 <EMIT-PUSH <VAR-VALUE-ADDRESS .TYP> LONG>)
189 <EMIT-PUSH <VAR-TYPE-ADDRESS <2 .TYP> LONG>>)
191 <EMIT-PUSH <TYPE-CODE .TYP> LONG>)>
192 <EMIT-PUSH <MA-IMM <FIX-CONSTANT? .VAR>> LONG>)
195 <CHTYPE-GEN .RES .TYP .RES>)>)>
198 <SETG GVAL-CAREFUL <>>
199 <DEFINE GVAL-GEN (ATM RES "OPTIONAL" (HINT <>) "AUX" VAC ATMADDR TYP TAC
200 ELABEL NLABEL ATMOFF)
201 #DECL ((ATM) <OR ATOM VARTBL> (RES) <OR ATOM VARTBL>
202 (HINT) <OR FALSE HINT>)
203 <COND (.HINT <SET TYP <PARSE-HINT .HINT TYPE>>) (ELSE <SET TYP <>>)>
204 <COND (,BOOT-MODE <SET ATMADDR <ADDR-VALUE-MQUOTE .ATM>>)
205 (<TYPE? .ATM VARTBL>)
208 <MA-DEF-DISP ,AC-M <SET ATMOFF
209 <+ <ADD-MVEC <CHTYPE .ATM XGLOC>> 4>>>>
210 ;<SET ATMADDR <ADDR-VALUE-MQUOTE <CHTYPE .ATM XGLOC>>>)>
212 <SET VAC <GET-AC PREF-VAL T>>
214 <EMIT-MOVE .ATMADDR <MA-REG .VAC> LONG>
215 <EMIT-MOVE <MA-REGD .VAC> <MA-REG .VAC> LONG>
216 <COND (<==? .RES STACK> <EMIT-PUSH <MA-REGD .VAC> DOUBLE>)
218 <COND (<OR <NOT .TYP> <COUNT-NEEDED? .TYP>>
220 <SET TAC <GET-AC DOUBLE T>>
221 <EMIT ,INST-MOVQ <MA-REGD .VAC> <MA-REG .TAC>>
222 <SET VAC <NEXT-AC .TAC>>)
224 <EMIT ,INST-MOVL <MA-DISP .VAC 4> <MA-REG .VAC>>)>
225 <COND (<NOT .TYP> <DEST-PAIR .VAC .TAC .RES T>)
226 (<DEST-DECL .VAC .RES .TYP T>)>)>)
227 (<AND <TYPE? .ATM VARTBL>
229 <COND (<SET TAC <VAR-VALUE-IN-AC? .ATM>>
231 ; "If atom is in AC, can win immediate"
232 <COND (<==? .RES STACK>
233 <EMIT-PUSH <MA-BDD .TAC 0> DOUBLE>)
235 <SET VAC <GET-AC DOUBLE T>>
236 <EMIT ,INST-MOVQ <MA-BDD .TAC 0> <MA-REG .VAC>>)>)
238 <SET VAC <GET-AC DOUBLE T>>
239 ; "Otherwise, pick up gbind through pointer on stack"
240 <EMIT ,INST-MOVL <GEN-LOC .ATM 4 T> <MA-REG .VAC>>
241 ; "Then get value out of that"
242 <COND (<==? .RES STACK>
243 <EMIT-PUSH <MA-REGD .VAC> DOUBLE>)
245 <EMIT ,INST-MOVQ <MA-REGD .VAC> <MA-REG .VAC>>)>)>
246 <COND (<N==? .RES STACK>
247 <DEST-PAIR <NEXT-AC .VAC> .VAC .RES T>)>)
248 (<AND ,GVAL-CAREFUL <N==? .ATM M$$BINDID>>
250 <SET TAC <GET-AC ,AC-0 T>>
251 <SET VAC <GET-AC ,AC-1 T>>
252 <SET ELABEL <MAKE-LABEL>>
253 <SET NLABEL <MAKE-LABEL>>
254 <COND (<TYPE? .ATM VARTBL>
256 <EMIT ,INST-MOVL <GEN-LOC .ATM 4 T> <MA-REG .VAC>>
257 ; "Barf if not there"
258 <GEN-BRANCH ,INST-BEQL .NLABEL <>>
260 <EMIT ,INST-MOVQ <MA-REGD .VAC> <MA-REG .TAC>>)
262 <EMIT ,INST-MOVQ .ATMADDR <MA-REG .TAC>>)>
264 <GEN-BRANCH ,INST-BNEQ .ELABEL <>>
265 <EMIT-LABEL .NLABEL <>>
266 <COND (<TYPE? .ATM VARTBL>
267 <EMIT ,INST-PUSHAL <VAR-VALUE-ADDRESS .ATM>>)
268 (T <EMIT ,INST-PUSHAL <MA-DISP ,AC-M .ATMOFF>>)>
269 <CALL-RTE ,IGVERR!-MIMOP CALL <COND (<N==? .RES STACK> .RES)>
271 <EMIT-LABEL .ELABEL <>>
272 <COND (<==? .RES STACK>
273 <EMIT-PUSH <MA-REG .TAC> DOUBLE>)
275 <DEST-PAIR <NEXT-AC .TAC> .TAC .RES T>)>)
277 <COND (<==? .RES STACK>
278 <EMIT-PUSH .ATMADDR DOUBLE>)
280 <SET TAC <GET-AC DOUBLE T>>
281 <EMIT ,INST-MOVQ .ATMADDR <MA-REG .TAC>>
282 <DEST-PAIR <NEXT-AC .TAC> .TAC .RES T>)>)>
286 <DEFINE SETG-GEN (ATM VAL
288 "AUX" VAC ATMADDR (A1 <>) (A2 <>) (TWOM <>) LV)
289 #DECL ((ATM) ATOM (RES) ANY)
290 <COND (<AND <TYPE? .VAL VARTBL> <SET LV <FIND-CACHE-VAR .VAL>>>
291 <SET A1 <LINKVAR-TYPE-WORD-AC .LV>>
292 <SET A2 <LINKVAR-VALUE-AC .LV>>)
294 <COND (,BOOT-MODE <SET ATMADDR <ADDR-VALUE-MQUOTE .ATM>>)
295 (<OR <FIX-CONSTANT? .VAL>
297 <NOT <AND <LINKVAR-VALUE-STORED .LV>
298 <LINKVAR-TYPE-STORED .LV>
299 <LINKVAR-COUNT-STORED .LV>>>
300 <NOT <AND .A1 <==? .A2 <NEXT-AC .A1>>>>>>
302 <SET ATMADDR <ADDR-VALUE-MQUOTE <CHTYPE .ATM XGLOC>>>)
305 <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ATM XGLOC>> 4>>>
306 ;<SET ATMADDR <ADDR-VALUE-MQUOTE <CHTYPE .ATM XGLOC>>>)>
307 <COND (<OR ,BOOT-MODE .TWOM>
308 <COND (.A1 <PROTECT .A1>)>
309 <COND (.A2 <PROTECT .A2>)>
310 <SET VAC <GET-AC PREF-VAL T>>
311 <EMIT ,INST-MOVL .ATMADDR <MA-REG .VAC>>
314 <EMIT ,INST-MOVL <MA-REGD .VAC> <MA-REG .VAC>>)>
315 <COND (<OR <TYPE? .VAL VARTBL> <FIX-CONSTANT? .VAL>>
316 <MOVE-TYPE .VAL <MA-REGD .VAC> <MA-DISP .VAC 2>>
317 <MOVE-VALUE .VAL <MA-DISP .VAC 4>>)
319 <EMIT-MOVE <ADDR-TYPE-MQUOTE .VAL>
323 <EMIT ,INST-MOVQ <VAR-TYPE-ADDRESS .VAL TYPE-WORD> .ATMADDR>)
324 (T <EMIT ,INST-MOVQ <ADDR-TYPE-MQUOTE .VAL> .ATMADDR>)>
327 <SETG BE-COMPATIBLE T>
329 <DEFINE SET-GEN (VAR VAL "OPTIONAL" (HINT <>) "AUX" VAC TAC CAC DCL LV)
330 #DECL ((VAR) VARTBL (VAL) ANY (HINT) <OR FALSE HINT>)
332 <COND (<TYPE? .VAL VARTBL>
333 <SET VAC <LOAD-VAR-APP .VAL <> <VARTBL-DECL .VAL> <>>>
334 <LINK-VAR-TO-AC .VAR .VAC VALUE <>>
335 <COND (<OR <SET DCL <VARTBL-DECL .VAR>>
336 <SET DCL <VARTBL-DECL .VAL>>>
337 <INDICATE-CACHED-VARIABLE-DECL .VAR .DCL>
338 <COND (<COUNT-NEEDED? .DCL>
339 <SET CAC <LOAD-VAR .VAL TYPE-WORD <> PREF-TYPE
341 <LINK-VAR-TO-AC .VAR .CAC TYPE-WORD <>>)>)
343 <SET TAC <LOAD-VAR .VAL TYPE-WORD <> PREF-TYPE <> <>>>
344 <LINK-VAR-TO-AC .VAR .TAC TYPE-WORD <>>)>)
345 (<N==? <PRIMTYPE .VAL> FIX>
346 <SET TAC <GET-AC DOUBLE T>>
347 <EMIT ,INST-MOVQ <ADDR-TYPE-M <ADD-MVEC .VAL>> <MA-REG .TAC>>
348 <DEST-PAIR <NEXT-AC .TAC> .TAC .VAR>
349 <INDICATE-CACHED-VARIABLE-DECL .VAR <TYPE .VAL>>)
352 <GEN-CONSTANT .VAL PREF-VAL PREF-TYPE COUNT-IF-NECESSARY>>
353 <LINK-VAR-TO-AC .VAR .VAC VALUE <>>
354 <AND ,CONSTANT-COUNT-AC
355 <LINK-VAR-TO-AC .VAR ,CONSTANT-COUNT-AC COUNT <>>>
356 <INDICATE-CACHED-VARIABLE-DECL .VAR <TYPE .VAL>>)>
357 <PROCESS-DESTINATION-HINT .HINT .VAR>
360 <DEFINE MRETURN-GEN (TVAR FVAR "OPTIONAL" RES)
362 <COND (<TYPE? .TVAR VARTBL> <PUT .TVAR ,VARTBL-DEAD? <>>)>
363 <COND (<TYPE? .FVAR VARTBL> <PUT .FVAR ,VARTBL-DEAD? <>>)>
365 <COND (<TYPE? .TVAR VARTBL> <VAR-VALUE-ADDRESS .TVAR>)
370 <COND (<AND ,MAKTUP-FLAG <0? ,ICALL-LEVEL>>
371 <EMIT ,INST-MOVL <MA-DISP ,AC-F -4> <MA-REG ,AC-2>>)
373 <EMIT ,INST-MOVL <MA-REG ,AC-F> <MA-REG ,AC-2>>)>)
375 <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .FVAR> <MA-REG ,AC-2>>)>
377 <CALL-RTE ,IMRETURN!-MIMOP JUMP <> <>>
378 UNCONDITIONAL-BRANCH>
380 <DEFINE RETURN-GEN (VAL "OPTIONAL" (FRM <>) RES)
381 #DECL ((VAL) ANY (FRM) <OR FALSE VARTBL>)
383 <COND (<TYPE? .FRM VARTBL> <PUT .FRM ,VARTBL-DEAD? <>>)>
384 <COND (<TYPE? .VAL VARTBL>
385 <PUT .VAL ,VARTBL-DEAD? <>>
386 <LOAD-VAR .VAL VALUE <> ,AC-1>
387 <LOAD-VAR .VAL TYPE-WORD <> ,AC-0>)
388 (ELSE <GEN-CONSTANT .VAL ,AC-1 ,AC-0 TYPE-WORD>)>
391 <COND (.FRM <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .FRM> <MA-REG ,AC-F>>)
392 (<AND ,MAKTUP-FLAG <0? ,ICALL-LEVEL>>
393 <EMIT ,INST-MOVL <MA-DISP ,AC-F -4> <MA-REG ,AC-F>>)>
394 <CALL-RTE ,FINIS!-MIMOP JUMP <> <>>
395 UNCONDITIONAL-BRANCH>
397 <DEFINE DISPATCH-GEN (VAR BASE "TUPLE" LABELS "AUX" (CT <LENGTH .LABELS>))
398 #DECL ((CT) FIX (LABELS) <TUPLE [REST ATOM]> (BASE) <PRIMTYPE WORD>)
401 <VAR-VALUE-ADDRESS .VAR>
409 <FUNCTION (LABEL "AUX" XREF)
410 <SET XREF <EMIT-LABEL-WORD .LABEL>>
411 <SAVE-XREF-AC-INFO .XREF <SAVE-STATE> <SAVE-LOAD-STATE>>>
415 <DEFINE OPDISP-GEN (RNUM TRONUM "TUPLE" LABELS "AUX" (NARGS .RNUM))
416 #DECL ((RNUM) FIX (TRONUM) <OR FALSE FIX> (LABELS) <TUPLE [REST
422 <MA-LIT <COND (.TRONUM <- .TRONUM .RNUM>)
423 (ELSE <- <LENGTH .LABELS> 1>)>>>
426 <EMIT-LABEL-WORD .LABEL>
427 <ADD-INTERNAL-ENTRY .NARGS .LABEL>
428 <SET NARGS <+ .NARGS 1>>>
432 <DEFINE MAKTUP-GEN ("TUPLE" TEMPS
433 "AUX" RES (TLEN <LENGTH .TEMPS>) (ARGS ,ARGLIST-VARS)
435 <SET RES <NTH .TEMPS .TLEN>>
437 <GEN-LOC <SET TVAR <FIND-VAR .RES>> 0>
438 <PUT .TVAR ,VARTBL-TEMP? <>>
440 <FCN (TEMPS "AUX" (TEMP <1 .TEMPS>))
441 <COND (<==? .TEMP => <MAPSTOP>)
442 (<OR <==? .RES .TEMP>
444 <COND (<AND <TYPE? .RES ADECL>
446 <==? <1 .RES> <1 .TEMP>>)
447 (<AND <TYPE? .RES ADECL>
449 <==? <1 .RES> .TEMP>)
450 (<AND <TYPE? .RES ATOM>
452 <==? .RES <1 .TEMP>>)>>
456 <EMIT ,INST-MOVL <MA-REG ,AC-0> <MA-REG ,AC-1>>
457 <COND (<NOT <EMPTY? .ARGS>>
458 <ADD-CONSTANT-TO-AC <- <LENGTH .ARGS>> ,AC-1>
459 <SET LNOARG <MAKE-LABEL>>
460 <GEN-BRANCH ,INST-BGEQ .LNOARG <>>
461 <EMIT ,INST-CLRL <MA-REG ,AC-1>>
462 <EMIT-LABEL .LNOARG <>>)>
464 <EMIT-PUSH <TYPE-CODE TUPLE> WORD>
465 <EMIT-PUSH <MA-REG ,AC-1> WORD>
467 <EMIT-PUSH <TYPE-WORD T$FRAME> LONG>
468 <EMIT-PUSH <MA-REG ,AC-F> LONG>
469 <EMIT ,INST-MOVL <MA-REG ,AC-TP> <MA-REG ,AC-2>>
470 <MAPF <> <FCN (VAR) <EMIT-PUSH <ADDR-VAR-TYPE .VAR> DOUBLE>> .ARGS>
471 <EMIT-PUSH <TYPE-CODE TUPLE> WORD>
472 <EMIT-PUSH <MA-REG ,AC-1> WORD>
473 <EMIT-PUSH <MA-REG ,AC-F> LONG>
474 <OR <0? <LENGTH .ARGS>>
476 <MA-IMM <* <LENGTH .ARGS> 8>>
477 <MA-DISP ,AC-TP -4>>>
478 <EMIT ,INST-MOVL <MA-REG ,AC-2> <MA-REG ,AC-F>>
479 <INDICATE-TEMP-PATCH <ADD-PATCH TEMPORARIES>>
482 <COND (<NOT <GASSIGNED? ICALL-LEVEL>> <SETG ICALL-LEVEL 0>)>
484 <DEFINE ICALL-GEN (LABEL "OPTIONAL" (RES <>) "AUX" VADDR TADDR TLAB)
485 #DECL ((LABEL) ATOM (RES) <OR FALSE ATOM VARTBL>)
487 <SETG ICALL-LEVEL <+ ,ICALL-LEVEL 1>>
488 <COND (<TYPE? .RES VARTBL>
489 <SET TADDR <ADDR-VAR-TYPE .RES>>
490 <SET VADDR <ADDR-VAR-VALUE .RES>>)>
491 <SETG ICALL-LABELS (.LABEL !,ICALL-LABELS)>
492 <NEW-MODEL <CREATE-MODEL>>
493 <CALL-RTE ,INCALL!-MIMOP CALL <> <>>
494 <SET TLAB <MAKE-LABEL>>
495 <EMIT-BRANCH ,INST-BRB .TLAB <> 0 <> T>
496 <COND (<==? .RES STACK> <EMIT-PUSH <MA-REG ,AC-0> DOUBLE>)
497 (<TYPE? .RES VARTBL> <EMIT ,INST-MOVQ <MA-REG ,AC-0> .TADDR>)>
498 <GEN-BRANCH ,INST-BRB .LABEL UNCONDITIONAL-BRANCH>
499 <EMIT-LABEL .TLAB <>>
502 "Args are: LOCAL variable being set; FRAME where new val is coming from;
503 variable in that frame for new value."
504 <DEFINE SETLR-GEN (LVAR FVAR NLVAR
506 "AUX" TAC FAC (SADDR <ADDR-VAR-OFFSET .NLVAR>) (TYP <>) REFNUM)
507 #DECL ((NLVAR) VARTBL (LVAR) <OR VARTBL ATOM>)
508 ; "If we don't call GEN-LOC, this frob may never get a stack slot"
509 <AND .HINT <SET TYP <PARSE-HINT .HINT TYPE>>>
511 <COND (<AND <TYPE? .LVAR VARTBL>
514 ; "Don't leave the old guy around in ACs"
515 <PROTECT <SET FAC <LOAD-VAR .FVAR VALUE <> PREF-VAL>>>
516 <COND (<==? .LVAR STACK>
517 ; "Handle case of pushing non-local value (code hacked
518 in ILDB-LOOKAHEAD pass)"
519 <EMIT-PUSH <MA-DISP .FAC .SADDR> DOUBLE>)
520 (<AND .TYP <NOT <COUNT-NEEDED? .TYP>>>
521 <SET TAC <GET-AC PREF-VAL T>>
522 ; "Don't clobber frame AC; these guys run in sets"
523 <EMIT ,INST-MOVL <MA-DISP .FAC <+ .SADDR 4>> <MA-REG .TAC>>
524 <DEST-DECL .TAC .LVAR .TYP>)
526 <SET TAC <GET-AC DOUBLE T>>
527 <EMIT ,INST-MOVQ <MA-DISP .FAC .SADDR> <MA-REG .TAC>>
528 <DEST-PAIR <NEXT-AC .TAC> .TAC .LVAR>)>
531 "Args are: FRAME where new value is going; variable in that frame; value
532 for variable (often local var, often not)"
533 <DEFINE SETRL-GEN (FVAR NLVAR LVAR
535 "AUX" FAC (SADDR <ADDR-VAR-OFFSET .NLVAR>) REFNUM TAC CADDR
537 #DECL ((NLVAR FVAR) VARTBL (SADDR) FIX)
539 <PROTECT <SET FAC <LOAD-VAR .FVAR VALUE <> PREF-VAL>>>
540 <AND .HINT <SET TYP <PARSE-HINT .HINT TYPE>>>
542 (<TYPE? .LVAR VARTBL> <SET TYP <VARTBL-DECL .LVAR>>)
543 (<SET TYP <TYPE .LVAR>>)>
544 <COND (<TYPE? .LVAR VARTBL>
545 <COND (<OR <NOT <SET LV <FIND-CACHE-VAR .LVAR>>>
546 <AND <SET T1 <LINKVAR-VALUE-AC .LV>>
547 <SET T2 <LINKVAR-TYPE-WORD-AC .LV>>
548 <==? .T1 <NEXT-AC .T2>>>
549 <AND <LINKVAR-VALUE-STORED .LV>
550 <LINKVAR-TYPE-STORED .LV>
551 <LINKVAR-COUNT-STORED .LV>>>
553 <COND (<AND .LV .T1> <MA-REG .T2>)
555 <ADDR-VAR-TYPE-VALUE .LVAR>)>
556 <MA-DISP .FAC .SADDR>>)
559 <VAR-VALUE-ADDRESS .LVAR>
560 <MA-DISP .FAC <+ .SADDR 4>>>
562 <TYPE-CODE .TYP WORD>
563 <MA-DISP .FAC .SADDR>>
564 <COND (<COUNT-NEEDED? .TYP>
565 <COND (<SET TAC <VAR-COUNT-IN-AC? .LVAR>>
568 <MA-DISP .FAC <+ .SADDR 2>>>)
569 (<SET CADDR <VAR-COUNT-STORED? .LVAR>>
572 <MA-DISP .FAC <+ .SADDR 2>>>)
573 (<ERROR "COUNT NOT FOUND" SETRL-GEN>)>)>)
576 <VAR-TYPE-ADDRESS .LVAR TYPE-WORD>
577 <MA-DISP .FAC .SADDR>>
579 <VAR-VALUE-ADDRESS .LVAR>
580 <MA-DISP .FAC <+ .SADDR 4>>>)>)
582 <EMIT ,INST-MOVQ <ADDR-TYPE-MQUOTE .LVAR> <MA-DISP .FAC .SADDR>>)>
585 <DEFINE FIXBIND-GEN () <CALL-RTE ,IFIXBND!-MIMOP CALL <> <>> NORMAL>
587 <DEFINE BIND-GEN (RES "OPTIONAL" HINT)
588 #DECL ((RES) <OR ATOM VARTBL>)
589 <CALL-RTE ,IBIND!-MIMOP CALL .RES <>>>
591 <DEFINE CFRAME-GEN (RES "OPTIONAL" HINT "AUX" VAC TLAB)
592 #DECL ((RES) <OR ATOM VARTBL>)
593 <SET VAC <GET-AC PREF-VAL T>>
594 <COND (<AND ,MAKTUP-FLAG <0? ,ICALL-LEVEL>>
595 <EMIT ,INST-MOVL <MA-DISP ,AC-F -4> <MA-REG .VAC>>)
596 (<EMIT ,INST-MOVL <MA-REG ,AC-F> <MA-REG .VAC>>)>
597 <EMIT ,INST-TSTL <MA-DISP .VAC -4>>
598 <SET TLAB <MAKE-LABEL>>
599 <GEN-BRANCH ,INST-BLSS .TLAB <>>
600 <EMIT-MOVE <MA-DISP .VAC -4> <MA-REG .VAC> LONG>
601 <EMIT-LABEL .TLAB <>>
602 <DEST-DECL .VAC .RES T$FRAME>
605 <DEFINE UNBIND-GEN (VAR)
607 <CALL-RTE ,IUNBIND!-MIMOP CALL <> <> .VAR>
610 <DEFINE GETS-GEN (CASE RES "OPTIONAL" HINT "AUX" CE AC)
612 <COND (<MEMBER <SPNAME .CASE> '["PURVEC" "DBVEC"]>
613 <COND (<==? .RES STACK>
614 <EMIT ,INST-MOVQ <ADDR-TYPE-M <ADD-MVEC <>>>
618 (<MEMBER <SPNAME .CASE> '["BIND" "BINDID"]>
619 <COND (<==? .RES STACK>
620 <COND (<=? <SPNAME .CASE> "BIND">
621 <EMIT-PUSH <TYPE-WORD LBIND> LONG>
622 <EMIT-PUSH <MA-ABS ,SPSTO-LOC> LONG>)
624 <EMIT-PUSH <TYPE-CODE FIX> LONG>
625 <EMIT-PUSH <MA-ABS ,BINDID-LOC> LONG>)>)
627 <COND (<SET AC <VAR-VALUE-IN-AC? .RES>>
628 <STORE-AC .AC <> <FIND-CACHE-VAR .RES>>)
630 <SET AC <GET-AC PREF-VAL T>>)>
631 <COND (<=? <SPNAME .CASE> "BIND">
632 <EMIT-MOVE <MA-ABS ,SPSTO-LOC> <MA-REG .AC> LONG>
633 <DEST-DECL .AC .RES LBIND>)
635 <EMIT-MOVE <MA-ABS ,BINDID-LOC> <MA-REG .AC> LONG>
636 <DEST-DECL .AC .RES FIX>)>)>)
638 <SET CE <FIND-CASE-ENTRY .CASE>>
639 <CALL-RTE ,IGETS!-MIMOP CALL .RES
640 <CSENT-VTYP .CE> <CSENT-OFF .CE>>)>
643 <DEFINE SETS-GEN (CASE VAL "AUX" CE)
644 <COND (<MEMBER <SPNAME .CASE> '["BIND" "BINDID"]>
645 <EMIT-MOVE <COND (<TYPE? .VAL VARTBL>
646 <VAR-VALUE-ADDRESS .VAL>)
649 <COND (<=? <SPNAME .CASE> "BIND">
651 (<MA-ABS ,BINDID-LOC>)> LONG>)
652 (<NOT <MEMBER <SPNAME .CASE> ["PURVEC" "DBVEC"]>>
653 <SET CE <FIND-CASE-ENTRY .CASE>>
654 <CALL-RTE ,ISETS!-MIMOP CALL <> <> .VAL <CSENT-OFF .CE>>)>
657 <NEWSTRUC CASE-ENTRY VECTOR
662 <DEFINE CREATE-CASE-ENTRY (KIND OFF VTYP)
663 #DECL ((KIND VTYP) ATOM (OFF) FIX)
664 <CHTYPE <VECTOR .KIND .OFF .VTYP> CASE-ENTRY>>
666 <GDECL (CASE-ENTRY-TABLE) <VECTOR [REST CASE-ENTRY]>>
668 <DEFINE FIND-CASE-ENTRY (KIND)
671 <COND (<=? <SPNAME .KIND> <SPNAME <CSENT-KIND .CE>>>
675 <DEFINE RECORD-GEN (TYPARG "TUPLE" ARGS)
676 #DECL ((TYPARG) <OR ATOM FIX>)
677 <COND (<TYPE? .TYPARG ATOM>
678 <SET TYPARG <2 <MEMQ .TYPARG ,TYPE-WORDS>>>)>
679 <CALL-STACK-FUNCTION .ARGS ,BRECORD!-MIMOP <> .TYPARG>
682 <DEFINE LIST-GEN (LEN RES "OPTIONAL" HINT)
683 #DECL ((LEN) <OR FIX VARTBL> (RES) <OR VARTBL ATOM>)
684 <CALL-RTE ,BLIST!-MIMOP CALL .RES LIST .LEN>
687 <DEFINE RTUPLE-GEN (TVAR FVAR "OPTIONAL" RES)
688 <CALL-RTE ,IRTUPLE!-MIMOP JUMP <> <> .TVAR .FVAR>
689 UNCONDITIONAL-BRANCH>
691 <DEFINE AGAIN-GEN (TVAR "OPTIONAL" RES)
692 #DECL ((TVAR) VARTBL)
693 <CALL-RTE ,IAGAIN!-MIMOP JUMP <> <> .TVAR>
694 UNCONDITIONAL-BRANCH>
696 <DEFINE RETRY-GEN (TVAR "OPTIONAL" RES)
697 #DECL ((TVAR) VARTBL)
698 <CALL-RTE ,IRETRY!-MIMOP JUMP <> <> .TVAR>
699 UNCONDITIONAL-BRANCH>
701 <DEFINE ACTIVATION-GEN ("OPTIONAL" VAR)
702 <CALL-RTE ,IACTIVATION!-MIMOP CALL <> <>>
705 <DEFINE TUPLE-GEN (NUM DEST "OPTIONAL" HINT)
706 #DECL ((NUM) <OR FIX VARTBL> (DEST) VARTBL)
707 <CALL-RTE ,ITUPLE!-MIMOP CALL .DEST TUPLE .NUM>>
709 <DEFINE SBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
710 #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
712 <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
713 <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
715 <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
716 <CALL-RTE ,ISBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
719 <DEFINE USBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
720 #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
722 <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
723 <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
725 <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
726 <CALL-RTE ,UISBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
729 <DEFINE INTGO-GEN ("AUX" (LAB <MAKE-LABEL>))
730 <COND (<AND <NOT ,BOOT-MODE>
732 <NOT ,DONT-INTERRUPT?>>
733 <EMIT ,INST-TSTL <MA-ABS ,INTFLG-LOC>>
734 <GEN-BRANCH ,INST-BEQL .LAB <>>
735 <CALL-RTE ,LCKINT!-MIMOP CALL <> <>>
736 <EMIT-LABEL .LAB <>>)>
739 <DEFINE TYPE-GEN (VAL RES "OPTIONAL" HINT "AUX" DAC)
740 #DECL ((VAL) VARTBL (RES) <OR ATOM VARTBL>)
741 <SET DAC <LOAD-VAR .VAL TYPE <> PREF-TYPE>>
742 <DEST-DECL .DAC .RES FIX>>
744 <DEFINE NEWTYPE-GEN (VAL1 RES "OPTIONAL" HINT)
745 #DECL ((VAL1) VARTBL (RES) <OR ATOM VARTBL>)
746 <CALL-RTE ,INEWTYPE!-MIMOP CALL .RES FIX .VAL1>>
748 <DEFINE TYPEW-GEN (ARG1 ARG2 RES "OPTIONAL" HINT)
749 #DECL ((ARG1 ARG2) VARTBL (RES) <OR ATOM VARTBL>)
750 <CALL-RTE ,ITYPEW!-MIMOP CALL .RES TYPE-W .ARG1 .ARG2>>
752 <DEFINE TYPEWC-GEN (ARG1 RES "OPTIONAL" HINT "AUX" VAC)
753 #DECL ((ARG1) VARTBL (RES) <OR ATOM VARTBL>)
754 <CALL-RTE ,ITYPEWC!-MIMOP CALL .RES TYPE-C .ARG1>>
756 <DEFINE OPEN-GEN (MODE BYTESZ NAME RES "OPTIONAL" (HINT <>))
757 #DECL ((MODE BYTESZ) <OR VARTBL FIX> (NAME) <OR STRING VARTBL>
758 (RES) <OR ATOM VARTBL>)
759 <CALL-RTE ,IOPEN!-MIMOP CALL .RES .HINT .MODE .BYTESZ .NAME>
762 <DEFINE CLOSE-GEN (CH "OPTIONAL" RES)
763 #DECL ((CH) <OR FIX VARTBL>)
764 <CALL-RTE ,ICLOSE!-MIMOP CALL <> <> .CH>
767 <DEFINE RESET-GEN (CH "OPTIONAL" RES)
768 #DECL ((CH) <OR FIX VARTBL>)
769 <CALL-RTE ,IRESET!-MIMOP CALL <> <> .CH>
772 <DEFINE READ-GEN (CHN STR NUMARGS GARB "OPTIONAL" (RES <>))
773 #DECL ((CHN NUMARGS) <OR VARTBL FIX> (STR) VARTBL)
774 <CALL-RTE ,IREAD!-MIMOP CALL .RES FIX .CHN .STR .NUMARGS .GARB>>
776 <DEFINE PRINT-GEN (CHN STR NUMARGS)
777 #DECL ((CHN NUMARGS) <OR VARTBL FIX> (STR) VARTBL)
778 <CALL-RTE ,IPRINT!-MIMOP CALL <> <> .CHN .STR .NUMARGS>>
780 <DEFINE RNTIME-GEN ("OPTIONAL" (RES <>))
781 <CALL-RTE ,IRNTIME!-MIMOP CALL .RES <>>>
783 <DEFINE SAVE-GEN (CHN "OPTIONAL" (ATMZN <>) (PURZN <>) (RES <>))
784 #DECL ((CHN) <OR VARTBL FIX>)
785 <CALL-RTE ,ISAVE!-MIMOP CALL .RES <> .CHN .ATMZN .PURZN>
788 <DEFINE RESTORE-GEN (CHN "OPTIONAL" (RES <>))
789 #DECL ((CHN) <OR VARTBL FIX>)
790 <CALL-RTE ,IRESTORE!-MIMOP CALL .RES <> .CHN>
793 <DEFINE COMPERR-GEN () <CALL-RTE ,ICOMPERR!-MIMOP CALL <> <>> NORMAL>
795 <DEFINE UNWCNT-GEN () <CALL-RTE ,IUNWCNT!-MIMOP JUMP <> <>> NORMAL>
797 <DEFINE IRECORD-GEN (TYPEC NARGS NWORDS RES "OPTIONAL" (HINT <>))
798 #DECL ((TYPEC NARGS NWORDS) <OR VARTBL FIX> (RES) <OR ATOM VARTBL>)
799 <CALL-RTE ,BIREC!-MIMOP CALL .RES .HINT .TYPEC .NARGS .NWORDS>
802 <DEFINE ADJ-GEN (AMT "AUX" VAC LVAR)
803 #DECL ((AMT) <OR FIX VARTBL>)
804 <COND (<TYPE? .AMT FIX> <ADD-CONSTANT-TO-AC <* .AMT 8> ,AC-TP>)
805 (<AND <SET LVAR <FIND-CACHE-VAR .AMT>>
806 <SET VAC <LINKVAR-VALUE-AC .LVAR>>>
807 <EMIT ,INST-ASHL <MA-IMM 3> <MA-REG .VAC>
808 <MA-REG <SET VAC <GET-AC PREF-VAL T>>>>
809 <EMIT ,INST-ADDL2 <MA-REG .VAC> <MA-REG ,AC-TP>>)
811 <EMIT ,INST-ASHL <MA-IMM 3> <VAR-VALUE-ADDRESS .AMT>
812 <MA-REG <SET VAC <GET-AC PREF-VAL T>>>>
813 <EMIT ,INST-ADDL2 <MA-REG .VAC> <MA-REG ,AC-TP>>)>
816 <DEFINE NTHU-GEN (STRUC NUM RES "OPTIONAL" (HINT <>))
817 <CALL-RTE ,INTHU!-MIMOP CALL .RES .HINT .STRUC .NUM>
820 <DEFINE RESTU-GEN (STRUC NUM RES "OPTIONAL" (HINT <>))
821 <CALL-RTE ,IRESTU!-MIMOP CALL .RES .HINT .STRUC .NUM>
824 <DEFINE PUTU-GEN (STRUC NUM VAL "OPTIONAL" (HINT <>))
825 <CALL-RTE ,IPUTU!-MIMOP CALL <> <> .STRUC .NUM .VAL>
828 <DEFINE ATIC-GEN (ARG "OPTIONAL" (RES <>) (HINT <>))
829 <CALL-RTE ,IATIC!-MIMOP CALL .RES .HINT .ARG>
832 <DEFINE PFRAME-GEN (FRM RES "OPTIONAL" HINT "AUX" VAC TAC NPL TLAB)
833 #DECL ((FRM) VARTBL (RES) <OR ATOM VARTBL>)
835 <SET VAC <LOAD-VAR .FRM VALUE <> ANY-AC>>
836 <EMIT ,INST-MOVL <MA-DISP .VAC -12> <MA-REG .VAC>>
837 <SET TLAB <MAKE-LABEL>>
839 <EMIT ,INST-TSTB <MA-DISP .VAC -1>>
840 <SET NPL <MAKE-LABEL>>
841 <GEN-BRANCH ,INST-BLSS .NPL <>>
842 <EMIT ,INST-MOVL <MA-DISP .VAC -4> <MA-REG .VAC>>
843 <GEN-BRANCH ,INST-BRB .TLAB UNCONDITIONAL-BRANCH>
845 <EMIT ,INST-MOVL <TYPE-WORD FRAME> <MA-REG .TAC>>
846 <DEST-PAIR .VAC .TAC .RES>
849 <DEFINE ARGS-GEN (FRM "OPTIONAL" (RES <>) (HINT <>))
851 <CALL-RTE ,IARGS!-MIMOP CALL .RES .HINT .FRM>>
853 <DEFINE VALUE-GEN (VAL RES "OPTIONAL" HINT "AUX" VAC)
854 #DECL ((RES) <OR ATOM VARTBL>)
856 <MOVE-VALUE .VAL .VAC>
857 <DEST-DECL .VAC .RES FIX>
860 <DEFINE OBJECT-GEN (TYP CNT VAL RES "AUX" TAC VAC (TDONE? <>))
861 <COND (<==? .RES STACK>
862 <COND (<TYPE? .TYP VARTBL>
863 <EMIT-PUSH <VAR-VALUE-ADDRESS .TYP> WORD>)
864 (<EMIT-PUSH <MA-IMM .TYP> WORD>)>
865 <COND (<TYPE? .CNT VARTBL>
866 <EMIT-PUSH <VAR-VALUE-ADDRESS .CNT> WORD>)
867 (<EMIT-PUSH <MA-IMM .CNT> WORD>)>
868 <COND (<TYPE? .VAL VARTBL>
869 <EMIT-PUSH <VAR-VALUE-ADDRESS .VAL> LONG>)
870 (<EMIT-PUSH <MA-IMM .VAL> LONG>)>)
872 <SET TAC <GET-AC DOUBLE T>>
873 <COND (<NOT <TYPE? .CNT VARTBL>>
876 <COND (<TYPE? .TYP VARTBL>
877 <EMIT ,INST-MOVZWL <VAR-VALUE-ADDRESS .TYP>
880 <EMIT-MOVE <MA-IMM .TYP> <MA-REG .TAC> LONG>)>)
881 (<NOT <TYPE? .TYP VARTBL>>
883 <EMIT-MOVE <MA-IMM <ORB .TYP <LSH .CNT 16>>>
884 <MA-REG .TAC> LONG>)>)>
886 <EMIT ,INST-MOVW <COND (<TYPE? .CNT VARTBL>
887 <VAR-VALUE-ADDRESS .CNT>)
888 (<MA-IMM .CNT>)> <MA-REG .TAC>>
889 <EMIT ,INST-ASHL <MA-LIT 16> <MA-REG .TAC> <MA-REG .TAC>>
890 <EMIT ,INST-MOVW <COND (<TYPE? .TYP VARTBL>
891 <VAR-VALUE-ADDRESS .TYP>)
892 (<MA-IMM .TYP>)> <MA-REG .TAC>>)>
893 <EMIT ,INST-MOVL <COND (<TYPE? .VAL VARTBL>
894 <VAR-VALUE-ADDRESS .VAL>)
896 <MA-REG <SET VAC <NEXT-AC .TAC>>>>
897 <DEST-PAIR .VAC .TAC .RES T>)>
900 <DEFINE NTH1-GEN (VAL RES "OPTIONAL" (HINT <>))
901 <CALL-RTE ,CINTH!-MIMOP CALL .RES .HINT .VAL>>
903 <DEFINE REST1-GEN (VAL RES "OPTIONAL" (HINT <>))
904 <CALL-RTE ,CIRST!-MIMOP CALL .RES .HINT .VAL>>
906 <DEFINE EMPTY?-GEN (VAR DIR LABEL "AUX" XLABEL)
907 #DECL ((VAR) VARTBL (DIR LABEL) ATOM)
908 <CALL-RTE ,CIEMP!-MIMOP CALL <> <> .VAR>
910 <GEN-BRANCH ,INST-BRB <SET XLABEL <MAKE-LABEL>>
911 UNCONDITIONAL-BRANCH <> T>)>
912 <GEN-BRANCH ,INST-BRB .LABEL UNCONDITIONAL-BRANCH <> <==? .DIR ->>
913 <COND (<==? .DIR +> <EMIT-LABEL .XLABEL <>>)>>
915 <DEFINE GASSIGNED?-GEN (VAL RES "OPTIONAL" (HINT <>))
916 <CALL-RTE ,CIGAS!-MIMOP CALL .RES .HINT .VAL>>
918 <DEFINE MONAD?-GEN (VAR DIR LABEL "AUX" XLABEL)
919 #DECL ((VAR) VARTBL (DIR LABEL) ATOM)
920 <CALL-RTE ,CIMON!-MIMOP CALL <> <> .VAR>
922 <GEN-BRANCH ,INST-BRB <SET XLABEL <MAKE-LABEL>>
923 UNCONDITIONAL-BRANCH <> T>)>
924 <GEN-BRANCH ,INST-BRB .LABEL UNCONDITIONAL-BRANCH <> <==? .DIR ->>
925 <COND (<==? .DIR +> <EMIT-LABEL .XLABEL <>>)>>
927 <DEFINE FGVAL-GEN (VAL RES "OPTIONAL" (HINT <>))
928 <CALL-RTE ,CIGVL!-MIMOP CALL .RES .HINT .VAL>>
930 <DEFINE ACALL-GEN (SBR NARG "OPT" (RES <>) (HINT <>))
931 <CALL-RTE ,IACALL!-MIMOP CALL .RES .HINT .SBR .NARG>>
933 ; "return 0 if pointer is not to stack; 1 if to unused stack area; -1 if to
935 <DEFINE ON-STACK?-GEN (OBJ RES "OPTIONAL" (HINT <>) (LABEL <MAKE-LABEL>) TAC)
937 <SET TAC <GET-AC PREF-VAL T>>
938 <LOAD-CONSTANT .TAC 0>
939 <DEST-DECL .TAC .RES FIX>
940 <EMIT ,INST-CMPL <MA-ABS ,STKBOT-LOC> <VAR-VALUE-ADDRESS .OBJ>>
941 <GEN-BRANCH ,INST-BGTR .LABEL <>> ; "Below stack"
942 <EMIT ,INST-CMPL <MA-ABS ,STKTOP-LOC> <VAR-VALUE-ADDRESS .OBJ>>
943 <GEN-BRANCH ,INST-BLSS .LABEL <>> ; "Above stack area"
944 <LOAD-CONSTANT .TAC 1> ; "Assume loser"
945 <EMIT ,INST-CMPL <MA-REG ,AC-TP> <VAR-VALUE-ADDRESS .OBJ>>
946 <GEN-BRANCH ,INST-BLSS .LABEL <>> ; "Above top of stack"
947 <LOAD-CONSTANT .TAC -1>
948 <EMIT-LABEL .LABEL <>>