2 <DEFINE NTH-LIST-GEN (SVAR NUM RES "OPTIONAL" (HINT <>) "AUX" VAC)
3 #DECL ((SVAR) <OR VARTBL <PRIMTYPE LIST>> (NUM) <OR FIX VARTBL>
4 (RES) <OR ATOM VARTBL> (HINT) <OR FALSE HINT>)
5 <COND (<NTH-LOOK-AHEAD NTHL!-MIMOP .SVAR .NUM .RES .HINT>)
7 <COND (<==? .NUM 1> <NTH-FIXOFFSET-GEN .SVAR 1 .RES .HINT>)
9 <SET VAC <LIST-REST-CONSTANT-GEN .SVAR <- .NUM 1>>>
10 <FINISH-NTH-FIXOFFSET-GEN .VAC 1 .RES .HINT>)
12 <SET VAC <LIST-REST-VAR-GEN .SVAR .NUM NTH>>
13 <FINISH-NTH-FIXOFFSET-GEN .VAC 1 .RES .HINT>)>
17 <DEFINE REST-LIST-GEN (SVAR NUM RES "OPTIONAL" HINT "AUX" VAC)
18 #DECL ((SVAR) <OR VARTBL <PRIMTYPE LIST>> (NUM) <OR FIX VARTBL>
19 (RES) <OR VARTBL ATOM>)
20 <COND (<==? .RES STACK> <EMIT-PUSH <TYPE-WORD LIST> LONG>)>
21 <COND (<TYPE? .NUM FIX>
22 <SET VAC <LIST-REST-CONSTANT-GEN .SVAR .NUM .RES>>)
23 (ELSE <SET VAC <LIST-REST-VAR-GEN .SVAR .NUM REST .RES>>)>
24 <COND (<N=? .RES STACK> <DEST-DECL .VAC .RES LIST>)>
28 <DEFINE LIST-REST-CONSTANT-GEN (SVAR NUM
30 "AUX" VAC LDISP CAC LABEL VAC1)
31 #DECL ((SVAR) VARTBL (NUM) FIX (RES) <OR FALSE VARTBL ATOM>)
32 <COND (<SET VAC <OR <VAR-VALUE-IN-AC? .SVAR>
33 <LOAD-VAR .SVAR VALUE <> PREF-VAL>>>
35 <COND (<AND <TYPE? .RES VARTBL>
36 <SET VAC1 <VAR-VALUE-IN-AC? .RES>>>
37 ; "If the loser's already in an ac, use that"
40 <EMIT-MOVE <MA-DISP .VAC ,LIST-NEXT-OFFSET>
45 (<OR <AND <==? .RES STACK> <1? .NUM>>
48 <SET VAC1 <GET-AC PREF-VAL T>>
49 <EMIT-MOVE <MA-DISP .VAC ,LIST-NEXT-OFFSET>
53 <SET NUM <- .NUM 1>>)>)>
55 <SET LDISP <MA-DISP .VAC ,LIST-NEXT-OFFSET>>
58 <COND (<==? .RES STACK> <EMIT-PUSH .LDISP LONG>)
59 (<EMIT-MOVE .LDISP <MA-REG .VAC> LONG>)>)
61 <PROTECT <SET CAC <GET-AC PREF-VAL T>>>
62 <COND (<==? .RES STACK> <LOAD-CONSTANT .CAC <- .NUM 2>>)
63 (ELSE <LOAD-CONSTANT .CAC <- .NUM 1>>)>
64 <SET LABEL <MAKE-LABEL>>
66 <EMIT-MOVE .LDISP <MA-REG .VAC> LONG>
67 <GEN-BRANCH ,INST-SOBGEQ .LABEL <> <MA-REG .CAC>>
68 <COND (<==? .RES STACK> <EMIT-PUSH .LDISP LONG>)>)>
71 <DEFINE LIST-REST-VAR-GEN (SVAR NVAR OP
73 "AUX" (STATUS? <>) VAC CAC SLABEL ELABEL LADDR)
74 #DECL ((SVAR) <OR VARTBL <PRIMTYPE LIST>> (NVAR) VARTBL (OP) ATOM
75 (RES) <OR FALSE ATOM VARTBL>)
77 <COND (<TYPE? .SVAR LIST>
78 <SET VAC <GEN-CONSTANT .SVAR PREF-VAL NONE NONE>>)
79 (ELSE <SET VAC <LOAD-VAR .SVAR VALUE T PREF-VAL>>)>
81 <COND (<AND <SET CAC <VAR-VALUE-IN-AC? .NVAR>> <AVAILABLE? .CAC>>
83 <COND (<OR <==? .OP NTH> <==? .RES STACK>>
84 <EMIT ,INST-DECL <MA-REG .CAC>>
87 <PROTECT-USE <SET CAC <GET-AC PREF-VAL T>>>
88 <COND (<OR <==? .OP NTH> <==? .RES STACK>>
89 <EMIT ,INST-SUBL3 <MA-IMM 1> <VAR-VALUE-ADDRESS .NVAR>
93 <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .NVAR>
96 <COND (<==? .CAC ,STATUS-AC> <SET STATUS? T>)>
98 <EMIT ,INST-TSTL <MA-REG .CAC>>)>
99 <SET ELABEL <MAKE-LABEL>>
100 <GEN-BRANCH ,INST-BLEQ .ELABEL <>>
101 <SET SLABEL <MAKE-LABEL>>
102 <EMIT-LABEL .SLABEL T>
103 <SET LADDR <MA-DISP .VAC ,LIST-NEXT-OFFSET>>
104 <EMIT-MOVE .LADDR <MA-REG .VAC> LONG>
105 <GEN-BRANCH ,INST-SOBGTR .SLABEL <> <MA-REG .CAC>>
106 <EMIT-LABEL .ELABEL <>>
107 <COND (<AND <==? .OP REST> <==? .RES STACK>> <EMIT-PUSH .LADDR LONG>)>
110 <DEFINE FINISH-NTH-FIXOFFSET-GEN (SVAC OFF RES HINT "OPT" (INDXAC <>)
111 "AUX" (TYP <>) RVAC TYPADDR CNTADDR VALADDR
113 #DECL ((SVAC) AC (OFF) FIX (RES) <OR VARTBL ATOM>
114 (HINT) <OR FALSE HINT> (INDXAC) <OR FALSE AC>)
115 <SET OFF <* <- .OFF 1> 8>>
116 <SET TYPADDR <MA-DISP .SVAC .OFF>>
117 <SET CNTADDR <MA-DISP .SVAC <+ .OFF 2>>>
118 <SET VALADDR <MA-DISP .SVAC <+ .OFF 4>>>
119 <AND .HINT <SET TYP <PARSE-HINT .HINT TYPE>>>
120 <COND (<AND <==? .RES STACK> <NOT ,GC-MODE>>
122 <EMIT ,INST-MOVQ <MA-INDX .INDXAC> .TYPADDR
125 <EMIT ,INST-MOVQ .TYPADDR <MA-AINC ,AC-TP>>)>)
127 <SET RVAC <GET-AC DOUBLE T>>
129 <EMIT ,INST-MOVQ <MA-INDX .INDXAC> .TYPADDR
132 <EMIT ,INST-MOVQ .TYPADDR <MA-REG .RVAC>>)>
133 <DEST-PAIR <NEXT-AC .RVAC> .RVAC .RES VALUE>)>>
135 <DEFINE FNTH-DET-VALUE-AC (SVAC TYP)
136 #DECL ((SVAC) AC (TYP) <OR FALSE ATOM>)
137 <COND (<AND .TYP <NOT <STRUCTURED-TYPE? .TYP>> <FREE-VALUE-AC? STORED>>
138 <PROTECT <GET-AC VALUE T>>)
139 (<ALL-DEAD? .SVAC> .SVAC)
141 <PROTECT <GET-AC PREF-VAL T>>)>>
143 <DEFINE NTH-FIXOFFSET-GEN (SVAR OFF RES HINT "AUX" VAC)
144 #DECL ((SVAR) VARTBL (OFF) FIX (REST) <OR ATOM VARTBL>
145 (HINT) <OR FALSE HINT>)
146 <PROTECT <SET VAC <LOAD-VAR .SVAR VALUE <> PREF-VAL>>>
147 <FINISH-NTH-FIXOFFSET-GEN .VAC .OFF .RES .HINT>>
149 <DEFINE NTH-VECTOR-GEN (SVAR OFF RES "OPTIONAL" (HINT <>))
150 #DECL ((SVAR) <OR VARTBL <PRIMTYPE VECTOR>> (OFF) <OR FIX VARTBL>
151 (RES) <OR ATOM VARTBL> (HINT) <OR FALSE HINT>)
152 <COND (<NTH-LOOK-AHEAD NTHUV!-MIMOP .SVAR .OFF .RES .HINT>)
154 <COND (<TYPE? .OFF FIX> <NTH-FIXOFFSET-GEN .SVAR .OFF .RES .HINT>)
155 (ELSE <NTH-VECTOR-VAR-GEN .SVAR .OFF .RES .HINT>)>
159 <DEFINE NTH-VECTOR-VAR-GEN (SVAR OFF RES HINT "AUX" VAC DAC)
160 #DECL ((SVAR) <OR VARTBL <PRIMTYPE VECTOR>> (OFF) VARTBL
161 (RES) <OR ATOM VARTBL> (HINT) <OR FALSE HINT>)
162 <SET DAC <LOAD-VAR .OFF VALUE <> PREF-VAL>>
164 <COND (<NOT <TYPE? .SVAR VARTBL>>
165 <PROTECT-USE <SET VAC <GET-AC PREF-VAL T>>>
166 <EMIT ,INST-MOVL <ADDR-VALUE-MQUOTE .SVAR> <MA-REG .VAC>>)
168 <PROTECT-USE <SET VAC <LOAD-VAR .SVAR VALUE <> PREF-VAL>>>)>
169 <FINISH-NTH-FIXOFFSET-GEN .VAC 0 .RES .HINT .DAC>>
171 <DEFINE REST-VECTOR-GEN (SVAR NUM RES "OPTIONAL" (HINT <>) "AUX" (TYP <>))
172 #DECL ((SVAR) <OR VARTBL <PRIMTYPE VECTOR>> (NUM) <OR FIX VARTBL>
173 (RES) <OR VARTBL ATOM>)
174 <AND .HINT <SET TYP <PARSE-HINT .HINT TYPE>>>
175 <REST-BLOCK-GEN .SVAR .NUM .RES 3 .TYP>>
177 <DEFINE REST-BYTE-GEN (SVAR NUM RES "OPTIONAL" HINT)
178 #DECL ((SVAR) <OR VARTBL <PRIMTYPE BYTES>> (NUM) <OR FIX VARTBL>
179 (RES) <OR VARTBL ATOM>)
180 <REST-BLOCK-GEN .SVAR .NUM .RES 0 BYTES>>
182 <DEFINE REST-STRING-GEN (SVAR NUM RES "OPTIONAL" HINT)
183 #DECL ((SVAR) <OR VARTBL <PRIMTYPE STRING>> (NUM) <OR FIX VARTBL>
184 (RES) <OR VARTBL ATOM>)
185 <REST-BLOCK-GEN .SVAR .NUM .RES 0 STRING>>
187 <DEFINE REST-UVECTOR-GEN (SVAR NUM RES "OPTIONAL" HINT)
188 #DECL ((SVAR) <OR VARTBL <PRIMTYPE UVECTOR>> (NUM) <OR FIX VARTBL>
189 (RES) <OR VARTBL ATOM>)
190 <REST-BLOCK-GEN .SVAR .NUM .RES 2 UVECTOR>>
192 <MSETG TYP-MASK <PUTBITS -1 <BITS 6 16> 0>>
194 <MSETG PTYP-MASK <PUTBITS 0 <BITS 3 16> -1>>
196 <DEFINE REST-BLOCK-GEN (SVAR NUM RES SHFT TYP "OPTIONAL" (INS <>) (ELAC <>)
197 (PUT? <>) (TYPE-ADDR <>))
198 #DECL ((SVAR) ANY (SHFT) FIX (NUM) <OR FIX VARTBL>
199 (RES) <OR VARTBL ATOM> (TYP) <OR ATOM FALSE>)
200 <COND (<==? .SVAR .RES>
201 <COND (<TYPE? .NUM FIX> <FIX-R-B-G-SELF .SVAR .NUM .SHFT .TYP
204 (ELSE <R-B-G-SELF .SVAR .NUM .SHFT .TYP>)>)
205 (<NOT <TYPE? .SVAR VARTBL>>
206 <R-B-G-Q .SVAR .NUM .RES .SHFT <PRIMTYPE .SVAR>>)
207 (<TYPE? .NUM FIX> <FIX-R-B-G-OTHER .SVAR .NUM .RES .SHFT .TYP
208 .INS .ELAC .PUT? .TYPE-ADDR>)
209 (ELSE <R-B-G .SVAR .NUM .RES .SHFT .TYP>)>
213 <DEFINE FIX-R-B-G-SELF (SVAR NUM SHFT TYP INS ELAC PUT? TYPE-ADDR
214 "AUX" (VAC <>) (TAC <>) (CAC <>) LV)
215 #DECL ((NUM SHFT) FIX (SVAR) VARTBL (TYP) <OR ATOM FALSE>)
216 <COND (<SET LV <FIND-CACHE-VAR .SVAR>>
217 <COND (<SET VAC <LINKVAR-VALUE-AC .LV>>
219 <COND (<NOT <SET TAC <LINKVAR-TYPE-WORD-AC .LV>>>
220 <COND (<AND <NOT <LINKVAR-COUNT-STORED .LV>>
221 <SET CAC <LINKVAR-COUNT-AC .LV>>>
226 <COND (.VAC <MUNG-AC .VAC>)>
227 <COND (.TAC <MUNG-AC .TAC>)
228 (.CAC <MUNG-AC .CAC>)>
231 <SET VAC <LOAD-VAR .SVAR VALUE T PREF-VAL>>)>)>
234 <MA-IMM <CHTYPE <LSH <- .NUM> 16> FIX>>
237 <COND (<==? .NUM 1> <EMIT ,INST-DECL <MA-REG .CAC>>)
238 (ELSE <EMIT ,INST-SUBL2 <MA-IMM .NUM> <MA-REG .CAC>>)>)
240 <COND (<==? .NUM 1> <EMIT ,INST-DECW <VAR-COUNT-ADDRESS .SVAR>>)
244 <VAR-COUNT-ADDRESS .SVAR>>)>)>
245 <SET NUM <SHIFT-NUM .NUM .SHFT>>
247 <COND (<TYPE? .INS ATOM>)
251 ; "Can happen putting into a vector"
252 <EMIT ,INST-MOVL .TYPE-ADDR <MA-AINC .VAC>>
253 <EMIT ,INST-MOVL <COND (<TYPE? .ELAC AC> <MA-REG .ELAC>)
257 <EMIT .INS <COND (<TYPE? .ELAC AC> <MA-REG .ELAC>)
260 (<EMIT .INS <MA-AINC .VAC> <COND (<TYPE? .ELAC AC>
265 <COND (.VAC <MA-REG .VAC>)
266 (ELSE <VAR-VALUE-ADDRESS .SVAR>)>>)
270 <COND (.VAC <MA-REG .VAC>)
271 (ELSE <VAR-VALUE-ADDRESS .SVAR>)>>)>
273 <DEST-DECL .VAC .SVAR .TYP>)>
275 <COND (.VAC <DEST-PAIR .VAC .TAC .SVAR>)
276 (T <LINK-VAR-TO-AC .SVAR .TAC TYPE-WORD>)>)
278 <COND (.VAC <DEST-COUNT-DECL .VAC .CAC .SVAR .TYP>)
280 <LINK-VAR-TO-AC .SVAR .CAC COUNT>
281 <INDICATE-CACHED-VARIABLE-DECL .SVAR .TYP>)>)>
284 <DEFINE FIX-R-B-G-OTHER (SVAR NUM RES SHFT TYP INS ELAC PUT? TYPE-ADDR
285 "AUX" (VAC <>) (CAC <>) LV (CN <>))
286 #DECL ((NUM SHFT) FIX (SVAR) VARTBL (TYP) <OR ATOM FALSE>)
288 <COND (<NOT <SET VAC <VAR-VALUE-IN-AC? .SVAR>>>
289 <SET VAC <LOAD-VAR .SVAR VALUE T PREF-VAL>>)>)>
290 <SET LV <FIND-CACHE-VAR .SVAR>>
291 <COND (<AND .LV <SET CAC <LINKVAR-TYPE-WORD-AC .LV>>>
292 <COND (<TYPE? .RES VARTBL>
296 <MA-IMM <CHTYPE <LSH <- .NUM> 16> FIX>>
300 <MA-IMM <CHTYPE <LSH <- .NUM> 16> FIX>>
303 (<AND .LV <SET CAC <LINKVAR-COUNT-AC .LV>>
304 <NOT <LINKVAR-COUNT-STORED .LV>> .TYP>
306 <COND (<TYPE? .RES VARTBL>
309 <COND (<==? .NUM 1> <EMIT ,INST-DECL <MA-REG .CAC>>)
311 <EMIT ,INST-SUBL2 <MA-IMM .NUM> <MA-REG .CAC>>)>)
313 <EMIT-PUSH <TYPE-CODE .TYP> WORD>
319 <COND (.CAC <MUNG-AC .CAC> <SET LV <FIND-CACHE-VAR .SVAR>>)>
320 <COND (<==? .RES STACK>)
321 (<AND .LV <LINKVAR-VALUE-AC .LV>>
322 <SET CAC <GET-AC PREF-TYPE T>>)
324 <SET CAC <GET-AC DOUBLE T>>
325 <SET VAC <NEXT-AC .CAC>>)>
327 <MA-IMM <CHTYPE <LSH <- .NUM> 16> FIX>>
328 <VAR-TYPE-ADDRESS .SVAR TYPE-WORD>
329 <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
330 (ELSE <MA-REG .CAC>)>>)>
331 <SET NUM <SHIFT-NUM .NUM .SHFT>>
333 <COND (<NOT <TYPE? .INS ATOM>>
336 <EMIT ,INST-MOVL .TYPE-ADDR <MA-AINC .VAC>>
337 <EMIT ,INST-MOVL <COND (<TYPE? .ELAC AC>
342 <EMIT .INS <COND (<TYPE? .ELAC AC>
347 <EMIT .INS <MA-AINC .VAC> <COND (<TYPE? .ELAC AC>
351 <COND (<SET VAC <VAR-VALUE-IN-AC? .SVAR>>
352 <EMIT ,INST-MOVAL <MA-DISP .VAC .NUM> <MA-AINC ,AC-TP>>)
356 <VAR-VALUE-ADDRESS .SVAR>
358 (<AND .LV <SET VAC <LINKVAR-VALUE-AC .LV>>>
360 <COND (<==? .NUM 1> <EMIT ,INST-INCL <MA-REG .VAC>>)
361 (ELSE <EMIT ,INST-ADDL2 <MA-IMM .NUM> <MA-REG .VAC>>)>)
363 <COND (<VAR-VALUE-IN-AC? .SVAR>
364 <EMIT ,INST-MOVAL <MA-DISP <VAR-VALUE-IN-AC? .SVAR> .NUM>
366 (T <SET VAC <GET-AC PREF-VAL T>>)>>>)
370 <VAR-VALUE-ADDRESS .SVAR>
373 <GET-AC PREF-VAL T>>)>>>)>)>
374 <COND (<N==? .RES STACK>
375 <COND (<NOT .CN> <DEST-PAIR .VAC .CAC .RES>)
376 (ELSE <DEST-COUNT-DECL .VAC .CAC .RES .TYP>)>)>>
378 <DEFINE R-B-G-SELF (SVAR NUM SHFT TYP "AUX" (VAC <>) (TAC <>) (CAC <>)
379 LV (NAC <>) (COUNT-STORED? <>))
380 #DECL ((SHFT) FIX (NUM SVAR) VARTBL (TYP) <OR ATOM FALSE>)
381 <COND (<SET LV <FIND-CACHE-VAR .SVAR>>
382 <COND (<SET VAC <LINKVAR-VALUE-AC .LV>>
384 <COND (<NOT <SET TAC <LINKVAR-TYPE-WORD-AC .LV>>>
385 <COND (<AND <NOT <LINKVAR-COUNT-STORED .LV>>
386 <SET CAC <LINKVAR-COUNT-AC .LV>>>
391 <COND (.VAC <MUNG-AC .VAC>)>
393 (.CAC <MUNG-AC .CAC>)>
394 <COND (<NOT <0? .SHFT>> <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>)>
398 <VAR-VALUE-ADDRESS .NUM>
399 <VAR-COUNT-ADDRESS .SVAR>>
400 <SET COUNT-STORED? T>)
402 <EMIT ,INST-SUBL2 <VAR-VALUE-ADDRESS .NUM> <MA-REG .CAC>>)
404 <SET COUNT-STORED? T>
406 <VAR-VALUE-ADDRESS .NUM>
407 <VAR-COUNT-ADDRESS .SVAR>>)>
408 <COND (<AND <NOT .VAC> <NOT <0? .SHFT>>>
409 <SET VAC <LOAD-VAR .SVAR JUST-VALUE <> PREF-VAL>>)>
412 <VAR-VALUE-ADDRESS .NUM>
413 <COND (.VAC <MA-REG .VAC>)
414 (ELSE <VAR-VALUE-ADDRESS .SVAR>)>>)
416 <EMIT ,INST-MOVAL <MA-INDX .NAC> <MA-REGD .VAC> <MA-REG .VAC>>)
423 <DEST-DECL .VAC .SVAR .TYP>)>
425 <COND (.VAC <DEST-COUNT-DECL .VAC .CAC .SVAR .TYP>)
427 <LINK-VAR-TO-AC .SVAR .CAC COUNT <>>
428 <INDICATE-CACHED-VARIABLE-DECL .SVAR .TYP>)>)>
429 <SET LV <FIND-CACHE-VAR .SVAR>>
430 <LINKVAR-TYPE-STORED .LV T>
431 <LINKVAR-COUNT-STORED .LV .COUNT-STORED?>>
433 <DEFINE R-B-G (SVAR NUM RES SHFT TYP
434 "AUX" (VAC <>) (CAC <>) LV (CN <>) (NAC <>)
436 #DECL ((SHFT) FIX (NUM SVAR) VARTBL (TYP) <OR ATOM FALSE>)
437 <SET LV <FIND-CACHE-VAR .SVAR>>
438 <COND (<NOT <0? .SHFT>>
439 <PROTECT <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>>)>
440 <COND (<AND .LV <SET CAC <LINKVAR-TYPE-WORD-AC .LV>>>
441 ; "Structure has type word in AC"
442 <COND (<TYPE? .RES VARTBL>
443 <COND (<AND .TYP <N==? <VARTBL-DECL .RES> .TYP>>
444 <SET FORCE-CHTYPE? T>)>
446 ; "Clobber type word, so COUNT-ADDRESS returns winnage"
449 <VAR-VALUE-ADDRESS .NUM>
450 <VAR-COUNT-ADDRESS .SVAR>
451 <VAR-COUNT-ADDRESS .RES T>>)
453 <EMIT-PUSH <MA-REG .CAC> LONG>
454 ; "Recycle type word AC onto stack"
456 <VAR-VALUE-ADDRESS .NUM>
457 <MA-DISP ,AC-TP -2>>)>)
458 (<AND .LV <SET CAC <LINKVAR-COUNT-AC .LV>> .TYP>
459 ; "Structure has count in AC, so winnage is possible"
461 <COND (<TYPE? .RES VARTBL>
465 <VAR-VALUE-ADDRESS .NUM>
468 <EMIT-PUSH <TYPE-CODE .TYP> WORD>
470 <VARTBL-VALUE-ADDRESS .NUM>
475 ; "Will hit this if type is unknown"
477 <SET LV <FIND-CACHE-VAR .SVAR>>)>
478 <COND (<==? .RES STACK>)
480 ; "Get an AC for the result"
481 <SET CAC <GET-AC PREF-TYPE T>>
483 <EMIT ,INST-CLRL <MA-REG .CAC>>)>
484 <COND (<==? .RES STACK>
485 <COND (.TYP <EMIT-PUSH <TYPE-CODE .TYP> WORD>)
486 (ELSE <EMIT ,INST-CLRW <MA-AINC ,AC-TP>>)>
488 <VAR-VALUE-ADDRESS .NUM>
489 <VAR-COUNT-ADDRESS .SVAR>
493 <VAR-VALUE-ADDRESS .NUM>
494 <VAR-COUNT-ADDRESS .SVAR>
501 (ELSE <SET CN T>)>)>)>
503 <COND (<AND <N==? .RES STACK>
505 <SET VAC <LINKVAR-VALUE-AC .LV>>>
508 <VAR-VALUE-ADDRESS .NUM>
512 <VAR-VALUE-ADDRESS .NUM>
513 <VAR-VALUE-ADDRESS .SVAR>
514 <MA-REG <SET VAC <GET-AC PREF-VAL T>>>>)
517 <VAR-VALUE-ADDRESS .NUM>
518 <VAR-VALUE-ADDRESS .SVAR>
521 <SET VAC <LOAD-VAR .SVAR JUST-VALUE <N==? .RES STACK> PREF-VAL>>
526 <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
527 (ELSE <MA-REG .VAC>)>>)
532 <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
533 (ELSE <MA-REG .VAC>)>>)>)>
534 <COND (<OR <NOT .TYP> .FORCE-CHTYPE?
535 <AND <N==? .TYP <VARTBL-DECL .SVAR>> <NOT .CN>>>
537 <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
539 (ELSE <VAR-TYPE-ADDRESS .RES>)>
540 <COND (<==? .RES STACK> <MA-DISP ,AC-TP -4>)
541 (ELSE <MA-REG .VAC>)>
544 <COND (<N==? .RES STACK>
545 <COND (.CAC <DEST-PAIR .VAC .CAC .RES>)
548 <LINK-VAR-TO-AC .RES .VAC VALUE <>>
549 <SET LV <FIND-CACHE-VAR .RES>>
550 <PUT .LV ,LINKVAR-COUNT-STORED T>
551 <PUT .LV ,LINKVAR-TYPE-STORED T>
552 <PUT .LV ,LINKVAR-TYPE-AC <>>
553 <PUT .LV ,LINKVAR-COUNT-AC <>>
554 <PUT .LV ,LINKVAR-TYPE-WORD-AC <>>)>)>)
557 <COND (.CAC <DEST-PAIR .VAC .CAC .RES>)
560 <LINK-VAR-TO-AC .RES .VAC VALUE <>>
561 <SET LV <FIND-CACHE-VAR .RES>>
562 <PUT .LV ,LINKVAR-COUNT-STORED T>
563 <PUT .LV ,LINKVAR-TYPE-STORED T>
564 <PUT .LV ,LINKVAR-TYPE-AC <>>
565 <PUT .LV ,LINKVAR-COUNT-AC <>>
566 <PUT .LV ,LINKVAR-TYPE-WORD-AC <>>)>)
567 (ELSE <DEST-COUNT-DECL .VAC .CAC .RES .TYP>)>)>>
569 <DEFINE R-B-G-Q (SVAR NUM RES SHFT TYP "AUX" NAC VAC CAC)
570 #DECL ((NUM) VARTBL (SHFT) FIX (TYP) ATOM)
571 <COND (<==? .RES STACK>
572 <EMIT-PUSH <TYPE-CODE <PRIMTYPE .SVAR>> WORD>
574 <VAR-VALUE-ADDRESS .NUM>
575 <MA-IMM <LENGTH .SVAR>>
578 <EMIT ,INST-SUBL3 <VAR-VALUE-ADDRESS .NUM>
579 <MA-IMM <LENGTH .SVAR>>
580 <MA-REG <SET CAC <GET-AC DOUBLE T>>>>)>
581 <COND (.CAC <SET VAC <NEXT-AC .CAC>>)>
583 <EMIT ,INST-ADDL3 <VAR-VALUE-ADDRESS .NUM>
584 <ADDR-VALUE-M <ADD-MVEC .SVAR>>
585 <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
588 <EMIT ,INST-MOVL <ADDR-VALUE-M <ADD-MVEC .SVAR>>
589 <COND (.VAC) (ELSE <SET VAC <GET-AC PREF-VAL T>>)>>
590 <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>
591 <EMIT <COND (<==? .SHFT 2> ,INST-MOVAL)
595 <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
596 (ELSE <MA-REG .VAC>)>>)>
597 <COND (<N==? .RES STACK>
598 <DEST-COUNT-DECL .VAC .CAC .RES <PRIMTYPE .SVAR>>)>>
601 <DEFINE DO-TYPE-CHANGE (TADDR VADDR TYP SHFT "AUX" T1)
602 <COND (.TYP <EMIT ,INST-MOVW <TYPE-CODE .TYP> .TADDR>)
604 <EMIT-MOVE <TYPE-CODE VECTOR> .TADDR WORD>
605 <GEN-COMP-INST .VADDR <MA-REG ,AC-TP> LONG>
606 <SET T1 <MAKE-LABEL>>
607 <GEN-BRANCH ,INST-BGTR .T1 <>>
608 <EMIT-MOVE <TYPE-CODE TUPLE> .TADDR WORD>
609 <EMIT-LABEL .T1 <>>)>>
611 <DEFINE SHIFT-NUM (NUM SHFT)
612 #DECL ((NUM SHFT) FIX)
613 <COND (<0? .SHFT> .NUM)
614 (<==? .SHFT 2> <* .NUM 4>)
617 <DEFINE LIST-LENGTH-GEN (SVAR RES "OPTIONAL" HINT "AUX" VAC CAC SLABEL ELABEL)
618 #DECL ((SVAR) VARTBL (RES) <OR ATOM VARTBL>)
619 <AND <SET VAC <VAR-VALUE-IN-AC? .SVAR>> <PROTECT .VAC>>
620 <SET CAC <GET-AC PREF-VAL T>>
621 <EMIT ,INST-CLRL <MA-REG .CAC>>
623 <SET VAC <LOAD-VAR .SVAR VALUE T PREF-VAL>>
625 <SET SLABEL <MAKE-LABEL>>
626 <SET ELABEL <MAKE-LABEL>>
627 <COND (<N==? .VAC ,STATUS-AC> <EMIT ,INST-TSTL <MA-REG .VAC>>)>
628 <GEN-BRANCH ,INST-BEQL .ELABEL <>>
629 <EMIT-LABEL .SLABEL T>
630 <EMIT ,INST-INCL <MA-REG .CAC>>
631 <EMIT-MOVE <MA-DISP .VAC ,LIST-NEXT-OFFSET> <MA-REG .VAC> LONG>
632 <GEN-BRANCH ,INST-BNEQ .SLABEL <>>
633 <EMIT-LABEL .ELABEL <>>
634 <DEST-DECL .CAC .RES FIX>
638 <DEFINE BLOCK-LENGTH-GEN (SVAR RES "OPTIONAL" HINT HINT2 "AUX" VAC AC LV)
639 #DECL ((SVAR) ANY (RES) <OR ATOM VARTBL>)
640 <COND (<NOT <TYPE? .SVAR VARTBL>>
641 <COND (<==? .RES STACK>
642 <PUSH-CONSTANT <LENGTH .SVAR>>)
644 <SET VAC <GET-AC PREF-VAL T>>
645 <COND (<EMPTY? .SVAR>
646 <EMIT ,INST-CLRL <MA-REG .VAC>>)
648 <EMIT ,INST-MOVL <MA-IMM <LENGTH .SVAR>>
650 <DEST-DECL .VAC .RES FIX>)>)
652 <EMIT-PUSH <TYPE-CODE FIX> LONG>
653 <COND (<AND <SET LV <FIND-CACHE-VAR .SVAR>>
654 <NOT <LINKVAR-COUNT-STORED .LV>>>
655 <SET VAC <LOAD-VAR .SVAR COUNT T PREF-VAL>>
656 <EMIT-PUSH <MA-REG .VAC> LONG>)
659 <ADDR-VAR-COUNT .SVAR> <MA-AINC ,AC-TP>>)>)
661 <COND (<AND <SET LV <FIND-CACHE-VAR .SVAR>>
662 <NOT <LINKVAR-COUNT-STORED .LV>>>
663 <PROTECT <SET VAC <LOAD-VAR .SVAR COUNT T PREF-VAL>>>)
665 <SET VAC <GET-AC PREF-VAL T>>
666 <EMIT ,INST-MOVZWL <ADDR-VAR-COUNT .SVAR>
668 <DEST-DECL .VAC .RES FIX>)>
671 <DEFINE LIST-EMP-GEN (SVAR DIR LABEL "OPTIONAL" HINT "AUX" CC STATUS? VAC LAC)
672 #DECL ((SVAR) VARTBL (DIR LABEL) ATOM)
673 <COND (<NOT <AND <SET VAC <VAR-VALUE-IN-AC? .SVAR>>
674 <==? .VAC ,STATUS-AC>>>
675 <EMIT ,INST-TSTL <VAR-VALUE-ADDRESS .SVAR>>)>
676 <COND (<==? .DIR +> <SET CC ,COND-CODE-EQ>)
677 (ELSE <SET CC ,COND-CODE-NE>)>
678 <GEN-BRANCH <NTH ,BRANCHES <+ .CC 1>> .LABEL <> <>>
682 <DEFINE BLOCK-EMP-GEN (SVAR DIR LABEL "OPTIONAL" HINT)
683 #DECL ((DIR LABEL) ATOM)
684 <COND (<TYPE? .SVAR VARTBL>
685 <ZERO-COUNT-TEST-GEN .SVAR .DIR .LABEL>
687 (<OR <TYPE? .SVAR ATOM> <NOT <EMPTY? .SVAR>>>
689 <GEN-BRANCH ,INST-BBR .LABEL <>>)>)
691 <GEN-BRANCH ,INST-BBR .LABEL <>>)>
694 <DEFINE ZERO-COUNT-TEST-GEN (VAR DIR LABEL
695 "AUX" STATUS? VADDR VAC LVAR (USE-CMP <>))
696 #DECL ((VAR) VARTBL (DIR) ATOM (LABEL) ATOM)
697 <COND (<OR <NOT <SET LVAR <FIND-CACHE-VAR .VAR>>>
698 <LINKVAR-COUNT-STORED .LVAR>>
699 <SET VADDR <VAR-COUNT-ADDRESS .VAR>>)
700 (<SET VAC <LINKVAR-COUNT-AC .LVAR>>
701 <SET VADDR <MA-REG .VAC>>)
702 (<SET VAC <LINKVAR-TYPE-WORD-AC .LVAR>>
703 <SET VADDR <MA-REG .VAC>>
706 <SET VADDR <VAR-COUNT-ADDRESS .VAR>>)>
707 <COND (<NOT <SET STATUS? <STATUS? .VAR COUNT>>>
709 <EMIT ,INST-CMPL .VADDR <MA-IMM *177777*>>)
710 (ELSE <EMIT ,INST-TSTW .VADDR>)>)
711 (ELSE <SET USE-CMP <>>)>
712 <COND (<==? .DIR +> <GEN-BRANCH ,INST-BLEQU .LABEL <>>)
713 (ELSE <GEN-BRANCH ,INST-BGTRU .LABEL <>>)>>
715 <DEFINE PUTREST-GEN (VAL1 VAL2 "AUX" VAC OFF NADDR)
716 #DECL ((VAL1) VARTBL (VAL2) <OR <PRIMTYPE LIST> VARTBL>)
717 <PROTECT <SET VAC <LOAD-VAR .VAL1 VALUE <> PREF-VAL>>>
718 <SET NADDR <MA-DISP .VAC ,LIST-NEXT-OFFSET>>
719 <COND (<TYPE? .VAL2 LIST>
720 <COND (<EMPTY? .VAL2> <EMIT ,INST-CLRL .NADDR>)
722 <SET OFF <ADD-MVEC .VAL2>>
723 <EMIT ,INST-MOVL <ADDR-VALUE-M .OFF> .NADDR>)>)
724 (<EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAL2> .NADDR>)>
728 <DEFINE PUT-LIST-GEN (VAR OFF VAL "OPTIONAL" (HINT <>) "AUX" VAC)
729 #DECL ((VAR) VARTBL (OFF) <OR FIX VARTBL> (VAL) ANY)
730 <COND (.HINT <SET HINT <PARSE-HINT .HINT TYPE>>)>
732 <COND (<==? .OFF 1> <SLOT-CLOBBER .VAR 1 .VAL <> .HINT>)
734 <SET VAC <LIST-REST-CONSTANT-GEN .VAR <- .OFF 1>>>
735 <FINISH-SLOT-CLOBBER .VAC 1 .VAL <> .HINT>)
737 <SET VAC <LIST-REST-VAR-GEN .VAR .OFF NTH>>
738 <FINISH-SLOT-CLOBBER .VAC 1 .VAL <> .HINT>)>
742 <DEFINE SLOT-CLOBBER (VAR OFF VAL UVC HINT "AUX" VAC ROFF)
743 #DECL ((VAR) VARTBL (OFF) FIX (VAL) ANY (UVC) BOOLEAN)
744 <PROTECT <SET VAC <LOAD-VAR .VAR VALUE <> PREF-VAL>>>
745 <FINISH-SLOT-CLOBBER .VAC .OFF .VAL .UVC .HINT>>
747 <DEFINE FINISH-SLOT-CLOBBER (VAC OFF VAL UVC HINT
749 "AUX" DTADDR DVADDR DCADDR ROFF
751 <TUPLE <COND (.INDXAC <MA-INDX .INDXAC>)
752 (ELSE <>)>>) LAC GAC DCL
754 #DECL ((VAC) AC (OFF) FIX (VAL) ANY (UVC) BOOLEAN
755 (INDXAC) <OR AC FALSE> (KLUDGE) TUPLE (LAC GAC) <OR AC FALSE>
756 (LVAR) <OR FALSE LINKVAR>)
757 <COND (.INDXAC <PROTECT .INDXAC>) (ELSE <SET KLUDGE <REST .KLUDGE>>)>
758 <COND (.UVC <SET ROFF <* <- .OFF 1> 4>>)
759 (ELSE <SET ROFF <* <- .OFF 1> 8>>)>
761 <COND (<NOT <TYPE? .VAL VARTBL>>
762 <COND (<SET FX? <FIX-CONSTANT? .VAL>>
767 <MA-DISP .VAC .ROFF>>)
770 ; "Lets us use literal"
773 !.KLUDGE <MA-DISP .VAC .ROFF>>)
775 <EMIT-MOVE <MA-IMM .FX?> <MA-DISP .VAC .ROFF>
781 <MA-DISP .VAC .ROFF>>)>)
784 <COND (<OR <AVAILABLE? .INDXAC>
785 <NOT <SET LAC <FREE-AC?>>>>
787 <EMIT ,INST-ASHL <MA-IMM 1>
791 <EMIT ,INST-ASHL <MA-IMM 1>
793 <MA-REG <SET INDXAC .LAC>>>)>
794 <PUT .KLUDGE 1 <MA-INDX .INDXAC>>)>
796 <EMIT-MOVE <TYPE-WORD <TYPE .VAL>>
803 <MA-DISP .VAC <+ .ROFF 4>>>)
809 <MA-DISP .VAC <+ .ROFF 4>>>)
811 <EMIT-MOVE <MA-IMM .FX?>
812 <MA-DISP .VAC <+ .ROFF 4>>
817 <ADDR-VALUE-MQUOTE .VAL>
819 <MA-DISP .VAC .ROFF>>)
822 <ADDR-TYPE-MQUOTE .VAL>
824 <MA-DISP .VAC .ROFF>>)>)
827 <VAR-VALUE-ADDRESS .VAL>
829 <MA-DISP .VAC .ROFF>>)
831 <SET LVAR <FIND-CACHE-VAR .VAL>>
833 <SET LAC <LINKVAR-TYPE-WORD-AC .LVAR>>
834 <SET GAC <LINKVAR-VALUE-AC .LVAR>>
835 <==? .GAC <NEXT-AC .LAC>>>
840 <MA-DISP .VAC .ROFF>>)
842 <AND <LINKVAR-VALUE-STORED .LVAR>
843 <LINKVAR-TYPE-STORED .LVAR>
845 <NOT <COUNT-NEEDED? .HINT>>>
846 <AND <SET DCL <VARTBL-DECL .VAL>>
847 <NOT <COUNT-NEEDED? .DCL>>>
848 <LINKVAR-COUNT-STORED .LVAR>>>>
851 <ADDR-VAR-TYPE-VALUE .VAL>
853 <MA-DISP .VAC .ROFF>>)
856 <COND (<OR <AVAILABLE? .INDXAC>
857 <NOT <SET LAC <FREE-AC?>>>>
859 <EMIT ,INST-ASHL <MA-IMM 1>
860 <MA-REG .INDXAC> <MA-REG .INDXAC>>)
862 <EMIT ,INST-ASHL <MA-IMM 1>
864 <MA-REG <SET INDXAC .LAC>>>)>
865 <PUT .KLUDGE 1 <MA-INDX .INDXAC>>)>
867 <NOT <COUNT-NEEDED? .HINT>>>)
869 <AND <LINKVAR-TYPE-STORED .LVAR>
870 <OR <AND <SET DCL <VARTBL-DECL .VAL>>
871 <NOT <COUNT-NEEDED? .DCL>>>
872 <LINKVAR-COUNT-STORED .LVAR>>>
873 <LINKVAR-TYPE-WORD-AC .LVAR>>
875 <VAR-TYPE-ADDRESS .VAL TYPEWORD>
877 <MA-DISP .VAC .ROFF>>)
879 <COND (<SET DCL <VARTBL-DECL .VAL>>
880 <COND (<NOT <COUNT-NEEDED? .DCL>>
882 ; "Will do right thing
884 (they really need count)"
888 (<LINKVAR-COUNT-STORED .LVAR>
889 ; "Could be better if could get
890 around indexing stuff"
891 <STORE-TYPE .DCL <ADDR-VAR-TYPE .VAL>>
892 <PUT .LVAR ,LINKVAR-TYPE-STORED
897 <MA-DISP .VAC .ROFF>>)
899 <STORE-TYPE .DCL <ADDR-VAR-TYPE .VAL>>
902 <LINKVAR-COUNT-AC .LVAR>>
903 <ADDR-VAR-COUNT .VAL>>
904 <LINKVAR-COUNT-STORED .LVAR T>
905 <LINKVAR-TYPE-STORED .LVAR T>
909 <MA-DISP .VAC .ROFF>>)>)
911 <COND (<LINKVAR-TYPE-STORED .LVAR>
914 <LINKVAR-COUNT-AC .LVAR>>
915 <ADDR-VAR-COUNT .VAL>>
916 <LINKVAR-COUNT-STORED .LVAR T>)
920 <LINKVAR-TYPE-AC .LVAR>>
921 <ADDR-VAR-TYPE .VAL>>
922 <LINKVAR-TYPE-STORED .LVAR T>)>
926 <MA-DISP .VAC .ROFF>>)>)>
929 <VAR-VALUE-ADDRESS .VAL>
931 <MA-DISP .VAC <+ .ROFF 4>>>)>)>)>
934 <DEFINE PUT-VEC-GEN (VAR OFF VAL "OPTIONAL" (HINT <>) (UVC <>))
935 #DECL ((VAR) VARTBL (OFF) <OR FIX VARTBL> (VAL) ANY)
936 <AND .HINT <SET HINT <PARSE-HINT .HINT TYPE>>>
938 <COND (<TYPE? .OFF FIX>
939 <SLOT-CLOBBER .VAR .OFF .VAL .UVC .HINT>)
941 <VAR-SLOT-CLOBBER .VAR .OFF .VAL .UVC .HINT>)>
945 <DEFINE PROTECT-VAL (VAL "AUX" LV)
946 #DECL ((VAL) ANY (LV) <OR FALSE LINKVAR>)
947 <COND (<AND <TYPE? .VAL VARTBL>
948 <SET LV <FIND-CACHE-VAR .VAL>>>
949 ; "Protect ACs for value, so don't clobber it when loading
951 <COND (<LINKVAR-VALUE-AC .LV>
952 <PROTECT <LINKVAR-VALUE-AC .LV>>)>
953 <COND (<LINKVAR-TYPE-WORD-AC .LV>
954 <PROTECT <LINKVAR-TYPE-WORD-AC .LV>>)>
955 <COND (<LINKVAR-TYPE-AC .LV>
956 <PROTECT <LINKVAR-TYPE-AC .LV>>)>
957 <COND (<LINKVAR-COUNT-AC .LV>
958 <PROTECT <LINKVAR-COUNT-AC .LV>>)>)>>
960 <DEFINE VAR-SLOT-CLOBBER (VAR OFF VAL UVC HINT "AUX" VAC NAC)
961 #DECL ((VAR) VARTBL (OFF) VARTBL (VAL) ANY (UVC) BOOLEAN)
963 <PROTECT-USE <SET NAC <LOAD-VAR .OFF VALUE <> PREF-VAL>>>
964 <PROTECT-USE <SET VAC <LOAD-VAR .VAR VALUE <> PREF-VAL>>>
965 <FINISH-SLOT-CLOBBER .VAC 0 .VAL .UVC .HINT .NAC>
968 <DEFINE NTH-STRING-GEN (S N R "OPTIONAL" (H <>))
969 <COND (<NTH-LOOK-AHEAD NTHUS!-MIMOP .S .N .R .H>)
971 <NTH-STRING-GEN-1 .S .N .R CHARACTER>)>>
973 <DEFINE NTH-BYTE-GEN (S N R "OPTIONAL" (H <>))
974 <COND (<NTH-LOOK-AHEAD NTHUB!-MIMOP .S .N .R .H>)
975 (T <NTH-STRING-GEN-1 .S .N .R FIX>)>>
977 <DEFINE NTH-STRING-GEN-1 (SVAR NUM RES TYP "AUX" VAC RVAC ACN NAC)
978 #DECL ((SVAR) <OR VARTBL STRING BYTES> (NUM) <OR VARTBL FIX>)
979 <COND (<TYPE? .SVAR VARTBL>
980 <SET VAC <LOAD-VAR .SVAR VALUE <> PREF-VAL>>)
982 <SET VAC <GET-AC PREF-VAL T>>
983 <MOVE-VALUE .SVAR .VAC>)>
985 <SET RVAC <GET-AC PREF-VAL T>>
987 <COND (<TYPE? .NUM FIX>
989 <MA-DISP .VAC <- .NUM 1>>
992 <PROTECT-USE <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>>
993 <EMIT ,INST-MOVZBL <MA-INDX .NAC>
994 <MA-DISP .VAC -1> <MA-REG .RVAC>>)>
995 <DEST-DECL .RVAC .RES .TYP>
998 <DEFINE PUT-STRING-GEN (SVAR NUM VAL "OPTIONAL" (INS PUTUS!-MIMOP)
999 "AUX" VAC CADDR CVAC DADDR NAC)
1000 #DECL ((SVAR) VARTBL (NUM) <OR VARTBL FIX> (VAL) <OR VARTBL
1004 <SET VAC <LOAD-VAR .SVAR VALUE <> PREF-VAL>>
1006 <COND (<TYPE? .VAL CHARACTER> <SET CADDR <MA-IMM <ASCII .VAL>>>)
1007 (<TYPE? .VAL FIX> <SET CADDR <MA-IMM .VAL>>)
1009 <COND (<SET CVAC <VAR-VALUE-IN-AC? .VAL>>
1011 <SET CADDR <MA-REG .CVAC>>)
1013 <SET CADDR <ADDR-VAR-CHAR-VALUE .VAL>>)>)>
1014 <COND (<TYPE? .NUM FIX>
1015 <SET DADDR <MA-DISP .VAC <- .NUM 1>>>
1016 <EMIT ,INST-MOVB .CADDR .DADDR>)
1018 <PROTECT-USE <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>>
1019 <SET DADDR <MA-DISP .VAC -1>>
1020 <EMIT ,INST-MOVB .CADDR <MA-INDX .NAC> .DADDR>)>
1023 <DEFINE PUT-BYTE-GEN (SVAR OFF VAL)
1024 <PUT-STRING-GEN .SVAR .OFF .VAL PUTUB!-MIMOP>>
1026 <DEFINE NTH-UVECTOR-GEN NUG (UVAR NUM RES
1027 "OPTIONAL" (HINT <>)
1028 "AUX" TYP VAC TAC CADDR RVAC (NAC <>) VAL)
1029 #DECL ((UVAR) <OR VARTBL UVECTOR> (NUM) <OR VARTBL FIX>
1030 (RES) <OR VARTBL ATOM> (HINT) <OR FALSE HINT>)
1031 <COND (<TYPE? .UVAR UVECTOR> <SET TYP FIX> ;<SET TYP <UTYPE .UVAR>>)
1032 (.HINT <SET TYP <PARSE-HINT .HINT TYPE>>)
1033 (ELSE <SET TYP FIX>)>
1034 <COND (<SET VAL <NTH-LOOK-AHEAD NTHUU!-MIMOP .UVAR .NUM .RES .TYP>>
1035 <RETURN .VAL .NUG>)>
1036 <COND (<TYPE? .NUM FIX>
1037 <COND (<TYPE? .UVAR VARTBL>
1038 <SET VAC <LOAD-VAR .UVAR VALUE <> PREF-VAL>>)
1040 <SET VAC <GET-AC PREF-VAL T>>
1041 <MOVE-VALUE .UVAR .VAC>)>
1042 <PROTECT-USE .VAC>)>
1045 <PROTECT-USE <SET TAC <LOAD-VAR .UVAR COUNT <> DATA>>>
1046 <EMIT-SHIFT ,INST-ASHL 2 .TAC LONG>
1047 <ADD-TO-AC .TAC <VAR-VALUE-ADDRESS .UVAR>>
1048 <COND (<==? .RES STACK>
1049 <EMIT-PUSH <MA-DISP .TAC 0> WORD>
1051 (<MOVE-TO-AC .TAC <MA-DISP .TAC 4> WORD>)>)>
1052 <COND (<TYPE? .RES VARTBL>
1053 <PROTECT <SET RVAC <GET-AC PREF-VAL T>>>)>
1054 <COND (<TYPE? .NUM FIX>
1055 <SET CADDR <MA-DISP .VAC <* <- .NUM 1> 4>>>)
1057 <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>
1059 <COND (<TYPE? .UVAR VARTBL>
1060 <SET VAC <LOAD-VAR .UVAR VALUE <> PREF-VAL>>)
1062 <SET VAC <GET-AC PREF-VAL T>>
1063 <MOVE-VALUE .UVAR <MA-REG .VAC>>)>
1065 <SET CADDR <MA-DISP .VAC -4>>)>
1066 <COND (<==? .RES STACK>
1067 <COND (.TYP <EMIT-PUSH <TYPE-WORD .TYP> LONG>)>
1069 <EMIT ,INST-MOVL <MA-INDX .NAC> .CADDR
1072 <EMIT ,INST-MOVL .CADDR <MA-AINC ,AC-TP>>)>)
1075 <EMIT ,INST-MOVL <MA-INDX .NAC> .CADDR
1078 <EMIT ,INST-MOVL .CADDR <MA-REG .RVAC>>)>
1079 <COND (.TYP <DEST-DECL .RVAC .RES .TYP>)
1080 (ELSE <DEST-TYPE-VALUE .RVAC .TAC .RES>)>)>
1083 <DEFINE PUT-UVECTOR-GEN (VAR OFF VAL "OPTIONAL" (HINT <>))
1084 #DECL ((VAR) VARTBL (OFF) <OR FIX VARTBL> (VAL) ANY)
1085 <PUT-VEC-GEN .VAR .OFF .VAL .HINT T>>
1087 <DEFINE BACKU-GEN (STR NUM RES "OPTIONAL" (HINT <>))
1088 <CALL-RTE ,IBACKU!-MIMOP CALL .RES .HINT .STR .NUM>
1091 <DEFINE TOPU-GEN (STR RES "OPTIONAL" (HINT <>))
1092 <CALL-RTE ,ITOPU!-MIMOP CALL .RES .HINT .STR>
1095 <SETG SAVES <IVECTOR 3 <>>>
1097 <DEFINE MOVE-WORDS-GEN (FROM TO CT "TUPLE" HINTS "AUX" (TYPE <>) SHIFT)
1100 <COND (<SET TYPE <PARSE-HINT .H TYPE>>
1104 <COND (<==? .TYPE VECTOR> <SET SHIFT 3>)
1106 <DO-BLT .FROM .TO .CT .SHIFT>)
1108 <ERROR BAD-HINT!-ERRORS .HINTS MOVE-WORDS-GEN>)>>
1110 <DEFINE MOVE-STRING-GEN (FROM TO CT "OPTIONAL" (HINT <>))
1111 <DO-BLT .FROM .TO .CT 0>>
1113 <DEFINE DO-BLT (FROM TO CT SHIFT
1114 "AUX" (SAVES ,SAVES) TAC)
1115 #DECL ((SAVES) VECTOR)
1116 <COND (<AND <TYPE? .FROM VARTBL>
1117 <SET TAC <VAR-VALUE-IN-AC? .FROM>>>
1118 ; "If this guy is in AC, save everything, but remember that
1124 <COND (<AND <TYPE? .TO VARTBL>
1125 <SET TAC <VAR-VALUE-IN-AC? .TO>>>
1131 <COND (<NOT <TYPE? .CT VARTBL>>
1132 <SET CT <LSH .CT .SHIFT>>)
1134 <COND (<G? .SHIFT 0>
1135 <SET TAC <LOAD-VAR .CT VALUE T PREF-VAL>>
1137 <EMIT ,INST-ASHL <MA-IMM .SHIFT> <MA-REG .TAC> <MA-REG .TAC>>
1139 (<SET TAC <VAR-VALUE-IN-AC? .CT>>
1145 ; "Now clobber all the ACs that don't have our arguments"
1146 <COND (<NOT <MEMQ ,AC-0 .SAVES>> <MUNG-AC ,AC-0>)>
1147 <COND (<NOT <MEMQ ,AC-1 .SAVES>> <MUNG-AC ,AC-1>)>
1148 <COND (<NOT <MEMQ ,AC-2 .SAVES>> <MUNG-AC ,AC-2>)>
1149 <COND (<NOT <MEMQ ,AC-3 .SAVES>> <MUNG-AC ,AC-3>)>
1150 <COND (<NOT <MEMQ ,AC-4 .SAVES>> <MUNG-AC ,AC-4>)>
1151 <COND (<NOT <MEMQ ,AC-5 .SAVES>> <MUNG-AC ,AC-5>)>
1153 <COND (<TYPE? .CT VARTBL>
1154 <COND (<3 .SAVES> <MA-REG <3 .SAVES>>)
1155 (<VAR-VALUE-ADDRESS .CT>)>)
1158 <COND (<TYPE? .FROM VARTBL>
1159 <COND (<1 .SAVES> <MA-REGD <1 .SAVES>>)
1161 <GEN-LOC .FROM 4 T>)>)
1163 <MA-DEF-DISP ,AC-M <+ <ADD-MVEC .FROM> 4>>)>
1164 <COND (<TYPE? .TO VARTBL>
1165 <COND (<2 .SAVES> <MA-REGD <2 .SAVES>>)
1167 <GEN-LOC .TO 4 T>)>)
1169 <MA-DEF-DISP ,AC-M <+ <ADD-MVEC .TO> 4>>)>>
1170 ; "Clobber acs that had our arguments"
1173 <COND (<AND .X <L=? <AC-NUMBER .X> 5>>
1178 <DEFINE STRING-EQUAL?-GEN (STR1 STR2 DIR LABEL "AUX" ELABEL
1179 (SAVES ,SAVES) TAC LV)
1180 #DECL ((DIR LABEL) ATOM (SAVES) VECTOR)
1181 <COND (<AND <NOT <TYPE? .STR1 VARTBL>>
1182 <NOT <TYPE? .STR2 VARTBL>>>
1183 ; "Handle constants, just for fun"
1185 <COND (<N=? .STR1 .STR2>
1186 <UCBRANCH-GEN .DIR .LABEL>)>)
1188 <UCBRANCH-GEN .DIR .LABEL>)>
1189 UNCONDITIONAL-BRANCH)
1191 ; "First, make sure lengths are equal"
1192 <COND (<AND <TYPE? .STR1 VARTBL> <SET TAC <VAR-TYPE-WORD-IN-AC? .STR1>>>
1193 <STORE-AC .TAC T <SET LV <FIND-CACHE-VAR .STR1>>>
1194 <STORE-AC .TAC <>>)>
1195 <COND (<AND <TYPE? .STR2 VARTBL> <SET TAC <VAR-TYPE-WORD-IN-AC? .STR2>>>
1196 <STORE-AC .TAC T <SET LV <FIND-CACHE-VAR .STR2>>>
1197 <STORE-AC .TAC <>>)>
1199 <COND (<TYPE? .STR1 VARTBL> <VAR-COUNT-ADDRESS .STR1>)
1200 (T <MA-IMM <LENGTH .STR1>>)>
1201 <COND (<TYPE? .STR2 VARTBL> <VAR-COUNT-ADDRESS .STR2>)
1202 (T <MA-IMM <LENGTH .STR2>>)>>
1203 <SET ELABEL <MAKE-LABEL>>
1205 ; "Jump if different lengths, since that's all we need."
1206 <GEN-BRANCH ,INST-BNEQ .LABEL <> <> <> T>)
1208 ; "Jump to failure location"
1209 <GEN-BRANCH ,INST-BNEQ .ELABEL <> <> <> T>)>
1211 ; "Try to get an AC with length"
1212 <COND (<TYPE? .STR1 VARTBL>
1213 <COND (<SET TAC <VAR-COUNT-IN-AC? .STR1>>
1216 <COND (<AND <NOT <1 .SAVES>>
1217 <TYPE? .STR2 VARTBL>>
1218 <COND (<SET TAC <VAR-COUNT-IN-AC? .STR2>>
1221 ; "Try to get AC with 1st string pointer"
1222 <COND (<AND <TYPE? .STR1 VARTBL>
1223 <SET TAC <VAR-VALUE-IN-AC? .STR1>>>
1227 ; "2nd string pointer"
1228 <COND (<AND <TYPE? .STR2 VARTBL>
1229 <SET TAC <VAR-VALUE-IN-AC? .STR2>>>
1233 ; "Make sure nothing left in these acs"
1234 <COND (<NOT <MEMQ ,AC-0 .SAVES>> <MUNG-AC ,AC-0>)
1236 <COND (<NOT <MEMQ ,AC-1 .SAVES>> <MUNG-AC ,AC-1>)
1238 <COND (<NOT <MEMQ ,AC-2 .SAVES>> <MUNG-AC ,AC-2>)
1240 <COND (<NOT <MEMQ ,AC-3 .SAVES>> <MUNG-AC ,AC-3>)
1245 <COND (<1 .SAVES> <MA-REG <1 .SAVES>>)
1246 (<NOT <TYPE? .STR1 VARTBL>>
1247 <MA-IMM <LENGTH .STR1>>)
1248 (<NOT <TYPE? .STR2 VARTBL>>
1249 <MA-IMM <LENGTH .STR2>>)
1251 <VAR-COUNT-ADDRESS .STR1>)>
1253 <COND (<2 .SAVES> <MA-REGD <2 .SAVES>>)
1254 (<TYPE? .STR1 VARTBL>
1255 <GEN-LOC .STR1 4 T>)
1257 <MA-DEF-DISP ,AC-M <+ <ADD-MVEC .STR1> 4>>)>
1259 <COND (<3 .SAVES> <MA-REGD <3 .SAVES>>)
1260 (<TYPE? .STR2 VARTBL>
1261 <GEN-LOC .STR2 4 T>)
1263 <MA-DEF-DISP ,AC-M <+ <ADD-MVEC .STR2> 4>>)>>
1264 ; "Clobber the acs we munged"
1269 ; "And jump to the right place"
1271 <GEN-BRANCH ,INST-BNEQ .LABEL <>>)
1273 <GEN-BRANCH ,INST-BEQL .LABEL <>>)>
1274 ; "Will jump here if lengths not equal and dir +"
1275 <EMIT-LABEL .ELABEL <>>
1276 CONDITIONAL-BRANCH)>>
1278 <DEFINE STRCOMP-GEN (STR1 STR2 RES "AUX" TAC LVAR
1280 <COND (<AND <NOT <TYPE? .STR1 VARTBL>>
1281 <NOT <TYPE? .STR2 VARTBL>>>
1282 <COND (<TYPE? .RES ATOM>
1283 <PUSH-CONSTANT <STRCOMP .STR1 .STR2>>)
1285 <SET-GEN .RES <STRCOMP .STR1 .STR2>>)>)
1292 <EMIT-MOVE <MA-IMM 0> <MA-REG ,AC-4> LONG>
1293 <COND (<NOT <TYPE? .STR1 VARTBL>>
1294 <SET LVAR <MA-IMM <LENGTH .STR1>>>)
1295 (<SET TAC <VAR-COUNT-IN-AC? .STR1>>
1296 <SET LVAR <MA-REG .TAC>>)
1298 <COND (<SET TAC <VAR-TYPE-WORD-IN-AC? .STR1>>
1299 <STORE-AC .TAC T <SET LV <FIND-CACHE-VAR .STR1>>>
1300 <STORE-AC .TAC <>>)>
1301 <SET LVAR <VAR-COUNT-ADDRESS .STR1>>)>
1302 <EMIT-MOVE .LVAR <MA-REG ,AC-3> LONG>
1305 <COND (<NOT <TYPE? .STR2 VARTBL>>
1306 <MA-IMM <LENGTH .STR2>>)
1307 (<SET TAC <VAR-COUNT-IN-AC? .STR2>>
1310 <COND (<SET TAC <VAR-TYPE-WORD-IN-AC? .STR2>>
1311 <STORE-AC .TAC T <FIND-CACHE-VAR .STR1>>
1312 <STORE-AC .TAC <>>)>
1313 <VAR-COUNT-ADDRESS .STR2>)>>
1314 <SET LAB1 <MAKE-LABEL>>
1315 <SET LAB2 <MAKE-LABEL>>
1316 <GEN-BRANCH ,INST-BEQL .LAB1 <> <> <> T>
1317 <GEN-BRANCH ,INST-BLSS .LAB2 <> <> <> T>
1318 ; "First is longer than second, so bias toward returning 1"
1319 <EMIT-MOVE <MA-IMM 1> <MA-REG ,AC-4> LONG>
1320 ; "Get right length into ac-3"
1321 <EMIT-MOVE <COND (<TYPE? .STR2 VARTBL>
1322 <VAR-COUNT-ADDRESS .STR2>)
1324 <MA-IMM <LENGTH .STR2>>)>
1325 <MA-REG ,AC-3> LONG>
1326 <GEN-BRANCH ,INST-BRB .LAB1 UNCONDITIONAL-BRANCH <> <> T>
1327 <EMIT-LABEL .LAB2 <>>
1328 ; "First is shorter"
1329 <EMIT-MOVE <MA-IMM -1> <MA-REG ,AC-4> LONG>
1330 <EMIT-LABEL .LAB1 <>>
1333 <COND (<TYPE? .STR1 VARTBL>
1334 <COND (<SET TAC <VAR-VALUE-IN-AC? .STR1>>
1337 <GEN-LOC .STR1 4 T>)>)
1338 (<MA-DEF-DISP ,AC-M <+ <ADD-MVEC .STR1> 4>>)>
1339 <COND (<TYPE? .STR2 VARTBL>
1340 <COND (<SET TAC <VAR-VALUE-IN-AC? .STR2>>
1343 <GEN-LOC .STR2 4 T>)>)
1344 (<MA-DEF-DISP ,AC-M <+ <ADD-MVEC .STR2> 4>>)>>
1345 <SET LAB1 <MAKE-LABEL>>
1346 <SET LAB2 <MAKE-LABEL>>
1347 ; "Just return what's in AC-4"
1348 <GEN-BRANCH ,INST-BEQL .LAB1 <> <> <> T>
1349 <GEN-BRANCH ,INST-BLSS .LAB2 <> <> <> T>
1350 <EMIT-MOVE <MA-IMM 1> <MA-REG ,AC-4> LONG>
1351 <GEN-BRANCH ,INST-BRB .LAB1 UNCONDITIONAL-BRANCH <> <> T>
1352 <EMIT-LABEL .LAB2 <>>
1353 <EMIT-MOVE <MA-IMM -1> <MA-REG ,AC-4> LONG>
1354 <EMIT-LABEL .LAB1 <>>
1355 <COND (<==? .RES STACK>
1356 <EMIT-PUSH <TYPE-WORD FIX> LONG>
1357 <EMIT-PUSH <MA-REG ,AC-4> LONG>)
1359 <DEST-DECL ,AC-4 .RES FIX>)>)>