10 <MSETG SHORT-MARK-BIT <CHTYPE <LSH 1 7> FIX>>
12 <MSETG MARK-BIT <CHTYPE <LSH 1 15> FIX>>
14 <MSETG DOPE-BIT <CHTYPE <LSH 1 5> FIX>>
24 <MA-DISP ,AC-TP <* .NUM -4>>>
26 <DEFINE CGC-RECORD-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM BOUNDS-ATOM RES
27 "OPTIONAL" (HINT <>) "AUX" RLEN STK? ALLOCADDR ENDADDR
28 (BOUNDS-LAB <MAKE-LABEL>) (IB-LAB <MAKE-LABEL>)
29 (F-LAB <MAKE-LABEL>) (EXIT-LAB <MAKE-LABEL>)
32 <SET HINT <PARSE-HINT .HINT RECORD-TYPE>>)>
33 <COND (<==? .HINT ATOM>
43 <ERROR BAD-HINT-FOR-CGC-RECORD!-ERRORS .HINT CGC-RECORD-GEN>)>
45 <FUNCTION (X) <MUNG-AC ,.X>>
46 '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
47 <SET ENDADDR <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
49 <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
51 <EMIT ,INST-CMPL <MA-REG ,AC-TP> <VAR-VALUE-ADDRESS .VAR>>
52 ; "See if this guy is on the stack"
53 <EMIT-BRANCH ,INST-BLSS .BOUNDS-LAB <> ,LAST-INST-LENGTH>
54 <EMIT ,INST-MOVQ <MA-DISP ,AC-M <ADD-MVEC <>>> <MA-REG ,AC-0>>
55 <EMIT-BRANCH ,INST-BRB .EXIT-LAB <> ,LAST-INST-LENGTH>
56 <EMIT-LABEL .BOUNDS-LAB T>
57 <FRAME-GEN .BOUNDS-ATOM>
58 <EMIT ,INST-MOVQ <VAR-TYPE-ADDRESS .VAR> <MA-AINC ,AC-TP>>
59 <CALL-GEN .BOUNDS-ATOM 1>
60 <EMIT ,INST-TSTL <MA-REG ,AC-1>>
61 <EMIT-BRANCH ,INST-BNEQ .IB-LAB <> ,LAST-INST-LENGTH>
62 <EMIT ,INST-MOVL <TYPE-WORD FIX> <MA-REG ,AC-0>>
63 <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
64 <EMIT-BRANCH ,INST-BRB .EXIT-LAB <> ,LAST-INST-LENGTH>
65 <EMIT-LABEL .IB-LAB T>)>
66 <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
67 <EMIT ,INST-TSTB <MA-DISP ,AC-1 <+ .RLEN 1>>>
68 <EMIT-BRANCH ,INST-BGEQ .M-LAB <> ,LAST-INST-LENGTH>
69 <EMIT ,INST-MOVL <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
70 <EMIT ,INST-MOVL <MA-DISP ,AC-1 <+ .RLEN 4>> <MA-REG ,AC-1>>
71 <EMIT-BRANCH ,INST-BRB .EXIT-LAB <> ,LAST-INST-LENGTH>
72 ; "Jump if already marked"
74 <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-1 <+ .RLEN 1>>>
75 <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>>
76 <EMIT ,INST-ADDL3 <MA-IMM <+ .RLEN 8>> <MA-REG ,AC-3> <MA-REG ,AC-6>>
77 <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
78 <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
79 <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
80 <FRAME-GEN .NEXT-ATOM>
81 <EMIT-PUSH <TYPE-WORD FIX> LONG>
82 <EMIT ,INST-MOVL <MA-IMM <+ .RLEN 8>> <MA-AINC ,AC-TP>>
83 <CALL-GEN .NEXT-ATOM 1>
84 <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
85 <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>>
86 <EMIT ,INST-ADDL3 <MA-IMM <+ .RLEN 8>> <MA-REG ,AC-3> <MA-REG ,AC-6>>
88 <EMIT ,INST-MOVL <MA-REG ,AC-3> <MA-DISP ,AC-1 <+ .RLEN 4>>>
89 <EMIT ,INST-MOVL <TYPE-CODE FIX> <MA-REG ,AC-5>>
90 <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR>
91 <EMIT ,INST-MOVQ <MA-DISP ,AC-1 .RLEN> <MA-DISP ,AC-3 .RLEN>>
92 <EMIT ,INST-BICB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 <+ .RLEN 1>>>
93 <EMIT ,INST-MOVL <MA-REG ,AC-3> <MA-REG ,AC-1>>
94 <EMIT ,INST-MOVL <TYPE-WORD FIX> <MA-REG ,AC-0>>
95 <EMIT-LABEL .EXIT-LAB T>
96 <COND (<==? .RES STACK>
97 <EMIT ,INST-MOVQ <MA-REG ,AC-0><MA-AINC ,AC-TP>>)
99 <DEST-PAIR ,AC-1 ,AC-0 .RES>)>
102 <DEFINE CGC-STBYTE-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM RES)
104 <FUNCTION (X) <MUNG-AC ,.X>>
105 '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
106 <EMIT ,INST-MOVZWL <VAR-COUNT-ADDRESS .VAR> <MA-REG ,AC-0>>
107 <EMIT ,INST-ADDL3 <MA-REG ,AC-0> <VAR-VALUE-ADDRESS .VAR>
109 <EMIT ,INST-ADDL2 <MA-IMM 3> <MA-REG ,AC-1>>
110 <EMIT ,INST-BICB2 <MA-IMM 3> <MA-REG ,AC-1>>
111 ; "Actual dope word pointer"
112 <EMIT ,INST-SUBL3 <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1> <MA-REG ,AC-0>>
113 ; "Number of bytes including slop in last word"
114 <CGC-UV-ST .VAR .ALLOC-ATOM .END-ATOM .NEXT-ATOM .RES>>
116 <DEFINE CGC-UVECTOR-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM RES)
118 <FUNCTION (X) <MUNG-AC ,.X>>
119 '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
120 <EMIT ,INST-MOVZWL <VAR-COUNT-ADDRESS .VAR> <MA-REG ,AC-0>>
121 <EMIT ,INST-ASHL <MA-IMM 2> <MA-REG ,AC-0> <MA-REG ,AC-0>>
122 <EMIT ,INST-ADDL3 <MA-REG ,AC-0> <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
123 <CGC-UV-ST .VAR .ALLOC-ATOM .END-ATOM .NEXT-ATOM .RES>>
125 ; "Call this guy with ac-0 set up to have number of bytes to subtract from
126 dope word pointer to get new pointer; ac-1 has pointer to dope word. 0-6
128 <DEFINE CGC-UV-ST (VAR ALLOC-ATOM END-ATOM NEXT-ATOM RES
129 "AUX" ENDADDR ALLOCADDR (M-LAB <MAKE-LABEL>)
130 (BLT-LOOP <MAKE-LABEL>) (NF-LAB <MAKE-LABEL>)
131 (F-LAB <MAKE-LABEL>) (SHT-LAB <MAKE-LABEL>)
132 (DONE-LAB <MAKE-LABEL>))
133 #DECL ((VAR) VARTBL (ALLOC-ATOM END-ATOM NEXT-ATOM) ATOM
134 (RES) <OR VARTBL ATOM>)
135 <SET ENDADDR <MA-DEF-DISP ,AC-M
136 <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
138 <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
139 ;"Pointers to GVAL slots for AL and END-SPACE"
140 <EMIT ,INST-TSTB <MA-DISP ,AC-1 1>>
141 <EMIT-BRANCH ,INST-BLSS .M-LAB <> ,LAST-INST-LENGTH>
142 <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-1 1>>
143 ;"can be BBSS when assembler and friends hacked"
144 <EMIT ,INST-PUSHL <MA-REG ,AC-0>> ;"Save for making new pointer"
145 <EMIT ,INST-MOVZWL <MA-DISP ,AC-1 2> <MA-REG ,AC-6>>
146 ;"Size of whole structure"
147 <EMIT ,INST-ASHL <MA-IMM 2> <MA-REG ,AC-6> <MA-REG ,AC-6>> ;"in bytes"
148 <EMIT ,INST-PUSHL <MA-REG ,AC-6>>
149 <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>> ;"Current allocation"
150 <EMIT ,INST-ADDL2 <MA-REG ,AC-3> <MA-REG ,AC-6>>
151 <EMIT-BRANCH ,INST-BVS .NF-LAB <> ,LAST-INST-LENGTH>
152 ;"See if overflowed--won't fit"
153 <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
154 <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
155 ;"See if won't fit in current area"
156 <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
157 <EMIT-LABEL .NF-LAB T>
158 <FRAME-GEN .NEXT-ATOM>
159 <EMIT-PUSH <TYPE-WORD FIX> LONG>
160 <EMIT ,INST-MOVL <MA-REGD ,AC-P> <MA-AINC ,AC-TP>>
161 <EMIT ,INST-PUSHL <MA-REG ,AC-1>>
162 <CALL-GEN .NEXT-ATOM 1> ;"Go to another area"
163 <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>> ;"get AL back"
164 <EMIT ,INST-MOVL <MA-AINC ,AC-P> <MA-REG ,AC-1>>
165 <EMIT ,INST-MOVL <MA-REGD ,AC-P> <MA-REG ,AC-6>>
166 ;"get stuff back from stack"
167 <EMIT ,INST-ADDL2 <MA-REG ,AC-3> <MA-REG ,AC-6>> ;"compute new AL"
168 <EMIT-LABEL .F-LAB T>
169 <EMIT ,INST-MOVAL <MA-DISP ,AC-6 -8> <MA-DISP ,AC-1 4>>
170 ;"stuff relocation into dope word
171 now points to 1st dw"
172 <EMIT ,INST-MOVL <TYPE-CODE FIX> <MA-REG ,AC-5>>
173 <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR> ;"update AL"
174 <EMIT ,INST-MOVL <MA-AINC ,AC-P> <MA-REG ,AC-6>>
175 ;"Get gross byte count back"
176 <EMIT ,INST-SUBL2 <MA-REG ,AC-6> <MA-REG ,AC-1>> ;"Top old structure"
177 <EMIT ,INST-ADDL2 <MA-IMM 8> <MA-REG ,AC-1>>
178 <EMIT-LABEL .BLT-LOOP T>
179 <EMIT ,INST-MOVL <MA-REG ,AC-6> <MA-REG ,AC-5>>
180 <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-IMM 65535>>
181 <GEN-BRANCH ,INST-BLSS .SHT-LAB <>>
182 <EMIT ,INST-MOVL <MA-IMM 65535> <MA-REG ,AC-5>>
183 <EMIT-LABEL .SHT-LAB T>
184 <EMIT ,INST-MOVC3 <MA-REG ,AC-5> <MA-REGD ,AC-1> <MA-REGD ,AC-3>>
185 <EMIT ,INST-SUBL2 <MA-IMM 65535> <MA-REG ,AC-6>>
186 <GEN-BRANCH ,INST-BGTR .BLT-LOOP <>>
187 <EMIT ,INST-BICB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 -7>>
189 <EMIT ,INST-SUBL3 <MA-IMM 8> <MA-REG ,AC-3> <MA-REG ,AC-1>>
190 <EMIT ,INST-SUBL2 <MA-AINC ,AC-P> <MA-REG ,AC-1>>
191 <GEN-BRANCH ,INST-BRB .DONE-LAB <>>
192 <EMIT-LABEL .M-LAB T>
193 <EMIT ,INST-MOVL <MA-DISP ,AC-1 4> <MA-REG ,AC-1>>
195 <EMIT ,INST-SUBL2 <MA-REG ,AC-0> <MA-REG ,AC-1>>
196 <EMIT-LABEL .DONE-LAB T>
197 <COND (<==? .RES STACK>
198 <EMIT-PUSH <VAR-TYPE-ADDRESS .VAR> LONG>
199 <EMIT-PUSH ,AC-1 LONG>)
201 <EMIT ,INST-MOVL <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
202 <DEST-PAIR ,AC-1 ,AC-0 .RES>)>
205 <DEFINE CGC-VECTOR-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM MARK-ATOM RES
206 "AUX" ENDADDR ALLOCADDR (NF-LAB <MAKE-LABEL>)
207 (F-LAB <MAKE-LABEL>) (LOOP-LAB <MAKE-LABEL>)
208 (NM-LAB <MAKE-LABEL>) (DONE-LAB <MAKE-LABEL>)
209 (M-LAB <MAKE-LABEL>))
210 <SET ENDADDR <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
212 <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
214 <FUNCTION (X) <MUNG-AC ,.X>>
215 '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
216 <EMIT ,INST-ADDL2 <MA-IMM <* 5 4>> <MA-REG ,AC-TP>>
218 <EMIT ,INST-MOVZWL <VAR-COUNT-ADDRESS .VAR> <MA-REG ,AC-2>>
219 <EMIT ,INST-ASHL <MA-IMM 3> <MA-REG ,AC-2> <MA-REG ,AC-2>>
220 <EMIT ,INST-MOVL <MA-REG ,AC-2> <GCTEMP 5>>
221 <EMIT ,INST-ADDL3 <MA-REG ,AC-2> <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-3>>
222 ; "2 has # of bytes in current pointer; 3 points to first dw"
223 <EMIT ,INST-TSTB <MA-DISP ,AC-3 1>>
224 <EMIT-BRANCH ,INST-BLSS .M-LAB <> ,LAST-INST-LENGTH>
225 ; "jump if already marked"
226 <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 1>>
227 <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 1>>
228 <EMIT ,INST-MOVZWL <MA-DISP ,AC-3 2> <MA-REG ,AC-6>>
229 ; "# of words in whole structure"
230 <EMIT ,INST-ASHL <MA-IMM 2> <MA-REG ,AC-6> <MA-REG ,AC-6>>
231 ; "Bytes in structure"
232 <EMIT ,INST-MOVL <MA-REG ,AC-6> <GCTEMP 2>>
233 <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
234 <EMIT ,INST-ADDL2 <MA-REG ,AC-1> <MA-REG ,AC-6>>
235 <EMIT-BRANCH ,INST-BVS .NF-LAB <> ,LAST-INST-LENGTH>
236 <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
237 <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
238 <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
239 <EMIT-LABEL .NF-LAB T>
240 <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 3>>
241 <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
242 <FRAME-GEN .NEXT-ATOM>
243 <EMIT-PUSH <TYPE-WORD FIX> LONG>
244 <EMIT ,INST-MOVL <MA-REG ,AC-3> <MA-AINC ,AC-TP>>
245 <CALL-GEN .NEXT-ATOM 1>
246 <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
247 <EMIT ,INST-MOVL <GCTEMP 3> <MA-REG ,AC-3>>
248 <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-6>>
249 <EMIT ,INST-ADDL2 <MA-REG ,AC-1> <MA-REG ,AC-6>>
251 <EMIT-LABEL .F-LAB T>
252 <EMIT ,INST-MOVAL <MA-DISP ,AC-6 -8> <MA-DISP ,AC-3 4>>
253 ; "Stuff pointer to new dw into old"
254 <EMIT ,INST-MOVQ <MA-REGD ,AC-3> <MA-DISP ,AC-6 -8>>
256 <EMIT ,INST-BICB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-6 -7>>
257 ; "Clear mark bit in new"
258 <EMIT ,INST-MOVL <TYPE-CODE FIX> <MA-REG ,AC-5>>
259 <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR>
260 <EMIT ,INST-SUBL2 <MA-IMM 8> <GCTEMP 2>>
261 ; "Flush dope words from byte count"
262 <EMIT ,INST-SUBL2 <GCTEMP 2> <MA-REG ,AC-3>>
263 ; "Point to top of old (ac 1 points to top of new)"
264 <EMIT ,INST-ASHL <MA-IMM -3> <GCTEMP 2> <GCTEMP 2>>
265 ; "Number of elements to mark"
266 <EMIT-BRANCH ,INST-BEQL .DONE-LAB <> ,LAST-INST-LENGTH>
267 <EMIT ,INST-MOVL <MA-REG ,AC-1> <MA-REG ,AC-4>>
268 <EMIT-LABEL .LOOP-LAB T>
269 <EMIT ,INST-MOVQ <MA-REGD ,AC-3> <MA-REG ,AC-0>>
270 <EMIT ,INST-BITB <MA-BYTE-IMM 7> <MA-REG ,AC-0>>
271 ; "See if this guy is structured"
272 <EMIT-BRANCH ,INST-BEQL .NM-LAB <> ,LAST-INST-LENGTH>
273 <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 3>>
274 <EMIT ,INST-MOVL <MA-REG ,AC-4> <GCTEMP 4>>
275 <FRAME-GEN .MARK-ATOM>
276 <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>
277 <CALL-GEN .MARK-ATOM 1>
278 <EMIT ,INST-MOVL <GCTEMP 3> <MA-REG ,AC-3>>
279 <EMIT ,INST-MOVL <GCTEMP 4> <MA-REG ,AC-4>>
280 <EMIT-LABEL .NM-LAB T>
281 <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-REGD ,AC-4>>
282 <EMIT ,INST-ADDL2 <MA-IMM 8> <MA-REG ,AC-3>>
283 <EMIT ,INST-ADDL2 <MA-IMM 8> <MA-REG ,AC-4>>
284 <EMIT ,INST-DECL <GCTEMP 2>>
285 <EMIT-BRANCH ,INST-BGTR .LOOP-LAB <> ,LAST-INST-LENGTH>
286 <EMIT-LABEL .DONE-LAB T>
287 <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-3>>
288 <EMIT-LABEL .M-LAB T>
289 <EMIT ,INST-MOVL <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
290 <EMIT ,INST-MOVL <MA-DISP ,AC-3 4> <MA-REG ,AC-1>>
291 <EMIT ,INST-SUBL2 <GCTEMP 5> <MA-REG ,AC-1>>
292 <EMIT ,INST-SUBL2 <MA-IMM <* 5 4>> <MA-REG ,AC-TP>>
293 <COND (<==? .RES STACK>
294 <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>)
295 (<DEST-PAIR ,AC-1 ,AC-0 .RES>)>
299 (VAR ALLOC-ATOM END-ATOM NEXT-ATOM BOUNDS-ATOM MARK-ATOM CHOMP "OPT" RES
300 "AUX" ENDADDR ALLOCADDR (M-LAB <MAKE-LABEL>) (DONE-LAB <MAKE-LABEL>)
301 (LOOP-LAB <MAKE-LABEL>) (NF-LAB <MAKE-LABEL>)
302 (F-LAB <MAKE-LABEL>) (NB-LAB <MAKE-LABEL>)
303 (MC-LAB <MAKE-LABEL>) (UNDO? <>))
304 <COND (<NOT <ASSIGNED? RES>>
307 <SET ENDADDR <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
309 <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
311 <FUNCTION (X) <MUNG-AC ,.X>>
312 '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
313 <EMIT ,INST-ADDL2 <MA-IMM <* 3 4>> <MA-REG ,AC-TP>>
314 <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-3>>
315 <EMIT ,INST-MOVL <MA-IMM 0> <GCTEMP 1>>
316 <EMIT-LABEL .LOOP-LAB T>
317 <EMIT ,INST-TSTB <MA-DISP ,AC-3 1>>
318 <EMIT-BRANCH ,INST-BLSS .M-LAB <> ,LAST-INST-LENGTH>
319 <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 1>>
320 ;"Mark bit set, need to hack this up."
321 <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
322 <EMIT ,INST-ADDL3 <MA-IMM ,LIST-LEN> <MA-REG ,AC-1> <MA-REG ,AC-6>>
323 <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
324 <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
325 <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
326 <EMIT-LABEL .NF-LAB T>
327 <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 2>>
328 <FRAME-GEN .NEXT-ATOM>
329 <EMIT-PUSH <TYPE-WORD FIX> LONG>
330 <EMIT-PUSH <MA-IMM ,LIST-LEN> LONG>
331 <CALL-GEN .NEXT-ATOM 1>
332 <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
333 <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
334 <EMIT ,INST-ADDL3 <MA-IMM ,LIST-LEN> <MA-REG ,AC-1> <MA-REG ,AC-6>>
335 <EMIT-LABEL .F-LAB T>
336 <EMIT ,INST-MOVL <TYPE-WORD FIX> <MA-REG ,AC-5>>
337 <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR>
338 <EMIT ,INST-ADDL2 <MA-IMM 4> <MA-REG ,AC-1>>
339 ;"Point to right part of list cell"
340 <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-4>>
341 ;"Pick up pointer to previous cell"
342 <EMIT-BRANCH ,INST-BEQL .NB-LAB <> ,LAST-INST-LENGTH>
343 <EMIT ,INST-MOVL <MA-REG ,AC-1> <MA-DISP ,AC-4 -4>>
344 ;"Fix up cdr pointer in previous cell"
345 <EMIT-LABEL .NB-LAB T>
346 <EMIT ,INST-MOVL <MA-REG ,AC-1> <GCTEMP 1>>
347 ;"New previous cell pointer"
348 <EMIT ,INST-MOVL <MA-DISP ,AC-3 -4> <MA-REG ,AC-4>>
349 ;"Pick up cdr pointer"
350 <EMIT ,INST-MOVL <MA-REG ,AC-1> <MA-DISP ,AC-3 -4>>
351 ;"Relocation for old cell"
352 <EMIT ,INST-MOVL <MA-REG ,AC-4> <MA-DISP ,AC-1 -4>>
353 ;"Make sure new cell doesn't have garbage in cdr slot"
354 <EMIT ,INST-MOVQ <MA-REGD ,AC-3> <MA-REG ,AC-0>>
355 <EMIT ,INST-BICL2 <MA-IMM ,MARK-BIT> <MA-REG ,AC-0>>
356 <EMIT ,INST-BITB <MA-BYTE-IMM 7> <MA-REG ,AC-0>>
357 ;"See if car's type needs marking"
358 <EMIT-BRANCH ,INST-BEQL .MC-LAB <> ,LAST-INST-LENGTH>
359 <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 2>>
360 <EMIT ,INST-MOVL <MA-REG ,AC-4> <GCTEMP 3>>
361 ;"Save pointer to old cell"
362 ;"Save old cdr pointer"
363 <FRAME-GEN .MARK-ATOM>
364 <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>
365 <CALL-GEN .MARK-ATOM 1> ;"Mark the guy"
366 <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
367 <EMIT ,INST-MOVL <GCTEMP 3> <MA-REG ,AC-4>>
368 <EMIT-LABEL .MC-LAB T>
369 <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-2>>
370 <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-REGD ,AC-2>>
372 ; "Save old CDR in new cell in case want to undo all this"
373 <EMIT ,INST-MOVL <MA-REG ,AC-4> <MA-REGD ,AC-2>>)>
374 <EMIT ,INST-MOVL <MA-REG ,AC-4> <MA-REG ,AC-3>>
375 ;"Move cdr pointer to right place"
376 <EMIT-BRANCH ,INST-BEQL .DONE-LAB <> ,LAST-INST-LENGTH>
377 ;"All done if empty cdr"
378 <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 2>>
379 <FRAME-GEN .BOUNDS-ATOM>
380 <EMIT-PUSH <TYPE-WORD LIST> LONG>
381 <EMIT-PUSH <MA-REG ,AC-3> LONG>
382 <CALL-GEN .BOUNDS-ATOM 1> ;"Check bounds of list cdr"
383 <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
384 <EMIT ,INST-TSTL <MA-REG ,AC-1>>
385 <EMIT-BRANCH ,INST-BNEQ .LOOP-LAB <> ,LAST-INST-LENGTH>
386 ;"Loop back if in bounds"
387 <EMIT-BRANCH ,INST-BRB .DONE-LAB <> ,LAST-INST-LENGTH>
388 <EMIT-LABEL .M-LAB T>
389 <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-2>>
390 ;"Pick up pointer to last cell"
391 <EMIT-BRANCH ,INST-BEQL .DONE-LAB <> ,LAST-INST-LENGTH>
392 ;"None, just clean up and leave"
393 <EMIT ,INST-MOVL <MA-DISP ,AC-3 -4> <MA-DISP ,AC-2 -4>>
394 ;"Clean up last cell"
395 <EMIT-LABEL .DONE-LAB T>
396 <EMIT ,INST-SUBL2 <MA-IMM <* 3 4>> <MA-REG ,AC-TP>>
397 <EMIT ,INST-MOVQ <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
398 <EMIT ,INST-MOVL <MA-DISP ,AC-1 -4> <MA-REG ,AC-1>>
399 <COND (<==? .RES STACK>
400 <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>)
401 (T <DEST-PAIR ,AC-1 ,AC-0 .RES>)>
404 <DEFINE MARKL-GEN (VAR VAL "AUX" VAC)
405 #DECL ((VAR) VARTBL (VAL) FIX)
406 <SET VAC <LOAD-VAR .VAR JUST-VALUE <> PREF-VAL>>
407 <FINISH-MARK .VAC .VAL>
410 <DEFINE IMARKU-GEN (VAR VAL SHIFT "AUX" VAC)
411 #DECL ((VAR) VARTBL (SHIFT) FIX (VAL) <OR FIX VARTBL>)
412 <USE-AC <SET VAC <LOAD-VAR .VAR COUNT T PREF-VAL>>>
413 <COND (<NOT <0? .SHIFT>>
414 <EMIT ,INST-ASHL <MA-IMM .SHIFT> <MA-REG .VAC> <MA-REG .VAC>>)>
415 <EMIT ,INST-ADDL2 <VAR-VALUE-ADDRESS .VAR> <MA-REG .VAC>>
417 <EMIT ,INST-ADDL2 <MA-IMM 3> <MA-REG .VAC>>
419 <MA-IMM ,ADDR-MASK-2>
421 <FINISH-MARK .VAC .VAL>
424 <DEFINE FINISH-MARK (VAC VAL)
425 #DECL ((VAC) AC (VAL) <OR FIX VARTBL>)
427 <EMIT ,INST-BICW2 <MA-WORD-IMM ,MARK-BIT> <MA-DISP .VAC 0>>)
429 <EMIT ,INST-BISW2 <MA-WORD-IMM ,MARK-BIT> <MA-DISP .VAC 0>>
430 <COND (<NOT <TYPE? .VAL FIX>>
431 <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAL>
432 <MA-DISP .VAC 4>>)>)>>
434 <DEFINE MARKUS-GEN (VAR VAL "OPT" (RES <>))
435 #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
436 <IMARKU-GEN .VAR .VAL 0>
439 <COND (<GASSIGNED? MARKUS-GEN><SETG MARKUB-GEN ,MARKUS-GEN>)>
441 <DEFINE MARKUV-GEN (VAR VAL)
442 #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
443 <IMARKU-GEN .VAR .VAL 3>
446 <DEFINE MARKUU-GEN (VAR VAL)
447 #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
448 <IMARKU-GEN .VAR .VAL 2>
451 <DEFINE MARKR-GEN (VAR VAL)
452 #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
453 <CALL-RTE ,IMARKR!-MIMOP CALL <> <> .VAR .VAL>
456 <DEFINE MARKL?-GEN (VAR RES "AUX" VAC)
457 #DECL ((VAR) VARTBL (RES) <OR VARTBL ATOM>)
458 <SET VAC <LOAD-VAR .VAR VALUE T PREF-VAL>>
459 <FINISH-MARK? .VAC .RES>
462 <DEFINE FINISH-MARK? (VAC RES
464 "AUX" (TLAB <MAKE-LABEL>) (ELAB <MAKE-LABEL>) NAC ADDR)
466 <EMIT ,INST-TSTB <MA-DISP .VAC 1>>
467 <GEN-BRANCH ,INST-BLSS .TLAB <> <>>
468 <EMIT ,INST-CLRL <MA-REG .VAC>>
471 <EMIT ,INST-MOVL <TYPE-CODE FIX>
472 <MA-REG <SET NAC <GET-AC PREF-TYPE T>>>>)>
473 <GEN-BRANCH ,INST-BRB .ELAB <> <>>
474 <EMIT-LABEL .TLAB <>>
476 <EMIT ,INST-MOVL <SET ADDR <MA-DISP .VAC 4>> <MA-REG .VAC>>
479 <EMIT ,INST-MOVL <SET ADDR <VAR-TYPE-ADDRESS .VAR TYPE-WORD>>
481 (ELSE <EMIT ,INST-MOVL <MA-IMM 1> <MA-REG .VAC>>)>
482 <EMIT-LABEL .ELAB <>>
483 <COND (<NOT .REL> <DEST-DECL .VAC .RES FIX>)
484 (ELSE <DEST-PAIR .VAC .NAC .REL>)>>
486 <DEFINE IMARKU?-GEN (VAR RES SHIFT REL "AUX" VAC)
487 #DECL ((VAR) VARTBL (SHIFT) FIX)
488 <SET VAC <LOAD-VAR .VAR COUNT T PREF-VAL>>
489 <COND (<NOT <0? .SHIFT>>
490 <EMIT ,INST-ASHL <MA-IMM .SHIFT> <MA-REG .VAC>
492 <EMIT ,INST-ADDL2 <VAR-VALUE-ADDRESS .VAR> <MA-REG .VAC>>
494 <EMIT ,INST-ADDL2 <MA-IMM 3> <MA-REG .VAC>>
495 <EMIT ,INST-BICB2 <MA-IMM ,ADDR-MASK-2> <MA-REG .VAC>>)>
496 <FINISH-MARK? .VAC .RES .REL .VAR>
499 <DEFINE MARKUU?-GEN (VAR RES "OPT" (REL <>))
501 <IMARKU?-GEN .VAR .RES 2 .REL>
504 <DEFINE MARKUV?-GEN (VAR RES "OPT" (REL <>))
506 <IMARKU?-GEN .VAR .RES 3 .REL>
509 <DEFINE MARKUS?-GEN (VAR RES "OPT" (REL <>))
511 <IMARKU?-GEN .VAR .RES 0 .REL>
514 <COND (<GASSIGNED? MARKUS?-GEN><SETG MARKUB?-GEN ,MARKUS?-GEN>)>
516 <DEFINE MARKR?-GEN (VAR RES "OPT" (REL .RES))
517 #DECL ((VAR) VARTBL (REL) <OR VARTBL FALSE>)
518 <CALL-RTE ,IMARKR?!-MIMOP CALL .REL <> .VAR>
521 <DEFINE SWNEXT-GEN (VAR GCP RES)
522 #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
523 <CALL-RTE ,ISWNEXT!-MIMOP CALL .RES <> .VAR .GCP>
526 <DEFINE NEXTS-GEN (VAR RES)
527 #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
528 <CALL-RTE ,INEXTS!-MIMOP CALL .RES <> .VAR>
531 <DEFINE CONTENTS-GEN (VAR RES
532 "AUX" VAC (TAC <>) (TLAB <MAKE-LABEL>)
533 (TLAB2 <MAKE-LABEL>) (ELAB <MAKE-LABEL>))
534 #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
535 <PROTECT <SET VAC <LOAD-VAR .VAR JUST-VALUE <> PREF-VAL>>>
536 <EMIT ,INST-MOVQ <MA-DISP .VAC 0>
537 <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
538 (ELSE <SET TAC <GET-AC DOUBLE T>>)>>
539 <EMIT ,INST-BITW <MA-WORD-IMM ,DOPE-BIT>
540 <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
541 (ELSE <MA-REG .TAC>)>>
542 <GEN-BRANCH ,INST-BEQL .TLAB2 <> <>>
543 <EMIT ,INST-BICW2 <MA-WORD-IMM ,DOPE-BIT>
544 <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
545 (ELSE <MA-REG .TAC>)>>
546 <EMIT ,INST-ADDL3 <MA-IMM 4> <MA-REG .VAC>
547 <COND (<==? .RES STACK> <MA-DISP ,AC-TP -4>)
548 (ELSE <MA-REG <NEXT-AC .TAC>>)>>
549 <EMIT ,INST-CMPW <TYPE-CODE FRAME WORD>
550 <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
551 (ELSE <MA-REG .TAC>)>>
552 <GEN-BRANCH ,INST-BEQL .TLAB <> <>>
553 <EMIT ,INST-CMPW <TYPE-CODE SFRAME WORD>
554 <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
556 <GEN-BRANCH ,INST-BNEQ .TLAB2 <> <>>
557 <EMIT-LABEL .TLAB <>>
558 <EMIT ,INST-ADDL3 <MA-IMM ,FLEN> <MA-REG .VAC>
559 <COND (<==? .RES STACK> <MA-DISP ,AC-TP -4>)
560 (ELSE <MA-REG <NEXT-AC .TAC>>)>>
561 <EMIT-LABEL .TLAB2 <>>
562 <COND (<N==? .RES STACK>
563 <DEST-PAIR <NEXT-AC .TAC> .TAC .RES>)>
566 <DEFINE PUTS-GEN (VAR1 VAR2
567 "AUX" VAC (TAC <>) (TLAB <MAKE-LABEL>)
568 (ELAB <MAKE-LABEL>) LV)
569 #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
570 <PROTECT <SET VAC <LOAD-VAR .VAR1 JUST-VALUE <> PREF-VAL>>>
571 <EMIT ,INST-BITW <MA-WORD-IMM ,DOPE-BIT> <MA-DISP .VAC 0>>
572 <GEN-BRANCH ,INST-BNEQ .TLAB <> <>>
573 <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR2> <MA-DISP .VAC 4>>
574 <EMIT-LABEL .TLAB <>>
577 <DEFINE RELL-GEN (VAR)
579 <CALL-RTE ,IRELL!-MIMOP CALL <> <> .VAR>>
581 <DEFINE RELU-GEN (VAR)
583 <CALL-RTE ,IRELU!-MIMOP CALL <> <> .VAR>>
585 <DEFINE RELR-GEN (VAR)
587 <CALL-RTE ,IRELR!-MIMOP CALL <> <> .VAR>>
589 <DEFINE ALLOCL-GEN (VAR DEST "AUX" VAC)
590 <SET VAC <LOAD-VAR .VAR JUST-VALUE T PREF-VAL>>
591 <EMIT ,INST-ADDL2 <MA-IMM 4> <MA-REG .VAC>>
592 <DEST-DECL .VAC .DEST LIST>>
594 <DEFINE ALLOCUU-GEN (VAR OLD DEST "OPT" (HINT <>) "AUX" VAC1 VAC2)
595 <PROTECT <SET VAC1 <LOAD-VAR .OLD TYPE-WORD <> PREF-VAL>>>
596 <SET VAC2 <LOAD-VAR .VAR VALUE <> PREF-VAL>>
597 <DEST-PAIR .VAC2 .VAC1 .DEST>>
599 <COND (<GASSIGNED? ALLOCUU-GEN><SETG ALLOCUV-GEN ,ALLOCUU-GEN>
601 <SETG ALLOCUS-GEN ,ALLOCUU-GEN>
603 <SETG ALLOCUB-GEN ,ALLOCUU-GEN>
605 <SETG ALLOCR-GEN ,ALLOCUU-GEN>)>
607 <DEFINE BLT-GEN (FROM TO NUMBER "OPT" (HINT <>) "AUX" (VAC <>)
608 (LAB <MAKE-LABEL>) (LAB1 <MAKE-LABEL>) VVAC)
609 <MAPF <> <FUNCTION (X) <MUNG-AC ,.X>>
610 '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
611 <COND (<AND <TYPE? .NUMBER FIX>
612 <SET NUMBER <* .NUMBER 4>>
613 <L=? .NUMBER *177777*>>
614 <LOAD-VAR .FROM JUST-VALUE T ,AC-1>
615 <LOAD-VAR .TO JUST-VALUE T ,AC-3>
616 <EMIT ,INST-MOVC3 <MA-WORD-IMM .NUMBER>
620 <SET VAC <MA-REG <GET-AC ,AC-5 T>>>
621 <SET VVAC <MA-REG <GET-AC ,AC-6 T>>>
622 <COND (<TYPE? .NUMBER FIX>
623 <EMIT ,INST-MOVL <MA-IMM .NUMBER>
626 <EMIT ,INST-ASHL <MA-IMM 2> <VAR-VALUE-ADDRESS .NUMBER>
628 <LOAD-VAR .FROM JUST-VALUE T ,AC-1>
629 <LOAD-VAR .TO JUST-VALUE T ,AC-3>
631 <EMIT-MOVE .VVAC .VAC LONG>
632 <EMIT ,INST-CMPL .VVAC <MA-IMM *177777*>>
633 <GEN-BRANCH ,INST-BLSS .LAB1 <>>
634 <EMIT-MOVE <MA-IMM *177777*> .VAC LONG>
636 <EMIT ,INST-MOVC3 .VAC
639 <EMIT ,INST-SUBL2 <MA-IMM *177777*> .VVAC>
640 <GEN-BRANCH ,INST-BGTR .LAB <>>)>
643 <DEFINE MPAGES-GEN (PGS DEST)
644 <CALL-RTE ,IMPAGES!-MIMOP CALL .DEST <> .PGS>>