2 % (c) The AQUA Project, Glasgow University, 1993-1995
5 \section[AlphaCode]{The Native (Alpha) Machine Code}
8 #include "HsVersions.h"
11 Addr(..),Cond(..),Imm(..),RI(..),Size(..),
12 AlphaCode(..),AlphaInstr(..),AlphaRegs,
17 baseRegOffset, stgRegMap, callerSaves,
21 v0, f0, sp, ra, pv, gp, zero, argRegs,
23 freeRegs, reservedRegs
25 -- and, for self-sufficiency ...
30 import AbsCSyn ( MagicId(..) )
31 import AsmRegAlloc ( MachineCode(..), MachineRegisters(..), FutureLive(..),
32 Reg(..), RegUsage(..), RegLiveness(..)
35 import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel, charToC )
36 import CgCompInfo ( mAX_Double_REG, mAX_Float_REG, mAX_Vanilla_REG )
38 import Maybes ( Maybe(..), maybeToBool )
39 import OrdList ( OrdList, mkUnitList, flattenOrdList )
41 import PrimRep ( PrimRep(..) )
48 %************************************************************************
50 \subsection[AlphaReg]{The Native (Alpha) Machine Register Table}
52 %************************************************************************
54 The alpha has 64 registers of interest; 32 integer registers and 32 floating
55 point registers. The mapping of STG registers to alpha machine registers
56 is defined in StgRegs.h. We are, of course, prepared for any eventuality.
63 v0, f0, ra, pv, gp, sp, zero :: Reg
66 ra = FixedReg ILIT(26)
68 gp = FixedReg ILIT(29)
69 sp = FixedReg ILIT(30)
70 zero = FixedReg ILIT(31)
72 t9, t10, t11, t12 :: Reg
78 argRegs :: [(Reg, Reg)]
79 argRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
82 realReg n@IBOX(i) = if _IS_TRUE_(freeReg i) then MappedReg i else FixedReg i
86 %************************************************************************
88 \subsection[TheAlphaCode]{The datatype for alpha assembly language}
90 %************************************************************************
92 Here is a definition of the Alpha assembly language.
97 | ImmInteger Integer -- Sigh.
98 | ImmCLbl CLabel -- AbstractC Label (with baggage)
99 | ImmLab Unpretty -- Simple string label
102 strImmLab s = ImmLab (uppStr s)
104 data Addr = AddrImm Imm
109 data Cond = EQ -- For CMP and BI
110 | LT -- For CMP and BI
111 | LE -- For CMP and BI
112 | ULT -- For CMP only
113 | ULE -- For CMP only
117 | ALWAYS -- For BI (same as BR)
118 | NEVER -- For BI (null instruction)
142 LD Size Reg Addr -- size, dst, src
143 | LDA Reg Addr -- dst, src
144 | LDAH Reg Addr -- dst, src
145 | LDGP Reg Addr -- dst, src
146 | LDI Size Reg Imm -- size, dst, src
147 | ST Size Reg Addr -- size, src, dst
152 | ABS Size RI Reg -- size, src, dst
153 | NEG Size Bool RI Reg -- size, overflow, src, dst
154 | ADD Size Bool Reg RI Reg -- size, overflow, src, src, dst
155 | SADD Size Size Reg RI Reg -- size, scale, src, src, dst
156 | SUB Size Bool Reg RI Reg -- size, overflow, src, src, dst
157 | SSUB Size Size Reg RI Reg -- size, scale, src, src, dst
158 | MUL Size Bool Reg RI Reg -- size, overflow, src, src, dst
159 | DIV Size Bool Reg RI Reg -- size, unsigned, src, src, dst
160 | REM Size Bool Reg RI Reg -- size, unsigned, src, src, dst
162 -- Simple bit-twiddling.
182 | CMP Cond Reg RI Reg
189 | FADD Size Reg Reg Reg
190 | FDIV Size Reg Reg Reg
191 | FMUL Size Reg Reg Reg
192 | FSUB Size Reg Reg Reg
193 | CVTxy Size Size Reg Reg
194 | FCMP Size Cond Reg Reg Reg
211 | COMMENT FAST_STRING
212 | SEGMENT CodeSegment
213 | ASCII Bool String -- needs backslash conversion?
216 type AlphaCode = OrdList AlphaInstr
220 %************************************************************************
222 \subsection[TheAlphaPretty]{Pretty-printing the Alpha Assembly Language}
224 %************************************************************************
228 printLabeledCodes :: PprStyle -> [AlphaInstr] -> Unpretty
229 printLabeledCodes sty codes = uppAboves (map (pprAlphaInstr sty) codes)
233 Printing the pieces...
237 pprReg :: Reg -> Unpretty
239 pprReg (FixedReg i) = pprAlphaReg i
240 pprReg (MappedReg i) = pprAlphaReg i
241 pprReg other = uppStr (show other) -- should only happen when debugging
243 pprAlphaReg :: FAST_INT -> Unpretty
244 pprAlphaReg i = uppPStr
246 ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1");
247 ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3");
248 ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5");
249 ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7");
250 ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9");
251 ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11");
252 ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13");
253 ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15");
254 ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17");
255 ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19");
256 ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21");
257 ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23");
258 ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25");
259 ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27");
260 ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29");
261 ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31");
262 ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1");
263 ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3");
264 ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5");
265 ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7");
266 ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9");
267 ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
268 ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
269 ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
270 ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
271 ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
272 ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
273 ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
274 ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
275 ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
276 ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
277 ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
278 _ -> SLIT("very naughty alpha register")
281 pprCond :: Cond -> Unpretty
282 pprCond EQ = uppPStr SLIT("eq")
283 pprCond LT = uppPStr SLIT("lt")
284 pprCond LE = uppPStr SLIT("le")
285 pprCond ULT = uppPStr SLIT("ult")
286 pprCond ULE = uppPStr SLIT("ule")
287 pprCond NE = uppPStr SLIT("ne")
288 pprCond GT = uppPStr SLIT("gt")
289 pprCond GE = uppPStr SLIT("ge")
291 pprImm :: PprStyle -> Imm -> Unpretty
293 pprImm sty (ImmInt i) = uppInt i
294 pprImm sty (ImmInteger i) = uppInteger i
296 pprImm sty (ImmCLbl l) = pprCLabel sty l
298 pprImm sty (ImmLab s) = s
300 pprAddr :: PprStyle -> Addr -> Unpretty
301 pprAddr sty (AddrReg reg) = uppBesides [uppLparen, pprReg reg, uppRparen]
303 pprAddr sty (AddrImm imm) = pprImm sty imm
305 pprAddr sty (AddrRegImm r1 imm) =
313 pprRI :: PprStyle -> RI -> Unpretty
314 pprRI sty (RIReg r) = pprReg r
315 pprRI sty (RIImm r) = pprImm sty r
317 pprRegRIReg :: PprStyle -> FAST_STRING -> Reg -> RI -> Reg -> Unpretty
318 pprRegRIReg sty name reg1 ri reg2 =
330 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
331 pprSizeRegRegReg name size reg1 reg2 reg3 =
344 pprSize :: Size -> Unpretty
360 pprAlphaInstr :: PprStyle -> AlphaInstr -> Unpretty
362 pprAlphaInstr sty (LD size reg addr) =
364 uppPStr SLIT("\tld"),
372 pprAlphaInstr sty (LDA reg addr) =
374 uppPStr SLIT("\tlda\t"),
380 pprAlphaInstr sty (LDAH reg addr) =
382 uppPStr SLIT("\tldah\t"),
388 pprAlphaInstr sty (LDGP reg addr) =
390 uppPStr SLIT("\tldgp\t"),
396 pprAlphaInstr sty (LDI size reg imm) =
398 uppPStr SLIT("\tldi"),
406 pprAlphaInstr sty (ST size reg addr) =
408 uppPStr SLIT("\tst"),
416 pprAlphaInstr sty (CLR reg) =
418 uppPStr SLIT("\tclr\t"),
422 pprAlphaInstr sty (ABS size ri reg) =
424 uppPStr SLIT("\tabs"),
432 pprAlphaInstr sty (NEG size ov ri reg) =
434 uppPStr SLIT("\tneg"),
436 if ov then uppPStr SLIT("v\t") else uppChar '\t',
442 pprAlphaInstr sty (ADD size ov reg1 ri reg2) =
444 uppPStr SLIT("\tadd"),
446 if ov then uppPStr SLIT("v\t") else uppChar '\t',
454 pprAlphaInstr sty (SADD size scale reg1 ri reg2) =
456 uppPStr (case scale of {L -> SLIT("\ts4"); Q -> SLIT("\ts8")}),
467 pprAlphaInstr sty (SUB size ov reg1 ri reg2) =
469 uppPStr SLIT("\tsub"),
471 if ov then uppPStr SLIT("v\t") else uppChar '\t',
479 pprAlphaInstr sty (SSUB size scale reg1 ri reg2) =
481 uppPStr (case scale of {L -> SLIT("\ts4"); Q -> SLIT("\ts8")}),
492 pprAlphaInstr sty (MUL size ov reg1 ri reg2) =
494 uppPStr SLIT("\tmul"),
496 if ov then uppPStr SLIT("v\t") else uppChar '\t',
504 pprAlphaInstr sty (DIV size uns reg1 ri reg2) =
506 uppPStr SLIT("\tdiv"),
508 if uns then uppPStr SLIT("u\t") else uppChar '\t',
516 pprAlphaInstr sty (REM size uns reg1 ri reg2) =
518 uppPStr SLIT("\trem"),
520 if uns then uppPStr SLIT("u\t") else uppChar '\t',
528 pprAlphaInstr sty (NOT ri reg) =
530 uppPStr SLIT("\tnot"),
537 pprAlphaInstr sty (AND reg1 ri reg2) = pprRegRIReg sty SLIT("and") reg1 ri reg2
538 pprAlphaInstr sty (ANDNOT reg1 ri reg2) = pprRegRIReg sty SLIT("andnot") reg1 ri reg2
539 pprAlphaInstr sty (OR reg1 ri reg2) = pprRegRIReg sty SLIT("or") reg1 ri reg2
540 pprAlphaInstr sty (ORNOT reg1 ri reg2) = pprRegRIReg sty SLIT("ornot") reg1 ri reg2
541 pprAlphaInstr sty (XOR reg1 ri reg2) = pprRegRIReg sty SLIT("xor") reg1 ri reg2
542 pprAlphaInstr sty (XORNOT reg1 ri reg2) = pprRegRIReg sty SLIT("xornot") reg1 ri reg2
544 pprAlphaInstr sty (SLL reg1 ri reg2) = pprRegRIReg sty SLIT("sll") reg1 ri reg2
545 pprAlphaInstr sty (SRL reg1 ri reg2) = pprRegRIReg sty SLIT("srl") reg1 ri reg2
546 pprAlphaInstr sty (SRA reg1 ri reg2) = pprRegRIReg sty SLIT("sra") reg1 ri reg2
548 pprAlphaInstr sty (ZAP reg1 ri reg2) = pprRegRIReg sty SLIT("zap") reg1 ri reg2
549 pprAlphaInstr sty (ZAPNOT reg1 ri reg2) = pprRegRIReg sty SLIT("zapnot") reg1 ri reg2
551 pprAlphaInstr sty (NOP) = uppPStr SLIT("\tnop")
553 pprAlphaInstr sty (CMP cond reg1 ri reg2) =
555 uppPStr SLIT("\tcmp"),
565 pprAlphaInstr sty (FCLR reg) =
567 uppPStr SLIT("\tfclr\t"),
571 pprAlphaInstr sty (FABS reg1 reg2) =
573 uppPStr SLIT("\tfabs\t"),
579 pprAlphaInstr sty (FNEG size reg1 reg2) =
581 uppPStr SLIT("\tneg"),
589 pprAlphaInstr sty (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
590 pprAlphaInstr sty (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
591 pprAlphaInstr sty (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
592 pprAlphaInstr sty (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
594 pprAlphaInstr sty (CVTxy size1 size2 reg1 reg2) =
596 uppPStr SLIT("\tcvt"),
598 case size2 of {Q -> uppPStr SLIT("qc"); _ -> pprSize size2},
605 pprAlphaInstr sty (FCMP size cond reg1 reg2 reg3) =
607 uppPStr SLIT("\tcmp"),
618 pprAlphaInstr sty (FMOV reg1 reg2) =
620 uppPStr SLIT("\tfmov\t"),
626 pprAlphaInstr sty (BI ALWAYS reg lab) = pprAlphaInstr sty (BR lab)
628 pprAlphaInstr sty (BI NEVER reg lab) = uppNil
630 pprAlphaInstr sty (BI cond reg lab) =
640 pprAlphaInstr sty (BF cond reg lab) =
642 uppPStr SLIT("\tfb"),
650 pprAlphaInstr sty (BR lab) =
651 uppBeside (uppPStr SLIT("\tbr\t")) (pprImm sty lab)
653 pprAlphaInstr sty (JMP reg addr hint) =
655 uppPStr SLIT("\tjmp\t"),
663 pprAlphaInstr sty (BSR imm n) =
664 uppBeside (uppPStr SLIT("\tbsr\t")) (pprImm sty imm)
666 pprAlphaInstr sty (JSR reg addr n) =
668 uppPStr SLIT("\tjsr\t"),
674 pprAlphaInstr sty (LABEL clab) =
676 if (externallyVisibleCLabel clab) then
677 uppBesides [uppPStr SLIT("\t.globl\t"), pprLab, uppChar '\n']
683 where pprLab = pprCLabel sty clab
685 pprAlphaInstr sty (FUNBEGIN clab) =
687 if (externallyVisibleCLabel clab) then
688 uppBesides [uppPStr SLIT("\t.globl\t"), pprLab, uppChar '\n']
691 uppPStr SLIT("\t.ent "),
700 pprLab = pprCLabel sty clab
701 #ifdef USE_FAST_STRINGS
702 pp_ldgp = uppPStr (_packCString (A# ":\n\tldgp $29,0($27)\n"#))
703 pp_frame = uppPStr (_packCString (A# "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"#))
705 pp_ldgp = uppStr ":\n\tldgp $29,0($27)\n"
706 pp_frame = uppStr "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"
709 pprAlphaInstr sty (FUNEND clab) =
710 uppBeside (uppPStr SLIT("\t.align 4\n\t.end ")) (pprCLabel sty clab)
712 pprAlphaInstr sty (COMMENT s) = uppBeside (uppPStr SLIT("\t# ")) (uppPStr s)
714 pprAlphaInstr sty (SEGMENT TextSegment)
715 = uppPStr SLIT("\t.text\n\t.align 3")
717 pprAlphaInstr sty (SEGMENT DataSegment)
718 = uppPStr SLIT("\t.data\n\t.align 3")
720 pprAlphaInstr sty (ASCII False str) =
722 uppStr "\t.asciz \"",
727 pprAlphaInstr sty (ASCII True str) = uppBeside (uppStr "\t.ascii \"") (asciify str 60)
729 asciify :: String -> Int -> Unpretty
730 asciify [] _ = uppStr ("\\0\"")
731 asciify s n | n <= 0 = uppBeside (uppStr "\"\n\t.ascii \"") (asciify s 60)
732 asciify ('\\':cs) n = uppBeside (uppStr "\\\\") (asciify cs (n-1))
733 asciify ('\"':cs) n = uppBeside (uppStr "\\\"") (asciify cs (n-1))
734 asciify (c:cs) n | isPrint c = uppBeside (uppChar c) (asciify cs (n-1))
735 asciify [c] _ = uppBeside (uppStr (charToC c)) (uppStr ("\\0\""))
736 asciify (c:(cs@(d:_))) n | isDigit d =
737 uppBeside (uppStr (charToC c)) (asciify cs 0)
739 uppBeside (uppStr (charToC c)) (asciify cs (n-1))
741 pprAlphaInstr sty (DATA s xs) = uppInterleave (uppChar '\n') (map pp_item xs)
742 where pp_item x = case s of
743 B -> uppBeside (uppPStr SLIT("\t.byte\t")) (pprImm sty x)
744 BU -> uppBeside (uppPStr SLIT("\t.byte\t")) (pprImm sty x)
745 W -> uppBeside (uppPStr SLIT("\t.word\t")) (pprImm sty x)
746 WU -> uppBeside (uppPStr SLIT("\t.word\t")) (pprImm sty x)
747 L -> uppBeside (uppPStr SLIT("\t.long\t")) (pprImm sty x)
748 Q -> uppBeside (uppPStr SLIT("\t.quad\t")) (pprImm sty x)
749 FF -> uppBeside (uppPStr SLIT("\t.f_floating\t")) (pprImm sty x)
750 DF -> uppBeside (uppPStr SLIT("\t.d_floating\t")) (pprImm sty x)
751 GF -> uppBeside (uppPStr SLIT("\t.g_floating\t")) (pprImm sty x)
752 SF -> uppBeside (uppPStr SLIT("\t.s_floating\t")) (pprImm sty x)
753 TF -> uppBeside (uppPStr SLIT("\t.t_floating\t")) (pprImm sty x)
757 %************************************************************************
759 \subsection[Schedule]{Register allocation information}
761 %************************************************************************
765 data AlphaRegs = SRegs BitSet BitSet
767 instance MachineRegisters AlphaRegs where
768 mkMRegs xs = SRegs (mkBS ints) (mkBS floats')
770 (ints, floats) = partition (< 32) xs
771 floats' = map (subtract 32) floats
773 possibleMRegs FloatRep (SRegs _ floats) = [ x + 32 | x <- listBS floats]
774 possibleMRegs DoubleRep (SRegs _ floats) = [ x + 32 | x <- listBS floats]
775 possibleMRegs _ (SRegs ints _) = listBS ints
777 useMReg (SRegs ints floats) n =
778 if n _LT_ ILIT(32) then SRegs (ints `minusBS` singletonBS IBOX(n)) floats
779 else SRegs ints (floats `minusBS` singletonBS (IBOX(n _SUB_ ILIT(32))))
781 useMRegs (SRegs ints floats) xs =
782 SRegs (ints `minusBS` ints')
783 (floats `minusBS` floats')
785 SRegs ints' floats' = mkMRegs xs
787 freeMReg (SRegs ints floats) n =
788 if n _LT_ ILIT(32) then SRegs (ints `unionBS` singletonBS IBOX(n)) floats
789 else SRegs ints (floats `unionBS` singletonBS (IBOX(n _SUB_ ILIT(32))))
791 freeMRegs (SRegs ints floats) xs =
792 SRegs (ints `unionBS` ints')
793 (floats `unionBS` floats')
795 SRegs ints' floats' = mkMRegs xs
797 instance MachineCode AlphaInstr where
798 regUsage = alphaRegUsage
799 regLiveness = alphaRegLiveness
800 patchRegs = alphaPatchRegs
802 -- We spill just below the frame pointer, leaving two words per spill location.
803 spillReg dyn (MemoryReg i pk) = mkUnitList (ST (kindToSize pk) dyn (spRel i))
804 loadReg (MemoryReg i pk) dyn = mkUnitList (LD (kindToSize pk) dyn (spRel i))
807 spRel n = AddrRegImm sp (ImmInt (n * 8))
809 kindToSize :: PrimRep -> Size
810 kindToSize PtrRep = Q
811 kindToSize CodePtrRep = Q
812 kindToSize DataPtrRep = Q
813 kindToSize RetRep = Q
814 kindToSize CostCentreRep = Q
815 kindToSize CharRep = BU
816 kindToSize IntRep = Q
817 kindToSize WordRep = Q
818 kindToSize AddrRep = Q
819 kindToSize FloatRep = TF
820 kindToSize DoubleRep = TF
821 kindToSize ArrayRep = Q
822 kindToSize ByteArrayRep = Q
823 kindToSize StablePtrRep = Q
824 kindToSize MallocPtrRep = Q
828 @alphaRegUsage@ returns the sets of src and destination registers used by
829 a particular instruction. Machine registers that are pre-allocated
830 to stgRegs are filtered out, because they are uninteresting from a
831 register allocation standpoint. (We wouldn't want them to end up on
836 alphaRegUsage :: AlphaInstr -> RegUsage
837 alphaRegUsage instr = case instr of
838 LD B reg addr -> usage (regAddr addr, [reg, t9])
839 LD BU reg addr -> usage (regAddr addr, [reg, t9])
840 LD W reg addr -> usage (regAddr addr, [reg, t9])
841 LD WU reg addr -> usage (regAddr addr, [reg, t9])
842 LD sz reg addr -> usage (regAddr addr, [reg])
843 LDA reg addr -> usage (regAddr addr, [reg])
844 LDAH reg addr -> usage (regAddr addr, [reg])
845 LDGP reg addr -> usage (regAddr addr, [reg])
846 LDI sz reg imm -> usage ([], [reg])
847 ST B reg addr -> usage (reg : regAddr addr, [t9, t10])
848 ST W reg addr -> usage (reg : regAddr addr, [t9, t10])
849 ST sz reg addr -> usage (reg : regAddr addr, [])
850 CLR reg -> usage ([], [reg])
851 ABS sz ri reg -> usage (regRI ri, [reg])
852 NEG sz ov ri reg -> usage (regRI ri, [reg])
853 ADD sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
854 SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
855 SUB sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
856 SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
857 MUL sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
858 DIV sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
859 REM sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
860 NOT ri reg -> usage (regRI ri, [reg])
861 AND r1 ar r2 -> usage (r1 : regRI ar, [r2])
862 ANDNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
863 OR r1 ar r2 -> usage (r1 : regRI ar, [r2])
864 ORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
865 XOR r1 ar r2 -> usage (r1 : regRI ar, [r2])
866 XORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
867 SLL r1 ar r2 -> usage (r1 : regRI ar, [r2])
868 SRL r1 ar r2 -> usage (r1 : regRI ar, [r2])
869 SRA r1 ar r2 -> usage (r1 : regRI ar, [r2])
870 ZAP r1 ar r2 -> usage (r1 : regRI ar, [r2])
871 ZAPNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
872 CMP co r1 ar r2 -> usage (r1 : regRI ar, [r2])
873 FCLR reg -> usage ([], [reg])
874 FABS r1 r2 -> usage ([r1], [r2])
875 FNEG sz r1 r2 -> usage ([r1], [r2])
876 FADD sz r1 r2 r3 -> usage ([r1, r2], [r3])
877 FDIV sz r1 r2 r3 -> usage ([r1, r2], [r3])
878 FMUL sz r1 r2 r3 -> usage ([r1, r2], [r3])
879 FSUB sz r1 r2 r3 -> usage ([r1, r2], [r3])
880 CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
881 FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
882 FMOV r1 r2 -> usage ([r1], [r2])
885 -- We assume that all local jumps will be BI/BF/BR. JMP must be out-of-line.
886 BI cond reg lbl -> usage ([reg], [])
887 BF cond reg lbl -> usage ([reg], [])
888 JMP reg addr hint -> RU (mkUniqSet (filter interesting (regAddr addr))) freeSet
890 BSR _ n -> RU (argSet n) callClobberedSet
891 JSR reg addr n -> RU (argSet n) callClobberedSet
896 usage (src, dst) = RU (mkUniqSet (filter interesting src))
897 (mkUniqSet (filter interesting dst))
899 interesting (FixedReg _) = False
902 regAddr (AddrReg r1) = [r1]
903 regAddr (AddrRegImm r1 _) = [r1]
904 regAddr (AddrImm _) = []
906 regRI (RIReg r) = [r]
910 freeRegs = freeMappedRegs [0..63]
912 freeMappedRegs :: [Int] -> [Reg]
918 = if _IS_TRUE_(freeReg i) then (MappedReg i) : acc else acc
920 freeSet :: UniqSet Reg
921 freeSet = mkUniqSet freeRegs
924 noUsage = RU emptyUniqSet emptyUniqSet
927 argSet :: Int -> UniqSet Reg
928 argSet 0 = emptyUniqSet
929 argSet 1 = mkUniqSet (freeMappedRegs [16, fReg 16])
930 argSet 2 = mkUniqSet (freeMappedRegs [16, 17, fReg 16, fReg 17])
931 argSet 3 = mkUniqSet (freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18])
932 argSet 4 = mkUniqSet (freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19])
933 argSet 5 = mkUniqSet (freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20])
934 argSet 6 = mkUniqSet (freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21])
936 callClobberedSet :: UniqSet Reg
937 callClobberedSet = mkUniqSet callClobberedRegs
941 [0, 1, 2, 3, 4, 5, 6, 7, 8,
942 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
943 fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15,
944 fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23,
945 fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
949 @alphaRegLiveness@ takes future liveness information and modifies it according to
950 the semantics of branches and labels. (An out-of-line branch clobbers the liveness
951 passed back by the following instruction; a forward local branch passes back the
952 liveness from the target label; a conditional branch merges the liveness from the
953 target and the liveness from its successor; a label stashes away the current liveness
954 in the future liveness environment).
957 alphaRegLiveness :: AlphaInstr -> RegLiveness -> RegLiveness
958 alphaRegLiveness instr info@(RL live future@(FL all env)) = case instr of
960 -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
962 BR (ImmCLbl lbl) -> RL (lookup lbl) future
963 BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionUniqSets` live) future
964 BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionUniqSets` live) future
965 JMP _ _ _ -> RL emptyUniqSet future
966 BSR _ _ -> RL live future
967 JSR _ _ _ -> RL live future
968 LABEL lbl -> RL live (FL (all `unionUniqSets` live) (addToFM env lbl live))
972 lookup lbl = case lookupFM env lbl of
974 Nothing -> trace ("Missing " ++ (uppShow 80 (pprCLabel (PprForAsm (\_->False) False id) lbl)) ++
975 " in future?") emptyUniqSet
979 @alphaPatchRegs@ takes an instruction (possibly with
980 MemoryReg/UnmappedReg registers) and changes all register references
981 according to the supplied environment.
985 alphaPatchRegs :: AlphaInstr -> (Reg -> Reg) -> AlphaInstr
986 alphaPatchRegs instr env = case instr of
987 LD sz reg addr -> LD sz (env reg) (fixAddr addr)
988 LDA reg addr -> LDA (env reg) (fixAddr addr)
989 LDAH reg addr -> LDAH (env reg) (fixAddr addr)
990 LDGP reg addr -> LDGP (env reg) (fixAddr addr)
991 LDI sz reg imm -> LDI sz (env reg) imm
992 ST sz reg addr -> ST sz (env reg) (fixAddr addr)
993 CLR reg -> CLR (env reg)
994 ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
995 NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
996 ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
997 SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
998 SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
999 SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
1000 MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
1001 DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
1002 REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
1003 NOT ar reg -> NOT (fixRI ar) (env reg)
1004 AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
1005 ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
1006 OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
1007 ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
1008 XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
1009 XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
1010 SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
1011 SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
1012 SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
1013 ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
1014 ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
1015 CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
1016 FCLR reg -> FCLR (env reg)
1017 FABS r1 r2 -> FABS (env r1) (env r2)
1018 FNEG s r1 r2 -> FNEG s (env r1) (env r2)
1019 FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
1020 FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
1021 FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
1022 FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
1023 CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
1024 FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
1025 FMOV r1 r2 -> FMOV (env r1) (env r2)
1026 BI cond reg lbl -> BI cond (env reg) lbl
1027 BF cond reg lbl -> BF cond (env reg) lbl
1028 JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
1029 JSR reg addr i -> JSR (env reg) (fixAddr addr) i
1033 fixAddr (AddrReg r1) = AddrReg (env r1)
1034 fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
1035 fixAddr other = other
1037 fixRI (RIReg r) = RIReg (env r)
1042 If you value your sanity, do not venture below this line.
1046 -- platform.h is generate and tells us what the target architecture is
1047 #include "../../includes/platform.h"
1048 #include "../../includes/MachRegs.h"
1049 #include "../../includes/alpha-dec-osf1.h"
1051 -- Redefine the literals used for Alpha floating point register names
1052 -- in the header files. Gag me with a spoon, eh?
1087 baseRegOffset :: MagicId -> Int
1088 baseRegOffset StkOReg = OFFSET_StkO
1089 baseRegOffset (VanillaReg _ ILIT(1)) = OFFSET_R1
1090 baseRegOffset (VanillaReg _ ILIT(2)) = OFFSET_R2
1091 baseRegOffset (VanillaReg _ ILIT(3)) = OFFSET_R3
1092 baseRegOffset (VanillaReg _ ILIT(4)) = OFFSET_R4
1093 baseRegOffset (VanillaReg _ ILIT(5)) = OFFSET_R5
1094 baseRegOffset (VanillaReg _ ILIT(6)) = OFFSET_R6
1095 baseRegOffset (VanillaReg _ ILIT(7)) = OFFSET_R7
1096 baseRegOffset (VanillaReg _ ILIT(8)) = OFFSET_R8
1097 baseRegOffset (FloatReg ILIT(1)) = OFFSET_Flt1
1098 baseRegOffset (FloatReg ILIT(2)) = OFFSET_Flt2
1099 baseRegOffset (FloatReg ILIT(3)) = OFFSET_Flt3
1100 baseRegOffset (FloatReg ILIT(4)) = OFFSET_Flt4
1101 baseRegOffset (DoubleReg ILIT(1)) = OFFSET_Dbl1
1102 baseRegOffset (DoubleReg ILIT(2)) = OFFSET_Dbl2
1103 baseRegOffset TagReg = OFFSET_Tag
1104 baseRegOffset RetReg = OFFSET_Ret
1105 baseRegOffset SpA = OFFSET_SpA
1106 baseRegOffset SuA = OFFSET_SuA
1107 baseRegOffset SpB = OFFSET_SpB
1108 baseRegOffset SuB = OFFSET_SuB
1109 baseRegOffset Hp = OFFSET_Hp
1110 baseRegOffset HpLim = OFFSET_HpLim
1111 baseRegOffset LivenessReg = OFFSET_Liveness
1112 --baseRegOffset ActivityReg = OFFSET_Activity
1114 baseRegOffset BaseReg = panic "baseRegOffset:BaseReg"
1115 baseRegOffset StdUpdRetVecReg = panic "baseRegOffset:StgUpdRetVecReg"
1116 baseRegOffset StkStubReg = panic "baseRegOffset:StkStubReg"
1117 baseRegOffset CurCostCentre = panic "baseRegOffset:CurCostCentre"
1118 baseRegOffset VoidReg = panic "baseRegOffset:VoidReg"
1121 callerSaves :: MagicId -> Bool
1122 #ifdef CALLER_SAVES_Base
1123 callerSaves BaseReg = True
1125 #ifdef CALLER_SAVES_StkO
1126 callerSaves StkOReg = True
1128 #ifdef CALLER_SAVES_R1
1129 callerSaves (VanillaReg _ ILIT(1)) = True
1131 #ifdef CALLER_SAVES_R2
1132 callerSaves (VanillaReg _ ILIT(2)) = True
1134 #ifdef CALLER_SAVES_R3
1135 callerSaves (VanillaReg _ ILIT(3)) = True
1137 #ifdef CALLER_SAVES_R4
1138 callerSaves (VanillaReg _ ILIT(4)) = True
1140 #ifdef CALLER_SAVES_R5
1141 callerSaves (VanillaReg _ ILIT(5)) = True
1143 #ifdef CALLER_SAVES_R6
1144 callerSaves (VanillaReg _ ILIT(6)) = True
1146 #ifdef CALLER_SAVES_R7
1147 callerSaves (VanillaReg _ ILIT(7)) = True
1149 #ifdef CALLER_SAVES_R8
1150 callerSaves (VanillaReg _ ILIT(8)) = True
1152 #ifdef CALLER_SAVES_FltReg1
1153 callerSaves (FloatReg ILIT(1)) = True
1155 #ifdef CALLER_SAVES_FltReg2
1156 callerSaves (FloatReg ILIT(2)) = True
1158 #ifdef CALLER_SAVES_FltReg3
1159 callerSaves (FloatReg ILIT(3)) = True
1161 #ifdef CALLER_SAVES_FltReg4
1162 callerSaves (FloatReg ILIT(4)) = True
1164 #ifdef CALLER_SAVES_DblReg1
1165 callerSaves (DoubleReg ILIT(1)) = True
1167 #ifdef CALLER_SAVES_DblReg2
1168 callerSaves (DoubleReg ILIT(2)) = True
1170 #ifdef CALLER_SAVES_Tag
1171 callerSaves TagReg = True
1173 #ifdef CALLER_SAVES_Ret
1174 callerSaves RetReg = True
1176 #ifdef CALLER_SAVES_SpA
1177 callerSaves SpA = True
1179 #ifdef CALLER_SAVES_SuA
1180 callerSaves SuA = True
1182 #ifdef CALLER_SAVES_SpB
1183 callerSaves SpB = True
1185 #ifdef CALLER_SAVES_SuB
1186 callerSaves SuB = True
1188 #ifdef CALLER_SAVES_Hp
1189 callerSaves Hp = True
1191 #ifdef CALLER_SAVES_HpLim
1192 callerSaves HpLim = True
1194 #ifdef CALLER_SAVES_Liveness
1195 callerSaves LivenessReg = True
1197 #ifdef CALLER_SAVES_Activity
1198 --callerSaves ActivityReg = True
1200 #ifdef CALLER_SAVES_StdUpdRetVec
1201 callerSaves StdUpdRetVecReg = True
1203 #ifdef CALLER_SAVES_StkStub
1204 callerSaves StkStubReg = True
1206 callerSaves _ = False
1208 stgRegMap :: MagicId -> Maybe Reg
1210 stgRegMap BaseReg = Just (FixedReg ILIT(REG_Base))
1213 stgRegMap StkOReg = Just (FixedReg ILIT(REG_StkOReg))
1216 stgRegMap (VanillaReg _ ILIT(1)) = Just (FixedReg ILIT(REG_R1))
1219 stgRegMap (VanillaReg _ ILIT(2)) = Just (FixedReg ILIT(REG_R2))
1222 stgRegMap (VanillaReg _ ILIT(3)) = Just (FixedReg ILIT(REG_R3))
1225 stgRegMap (VanillaReg _ ILIT(4)) = Just (FixedReg ILIT(REG_R4))
1228 stgRegMap (VanillaReg _ ILIT(5)) = Just (FixedReg ILIT(REG_R5))
1231 stgRegMap (VanillaReg _ ILIT(6)) = Just (FixedReg ILIT(REG_R6))
1234 stgRegMap (VanillaReg _ ILIT(7)) = Just (FixedReg ILIT(REG_R7))
1237 stgRegMap (VanillaReg _ ILIT(8)) = Just (FixedReg ILIT(REG_R8))
1240 stgRegMap (FloatReg ILIT(1)) = Just (FixedReg ILIT(REG_Flt1))
1243 stgRegMap (FloatReg ILIT(2)) = Just (FixedReg ILIT(REG_Flt2))
1246 stgRegMap (FloatReg ILIT(3)) = Just (FixedReg ILIT(REG_Flt3))
1249 stgRegMap (FloatReg ILIT(4)) = Just (FixedReg ILIT(REG_Flt4))
1252 stgRegMap (DoubleReg ILIT(1)) = Just (FixedReg ILIT(REG_Dbl1))
1255 stgRegMap (DoubleReg ILIT(2)) = Just (FixedReg ILIT(REG_Dbl2))
1258 stgRegMap TagReg = Just (FixedReg ILIT(REG_TagReg))
1261 stgRegMap RetReg = Just (FixedReg ILIT(REG_Ret))
1264 stgRegMap SpA = Just (FixedReg ILIT(REG_SpA))
1267 stgRegMap SuA = Just (FixedReg ILIT(REG_SuA))
1270 stgRegMap SpB = Just (FixedReg ILIT(REG_SpB))
1273 stgRegMap SuB = Just (FixedReg ILIT(REG_SuB))
1276 stgRegMap Hp = Just (FixedReg ILIT(REG_Hp))
1279 stgRegMap HpLim = Just (FixedReg ILIT(REG_HpLim))
1282 stgRegMap LivenessReg = Just (FixedReg ILIT(REG_Liveness))
1285 --stgRegMap ActivityReg = Just (FixedReg ILIT(REG_Activity))
1287 #ifdef REG_StdUpdRetVec
1288 stgRegMap StdUpdRetVecReg = Just (FixedReg ILIT(REG_StdUpdRetVec))
1291 stgRegMap StkStubReg = Just (FixedReg ILIT(REG_StkStub))
1293 stgRegMap _ = Nothing
1297 Here is the list of registers we can use in register allocation.
1299 With a per-instruction clobber list, we might be able to get some of
1300 these back, but it's probably not worth the hassle.
1304 freeReg :: FAST_INT -> FAST_BOOL
1306 freeReg ILIT(26) = _FALSE_ -- return address (ra)
1307 freeReg ILIT(28) = _FALSE_ -- reserved for the assembler (at)
1308 freeReg ILIT(29) = _FALSE_ -- global pointer (gp)
1309 freeReg ILIT(30) = _FALSE_ -- stack pointer (sp)
1310 freeReg ILIT(31) = _FALSE_ -- always zero (zero)
1311 freeReg ILIT(63) = _FALSE_ -- always zero (f31)
1314 freeReg ILIT(REG_Base) = _FALSE_
1317 freeReg ILIT(REG_StkO) = _FALSE_
1320 freeReg ILIT(REG_R1) = _FALSE_
1323 freeReg ILIT(REG_R2) = _FALSE_
1326 freeReg ILIT(REG_R3) = _FALSE_
1329 freeReg ILIT(REG_R4) = _FALSE_
1332 freeReg ILIT(REG_R5) = _FALSE_
1335 freeReg ILIT(REG_R6) = _FALSE_
1338 freeReg ILIT(REG_R7) = _FALSE_
1341 freeReg ILIT(REG_R8) = _FALSE_
1344 freeReg ILIT(REG_Flt1) = _FALSE_
1347 freeReg ILIT(REG_Flt2) = _FALSE_
1350 freeReg ILIT(REG_Flt3) = _FALSE_
1353 freeReg ILIT(REG_Flt4) = _FALSE_
1356 freeReg ILIT(REG_Dbl1) = _FALSE_
1359 freeReg ILIT(REG_Dbl2) = _FALSE_
1362 freeReg ILIT(REG_Tag) = _FALSE_
1365 freeReg ILIT(REG_Ret) = _FALSE_
1368 freeReg ILIT(REG_SpA) = _FALSE_
1371 freeReg ILIT(REG_SuA) = _FALSE_
1374 freeReg ILIT(REG_SpB) = _FALSE_
1377 freeReg ILIT(REG_SuB) = _FALSE_
1380 freeReg ILIT(REG_Hp) = _FALSE_
1383 freeReg ILIT(REG_HpLim) = _FALSE_
1386 freeReg ILIT(REG_Liveness) = _FALSE_
1389 --freeReg ILIT(REG_Activity) = _FALSE_
1391 #ifdef REG_StdUpdRetVec
1392 freeReg ILIT(REG_StdUpdRetVec) = _FALSE_
1395 freeReg ILIT(REG_StkStub) = _FALSE_
1399 reservedRegs :: [Int]
1400 reservedRegs = [NCG_Reserved_I1, NCG_Reserved_I2, NCG_Reserved_F1, NCG_Reserved_F2]