2 "CODE IS STORED IN A LIST OF UVECTORS. EACH INSTRUCTION IS A FIX. THE
3 INSTRUCTION CONTAINS THE INSTRUCTION BYTE (8 BITS) + INFORMATION TO FIX UP THE
4 INSTRUCTION. WHEN AN INSTRUCTION DOES NOT FIT INTO A SINGLE FIX IT IS
5 FOLLOWED BY ADDITIONAL FIXES. EVERY INSTRUCTION TAKES UP AN INTEGER NUMBER OF
6 FIXES EVEN THOUGH THE OUTPUT VERSION MAY BE DIFFERENT. THERE IS A TEMPORARY
7 FIXUP TABLE WHICH IS USED TO DETERMINE THE LOCATION OF THE TEMPORARIES AND
8 ALSO A LABEL FIXUP TABLE TO KEEP TRACK OF THE LABELS. THE SYSTEM ATTEMPTS
9 TO FIX UP LABELS IN PARTICULAR INTERVALS SO THAT IT DOESN'T HAVE TO KEEP
10 TRACK OF TOO MANY LABELS. ANY NON-LOOPING LABELS WILL BE FLUSHED AS SOON
11 AS THEY ARE FIXED UP. THERE IS ALSO A CONSTANT TABLE WHICH KEEPS TRACK OF
12 THE LOCATION OF ALL FULL-WORD CONSTANTS. THESE ARE FIXED UP LIKE LABELS. IN
13 GENERAL THE FIRST OCCURANCE OF A 32 BIT CONSTANT WILL BE OUTPUT AS AN
14 IMMEDIATE INSTRUCTION. ALL OTHER OCCURANCES WILL BE OUTPUT AS A REFERENCE
15 TO THAT CONSTANT IN PC-RELATIVE MODE (THIS WILL BE AN OPTION. WE MAY
16 EVENTUALLY GENERATE ALL CONSTANTS IMMEDIATE IF THAT PROVES TO GENERATE
20 <SETG CURRENT-CODE <IUVECTOR ,CODEVEC-LENGTH 0>>
21 <SETG CODE-LIST (,CURRENT-CODE)>
25 <SETG CURRENT-CODE <1 ,CODE-LIST>>
27 <SETG SAVED-CODE-COUNT <>>
28 <SETG SAVED-CODE-STACK ()>>
30 <DEFINE NTH-CODE (NUM "AUX" (CL ,CODE-LIST))
31 #DECL ((NUM) FIX (CL) <LIST [REST CODEVEC]>)
33 <COND (<L=? .PTR ,CODEVEC-LENGTH> <RETURN <NTH <1 .CL> .PTR>>)>
34 <COND (<EMPTY? <SET CL <REST .CL>>>
35 <ERROR OUT-OF-BOUNDS .NUM NTH-CODE>)>
36 <SET PTR <- .PTR ,CODEVEC-LENGTH>>>>
38 <DEFINE PUT-CODE (NUM VAL "AUX" (CL ,CODE-LIST))
39 #DECL ((NUM VAL) FIX (CL) <LIST [REST CODEVEC]>)
41 <COND (<L=? .PTR ,CODEVEC-LENGTH>
42 <PUT <1 .CL> .PTR .VAL>
44 <COND (<EMPTY? <SET CL <REST .CL>>>
45 <ERROR OUT-OF-BOUNDS .NUM>)>
46 <SET PTR <- .PTR ,CODEVEC-LENGTH>>>>
48 <DEFINE ADD-WORD-TO-CODE (WD
49 "AUX" RLST (CCODE ,CURRENT-CODE)
52 <COND (<EMPTY? .CCODE>
54 <REST ,CODE-LIST <- </ <- .COUNT 1> ,CODEVEC-LENGTH> 1>>>
55 <COND (<1? <LENGTH .RLST>>
56 <SET CCODE <IUVECTOR ,CODEVEC-LENGTH 0>>
57 <PUTREST .RLST (.CCODE)>)
58 (ELSE <SET CCODE <2 .RLST>>)>)>
60 <SETG CURRENT-CODE <REST .CCODE>>
61 <SETG CODE-COUNT <+ .COUNT 1>>>
63 <DEFINE PRINT-SPEC-LABEL (X "AUX" (OUTCHAN .OUTCHAN))
64 #DECL ((X) SPEC-LABEL)
65 <PRINC "ITAG" .OUTCHAN>
66 <PRIN1 <CHTYPE .X FIX> .OUTCHAN>>
68 <COND (<GASSIGNED? PRINT-SPEC-LABEL> <PRINTTYPE SPEC-LABEL ,PRINT-SPEC-LABEL>)>
70 <DEFINE PRINT-LABEL-REF (LREF "AUX" (OUTCHAN .OUTCHAN))
71 #DECL ((LREF) LABEL-REF)
72 <PRINC "#LABEL-REF " .OUTCHAN>
73 <PRIN1 <LABEL-REF-NAME .LREF> .OUTCHAN>>
75 <COND (<GASSIGNED? PRINT-LABEL-REF> <PRINTTYPE LABEL-REF ,PRINT-LABEL-REF>)>
77 <DEFINE INIT-LABEL-TABLE (RESTART "AUX" TMP LAB)
79 <SET LAB <CREATE-LABEL-REF \ >>
80 <SET TMP <IVECTOR ,MAX-OUTST-LABELS '.LAB>>
81 <SETG OUTST-LABEL-TABLE <REST .TMP <LENGTH .TMP>>>
82 <AND .RESTART <SETG CURRENT-SLABEL 0>>
86 <DEFINE MAKE-LABEL ("OPTIONAL" (ATM? <>) "AUX" STR
87 (NUM <COND (<NOT <GASSIGNED? CURRENT-SLABEL>> 0)
90 <SETG CURRENT-SLABEL .NUM>
92 <COND (<NOT <TYPE? .ATM? STRING>> <SET ATM? "ITAG">)>
93 <SET STR <STRING .ATM? <UNPARSE .NUM>>>
94 <OR <LOOKUP .STR ,VAR-OBLIST> <INSERT .STR ,VAR-OBLIST>>)
95 (<CHTYPE .NUM SPEC-LABEL>)>>
97 <DEFINE COPY-PSAVE (PSAVE NCODE "AUX" RES INST)
98 #DECL ((PSAVE) PTN-SAVE (NCODE) CODEVEC)
100 <CHTYPE <VECTOR .NCODE
106 <PUT .PSAVE ,PTNS-SUBS (.RES !<PTNS-SUBS .PSAVE>)>
107 <SETG PTNS-TABLE (.RES !,PTNS-TABLE)>
108 <SET INST <PUT-RHW ,INST-PSTORE ,PTNS-COUNT>>
109 <SETG PTNS-COUNT <+ ,PTNS-COUNT 1>>
112 <DEFINE KILL-PSAVE (PSAVE)
113 #DECL ((PSAVE) PTN-SAVE)
114 <PUT .PSAVE ,PTNS-USE <>>
115 <MAPF <> <FCN (SPS) <PUT .SPS ,PTNS-USE <>>> <PTNS-SUBS .PSAVE>>>
117 <DEFINE EMIT-POTENTIAL-STORE (CODE KIND LVAR "AUX" PTN)
118 #DECL ((CODE) CODEVEC (KIND) ATOM (LVAR) LINKVAR)
120 <CHTYPE <VECTOR .CODE <LINKVAR-VAR .LVAR> .KIND T ()> PTN-SAVE>>
121 <SETG PTNS-TABLE (.PTN !,PTNS-TABLE)>
122 <ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-PSTORE 24>
125 <SETG PTNS-COUNT <+ ,PTNS-COUNT 1>>
127 <FCN (XREF "AUX" (CPSAVE <XREF-INFO-PSAVES .XREF>))
128 <PUT .XREF ,XREF-INFO-PSAVES (.PTN !.CPSAVE)>>
129 <LINKVAR-POTENTIAL-SAVES .LVAR>>>
131 <DEFINE GET-PTNS (NUM) <NTH ,PTNS-TABLE <- ,PTNS-COUNT .NUM>>>
133 <DEFINE SAVE-XREF-AC-INFO (XREF SSTATE SLSTATE)
134 #DECL ((XREF) XREF-INFO (SSTATE) AC-STATE (SLSTATE) SLOAD-STATE)
135 <PUT .XREF ,XREF-INFO-SAVED-AC-INFO .SSTATE>
136 <PUT .XREF ,XREF-INFO-SLSTATE .SLSTATE>>
138 <DEFINE PRINT-XREF-INFO (XREF "AUX" (OUTCHAN .OUTCHAN))
139 #DECL ((XREF) XREF-INFO)
140 <PRINC "#XREF-INFO " .OUTCHAN>
141 <PRIN1 <LABEL-REF-NAME <XREF-INFO-LABEL .XREF>> .OUTCHAN>
143 <PRIN1 <XREF-INFO-POINT .XREF> .OUTCHAN>>
145 <COND (<GASSIGNED? PRINT-XREF-INFO> <PRINTTYPE XREF-INFO ,PRINT-XREF-INFO>)>
147 "UPDATE THE LABEL TABLES FOR A BRANCH"
149 <DEFINE UPDLT-BRANCH (LABEL CODEPTR STATUS? LILEN FORCEL?
150 "AUX" NLREF (OUTST ,OUTST-LABEL-TABLE) XREF)
151 #DECL ((LABEL) <OR ATOM SPEC-LABEL> (CODEPTR) FIX (FORCEL?) BOOLEAN)
152 <SET NLREF <GET-LREF .LABEL>>
153 <ADD-XREF .NLREF .CODEPTR .STATUS? .LILEN .FORCEL?>>
155 <DEFINE GET-LREF GL (LABEL "OPTIONAL" (JUST-LOOKING? <>) "AUX" NLR)
156 #DECL ((LABEL) <OR ATOM SPEC-LABEL>)
159 #DECL ((LREF) LABEL-REF)
160 <COND (<==? <LABEL-REF-NAME .LREF> .LABEL>
161 <COND (<NOT .JUST-LOOKING?>
162 <LABEL-REF-NOT-REAL .LREF <>>)>
163 <RETURN .LREF .GL>)>>
165 <SET NLR <CREATE-LABEL-REF .LABEL>>
166 <LABEL-REF-NOT-REAL .NLR .JUST-LOOKING?>
167 <ADD-OUTSTANDING-LABEL .NLR>
170 <DEFINE CREATE-LABEL-REF (NAME)
171 #DECL ((NAME) <OR ATOM SPEC-LABEL>)
172 <CHTYPE [.NAME () -1 0 <> <> () () <>] LABEL-REF>>
174 <DEFINE ADD-OUTSTANDING-LABEL (LREF "AUX" (OUTST ,OUTST-LABEL-TABLE) NOUTST)
175 #DECL ((LREF) LABEL-REF)
176 <COND (<==? .OUTST <TOP .OUTST>>
177 <SET NOUTST <VECGROW .OUTST ,MAX-OUTST-LABELS>>
178 <SET NOUTST <REST .NOUTST <- ,MAX-OUTST-LABELS 1>>>
179 <PUT .NOUTST 1 .LREF>
180 <SUBSTRUC .OUTST 0 <LENGTH .OUTST> <REST .NOUTST>>
181 <SETG OUTST-LABEL-TABLE .NOUTST>)
183 <SET OUTST <BACK .OUTST>>
185 <SETG OUTST-LABEL-TABLE .OUTST>)>>
187 "FINDS AND REMOVES A LABEL FROM THE OUTSTANDING LABEL TABLE. THE LABEL WILL
188 NOT BE REMOVED IF IT IS A LOOP LABEL"
190 <DEFINE REMOVE-OUTSTANDING-LABEL (LABEL "AUX" (OUTST ,OUTST-LABEL-TABLE))
191 #DECL ((LABEL) <OR SPEC-LABEL ATOM> (OUTST) <VECTOR [REST LABEL-REF]>
192 (VALUE) <OR FALSE LABEL-REF>)
193 <REPEAT ((PTR 1) LREF (LEN <LENGTH .OUTST>))
194 <COND (<G? .PTR .LEN> <RETURN <>>)>
195 <SET LREF <NTH .OUTST .PTR>>
196 <COND (<==? <LABEL-REF-NAME .LREF> .LABEL>
197 <COND (<OR <LABEL-REF-LOOP-LABEL .LREF>
198 <LABEL-REF-NOT-REAL .LREF>>
201 <SETG OUTST-LABEL-TABLE <REST .OUTST>>
204 <SUBSTRUC .OUTST 0 <- .PTR 1> <REST .OUTST>>
205 <SETG OUTST-LABEL-TABLE <REST .OUTST>>
207 <SET PTR <+ .PTR 1>>>>
209 "UPDATE LABEL TABLES WHEN ENCOUNTERING AN ACTUAL LABEL"
211 <DEFINE UPDLT-LABEL (LABEL CODEPTR LOOP?
212 "AUX" LREF (LTAB ,LABEL-TABLE)
213 (TABPTR <+ <LENGTH .LTAB> 1>))
214 #DECL ((LABEL) <OR ATOM SPEC-LABEL> (CODEPTR) FIX
215 (LOOP?) <OR FALSE AC-STATE ATOM>)
216 <SET LREF <REMOVE-OUTSTANDING-LABEL .LABEL>>
218 <SET LREF <CREATE-LABEL-REF .LABEL>>
219 <ADD-OUTSTANDING-LABEL .LREF>)
220 (<LABEL-REF-NOT-REAL .LREF <>>)>
221 <PUT .LREF ,LABEL-REF-CODE-PTR .CODEPTR>
222 <PUT .LREF ,LABEL-REF-LOOP-LABEL .LOOP?>
223 <COND (<EMPTY? .LTAB> <SETG LABEL-TABLE (.LREF)>)
224 (<PUTREST <REST .LTAB <- <LENGTH .LTAB> 1>> (.LREF)>)>
225 <FIXUP-BRANCH-REFERENCES <LABEL-REF-XREFS .LREF> .TABPTR>
226 <LABEL-REF-LIVE-VARS .LREF ()>
227 <LABEL-REF-DEAD-VARS .LREF ()>
230 <DEFINE FIXUP-BRANCH-REFERENCES (XREFS TABPTR)
231 #DECL ((XREFS) <LIST [REST XREF-INFO]> (TABPTR) FIX)
233 <FCN (XREF "AUX" (CODPTR <XREF-INFO-POINT .XREF>) INST)
235 <CHTYPE <ORB <NTH-CODE .CODPTR> .TABPTR> FIX>>
236 <PUT-CODE .CODPTR .INST>>
239 <DEFINE ADD-XREF (LREF CODPTR STATUS? LILEN FORCEL? "AUX" XREF)
240 #DECL ((LREF) LABEL-REF (CODPTR) FIX (VALUE) XREF-INFO (STATUS?) ANY
241 (LILEN) FIX (FORCEL?) BOOLEAN)
243 <CHTYPE <VECTOR .LREF
256 <PUT .LREF ,LABEL-REF-XREFS (.XREF !<LABEL-REF-XREFS .LREF>)>
259 <DEFINE EMIT-BRANCH (INST LABEL STATUS? LILEN
260 "OPTIONAL" (ACNUM <>) (FORCEL? <>) (XT <>)
261 "AUX" XREF (CNT 1) LREF)
262 #DECL ((INST) FIX (LABEL) <OR ATOM SPEC-LABEL> (XREF) XREF-INFO
264 <SET INST <CHTYPE <LSH .INST 24> FIX>>
265 <SET XREF <UPDLT-BRANCH .LABEL ,CODE-COUNT .STATUS? .LILEN .FORCEL?>>
266 <SET LREF <XREF-INFO-LABEL .XREF>>
267 <COND (<NOT <0? <LABEL-REF-CODE-PTR .LREF>>>
270 <COND (<==? .TREF .LREF> <MAPLEAVE>)>
271 <SET CNT <+ .CNT 1>>>
273 <SET INST <CHTYPE <ORB .INST .CNT> FIX>>)>
274 <COND (.ACNUM <SET INST <CHTYPE <ORB .INST <LSH .ACNUM -8>> FIX>>)>
275 <ADD-WORD-TO-CODE .INST>
276 <SETG LAST-INST-LENGTH 1>
279 <DEFINE EMIT-LABEL (LABEL LOOP?)
280 #DECL ((LABEL) <OR ATOM SPEC-LABEL> (LOOP?) <OR FALSE AC-STATE ATOM>)
281 <UPDLT-LABEL .LABEL ,CODE-COUNT .LOOP?>>
283 "THE CONSTANT TABLE CONSISTS OF CONSTANT ADDRESS PAIRS. THE ADDRESS MAY HAVE
284 3 STATES. IF IT IS NON-ZERO. THEN IT IS THE ADDRESS OF THE MOST RECENT
285 EMITTED VERSION OF A CONSTANT. IF IT IS ZERO THEN IT INDICATES THAT A VERSION
286 OF THE CONSTANT WILL BE EMITTED BY SOME INSTRUCTION IN THE CURRENT SUBROUTINE
287 -1 IS USED BY THE SCAN PASS TO INDICATE THAT THE CONSTANT WILL HAVE BEEN
288 BEEN EMITTED BY A PREVIOUS INSTRUCTION"
290 <DEFINE INIT-CONSTANTS ()
291 <SETG CONSTANT-POINTER 1>
292 <SETG CONSTANT-TABLE <IUVECTOR ,CONSTANT-TABLE-SIZE 0>>>
294 <DEFINE RESET-CONSTANTS () <SETG CONSTANT-POINTER 1>>
296 "WARNING: THIS ADDS AN ENTRY TO THE CONSTANT TABLE IF IT IS NOT
297 ALREADY THERE. THE INITIAL VERSION OF THIS ALGORITHM USES LINEAR
298 SEARCH. THIS MAY SLOW DOWN THE WORLD"
300 <DEFINE AGEN-CONST (NUM "AUX" (TAB ,CONSTANT-TABLE) NTAB)
304 (<==? .PTR ,CONSTANT-POINTER>
305 <COND (<G? .PTR <LENGTH .TAB>>
307 <IUVECTOR <+ <LENGTH .TAB> ,CONSTANT-TABLE-INCREMENT>
310 <FCN (TAB1 TAB2) <PUT .TAB1 1 <1 .TAB2>>>
314 <SETG CONSTANT-TABLE .TAB>)>
315 <PUT ,CONSTANT-TABLE .PTR .NUM>
316 <PUT ,CONSTANT-TABLE <+ .PTR 1> 0>
317 <SETG CONSTANT-POINTER <+ ,CONSTANT-POINTER 2>>
319 (<==? .NUM <NTH .TAB .PTR>> <RETURN .PTR>)>
320 <SET PTR <+ .PTR 2>>>>
322 <DEFINE INIT-PATCH-TABLE () <SETG PATCH-TABLE ()> <SETG NUM-PATCH 1>>
324 <DEFINE ADD-PATCH (PATCHTYPE "AUX" NPATCH INST (NUM ,NUM-PATCH))
325 #DECL ((PATCHTYPE) ATOM)
326 <SET NPATCH <CHTYPE <VECTOR ![!] .PATCHTYPE> PATCH>>
327 <SETG PATCH-TABLE (.NPATCH !,PATCH-TABLE)>
328 <SET INST <CHTYPE <ORB <LSH ,INST-PATCH 24> .NUM> FIX>>
329 <ADD-WORD-TO-CODE .INST>
330 <SETG NUM-PATCH <+ .NUM 1>>
333 <DEFINE GET-PATCH (NUM "AUX" (TAB ,PATCH-TABLE))
334 #DECL ((NUM) FIX (CDV) CODEVEC)
335 <NTH .TAB <- <LENGTH .TAB> <- .NUM 1>>>>
337 <DEFINE INSERT-PATCH (NUM CDV "AUX" PATCH)
338 #DECL ((NUM) FIX (CDV) CODEVEC)
339 <SET PATCH <GET-PATCH .NUM>>
340 <PUT .PATCH ,PATCH-CODE .CDV>>
342 <DEFINE EMIT (INST "TUPLE" FIELDS)
343 <COND (<MEMQ .INST ,SPECIAL-OPS>
345 <CHTYPE <ORB <LSH .INST 24> <ANDB .INST *7777*>> FIX>>)
346 (ELSE <REAL-EMIT .INST .FIELDS <>>)>>
348 <GDECL (LAST-INST-LENGTH) FIX>
351 <DEFINE REAL-EMIT (INST FIELDS WHERE
352 "AUX" (INST-INFO <GET-INST-INFO .INST>)
353 (NUM-OPS <CHTYPE <LSH <2 .INST-INFO> <- ,INIT-SHIFT>>
356 #DECL ((FNUM INST NUM-OPS SHFT) FIX (WHERE) <OR FALSE FIX>
357 (INST-INFO) <UVECTOR [3 FIX]> (FIELDS) TUPLE)
358 <SET INST <CHTYPE <LSH .INST 24> FIX>>
359 <COND (<NOT .WHERE> <SETG LAST-INST-LENGTH 0>)>
361 <FCN (FLD "AUX" REG-OR-LIT EAC SIZC MODC OPREQ (NBYTES 0) IMWRD)
362 #DECL ((REG-OR-LIT EAC SIZC MODC OPREQ NBYTES IMWRD) FIX)
364 <ERROR TOO-MANY-OPERANDS!-ERRORS .INST !.FIELDS>)>
365 <COND (<NOT <TYPE? .FLD EFF-ADDR LADDR>>
366 <ERROR BAD-CALL-TO-EMIT!-ERRORS .INST !.FIELDS>)>
367 <COND (<TYPE? .FLD LADDR>
368 <SET IMWRD <CHTYPE <2 .FLD> FIX>>
369 <SET FLD <CHTYPE <LSH <1 .FLD> -24> FIX>>)
371 <SET IMWRD <CHTYPE <LSH .FLD 8> FIX>>
373 <SET FLD <CHTYPE <LSH .FLD -24> FIX>>)>
374 <SET EAC <CHTYPE <ANDB .FLD 240> FIX>>
375 <SET REG-OR-LIT <CHTYPE <ANDB .FLD 15> FIX>>
376 <COND (<N==? .EAC ,AM-INX>
377 <SET NUM-OPS <- .NUM-OPS 1>>
378 <SET OPREQ <GET-OP-INFO .FNUM .INST-INFO>>
379 <SET SIZC <CHTYPE <ANDB .OPREQ 7> FIX>>
380 <SET MODC <CHTYPE <LSH .OPREQ -3> FIX>>
381 <SET FNUM <+ .FNUM 1>>)>
382 <COND (<AND <G=? .EAC ,AM-INX>
384 <==? .REG-OR-LIT ,NAC-PC>>
385 <ERROR CANT-INDEX-PC!-ERRORS .INST !.FIELDS>)
387 <COND (<OR <AND <OR <==? .EAC ,AM-AINCD>
388 <AND <==? .EAC ,AM-AINC>
389 <OR <==? .SIZC ,SZ-L>
391 <==? .REG-OR-LIT ,NAC-PC>>
395 (<OR <==? .EAC ,AM-WD>
397 <AND <==? .EAC ,AM-AINC>
399 <==? .REG-OR-LIT ,NAC-PC>>>
401 (<OR <==? .EAC ,AM-BD>
403 <AND <==? .EAC ,AM-AINC>
405 <==? .REG-OR-LIT ,NAC-PC>>>
407 (<AND <==? .EAC ,AM-AINC> <==? .REG-OR-LIT ,NAC-PC>>
408 <COND (<OR <==? .SIZC ,SZ-Q> <==? .SIZC ,SZ-D>>
410 (<==? .SIZC ,SZ-O> <SET NBYTES 16>)
411 (ELSE <ERROR FOO!-ERRORS>)>)
412 (ELSE <SET NBYTES 0>)>)
413 (ELSE <SET NBYTES 0>)>
414 <SET INST <CHTYPE <ORB .INST <LSH .FLD .SHFT>> FIX>>
415 <COND (<L? <SET SHFT <- .SHFT 8>> 0>
418 <PUT-CODE .WHERE .INST>
419 <SET WHERE <+ .WHERE 1>>)
421 <ADD-WORD-TO-CODE .INST>
422 <SETG LAST-INST-LENGTH <+ ,LAST-INST-LENGTH 1>>)>
425 <COND (<L? <SET NBYTES <- .NBYTES 1>> 0> <RETURN>)>
428 <LSH <ANDB .IMWRD *37700000000*>
431 <SET IMWRD <CHTYPE <LSH .IMWRD 8> FIX>>
432 <COND (<L? <SET SHFT <- .SHFT 8>> 0>
434 <PUT-CODE .WHERE .INST>
435 <SET WHERE <+ .WHERE 1>>)
437 <ADD-WORD-TO-CODE .INST>
438 <SETG LAST-INST-LENGTH
439 <+ ,LAST-INST-LENGTH 1>>)>
443 <COND (<N==? .NUM-OPS 0> <ERROR TOO-FEW-FIELDS!-ERRORS .INST !.FIELDS>)>
444 <COND (<N==? .SHFT 24>
445 <COND (.WHERE <PUT-CODE .WHERE .INST> <SET WHERE <+ .WHERE 1>>)
447 <ADD-WORD-TO-CODE .INST>
448 <SETG LAST-INST-LENGTH <+ ,LAST-INST-LENGTH 1>>)>)>>
451 <DEFINE EMIT-LABEL-WORD (LABEL "AUX" XREF LREF (INST 0) (CNT 1))
452 #DECL ((LABEL) ATOM (XREF) XREF-INFO)
453 <SET XREF <UPDLT-BRANCH .LABEL ,CODE-COUNT NORMAL 1 <>>>
454 <SET LREF <XREF-INFO-LABEL .XREF>>
455 <COND (<NOT <0? <LABEL-REF-CODE-PTR .LREF>>>
458 <COND (<==? .TREF .LREF> <MAPLEAVE>)>
459 <SET CNT <+ .CNT 1>>>
461 <SET INST <CHTYPE <ORB .INST .CNT> FIX>>)>
462 <ADD-WORD-TO-CODE .INST>
463 <SETG LAST-INST-LENGTH 1>
467 <DEFINE BAD-MOVE (EA1 EA2 MSIZE "OPT" EXTRA "AUX" INST)
469 <COND (<==? .MSIZE ZWL> <SET INST ,INST-MOVZWL>)
470 (<==? .MSIZE LONG> <SET INST ,INST-MOVL>)
471 (<==? .MSIZE WORD> <SET INST ,INST-MOVW>)
472 (<==? .MSIZE BYTE> <SET INST ,INST-MOVB>)
473 (<==? .MSIZE DOUBLE> <SET INST ,INST-MOVQ>)>
474 <COND (<AND <ASSIGNED? EXTRA> .EXTRA>
475 <COND (<N==? <PRIMTYPE .EXTRA> FIX>
476 <EMIT .INST .EA1 !.EXTRA .EA2>)
478 <EMIT .INST .EA1 .EXTRA .EA2>)>)
480 <EMIT .INST .EA1 .EA2>)>>
482 <DEFINE RE-EMIT-MOVE (PTR EA1 EA2 MSIZE "AUX" INST (X <TUPLE .EA1 .EA2>))
483 #DECL ((EA1 EA2) EFF-ADDR (MSIZE) ATOM (PTR) FIX)
485 <COND (<==? .MSIZE LONG> <SET INST ,INST-MOVL>)
486 (<==? .MSIZE WORD> <SET INST ,INST-MOVW>)
487 (<==? .MSIZE BYTE> <SET INST ,INST-MOVB>)
488 (<==? .MSIZE DOUBLE> <SET INST ,INST-MOVQ>)>
489 <REAL-EMIT .INST .X .PTR>>
491 "MAKE SURE CONSTANT IS CORRECT IF IMMEDIATE. IF LONG WORD OPERATION
492 SHOULD USE CONSTANT TABLE"
494 <DEFINE IMM-CHECK (EA SIZE "AUX" FLD NUM)
495 #DECL ((EA) EFF-ADDR (SIZE) ATOM)
496 <SET FLD <GET-FIELD .EA ,EA-FIELD>>
497 <COND (<==? .SIZE LONG>
498 <COND (<==? .FLD ,ADDRESS-IMM-LONG>
499 <CHTYPE <PUTBITS .EA ,EA-FIELD ,ADDRESS-IMM> EFF-ADDR>)
500 (<==? .FLD ,ADDRESS-IMM>
501 <SET NUM <EXTEND <LHW .EA>>>
502 <SET NUM <AGEN-CONST .NUM>>
503 <CHTYPE <PUT-LHW .FLD .NUM> EFF-ADDR>)
505 (<==? .FLD ,ADDRESS-IMM-LONG>
506 <ERROR "CANT USE LONG CONSTANT" .EA .SIZE IMM-CHECK>)
509 <DEFINE START-CODE-INSERT ("AUX" (CNT ,SAVED-CODE-COUNT))
510 <COND (.CNT <SETG SAVED-CODE-STACK (.CNT !,SAVED-CODE-STACK)>)>
511 <SETG SAVED-CODE-COUNT ,CODE-COUNT>>
513 <DEFINE END-CODE-INSERT ("AUX" (CCOUNT ,CODE-COUNT) RES
514 (START ,SAVED-CODE-COUNT))
515 #DECL ((VALUE) CODEVEC)
519 <COND (<==? .CCOUNT .START> <MAPSTOP>)>
520 <SET EL <NTH-CODE .START>>
521 <SET START <+ .START 1>>
523 <SETG CODE-COUNT ,SAVED-CODE-COUNT>
524 <REPEAT ((PTR ,CODE-COUNT) (CL ,CODE-LIST))
525 #DECL ((CL) <LIST [REST UVECTOR]>)
526 <COND (<L=? <- .PTR 1> ,CODEVEC-LENGTH>
527 <SETG CURRENT-CODE <REST <1 .CL> <- .PTR 1>>>
529 <COND (<EMPTY? <SET CL <REST .CL>>>
530 <ERROR OUT-OF-BOUNDS END-CODE-INSERT>)>
531 <SET PTR <- .PTR ,CODEVEC-LENGTH>>>
532 <COND (<EMPTY? ,SAVED-CODE-STACK> <SETG SAVED-CODE-COUNT <>>)
534 <SETG SAVED-CODE-COUNT <1 ,SAVED-CODE-STACK>>
535 <SETG SAVED-CODE-STACK <REST ,SAVED-CODE-STACK>>)>
538 <DEFINE EMIT-MOVE GM (EA1 EA2 SZ "OPT" (EXTRA <>) "AUX" TMP (ISZ .SZ) ABS TB
540 <COND (<AND <NOT .EXTRA>
542 <==? <1 .EA1> <MA-AINC ,AC-PC>>
543 <==? <LENGTH .EA1> 2>
545 ; "Get constant back"
546 <SET TMP <CHTYPE <LREV <2 .EA1>> FIX>>
548 ; "Do sign-extension"
549 <COND (<NOT <0? <ANDB .TMP *020000000000*>>>
550 <SET TMP <PUTBITS .TMP <BITS 4 32> -1>>)>)>
552 <COND (<AND <L? .TMP 256>
555 (<AND <L? .TMP 65536>
560 (<AND <TYPE? .EA1 EFF-ADDR>
561 <L=? <SET TMP <LREV .EA1>> *77*>
566 ; "can't do anything here"
567 <BAD-MOVE .EA1 .EA2 .SZ .EXTRA>
570 <SET INST <COND (<==? .SZ BYTE> ,INST-CLRB)
571 (<==? .SZ WORD> ,INST-CLRW)
572 (<==? .SZ LONG> ,INST-CLRL)
573 (<==? .SZ DOUBLE> ,INST-CLRQ)>>
575 (<AND <L=? .ABS *77*>
577 <SET EA1 <MA-LIT .ABS>>
579 <BAD-MOVE .EA1 .EA2 .SZ .EXTRA>)
581 <SET INST <COND (<==? .SZ BYTE> ,INST-MNEGB)
582 (<==? .SZ WORD> ,INST-MNEGW)
583 (<==? .SZ LONG> ,INST-MNEGL)>>
584 <EMIT .INST .EA1 .EA2>)>)
586 <BAD-MOVE .EA1 .EA2 .SZ .EXTRA>)
588 <COND (<==? .ISZ BYTE>
596 <EMIT <COND (<==? .SZ WORD> <1 .TB>)
598 <COND (<==? .ISZ BYTE> <MA-BYTE-IMM .TMP>)
599 (<==? .ISZ WORD> <MA-WORD-IMM .TMP>)
600 (<==? .ISZ LONG> <MA-LONG-IMM .TMP>)>
603 <DEFINE EMIT-PUSH EP (EADDR SZ "AUX" TMP (ISZ .SZ) ABS TB)
604 #DECL ((EADDR) <OR EFF-ADDR LADDR> (SZ) ATOM (TB) VECTOR)
605 <EMIT-MOVE .EADDR <MA-AINC ,AC-TP> .SZ>>
607 <SETG BYTE-TAB [[,INST-CVTBW ,INST-CVTWL]
608 [,INST-MOVZBW ,INST-MOVZBL]]>
609 <SETG WORD-TAB [[0 ,INST-CVTWL]
612 <DEFINE EMIT-POP (EADDR SZ)
613 #DECL ((EADDR) <OR AC EFF-ADDR> (SZ) ATOM)
614 <COND (<TYPE? .EADDR EFF-ADDR> <EMIT-MOVE <MA-ADEC ,AC-TP> .EADDR .SZ>)
615 (ELSE <EMIT-MOVE <MA-ADEC ,AC-TP> <MA-REG .EADDR> .SZ>)>>
617 <DEFINE CLEAR-PUSH ("OPTIONAL" (LENGTH LONG))
618 <EMIT <COND (<==? .LENGTH LONG> ,INST-CLRL)
619 (<==? .LENGTH WIRD> ,INST-CLRW)
620 (<==? .LENGTH BYTE> ,INST-CLRB)
621 (<==? .LENGTH DOUBLE> ,INST-CLRQ)
625 <DEFINE FIND-CALL-ENTRY (NAME)
629 <COND (<SAME-NAME? <CET-MSUBR-NAME .CE> .NAME>
633 <DEFINE FIND-CALL-POINT (NAME NARGS "AUX" CE)
634 #DECL ((NAME) ATOM (NARGS) FIX)
635 <COND (<SET CE <FIND-CALL-ENTRY .NAME>> <FIND-ENTRY-LOC .CE .NARGS>)>>
637 <DEFINE FIND-ENTRY-LOC (CE NARGS "AUX" (CUV <CET-DISPATCH .CE>))
638 #DECL ((CE) CALL-ENTRY (NARGS) FIX)
640 <AND <==? <1 .CUV> .NARGS> <RETURN <2 .CUV>>>
641 <AND <==? <1 .CUV> -1> <SET FINAL <2 .CUV>>>
642 <COND (<AND <==? .NARGS -1> .FINAL> <RETURN .FINAL>)
643 (<AND <==? <LENGTH .CUV> 2> <G? .NARGS <1 .CUV>>>
645 (<EMPTY? .CUV> <RETURN .FINAL>)>
646 <SET CUV <REST .CUV 2>>>>
648 <DEFINE INIT-INTERNAL-ENTRYS () <SETG INTERNAL-ENTRY-TABLE ()>>
650 <DEFINE INIT-CALL-ENTRYS () <SETG CALL-ENTRY-TABLE ()>>
652 <DEFINE ADD-INTERNAL-ENTRY (NUMARGS LABEL "AUX" IE)
653 #DECL ((NUMARGS) FIX (LABEL) <OR ATOM SPEC-LABEL>)
656 <COND (<==? <LABEL-REF-NAME .LREF> .LABEL>
657 <SET IE <CHTYPE <VECTOR .NUMARGS .LREF> INT-ENTRY>>
658 <SETG INTERNAL-ENTRY-TABLE
659 (.IE !,INTERNAL-ENTRY-TABLE)>)>>
662 <DEFINE UPDATE-CALL-ENTRY-TABLE (FNAME "AUX" CUV CE)
668 (NARGS <IE-NUMBER-ARGS .IE>)
669 (LABEL <IE-LABEL-REF .IE>))
670 <MAPRET .NARGS <LABEL-REF-REL-ADDR .LABEL>>>
671 ,INTERNAL-ENTRY-TABLE>>
672 <SET CE <CHTYPE <VECTOR .FNAME .CUV> CALL-ENTRY>>
673 <SETG CALL-ENTRY-TABLE (.CE !,CALL-ENTRY-TABLE)>
676 <SETG CALL-TABLE <IVECTOR ,CT-NUMBER-CALLS <>>>
678 <DEFINE RESET-CALL-TABLE ()
679 <SETG CALL-POINTER 1>
680 <MAPR <> <FCN (X) <PUT .X 1 <>>> ,CALL-TABLE>>
682 <DEFINE EMIT-CALL (FCN NUMARGS
683 "AUX" UC (CNT ,CALL-POINTER) (TAB ,CALL-TABLE) INST)
684 #DECL ((FCN) ATOM (NUMARGS) FIX)
685 <SET UC <CHTYPE <VECTOR .FCN .NUMARGS 0 0> UNRESOLVED-CALL>>
686 <COND (<G? .CNT <LENGTH .TAB>>
687 <SETG CALL-TABLE <VECGROW ,CALL-TABLE ,CT-NUMBER-CALLS>>)>
688 <PUT ,CALL-TABLE .CNT .UC>
689 <SETG CALL-POINTER <+ .CNT 1>>
690 <ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-CALL 24>
695 <DEFINE VECGROW (TAB INCR "AUX" NEWVEC)
696 #DECL ((INCR) FIX (TAB) VECTOR)
697 <SET NEWVEC <IVECTOR <+ <LENGTH .TAB> .INCR>>>
698 <MAPR <> <FCN (OVEC NVEC) <PUT .NVEC 1 <1 .OVEC>>> .TAB .NEWVEC>
701 <SETG PUSH-LABEL-TABLE <IVECTOR 100 <>>>
703 <DEFINE RESET-PUSH-LABEL-TABLE () <SETG PUSH-LABEL-COUNT 1>>
705 <DEFINE EMIT-PUSH-LABEL (LABEL
706 "AUX" (CNT ,PUSH-LABEL-COUNT) (TAB ,PUSH-LABEL-TABLE)
708 #DECL ((LABEL) <OR ATOM SPEC-LABEL>)
709 <SET NLREF <CREATE-LABEL-REF .LABEL>>
710 <ADD-OUTSTANDING-LABEL .NLREF>
711 <COND (<G? .CNT <LENGTH .TAB>>
712 <SETG PUSH-LABEL-TABLE <VECGROW .TAB 100>>)>
713 <PUT ,PUSH-LABEL-TABLE .CNT .NLREF>
714 <SETG PUSH-LABEL-COUNT <+ .CNT 1>>
715 <ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-PUSHLAB 24> .CNT>
719 <SETG MOVE-LABEL-TABLE <IVECTOR 100 <>>>
721 <DEFINE RESET-MOVE-LABEL-TABLE () <SETG MOVE-LABEL-COUNT 1>>
723 <DEFINE EMIT-MOVE-LABEL (LABEL EA
724 "AUX" (CNT ,MOVE-LABEL-COUNT) (TAB ,MOVE-LABEL-TABLE)
726 #DECL ((LABEL) <OR ATOM SPEC-LABEL>)
727 <SET NLREF <CREATE-LABEL-REF .LABEL>>
728 <ADD-OUTSTANDING-LABEL .NLREF>
729 <COND (<G? .CNT <LENGTH .TAB>>
730 <SETG MOVE-LABEL-TABLE <VECGROW .TAB 100>>)>
731 <PUT ,MOVE-LABEL-TABLE .CNT .NLREF>
732 <SETG MOVE-LABEL-COUNT <+ .CNT 1>>
733 <ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-MOVELAB 24>
734 <LSH <ANDB .EA *37700000000*> -8>