2 <DEFINE PROCESS-BRANCH-1 (INST BYTEOFF CODEPTR
3 "AUX" PTR LREF (XREF <>) ROFF CDV)
4 #DECL ((INSC EAT CODEPTR INST BYTEOFF PTR INITLEN) FIX (LREF) LABEL-REF
5 (XREF) <OR FALSE XREF-INFO> (CDV) <OR FALSE CODEVEC>)
6 <SET PTR <CHTYPE <ANDB .INST 65535> FIX>>
7 <SET LREF <NTH ,LABEL-TABLE .PTR>>
10 <COND (<==? <XREF-INFO-POINT .TREF> .CODEPTR>
13 <LABEL-REF-XREFS .LREF>>
15 <ERROR "JUMP NOT FOUND" .LREF .CODEPTR .BYTEOFF PROCESS-BRANCH>>
16 <SET CDV <XREF-INFO-STACK-SAVE-CODE .XREF>>
19 <SET BYTEOFF <SCAN-PASS .BYTEOFF () .CDV <> <+ <LENGTH .CDV> 1>>>>
22 <DEFINE PROCESS-BRANCH-2 (INST BYTEOFF CODEPTR INSC EAT
23 "AUX" PTR LREF (XREF <>) ROFF CDV)
24 #DECL ((INSC EAT CODEPTR INST BYTEOFF PTR INITLEN) FIX (LREF) LABEL-REF
25 (XREF) <OR FALSE XREF-INFO> (CDV) <OR FALSE CODEVEC>)
26 <SET PTR <CHTYPE <ANDB .INST 65535> FIX>>
27 <SET LREF <NTH ,LABEL-TABLE .PTR>>
30 <COND (<==? <XREF-INFO-POINT .TREF> .CODEPTR>
33 <LABEL-REF-XREFS .LREF>>
35 <ERROR "JUMP NOT FOUND" .LREF .CODEPTR .BYTEOFF PROCESS-BRANCH>>
36 <SET PTR <LABEL-REF-REL-ADDR .LREF>>
37 <COND (<==? .EAT ,OP-BW> <SET BYTEOFF <+ .BYTEOFF 2>>)
39 <SET ROFF <- .PTR .BYTEOFF 1>>
40 <COND (<OR <L? .PTR 0>
43 <XREF-INFO-FORCE-LONG .XREF>>
44 <PUT .XREF ,XREF-INFO-SHORT <>>
45 <COND (<==? .INSC ,INST-BRB>
46 <SET BYTEOFF <+ .BYTEOFF 2>>)
47 (<OR <==? .INSC ,INST-SOBGEQ>
48 <==? .INSC ,INST-SOBGTR>>
49 <SET BYTEOFF <+ .BYTEOFF 5>>)
50 (<OR <==? .INSC ,INST-AOBLSS>
51 <==? .INSC ,INST-AOBLEQ>>
52 <SET BYTEOFF <+ .BYTEOFF 6>>)
53 (ELSE <SET BYTEOFF <+ .BYTEOFF 4>>)>)
55 <PUT .XREF ,XREF-INFO-SHORT T>
56 <SET BYTEOFF <+ .BYTEOFF 1>>)>)>
59 <DEFINE AGEN-BRANCH-1 (INST BYTEOFF CODEPTR INSCODE
60 "AUX" PTR LREF XREF (SAVED-POINT 0) CDV ROFF)
61 #DECL ((CODEPTR INST BYTEOFF INSCODE) FIX)
62 <SET PTR <CHTYPE <ANDB .INST 65535> FIX>>
63 <SET LREF <NTH ,LABEL-TABLE .PTR>>
64 <SET PTR <LABEL-REF-REL-ADDR .LREF>>
67 <COND (<==? <XREF-INFO-POINT .TREF> .CODEPTR>
70 <LABEL-REF-XREFS .LREF>>
71 <SET CDV <XREF-INFO-STACK-SAVE-CODE .XREF>>
75 <OUTPUT-PASS .BYTEOFF () .CDV <+ <LENGTH .CDV> 1> <>>>>
78 <DEFINE AGEN-BRANCH-2 (INST BYTEOFF CODEPTR INSCODE WHERE EAT
79 "AUX" PTR LREF XREF ROFF SAVED-P)
80 #DECL ((BYTEOFF INSCODE WHERE EAT ROFF PTR) FIX)
81 <SET PTR <CHTYPE <ANDB .INST 65535> FIX>>
82 <SET LREF <NTH ,LABEL-TABLE .PTR>>
83 <SET PTR <LABEL-REF-REL-ADDR .LREF>>
86 <COND (<==? <XREF-INFO-POINT .TREF> .CODEPTR>
89 <LABEL-REF-XREFS .LREF>>
90 <SET BYTEOFF <+ .BYTEOFF 1>>
91 <SET ROFF <- .PTR .BYTEOFF>>
92 <SET SAVED-P ,FBYTE-OFFSET>
93 <COND (<XREF-INFO-SHORT .XREF>
94 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB .ROFF 255> FIX>>
95 <PUT .XREF ,XREF-INFO-SHORT T>)
97 <SET ROFF <- .ROFF 1>>
98 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB .ROFF 255> FIX>>
99 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <LSH .ROFF -8> 255> FIX>>
100 <SET BYTEOFF <+ .BYTEOFF 1>>
101 <PUT .XREF ,XREF-INFO-SHORT <>>)
102 (<OR <==? .INSCODE ,INST-SOBGEQ> <==? .INSCODE ,INST-SOBGTR>>
103 <PUT-FCODE .WHERE ,INST-DECL>
104 <ADD-BYTE-TO-FCODE <COND (<==? .INSCODE ,IST-SOBGEQ> ,INST-BGEQ)
106 <ADD-BYTE-TO-FCODE 3>
107 <ADD-BYTE-TO-FCODE ,INST-BRW>
108 <SET SAVED-P ,FBYTE-OFFSET>
109 <SET BYTEOFF <+ .BYTEOFF 4>>
110 <SET ROFF <- .ROFF 4>>
111 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB .ROFF 255> FIX>>
112 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <LSH .ROFF -8> 255> FIX>>
113 <PUT .XREF ,XREF-INFO-SHORT <>>)
114 (<OR <==? .INSCODE ,INST-SOBGEQ> <==? .INSCODE ,INST-AOBLSS>>
115 <SET ROFF <- .ROFF 5>>
116 <ADD-BYTE-TO-FCODE 2>
117 <ADD-BYTE-TO-FCODE ,INST-BRB>
118 <ADD-BYTE-TO-FCODE 3>
119 <ADD-BYTE-TO-FCODE ,INST-BRW>
120 <SET SAVED-P ,FBYTE-OFFSET>
121 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB .ROFF 255> FIX>>
122 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <LSH .ROFF -8> 255> FIX>>
123 <SET BYTEOFF <+ .BYTEOFF 5>>
124 <PUT .XREF ,XREF-INFO-SHORT <>>)
125 (<N==? .INSCODE ,INST-BRB>
126 <PUT-FCODE .WHERE <INS-INVERT .INSCODE>>
127 <SET ROFF <- .ROFF 3>>
128 <ADD-BYTE-TO-FCODE 3>
129 <ADD-BYTE-TO-FCODE ,INST-BRW>
130 <SET SAVED-P ,FBYTE-OFFSET>
131 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB .ROFF 255> FIX>>
132 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <LSH .ROFF -8> 255> FIX>>
133 <SET BYTEOFF <+ .BYTEOFF 3>>
134 <PUT .XREF ,XREF-INFO-SHORT <>>)
136 <PUT-FCODE .WHERE ,INST-BRW>
137 <SET BYTEOFF <+ .BYTEOFF 1>>
138 <SET ROFF <- .ROFF 1>>
139 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB .ROFF 255> FIX>>
140 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <LSH .ROFF -8> 255> FIX>>
141 <PUT .XREF ,XREF-INFO-SHORT <>>)>
142 <PUT .XREF ,XREF-INFO-ADDR .BYTEOFF>
143 <PUT .XREF ,XREF-INFO-POINT .SAVED-P>
146 <DEFINE INS-INVERT (INS) #DECL ((INS) FIX)
147 <CHTYPE <XORB .INS 1> FIX>>
149 "PASS TO FIXUP THE LABELS IN THE FINAL CODE"
151 <DEFINE FIXUP-PASS ("AUX" (LABELS ,LABEL-TABLE) POINT ADDR)
154 <SET ADDR <LABEL-REF-REL-ADDR .LREF>>
156 <FCN (XREF "AUX" DADDR)
157 <SET POINT <XREF-INFO-POINT .XREF>>
158 <SET DADDR <- .ADDR <XREF-INFO-ADDR .XREF>>>
159 <AND <XREF-INFO-SHORT .XREF>
160 <G? <ABS .DADDR> 127>
161 <ERROR "CANT FIT OFFSET" FIXUP-PASS>>
162 <COND (<XREF-INFO-SHORT .XREF>
164 <CHTYPE <ANDB .DADDR 255> FIX>>)
167 <CHTYPE <ANDB .DADDR 255> FIX>>
168 <PUT-FCODE <+ .POINT 1>
169 <CHTYPE <ANDB <LSH .DADDR -8> 255>
171 <LABEL-REF-XREFS .LREF>>
172 <COND (<SET POINT <LABEL-REF-PUSH-POINTER .LREF>>
173 <PUT-FCODE .POINT <CHTYPE <ANDB .ADDR 255> FIX>>
174 <PUT-FCODE <+ .POINT 1> <CHTYPE <ANDB <LSH .ADDR -8> 255>
176 <PUT-FCODE <+ .POINT 2> <CHTYPE <ANDB <LSH .ADDR -16> 255>
178 <PUT-FCODE <+ .POINT 3> <CHTYPE <ANDB <LSH .ADDR -24> 255>
182 <DEFINE CLEAR-CONSTANT-TABLE-FOR-SCAN ()
183 <REPEAT ((PTR ,CONSTANT-TABLE) (MCNT ,CONSTANT-POINTER))
184 <COND (<==? <2 .PTR> -1> <PUT .PTR 2 0>)>
185 <COND (<L=? <SET MCNT <- .MCNT 2>> 0> <RETURN>)>
186 <SET PTR <REST .PTR 2>>>>
188 <DEFINE CHECK-CONSTANT-TABLE (PTR BYTEOFF "AUX" (TAB ,CONSTANT-TABLE))
189 #DECL ((PTR BYTEOFF) FIX)
191 <COND (<0? <NTH .TAB .PTR>> <PUT .TAB .PTR -1> T)
192 (<==? <NTH .TAB .PTR> -1> <>)
194 <SET BYTEOFF <- .BYTEOFF <NTH .TAB .PTR>>>
195 <COND (<G? .BYTEOFF ,JUMP-EXTENT> <PUT .TAB .PTR -1> T)
198 <DEFINE ASSEMBLE-CODE (SBYTEOFF FNAME "AUX" EBYTEOFF CE)
199 #DECL ((SBYTEOFF EBYTEOFF) FIX (FNAME) ATOM)
200 <PROG ((LBYTEOFF <>))
202 <CLEAR-CONSTANT-TABLE-FOR-SCAN>
203 <SET EBYTEOFF <SCAN-PASS .SBYTEOFF>>
204 <COND (<AND <NOT .LBYTEOFF> ,GLUE>
206 <CHECK-UNRESOLVED-CALLS .EBYTEOFF .SBYTEOFF>>
207 <COND (<N==? .LBYTEOFF .SBYTEOFF>
208 <SET SBYTEOFF .LBYTEOFF>
210 <REPEAT (NEBYTEOFF (NPASSES ,MAX-NUMBER-PASSES))
211 <COND (<0? .NPASSES> <RETURN>)>
212 <CLEAR-CONSTANT-TABLE-FOR-SCAN>
214 <SET NEBYTEOFF <SCAN-PASS .SBYTEOFF>>
215 <COND (<0? <- .NEBYTEOFF .EBYTEOFF>> <RETURN>)>
216 <SET EBYTEOFF .NEBYTEOFF>
217 <SET NPASSES <- .NPASSES 1>>>
218 <CLEAR-CONSTANT-TABLE-FOR-SCAN>
220 <SET EBYTEOFF <OUTPUT-PASS .SBYTEOFF>>
223 <SET CE <UPDATE-CALL-ENTRY-TABLE .FNAME>>
224 <ADD-UNRESOLVED-CALLS>
225 <FIXUP-UNRESOLVED-CALLS .CE>)>
226 (.SBYTEOFF .EBYTEOFF)>
228 <DEFINE SCAN-PASS (BYTEOFF
229 "OPTIONAL" (CL ,CODE-LIST) (CV <1 .CL>) (CLABELS T)
230 (MAXPTR ,CODE-COUNT))
231 #DECL ((BYTEOFF VALUE MAXPTR) FIX (CL) LIST (CV) CODEVEC)
232 <OR <EMPTY? .CL> <SET CL <REST .CL>>>
233 <REPEAT ((PTR 1) INS INSCODE EAT AFLG OP-INF NUM-OPS (IN-CASE? <>)
235 #DECL ((CB PTR INS INSCODE EAT NUM-OPS) FIX
236 (OP-INF) <UVECTOR [REST FIX]>
237 (IN-CASE?) <OR FALSE FIX>)
239 <COND (.CLABELS <CHECK-LABEL .BYTEOFF .PTR>)>
241 <SET INSCODE <CHTYPE <LSH .INS -24> FIX>>
242 <COND (<EMPTY? <SET CV <REST .CV>>>
243 <COND (<EMPTY? .CL> <SET AFLG <>>)
244 (ELSE <SET CV <1 .CL>> <SET CL <REST .CL>>)>)>
247 <COND (<L? <SET IN-CASE? <- .IN-CASE? 1>> 0>
249 <SET BYTEOFF <+ .BYTEOFF 2>>
251 <SET OP-INF <GET-INST-INFO .INSCODE>>
252 <SET NUM-OPS <CHTYPE <LSH <2 .OP-INF> <- ,INIT-SHIFT>> FIX>>
254 (<MEMQ .INSCODE ,SPECIAL-OPS>
255 <SET BYTEOFF <SCAN-SPECIAL-CODE .INS .BYTEOFF>>)
257 <COND (<MEMQ .INSCODE ,BRANCH-INS>
258 <SET BYTEOFF <PROCESS-BRANCH-1 .INS .BYTEOFF <- .PTR 1>>>)>
259 <COND (<MEMQ .INSCODE ,CASE-INS> <SET IN-CASE? 0>)>
260 <SET BYTEOFF <+ .BYTEOFF 1>>
263 <REPEAT ((SHFT -24) (FNUM 1) EAC R-OR-L ADR (SIZ 1) (DO-IMM <>))
264 #DECL ((DO-IMM) <OR FIX FALSE>)
265 <COND (<L? <SET NUM-OPS <- .NUM-OPS 1>> 0> <SET SIZ <- .SIZ 1>>)>
267 <COND (<L? <SET SIZ <- .SIZ 1>> 0>
268 <COND (<AND .IN-CASE? .DO-IMM>
269 <COND (<L=? .NUM-OPS 0>
270 <SET IN-CASE? .DO-IMM>)
276 (<G? <SET SHFT <+ .SHFT 8>> 0>
279 <OR .AFLG <ERROR ACCESS-BEYOND-END-OF-CODE!-ERRORS>>
281 <COND (<EMPTY? <SET CV <REST .CV>>>
282 <COND (<EMPTY? .CL> <SET AFLG <>>)
285 <SET CL <REST .CL>>)>)>)>
287 <SET ADR <CHTYPE <ANDB <LSH .INS .SHFT> 255> FIX>>
289 <SET DO-IMM <ORB .DO-IMM <LSH .ADR .CNT>>>)>>
290 <COND (<L? .NUM-OPS 0> <RETURN>)>
291 <SET EAC <CHTYPE <ANDB .ADR 240> FIX>>
292 <SET R-OR-L <CHTYPE <ANDB .ADR 15> FIX>>
294 <CHTYPE <ANDB <SET EAT <GET-OP-INFO .FNUM .OP-INF>> 7> FIX>>
295 <SET FNUM <+ .FNUM 1>>
296 <COND (<OR <==? .EAT ,OP-BB> <==? .EAT ,OP-BW>>
298 <PROCESS-BRANCH-2 .INS
306 <SET BYTEOFF <+ .BYTEOFF 1>>
308 <COND (<0? .NUM-OPS> <SET IN-CASE? .R-OR-L>)
309 (<1? .NUM-OPS> <SET CB .R-OR-L>)>)>)
311 <SET FNUM <- .FNUM 1>>
312 <SET NUM-OPS <+ .NUM-OPS 1>>
313 <SET BYTEOFF <+ .BYTEOFF 1>>
315 (<OR <==? .EAC ,AM-REG>
319 <SET BYTEOFF <+ .BYTEOFF 1>>)
320 (<OR <==? .EAC ,AM-AINC> <==? .EAC ,AM-AINCD>>
321 <COND (<==? .R-OR-L ,NAC-PC>
322 <COND (<==? .EAC ,AM-AINCD> <SET SIZ 5>)
323 (<OR <==? .SIZ ,SZ-L> <==? .SIZ ,SZ-F>>
325 (<==? .SIZ ,SZ-W> <SET SIZ 3>)
327 <COND (<AND .IN-CASE? <L=? .NUM-OPS 1>>
329 <SET BYTEOFF <+ .BYTEOFF .SIZ>>)
330 (ELSE <SET BYTEOFF <+ .BYTEOFF 1>> <SET SIZ 1>)>)
332 <COND (<OR <==? .EAC ,AM-BDD> <==? .EAC ,AM-BD>> <SET SIZ 2>)
333 (<OR <==? .EAC ,AM-WDD> <==? .EAC ,AM-WD>> <SET SIZ 3>)
334 (<OR <==? .EAC ,AM-LDD> <==? .EAC ,AM-LD>>
336 <SET BYTEOFF <+ .BYTEOFF .SIZ>>)>>)>)>
337 <OR .AFLG <RETURN .BYTEOFF>>
339 <COND (<EMPTY? .CL> <RETURN .BYTEOFF>)>
341 <SET CL <REST .CL>>)>
342 <COND (<G=? .PTR .MAXPTR> <RETURN .BYTEOFF>)>>>
344 <DEFINE SCAN-SPECIAL-CODE (INST BYTEOFF
346 <CHTYPE <ANDB .INST 65535> FIX>)
347 (CODE <CHTYPE <LSH .INST -24> FIX>) PSAVE
349 #DECL ((BYTEOFF INST) FIX)
350 <COND (<==? .CODE ,INST-PATCH>
351 <COND (<NOT <0? .OFFS>>
352 <SET PATCH <PATCH-CODE <GET-PATCH .OFFS>>>
359 <+ <LENGTH .PATCH> 1>>>>)>)
360 (<==? .CODE ,INST-PSTORE>
361 <SET PSAVE <GET-PTNS .OFFS>>
362 <COND (<PTNS-USE .PSAVE>
363 <SET PATCH <PTNS-CODE .PSAVE>>
370 <+ <LENGTH .PATCH> 1>>>>)>)
371 (<==? .CODE ,INST-CALL> <SET BYTEOFF <SCAN-CALL .OFFS .BYTEOFF>>)
372 (<==? .CODE ,INST-PUSHLAB> <SET BYTEOFF <+ .BYTEOFF 7>>)
373 (<==? .CODE ,INST-MOVELAB> <SET BYTEOFF <+ .BYTEOFF 7>>)>
376 <DEFINE SCAN-CALL (OFF BYTEOFF "AUX" REF CBOFF)
377 #DECL ((OFF BYTEOFF) FIX (CBOFF) <OR FALSE FIX>)
378 <SET REF <NTH ,CALL-TABLE .OFF>>
380 <FIND-CALL-POINT <UC-NAME .REF> <UC-NUMBER-ARGS .REF>>>
381 <COND (<G? <ABS <- <+ .BYTEOFF 2> .CBOFF>> ,JUMP-EXTENT>
382 <SET BYTEOFF <+ .BYTEOFF 6>>)
383 (<SET BYTEOFF <+ .BYTEOFF 3>>)>)
384 (<SET BYTEOFF <+ .BYTEOFF 3>>)>
387 <DEFINE OUTPUT-CALL (BYTEOFF OFF "AUX" REF CBOFF AINST PNT)
388 #DECL ((OFF BYTEOFF) FIX)
389 <SET REF <NTH ,CALL-TABLE .OFF>>
391 (<SET CBOFF <FIND-CALL-POINT <UC-NAME .REF> <UC-NUMBER-ARGS .REF>>>
392 <PUT .REF ,UC-CODE-PTR -1>
393 <COND (<G? <ABS <SET OFF <- <+ .BYTEOFF 3> .CBOFF>>> ,JUMP-EXTENT>
395 <ADD-BYTE-TO-FCODE ,INST-JMP>
396 <ADD-BYTE-TO-FCODE <CHTYPE <ORB ,AM-LD <AC-NUMBER ,AC-PC>> FIX>>
397 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <SET OFF <- .OFF>> 255> FIX>>
398 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <LSH .OFF -8> 255> FIX>>
399 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <LSH .OFF -16> 255> FIX>>
400 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <LSH .OFF -24> 255> FIX>>
401 <SET BYTEOFF <+ .BYTEOFF 6>>)
403 <ADD-BYTE-TO-FCODE ,INST-BRW>
404 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <SET OFF <- .OFF>> 255> FIX>>
405 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <LSH .OFF -8> 255> FIX>>
406 <SET BYTEOFF <+ .BYTEOFF 3>>)>)
408 <SET PNT <ADD-BYTE-TO-FCODE ,INST-BRW>>
409 <PUT .REF ,UC-CALL-BYTEOFF <+ .BYTEOFF 3>>
410 <PUT .REF ,UC-CODE-PTR <+ .PNT 1>>
411 <ADD-BYTE-TO-FCODE 0>
412 <ADD-BYTE-TO-FCODE 0>
413 <SET BYTEOFF <+ .BYTEOFF 3>>)>
416 <DEFINE GEN-SPECIAL-CODE (INST BYTEOFF
417 "AUX" (OFFS <CHTYPE <ANDB .INST 65535> FIX>)
418 (CODE <CHTYPE <LSH .INST -24> FIX>) PSAVE
420 #DECL ((BYTEOFF INST) FIX)
421 <COND (<==? .CODE ,INST-PATCH>
422 <COND (<NOT <0? .OFFS>>
423 <SET PATCH <PATCH-CODE <GET-PATCH .OFFS>>>
430 <+ <LENGTH .PATCH> 1>
432 (<==? .CODE ,INST-PSTORE>
433 <SET PSAVE <GET-PTNS .OFFS>>
434 <COND (<PTNS-USE .PSAVE>
435 <SET PATCH <PTNS-CODE .PSAVE>>
442 <+ <LENGTH .PATCH> 1>
444 (<==? .CODE ,INST-CALL>
445 <SET BYTEOFF <OUTPUT-CALL .BYTEOFF .OFFS>>)
446 (<==? .CODE ,INST-PUSHLAB>
447 <OUTPUT-PUSHLAB .OFFS .BYTEOFF>
448 <SET BYTEOFF <+ .BYTEOFF 7>>)
449 (<==? .CODE ,INST-MOVELAB>
450 <OUTPUT-MOVELAB .INST .OFFS .BYTEOFF>
451 <SET BYTEOFF <+ .BYTEOFF 7>>)>
454 <DEFINE OUTPUT-PUSHLAB (OFF BYTEOFF "AUX" AINST LREF)
456 <SET LREF <NTH ,PUSH-LABEL-TABLE .OFF>>
457 <ADD-BYTE-TO-FCODE ,INST-MOVL>
458 <ADD-BYTE-TO-FCODE <CHTYPE <LSH <MA-AINC ,AC-PC> -24> FIX>>
459 <SET AINST <ADD-BYTE-TO-FCODE 0>>
460 <ADD-BYTE-TO-FCODE 0>
461 <ADD-BYTE-TO-FCODE 0>
462 <ADD-BYTE-TO-FCODE 0>
463 <ADD-BYTE-TO-FCODE <CHTYPE <LSH <MA-AINC ,AC-TP> -24> FIX>>
464 <PUT .LREF ,LABEL-REF-PUSH-POINTER .AINST>>
466 <DEFINE OUTPUT-MOVELAB (INST OFF BYTEOFF "AUX" LREF AINST)
468 <SET LREF <NTH ,MOVE-LABEL-TABLE .OFF>>
469 <ADD-BYTE-TO-FCODE ,INST-MOVL>
470 <ADD-BYTE-TO-FCODE <CHTYPE <LSH <MA-AINC ,AC-PC> -24> FIX>>
471 <SET AINST <ADD-BYTE-TO-FCODE 0>>
472 <ADD-BYTE-TO-FCODE 0>
473 <ADD-BYTE-TO-FCODE 0>
474 <ADD-BYTE-TO-FCODE 0>
475 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <LSH .INST -16> 255> FIX>>
476 <PUT .LREF ,LABEL-REF-PUSH-POINTER .AINST>>
478 <DEFINE INIT-LABEL-CHECK ("AUX" (LREF <1 ,LABEL-TABLE>))
479 <SETG LABEL-POINTER ,LABEL-TABLE>
480 <SETG LABEL-OFFSET <LABEL-REF-CODE-PTR .LREF>>>
482 <DEFINE CHECK-LABEL (BYTEOFF PTR "AUX" LABEL RPTR)
483 #DECL ((BYTEOFF PTR) FIX (LABEL) LABEL-REF)
485 <COND (<==? .PTR ,LABEL-OFFSET>
486 <SET RPTR ,LABEL-POINTER>
487 <SET LABEL <1 .RPTR>>
488 <PUT .LABEL ,LABEL-REF-REL-ADDR .BYTEOFF>
489 <COND (<EMPTY? <SET RPTR <REST .RPTR>>>
490 <SETG LABEL-POINTER .RPTR>
491 <SETG LABEL-OFFSET -1>)
493 <SETG LABEL-OFFSET <LABEL-REF-CODE-PTR <1 .RPTR>>>
494 <SETG LABEL-POINTER .RPTR>
497 <DEFINE OUTPUT-PASS (BYTEOFF
498 "OPTIONAL" (CL ,CODE-LIST) (CV <1 .CL>)
499 (MAXPTR ,CODE-COUNT) (CLABELS T))
500 #DECL ((BYTEOFF VALUE MAXPTR) FIX (CL) LIST (CV) CODEVEC)
501 <OR <EMPTY? .CL> <SET CL <REST .CL>>>
502 <REPEAT ((PTR 1) INSCODE SAVED-CV INS AFLG OP-INF NUM-OPS EAT XREF
503 LREF LB (IN-CASE? <>) START-CASE)
504 #DECL ((LB PTR INSCODE INS NUM-OPS EAT) FIX (OP-INF) UVECTOR
505 (IN-CASE?) <OR FALSE FIX>)
507 <COND (.CLABELS <CHECK-LABEL .BYTEOFF .PTR>)>
509 <SET INSCODE <CHTYPE <LSH .INS -24> FIX>>
510 <COND (<EMPTY? <SET CV <REST .CV>>>
511 <COND (<EMPTY? .CL> <SET AFLG <>>)
512 (ELSE <SET CV <1 .CL>> <SET CL <REST .CL>>)>)>
515 <SET BYTEOFF <+ .BYTEOFF 2>>
518 <SET LREF <NTH ,LABEL-TABLE <CHTYPE .INS FIX>>>>>
521 <COND (<==? <XREF-INFO-POINT .TREF> <- .PTR 1>>
524 <LABEL-REF-XREFS .LREF>>
525 <PUT .XREF ,XREF-INFO-ADDR .START-CASE>
526 <PUT .XREF ,XREF-INFO-POINT ,FBYTE-OFFSET>
527 <SET INSCODE <- .INSCODE .START-CASE>>
528 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB .INSCODE 255> FIX>>
529 <ADD-BYTE-TO-FCODE <CHTYPE <ANDB <LSH .INSCODE -8> 255> FIX>>
530 <COND (<L? <SET IN-CASE? <- .IN-CASE? 1>> 0> <SET IN-CASE? <>>)>
532 <SET OP-INF <GET-INST-INFO .INSCODE>>
533 <SET NUM-OPS <CHTYPE <LSH <2 .OP-INF> <- ,INIT-SHIFT>> FIX>>
535 (<MEMQ .INSCODE ,SPECIAL-OPS>
536 <SET BYTEOFF <GEN-SPECIAL-CODE .INS .BYTEOFF>>)
538 <COND (<MEMQ .INSCODE ,CASE-INS> <SET IN-CASE? 0>)>
539 <COND (<MEMQ .INSCODE ,BRANCH-INS>
540 <SET BYTEOFF <AGEN-BRANCH-1 .INS .BYTEOFF <- .PTR 1> .INSCODE>>)>
541 <SET SAVED-CV <ADD-BYTE-TO-FCODE .INSCODE>>
542 <SET BYTEOFF <+ .BYTEOFF 1>>
545 <REPEAT ((SHFT -24) (FNUM 1) EAC R-OR-L ADR SIZ)
546 #DECL ((SHFT FNUM EAC R-OR-L ADR SIZ) FIX)
547 <COND (<L? <SET NUM-OPS <- .NUM-OPS 1>> 0> <RETURN>)>
548 <COND (<G? <SET SHFT <+ .SHFT 8>> 0>
551 <OR .AFLG <ERROR ACCESS-BEYOND-END-OF-CODE!-ERRORS>>
553 <COND (<EMPTY? <SET CV <REST .CV>>>
554 <COND (<EMPTY? .CL> <SET AFLG <>>)
555 (ELSE <SET CV <1 .CL>> <SET CL <REST .CL>>)>)>)>
556 <SET ADR <CHTYPE <ANDB <LSH .INS .SHFT> 255> FIX>>
557 <SET EAC <CHTYPE <ANDB .ADR 240> FIX>>
558 <SET R-OR-L <CHTYPE <ANDB .ADR 15> FIX>>
560 <CHTYPE <ANDB <SET EAT <GET-OP-INFO .FNUM .OP-INF>> 7> FIX>>
561 <SET FNUM <+ .FNUM 1>>
563 (<OR <==? .EAT ,OP-BB> <==? .EAT ,OP-BW>>
572 <ADD-BYTE-TO-FCODE .ADR>
573 <SET BYTEOFF <+ .BYTEOFF 1>>
575 <COND (<0? .NUM-OPS> <SET IN-CASE? .ADR>)
576 (<1? .NUM-OPS> <SET LB .ADR>)>)>)
578 <SET FNUM <- .FNUM 1>>
579 <SET NUM-OPS <+ .NUM-OPS 1>>
580 <ADD-BYTE-TO-FCODE .ADR>
581 <SET BYTEOFF <+ .BYTEOFF 1>>)
582 (<OR <==? .EAC ,AM-REG> <==? .EAC ,AM-REGD> <==? .EAC ,AM-ADEC>>
583 <ADD-BYTE-TO-FCODE .ADR>
584 <SET BYTEOFF <+ .BYTEOFF 1>>)
585 (<OR <==? .EAC ,AM-AINC> <==? .EAC ,AM-AINCD>>
587 (<==? .R-OR-L ,NAC-PC>
588 <ADD-BYTE-TO-FCODE .ADR>
589 <SET BYTEOFF <+ .BYTEOFF 1>>
590 <COND (<==? .EAC ,AM-AINCD> <SET SIZ 4>)
591 (<OR <==? .SIZ ,SZ-L> <==? .SIZ ,SZ-F>> <SET SIZ 4>)
592 (<==? .SIZ ,SZ-W> <SET SIZ 2>)
594 <REPEAT ((CNT -8) (IMM 0))
595 <COND (<L? <SET SIZ <- .SIZ 1>> 0>
597 <COND (<L=? .NUM-OPS 0>
599 (<1? .NUM-OPS> <SET LB .IMM>)>)>
601 <COND (<G? <SET SHFT <+ .SHFT 8>> 0>
604 <OR .AFLG <ERROR ACCESS-BEYOND-END-OF-CODE!-ERRORS>>
606 <COND (<EMPTY? <SET CV <REST .CV>>>
607 <COND (<EMPTY? .CL> <SET AFLG <>>)
610 <SET CL <REST .CL>>)>)>)>
612 <SET ADR <CHTYPE <ANDB <LSH .INS .SHFT> 255> FIX>>
613 <SET IMM <ORB .IMM <LSH .ADR .CNT>>>
614 <ADD-BYTE-TO-FCODE .ADR>
615 <SET BYTEOFF <+ .BYTEOFF 1>>>)
616 (ELSE <ADD-BYTE-TO-FCODE .ADR> <SET BYTEOFF <+ .BYTEOFF 1>>)>)
618 <ADD-BYTE-TO-FCODE .ADR>
619 <SET BYTEOFF <+ .BYTEOFF 1>>
620 <COND (<OR <==? .EAC ,AM-BDD> <==? .EAC ,AM-BD>> <SET SIZ 1>)
621 (<OR <==? .EAC ,AM-WDD> <==? .EAC ,AM-WD>> <SET SIZ 2>)
622 (<OR <==? .EAC ,AM-LDD> <==? .EAC ,AM-LD>> <SET SIZ 4>)>
624 <COND (<L? <SET SIZ <- .SIZ 1>> 0> <RETURN>)>
625 <COND (<G? <SET SHFT <+ .SHFT 8>> 0>
628 <OR .AFLG <ERROR ACCESS-BEYOND-END-OF-CODE!-ERRORS>>
630 <COND (<EMPTY? <SET CV <REST .CV>>>
631 <COND (<EMPTY? .CL> <SET AFLG <>>)
634 <SET CL <REST .CL>>)>)>)>
635 <SET ADR <CHTYPE <ANDB <LSH .INS .SHFT> 255> FIX>>
636 <ADD-BYTE-TO-FCODE .ADR>
637 <SET BYTEOFF <+ .BYTEOFF 1>>>)>>)>)>
638 <COND (.IN-CASE? <SET START-CASE .BYTEOFF>)>
639 <OR .AFLG <RETURN .BYTEOFF>>
641 <COND (<EMPTY? .CL> <RETURN .BYTEOFF>)>
643 <SET CL <REST .CL>>)>
644 <COND (<G=? .PTR .MAXPTR> <RETURN .BYTEOFF>)>>
645 <COND (.CLABELS <+ .BYTEOFF <FORCE-OUT-FCODE>>) (.BYTEOFF)>>
647 <DEFINE SWAP-MODE (MODEA "AUX" LOW HIGH)
649 <SET LOW <GETBITS .MODEA <BITS 3 0>>>
650 <SET HIGH <GET-FIELD .MODEA <BITS 3 3>>>
651 <PUTBITS .HIGH <BITS 3 3> .LOW>>
653 <DEFINE GENEA (EA BYTEOFF DISP SZ "AUX" WD AMODE (RES .EA) TAB)
654 #DECL ((DISP EA SZ BYTEOFF) FIX (VALUE) FIX)
655 <COND (<AND <==? .EA ,ADDRESS-IMM> <==? .SZ ,LENGTH-LONG>>
656 <SET TAB ,CONSTANT-TABLE>
657 <COND (<0? <SET WD <NTH .TAB <+ .DISP 1>>>>
658 <SET WD <NTH .TAB .DISP>>
659 <PUT .TAB <+ .DISP 1> .BYTEOFF>
660 <ADD-WORD-TO-FCODE <LHW .WD>>
661 <ADD-WORD-TO-FCODE .WD>
662 <SET BYTEOFF <+ .BYTEOFF 4>>)
664 <SET RES ,ADDRESS-PCDISP>
665 <ADD-WORD-TO-FCODE <- .WD .BYTEOFF>>
666 <SET BYTEOFF <+ .BYTEOFF 2>>)>)
668 <SET AMODE <GET-FIELD .EA <BITS 3 3>>>
670 <SET BYTEOFF <+ .BYTEOFF 2>>
671 <ADD-WORD-TO-FCODE .DISP>)>)>
672 <PUT-LHW .RES .BYTEOFF>>
676 <COND (<1? <GET-FIELD .X <BITS 1 15>>> <ORB .X <LSH -1 16>>)
679 <DEFINE EXTEND-BYTE (X)
681 <COND (<1? <GET-FIELD .X <BITS 1 7>>> <ORB .X <LSH -1 8>>)
684 <DEFINE FORCE-OUT-FCODE ("AUX" (SHFT ,FSHIFT))
687 <COND (<L=? <SET SHFT <- .SHFT 8>> 0> <RETURN .I>)>
688 <ADD-BYTE-TO-FCODE 0>
691 <DEFINE INIT-UNRESOLVED-CALLS () <SETG UNRESOLVED-CALLS-TABLE ()>>
693 <DEFINE CHECK-UNRESOLVED-CALLS (EBYTEOFF SBYTEOFF)
694 #DECL ((SBYTEOFF EBYTEOFF) FIX)
696 <FCN (UCALL "AUX" NPTR TEM)
697 <COND (<G? <- .EBYTEOFF <UC-CALL-BYTEOFF .UCALL>>
700 <SET TEM <- .SBYTEOFF <UC-CALL-BYTEOFF .UCALL>>>
702 <ERROR CANT-JUMP-FAR-ENOUGH
703 .UCALL .SBYTEOFF .EBYTEOFF
704 CHECK-UNRESOLVED-CALLS>)>
705 <PUT-FCODE <UC-CODE-PTR .UCALL>
706 <CHTYPE <ANDB .TEM 255> FIX>>
707 <PUT-FCODE <+ <UC-CODE-PTR .UCALL> 1>
708 <CHTYPE <ANDB <LSH .TEM -8> 255> FIX>>
709 <PUT .UCALL ,UC-CALL-BYTEOFF <+ .SBYTEOFF 3>>
710 <ADD-BYTE-TO-FCODE ,INST-BRW>
711 <SET NPTR <ADD-BYTE-TO-FCODE 0>>
712 <ADD-BYTE-TO-FCODE 0>
713 <PUT .UCALL ,UC-CODE-PTR .NPTR>
714 <SET SBYTEOFF <+ .SBYTEOFF 3>>)>>
715 ,UNRESOLVED-CALLS-TABLE>
718 <DEFINE ADD-UNRESOLVED-CALLS ("AUX" (TAB ,UNRESOLVED-CALLS-TABLE))
721 <OR .UCALL <MAPLEAVE>>
722 <COND (<G? <UC-CODE-PTR .UCALL> 0>
726 ; "Try a little harder to keep calls in the
727 right order, avoiding fencepost death
728 in check-unresolved-calls"
729 <PUTREST <REST .TAB <- <LENGTH .TAB> 1>>
732 <SETG UNRESOLVED-CALLS-TABLE .TAB>>
734 <DEFINE FIXUP-UNRESOLVED-CALLS (CE "AUX" (NAME <CET-MSUBR-NAME .CE>))
735 #DECL ((CE) CALL-ENTRY)
736 <REPEAT ((PTR ,UNRESOLVED-CALLS-TABLE) (PPTR .PTR) UCALL OFF)
737 #DECL ((OFF) <OR FALSE FIX>)
738 <COND (<EMPTY? .PTR> <RETURN>)>
740 <COND (<SAME-NAME? <UC-NAME .UCALL> .NAME>
741 <OR <SET OFF <FIND-ENTRY-LOC .CE <UC-NUMBER-ARGS .UCALL>>>
742 <ERROR "CANT JUMP" FIXUP-UNRESOLVED-CALLS>>
743 <SET OFF <- .OFF <UC-CALL-BYTEOFF .UCALL>>>
744 <AND <G? <ABS .OFF> ,JUMP-EXTENT>
745 <ERROR "CANT JUMP" FIXUP-UNRESOLVED-CALLS>>
746 <PUT-FCODE <UC-CODE-PTR .UCALL> <CHTYPE <ANDB .OFF 255> FIX>>
747 <PUT-FCODE <+ <UC-CODE-PTR .UCALL> 1>
748 <CHTYPE <ANDB <LSH .OFF -8> 255> FIX>>
749 <COND (<==? .PTR .PPTR>
750 <SETG UNRESOLVED-CALLS-TABLE <REST .PTR>>
751 <SET PPTR <REST .PTR>>)
752 (<PUTREST .PPTR <REST .PTR>>)>)
754 <SET PTR <REST .PTR>>>>