2 % (c) The AQUA Project, Glasgow University, 1993-1995
5 \section[SparcCode]{The Native (Sparc) Machine Code}
8 #define ILIT2(x) ILIT(x)
9 #include "HsVersions.h"
12 Addr(..),Cond(..),Imm(..),RI(..),Size(..),
13 SparcCode(..),SparcInstr(..),SparcRegs,
14 strImmLit, --UNUSED: strImmLab,
18 baseRegOffset, stgRegMap, callerSaves,
24 g0, o0, f0, fp, sp, argRegs,
26 freeRegs, reservedRegs,
28 -- and, for self-sufficiency ...
29 CLabel, CodeSegment, OrdList, PrimKind, Reg, UniqSet(..),
30 UniqFM, FiniteMap, Unique, MagicId, CSeq, BitSet
35 import AbsCSyn ( MagicId(..) )
36 import AsmRegAlloc ( MachineCode(..), MachineRegisters(..), FutureLive(..),
37 Reg(..), RegUsage(..), RegLiveness(..)
40 import CgCompInfo ( mAX_Double_REG, mAX_Float_REG, mAX_Vanilla_REG )
41 import CLabelInfo ( CLabel, pprCLabel, externallyVisibleCLabel, charToC )
43 import Maybes ( Maybe(..), maybeToBool )
44 import OrdList ( OrdList, mkUnitList, flattenOrdList )
46 import PrimKind ( PrimKind(..) )
53 %************************************************************************
55 \subsection[SparcReg]{The Native (Sparc) Machine Register Table}
57 %************************************************************************
59 The sparc has 64 registers of interest; 32 integer registers and 32 floating
60 point registers. The mapping of STG registers to sparc machine registers
61 is defined in StgRegs.h. We are, of course, prepared for any eventuality.
63 ToDo: Deal with stg registers that live as offsets from BaseReg!(JSM)
67 gReg,lReg,iReg,oReg,fReg :: Int -> Int
75 fPair (FixedReg i) = FixedReg (i _ADD_ ILIT(1))
76 fPair (MappedReg i) = MappedReg (i _ADD_ ILIT(1))
78 g0, fp, sp, o0, f0 :: Reg
79 g0 = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
80 fp = case (iReg 6) of { IBOX(i6) -> FixedReg i6 }
81 sp = case (oReg 6) of { IBOX(o6) -> FixedReg o6 }
86 argRegs = map realReg [oReg i | i <- [0..5]]
88 realReg n@IBOX(i) = if _IS_TRUE_(freeReg i) then MappedReg i else FixedReg i
92 %************************************************************************
94 \subsection[TheSparcCode]{The datatype for sparc assembly language}
96 %************************************************************************
98 Here is a definition of the Sparc assembly language.
102 data Imm = ImmInt Int
103 | ImmInteger Integer -- Sigh.
104 | ImmCLbl CLabel -- AbstractC Label (with baggage)
105 | ImmLab Unpretty -- Simple string label (underscored)
106 | ImmLit Unpretty -- Simple string
107 | LO Imm -- Possible restrictions
111 --UNUSED:strImmLab s = ImmLab (uppStr s)
112 strImmLit s = ImmLit (uppStr s)
114 data Addr = AddrRegReg Reg Reg
141 riZero (RIImm (ImmInt 0)) = True
142 riZero (RIImm (ImmInteger 0)) = True
143 riZero (RIReg (FixedReg ILIT(0))) = True
160 LD Size Addr Reg -- size, src, dst
161 | ST Size Reg Addr -- size, src, dst
165 | ADD Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
166 | SUB Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
168 -- Simple bit-twiddling.
170 | AND Bool Reg RI Reg -- cc?, src1, src2, dst
171 | ANDN Bool Reg RI Reg -- cc?, src1, src2, dst
172 | OR Bool Reg RI Reg -- cc?, src1, src2, dst
173 | ORN Bool Reg RI Reg -- cc?, src1, src2, dst
174 | XOR Bool Reg RI Reg -- cc?, src1, src2, dst
175 | XNOR Bool Reg RI Reg -- cc?, src1, src2, dst
176 | SLL Reg RI Reg -- src1, src2, dst
177 | SRL Reg RI Reg -- src1, src2, dst
178 | SRA Reg RI Reg -- src1, src2, dst
179 | SETHI Imm Reg -- src, dst
180 | NOP -- Really SETHI 0, %g0, but worth an alias
184 -- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single instructions
185 -- right up until we spit them out.
187 | FABS Size Reg Reg -- src dst
188 | FADD Size Reg Reg Reg -- src1, src2, dst
189 | FCMP Bool Size Reg Reg -- exception?, src1, src2, dst
190 | FDIV Size Reg Reg Reg -- src1, src2, dst
191 | FMOV Size Reg Reg -- src, dst
192 | FMUL Size Reg Reg Reg -- src1, src2, dst
193 | FNEG Size Reg Reg -- src, dst
194 | FSQRT Size Reg Reg -- src, dst
195 | FSUB Size Reg Reg Reg -- src1, src2, dst
196 | FxTOy Size Size Reg Reg -- src, dst
200 | BI Cond Bool Imm -- cond, annul?, target
201 | BF Cond Bool Imm -- cond, annul?, target
204 | CALL Imm Int Bool -- target, args, terminal
209 | COMMENT FAST_STRING
210 | SEGMENT CodeSegment
211 | ASCII Bool String -- needs backslash conversion?
214 type SparcCode = OrdList SparcInstr
218 %************************************************************************
220 \subsection[TheSparcPretty]{Pretty-printing the Sparc Assembly Language}
222 %************************************************************************
226 printLabeledCodes :: PprStyle -> [SparcInstr] -> Unpretty
227 printLabeledCodes sty codes = uppAboves (map (pprSparcInstr sty) codes)
231 Printing the pieces...
235 pprReg :: Reg -> Unpretty
237 pprReg (FixedReg i) = pprSparcReg i
238 pprReg (MappedReg i) = pprSparcReg i
239 pprReg other = uppStr (show other) -- should only happen when debugging
241 pprSparcReg :: FAST_INT -> Unpretty
242 pprSparcReg i = uppPStr
244 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
245 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
246 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
247 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
248 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
249 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
250 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
251 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
252 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
253 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
254 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
255 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
256 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
257 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
258 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
259 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
260 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
261 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
262 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
263 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
264 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
265 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
266 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
267 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
268 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
269 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
270 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
271 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
272 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
273 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
274 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
275 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
276 _ -> SLIT("very naughty sparc register")
279 pprCond :: Cond -> Unpretty
282 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
283 GEU -> SLIT("geu"); LU -> SLIT("lu");
284 EQ -> SLIT("e"); GT -> SLIT("g");
285 GE -> SLIT("ge"); GU -> SLIT("gu");
286 LT -> SLIT("l"); LE -> SLIT("le");
287 LEU -> SLIT("leu"); NE -> SLIT("ne");
288 NEG -> SLIT("neg"); POS -> SLIT("pos");
289 VC -> SLIT("vc"); VS -> SLIT("vs")
292 pprImm :: PprStyle -> Imm -> Unpretty
294 pprImm sty (ImmInt i) = uppInt i
295 pprImm sty (ImmInteger i) = uppInteger i
304 #ifdef USE_FAST_STRINGS
305 pp_lo = uppPStr (_packCString (A# "%lo("#))
307 pp_lo = uppStr "%lo("
317 #ifdef USE_FAST_STRINGS
318 pp_hi = uppPStr (_packCString (A# "%hi("#))
320 pp_hi = uppStr "%hi("
323 pprImm sty (ImmCLbl l) = pprCLabel sty l
325 pprImm (PprForAsm _ False _) (ImmLab s) = s
326 pprImm _ (ImmLab s) = uppBeside (uppChar '_') s
328 pprImm sty (ImmLit s) = s
330 pprAddr :: PprStyle -> Addr -> Unpretty
331 pprAddr sty (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
333 pprAddr sty (AddrRegReg r1 r2) =
340 pprAddr sty (AddrRegImm r1 (ImmInt i))
349 pprAddr sty (AddrRegImm r1 (ImmInteger i))
358 pprAddr sty (AddrRegImm r1 imm) =
365 pprRI :: PprStyle -> RI -> Unpretty
366 pprRI sty (RIReg r) = pprReg r
367 pprRI sty (RIImm r) = pprImm sty r
369 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Unpretty
370 pprSizeRegReg name size reg1 reg2 =
375 F -> uppPStr SLIT("s\t")
376 DF -> uppPStr SLIT("d\t")),
382 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
383 pprSizeRegRegReg name size reg1 reg2 reg3 =
388 F -> uppPStr SLIT("s\t")
389 DF -> uppPStr SLIT("d\t")),
397 pprRegRIReg :: PprStyle -> FAST_STRING -> Bool -> Reg -> RI -> Reg -> Unpretty
398 pprRegRIReg sty name b reg1 ri reg2 =
402 if b then uppPStr SLIT("cc\t") else uppChar '\t',
410 pprRIReg :: PprStyle -> FAST_STRING -> Bool -> RI -> Reg -> Unpretty
411 pprRIReg sty name b ri reg1 =
415 if b then uppPStr SLIT("cc\t") else uppChar '\t',
421 pprSize :: Size -> Unpretty
434 #ifdef USE_FAST_STRINGS
435 pp_ld_lbracket = uppPStr (_packCString (A# "\tld\t["#))
436 pp_rbracket_comma = uppPStr (_packCString (A# "],"#))
437 pp_comma_lbracket = uppPStr (_packCString (A# ",["#))
438 pp_comma_a = uppPStr (_packCString (A# ",a"#))
440 pp_ld_lbracket = uppStr "\tld\t["
441 pp_rbracket_comma = uppStr "],"
442 pp_comma_lbracket = uppStr ",["
443 pp_comma_a = uppStr ",a"
446 pprSparcInstr :: PprStyle -> SparcInstr -> Unpretty
448 -- a clumsy hack for now, to handle possible alignment problems
450 pprSparcInstr sty (LD DF addr reg) | maybeToBool addrOff =
464 addrOff = offset addr 4
465 addr2 = case addrOff of Just x -> x
467 pprSparcInstr sty (LD size addr reg) =
469 uppPStr SLIT("\tld"),
478 -- The same clumsy hack as above
480 pprSparcInstr sty (ST DF reg addr) | maybeToBool addrOff =
482 uppPStr SLIT("\tst\t"),
487 uppPStr SLIT("]\n\tst\t"),
494 addrOff = offset addr 4
495 addr2 = case addrOff of Just x -> x
497 pprSparcInstr sty (ST size reg addr) =
499 uppPStr SLIT("\tst"),
508 pprSparcInstr sty (ADD x cc reg1 ri reg2)
509 | not x && not cc && riZero ri =
511 uppPStr SLIT("\tmov\t"),
516 | otherwise = pprRegRIReg sty (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
518 pprSparcInstr sty (SUB x cc reg1 ri reg2)
519 | not x && cc && reg2 == g0 =
521 uppPStr SLIT("\tcmp\t"),
526 | not x && not cc && riZero ri =
528 uppPStr SLIT("\tmov\t"),
533 | otherwise = pprRegRIReg sty (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
535 pprSparcInstr sty (AND b reg1 ri reg2) = pprRegRIReg sty SLIT("and") b reg1 ri reg2
536 pprSparcInstr sty (ANDN b reg1 ri reg2) = pprRegRIReg sty SLIT("andn") b reg1 ri reg2
538 pprSparcInstr sty (OR b reg1 ri reg2)
539 | not b && reg1 == g0 =
541 uppPStr SLIT("\tmov\t"),
546 | otherwise = pprRegRIReg sty SLIT("or") b reg1 ri reg2
548 pprSparcInstr sty (ORN b reg1 ri reg2) = pprRegRIReg sty SLIT("orn") b reg1 ri reg2
550 pprSparcInstr sty (XOR b reg1 ri reg2) = pprRegRIReg sty SLIT("xor") b reg1 ri reg2
551 pprSparcInstr sty (XNOR b reg1 ri reg2) = pprRegRIReg sty SLIT("xnor") b reg1 ri reg2
553 pprSparcInstr sty (SLL reg1 ri reg2) = pprRegRIReg sty SLIT("sll") False reg1 ri reg2
554 pprSparcInstr sty (SRL reg1 ri reg2) = pprRegRIReg sty SLIT("srl") False reg1 ri reg2
555 pprSparcInstr sty (SRA reg1 ri reg2) = pprRegRIReg sty SLIT("sra") False reg1 ri reg2
557 pprSparcInstr sty (SETHI imm reg) =
559 uppPStr SLIT("\tsethi\t"),
565 pprSparcInstr sty (NOP) = uppPStr SLIT("\tnop")
567 pprSparcInstr sty (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
568 pprSparcInstr sty (FABS DF reg1 reg2) =
569 uppBeside (pprSizeRegReg SLIT("fabs") F reg1 reg2)
570 (if (reg1 == reg2) then uppNil
571 else uppBeside (uppChar '\n')
572 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
574 pprSparcInstr sty (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
575 pprSparcInstr sty (FCMP e size reg1 reg2) =
576 pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
577 pprSparcInstr sty (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
579 pprSparcInstr sty (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
580 pprSparcInstr sty (FMOV DF reg1 reg2) =
581 uppBeside (pprSizeRegReg SLIT("fmov") F reg1 reg2)
582 (if (reg1 == reg2) then uppNil
583 else uppBeside (uppChar '\n')
584 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
586 pprSparcInstr sty (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
588 pprSparcInstr sty (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
589 pprSparcInstr sty (FNEG DF reg1 reg2) =
590 uppBeside (pprSizeRegReg SLIT("fneg") F reg1 reg2)
591 (if (reg1 == reg2) then uppNil
592 else uppBeside (uppChar '\n')
593 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
595 pprSparcInstr sty (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
596 pprSparcInstr sty (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
597 pprSparcInstr sty (FxTOy size1 size2 reg1 reg2) =
616 pprSparcInstr sty (BI cond b lab) =
618 uppPStr SLIT("\tb"), pprCond cond,
619 if b then pp_comma_a else uppNil,
624 pprSparcInstr sty (BF cond b lab) =
626 uppPStr SLIT("\tfb"), pprCond cond,
627 if b then pp_comma_a else uppNil,
632 pprSparcInstr sty (JMP addr) = uppBeside (uppPStr SLIT("\tjmp\t")) (pprAddr sty addr)
634 pprSparcInstr sty (CALL imm n _) =
636 uppPStr SLIT("\tcall\t"),
642 pprSparcInstr sty (LABEL clab) =
644 if (externallyVisibleCLabel clab) then
645 uppBesides [uppPStr SLIT("\t.global\t"), pprLab, uppChar '\n']
651 where pprLab = pprCLabel sty clab
653 pprSparcInstr sty (COMMENT s) = uppBeside (uppPStr SLIT("! ")) (uppPStr s)
655 pprSparcInstr sty (SEGMENT TextSegment)
656 = uppPStr SLIT("\t.text\n\t.align 4")
658 pprSparcInstr sty (SEGMENT DataSegment)
659 = uppPStr SLIT("\t.data\n\t.align 8") -- Less than 8 will break double constants
661 pprSparcInstr sty (ASCII False str) =
663 uppStr "\t.asciz \"",
668 pprSparcInstr sty (ASCII True str) = uppBeside (uppStr "\t.ascii \"") (asciify str 60)
670 asciify :: String -> Int -> Unpretty
671 asciify [] _ = uppStr ("\\0\"")
672 asciify s n | n <= 0 = uppBeside (uppStr "\"\n\t.ascii \"") (asciify s 60)
673 asciify ('\\':cs) n = uppBeside (uppStr "\\\\") (asciify cs (n-1))
674 asciify ('\"':cs) n = uppBeside (uppStr "\\\"") (asciify cs (n-1))
675 asciify (c:cs) n | isPrint c = uppBeside (uppChar c) (asciify cs (n-1))
676 asciify [c] _ = uppBeside (uppStr (charToC c)) (uppStr ("\\0\""))
677 asciify (c:(cs@(d:_))) n | isDigit d =
678 uppBeside (uppStr (charToC c)) (asciify cs 0)
680 uppBeside (uppStr (charToC c)) (asciify cs (n-1))
682 pprSparcInstr sty (DATA s xs) = uppInterleave (uppChar '\n') (map pp_item xs)
683 where pp_item x = case s of
684 SB -> uppBeside (uppPStr SLIT("\t.byte\t")) (pprImm sty x)
685 UB -> uppBeside (uppPStr SLIT("\t.byte\t")) (pprImm sty x)
686 W -> uppBeside (uppPStr SLIT("\t.word\t")) (pprImm sty x)
687 DF -> uppBeside (uppPStr SLIT("\t.double\t")) (pprImm sty x)
691 %************************************************************************
693 \subsection[Schedule]{Register allocation information}
695 %************************************************************************
697 Getting the conflicts right is a bit tedious for doubles. We'd have to
698 add a conflict function to the MachineRegisters class, and we'd have to
699 put a PrimKind in the MappedReg datatype, or use some kludge (e.g. register
700 64 + n is really the same as 32 + n, except that it's used for a double,
701 so it also conflicts with 33 + n) to deal with it. It's just not worth the
702 bother, so we just partition the free floating point registers into two
703 sets: one for single precision and one for double precision. We never seem
704 to run out of floating point registers anyway.
708 data SparcRegs = SRegs BitSet BitSet BitSet
710 instance MachineRegisters SparcRegs where
711 mkMRegs xs = SRegs (mkBS ints) (mkBS singles') (mkBS doubles')
713 (ints, floats) = partition (< 32) xs
714 (singles, doubles) = partition (< 48) floats
715 singles' = map (subtract 32) singles
716 doubles' = map (subtract 32) (filter even doubles)
718 possibleMRegs FloatKind (SRegs _ singles _) = [ x + 32 | x <- listBS singles]
719 possibleMRegs DoubleKind (SRegs _ _ doubles) = [ x + 32 | x <- listBS doubles]
720 possibleMRegs _ (SRegs ints _ _) = listBS ints
722 useMReg (SRegs ints singles doubles) n =
723 if n _LT_ ILIT(32) then SRegs (ints `minusBS` singletonBS IBOX(n)) singles doubles
724 else if n _LT_ ILIT(48) then SRegs ints (singles `minusBS` singletonBS (IBOX(n _SUB_ ILIT(32)))) doubles
725 else SRegs ints singles (doubles `minusBS` singletonBS (IBOX(n _SUB_ ILIT(32))))
727 useMRegs (SRegs ints singles doubles) xs =
728 SRegs (ints `minusBS` ints')
729 (singles `minusBS` singles')
730 (doubles `minusBS` doubles')
732 SRegs ints' singles' doubles' = mkMRegs xs
734 freeMReg (SRegs ints singles doubles) n =
735 if n _LT_ ILIT(32) then SRegs (ints `unionBS` singletonBS IBOX(n)) singles doubles
736 else if n _LT_ ILIT(48) then SRegs ints (singles `unionBS` singletonBS (IBOX(n _SUB_ ILIT(32)))) doubles
737 else SRegs ints singles (doubles `unionBS` singletonBS (IBOX(n _SUB_ ILIT(32))))
739 freeMRegs (SRegs ints singles doubles) xs =
740 SRegs (ints `unionBS` ints')
741 (singles `unionBS` singles')
742 (doubles `unionBS` doubles')
744 SRegs ints' singles' doubles' = mkMRegs xs
746 instance MachineCode SparcInstr where
747 -- Alas, we don't do anything clever with our OrdLists
749 -- flatten = flattenOrdList
751 regUsage = sparcRegUsage
752 regLiveness = sparcRegLiveness
753 patchRegs = sparcPatchRegs
755 -- We spill just below the frame pointer, leaving two words per spill location.
756 spillReg dyn (MemoryReg i pk) = mkUnitList (ST (kindToSize pk) dyn (fpRel (-2 * i)))
757 loadReg (MemoryReg i pk) dyn = mkUnitList (LD (kindToSize pk) (fpRel (-2 * i)) dyn)
759 -- Duznae work for offsets greater than 13 bits; we just hope for the best
761 fpRel n = AddrRegImm fp (ImmInt (n * 4))
763 kindToSize :: PrimKind -> Size
764 kindToSize PtrKind = W
765 kindToSize CodePtrKind = W
766 kindToSize DataPtrKind = W
767 kindToSize RetKind = W
768 kindToSize InfoPtrKind = W
769 kindToSize CostCentreKind = W
770 kindToSize CharKind = UB
771 kindToSize IntKind = W
772 kindToSize WordKind = W
773 kindToSize AddrKind = W
774 kindToSize FloatKind = F
775 kindToSize DoubleKind = DF
776 kindToSize ArrayKind = W
777 kindToSize ByteArrayKind = W
778 kindToSize StablePtrKind = W
779 kindToSize MallocPtrKind = W
783 @sparcRegUsage@ returns the sets of src and destination registers used by
784 a particular instruction. Machine registers that are pre-allocated
785 to stgRegs are filtered out, because they are uninteresting from a
786 register allocation standpoint. (We wouldn't want them to end up on
791 sparcRegUsage :: SparcInstr -> RegUsage
792 sparcRegUsage instr = case instr of
793 LD sz addr reg -> usage (regAddr addr, [reg])
794 ST sz reg addr -> usage (reg : regAddr addr, [])
795 ADD x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
796 SUB x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
797 AND b r1 ar r2 -> usage (r1 : regRI ar, [r2])
798 ANDN b r1 ar r2 -> usage (r1 : regRI ar, [r2])
799 OR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
800 ORN b r1 ar r2 -> usage (r1 : regRI ar, [r2])
801 XOR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
802 XNOR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
803 SLL r1 ar r2 -> usage (r1 : regRI ar, [r2])
804 SRL r1 ar r2 -> usage (r1 : regRI ar, [r2])
805 SRA r1 ar r2 -> usage (r1 : regRI ar, [r2])
806 SETHI imm reg -> usage ([], [reg])
807 FABS s r1 r2 -> usage ([r1], [r2])
808 FADD s r1 r2 r3 -> usage ([r1, r2], [r3])
809 FCMP e s r1 r2 -> usage ([r1, r2], [])
810 FDIV s r1 r2 r3 -> usage ([r1, r2], [r3])
811 FMOV s r1 r2 -> usage ([r1], [r2])
812 FMUL s r1 r2 r3 -> usage ([r1, r2], [r3])
813 FNEG s r1 r2 -> usage ([r1], [r2])
814 FSQRT s r1 r2 -> usage ([r1], [r2])
815 FSUB s r1 r2 r3 -> usage ([r1, r2], [r3])
816 FxTOy s1 s2 r1 r2 -> usage ([r1], [r2])
818 -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
819 JMP addr -> RU (mkUniqSet (filter interesting (regAddr addr))) freeSet
821 CALL _ n True -> endUsage
822 CALL _ n False -> RU (argSet n) callClobberedSet
827 usage (src, dst) = RU (mkUniqSet (filter interesting src))
828 (mkUniqSet (filter interesting dst))
830 interesting (FixedReg _) = False
833 regAddr (AddrRegReg r1 r2) = [r1, r2]
834 regAddr (AddrRegImm r1 _) = [r1]
836 regRI (RIReg r) = [r]
840 freeRegs = freeMappedRegs (\ x -> x) [0..63]
842 freeMappedRegs :: (Int -> Int) -> [Int] -> [Reg]
844 freeMappedRegs modify nums
849 modified_i = case (modify n) of { IBOX(x) -> x }
851 if _IS_TRUE_(freeReg modified_i) then (MappedReg modified_i) : acc else acc
853 freeSet :: UniqSet Reg
854 freeSet = mkUniqSet freeRegs
857 noUsage = RU emptyUniqSet emptyUniqSet
860 endUsage = RU emptyUniqSet freeSet
863 argSet :: Int -> UniqSet Reg
864 argSet 0 = emptyUniqSet
865 argSet 1 = mkUniqSet (freeMappedRegs oReg [0])
866 argSet 2 = mkUniqSet (freeMappedRegs oReg [0,1])
867 argSet 3 = mkUniqSet (freeMappedRegs oReg [0,1,2])
868 argSet 4 = mkUniqSet (freeMappedRegs oReg [0,1,2,3])
869 argSet 5 = mkUniqSet (freeMappedRegs oReg [0,1,2,3,4])
870 argSet 6 = mkUniqSet (freeMappedRegs oReg [0,1,2,3,4,5])
872 callClobberedSet :: UniqSet Reg
873 callClobberedSet = mkUniqSet callClobberedRegs
875 callClobberedRegs = freeMappedRegs (\x -> x)
877 [oReg i | i <- [0..5]] ++
878 [gReg i | i <- [1..7]] ++
879 [fReg i | i <- [0..31]] )
883 @sparcRegLiveness@ takes future liveness information and modifies it according to
884 the semantics of branches and labels. (An out-of-line branch clobbers the liveness
885 passed back by the following instruction; a forward local branch passes back the
886 liveness from the target label; a conditional branch merges the liveness from the
887 target and the liveness from its successor; a label stashes away the current liveness
888 in the future liveness environment).
891 sparcRegLiveness :: SparcInstr -> RegLiveness -> RegLiveness
892 sparcRegLiveness instr info@(RL live future@(FL all env)) = case instr of
894 -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
896 BI ALWAYS _ (ImmCLbl lbl) -> RL (lookup lbl) future
897 BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionUniqSets` live) future
898 BF ALWAYS _ (ImmCLbl lbl) -> RL (lookup lbl) future
899 BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionUniqSets` live) future
900 JMP _ -> RL emptyUniqSet future
901 CALL _ i True -> RL emptyUniqSet future
902 CALL _ i False -> RL live future
903 LABEL lbl -> RL live (FL (all `unionUniqSets` live) (addToFM env lbl live))
907 lookup lbl = case lookupFM env lbl of
909 Nothing -> trace ("Missing " ++ (uppShow 80 (pprCLabel (PprForAsm (\_->False) False id) lbl)) ++
910 " in future?") emptyUniqSet
914 @sparcPatchRegs@ takes an instruction (possibly with MemoryReg/UnmappedReg registers) and
915 changes all register references according to the supplied environment.
919 sparcPatchRegs :: SparcInstr -> (Reg -> Reg) -> SparcInstr
920 sparcPatchRegs instr env = case instr of
921 LD sz addr reg -> LD sz (fixAddr addr) (env reg)
922 ST sz reg addr -> ST sz (env reg) (fixAddr addr)
923 ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
924 SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
925 AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2)
926 ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2)
927 OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2)
928 ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2)
929 XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2)
930 XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2)
931 SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
932 SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
933 SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
934 SETHI imm reg -> SETHI imm (env reg)
935 FABS s r1 r2 -> FABS s (env r1) (env r2)
936 FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
937 FCMP e s r1 r2 -> FCMP e s (env r1) (env r2)
938 FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
939 FMOV s r1 r2 -> FMOV s (env r1) (env r2)
940 FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
941 FNEG s r1 r2 -> FNEG s (env r1) (env r2)
942 FSQRT s r1 r2 -> FSQRT s (env r1) (env r2)
943 FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
944 FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2)
945 JMP addr -> JMP (fixAddr addr)
949 fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
950 fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
952 fixRI (RIReg r) = RIReg (env r)
956 Sometimes, we want to be able to modify addresses at compile time.
957 (Okay, just for chrCode of a fetch.)
961 #ifdef __GLASGOW_HASKELL__
964 is13Bits :: Int -> Bool
967 is13Bits :: Integer -> Bool
972 is13Bits :: Integral a => a -> Bool
973 is13Bits x = x >= -4096 && x < 4096
975 offset :: Addr -> Int -> Maybe Addr
977 offset (AddrRegImm reg (ImmInt n)) off
978 | is13Bits n2 = Just (AddrRegImm reg (ImmInt n2))
979 | otherwise = Nothing
982 offset (AddrRegImm reg (ImmInteger n)) off
983 | is13Bits n2 = Just (AddrRegImm reg (ImmInt (fromInteger n2)))
984 | otherwise = Nothing
985 where n2 = n + toInteger off
987 offset (AddrRegReg reg (FixedReg ILIT(0))) off
988 | is13Bits off = Just (AddrRegImm reg (ImmInt off))
989 | otherwise = Nothing
995 If you value your sanity, do not venture below this line.
999 -- platform.h is generate and tells us what the target architecture is
1000 #include "../../includes/platform.h"
1001 #include "../../includes/MachRegs.h"
1002 #if sunos4_TARGET_OS
1003 #include "../../includes/sparc-sun-sunos4.h"
1005 #include "../../includes/sparc-sun-solaris2.h"
1008 -- Redefine the literals used for Sparc register names in the header
1009 -- files. Gag me with a spoon, eh?
1076 baseRegOffset :: MagicId -> Int
1077 baseRegOffset StkOReg = OFFSET_StkO
1078 baseRegOffset (VanillaReg _ ILIT2(1)) = OFFSET_R1
1079 baseRegOffset (VanillaReg _ ILIT2(2)) = OFFSET_R2
1080 baseRegOffset (VanillaReg _ ILIT2(3)) = OFFSET_R3
1081 baseRegOffset (VanillaReg _ ILIT2(4)) = OFFSET_R4
1082 baseRegOffset (VanillaReg _ ILIT2(5)) = OFFSET_R5
1083 baseRegOffset (VanillaReg _ ILIT2(6)) = OFFSET_R6
1084 baseRegOffset (VanillaReg _ ILIT2(7)) = OFFSET_R7
1085 baseRegOffset (VanillaReg _ ILIT2(8)) = OFFSET_R8
1086 baseRegOffset (FloatReg ILIT2(1)) = OFFSET_Flt1
1087 baseRegOffset (FloatReg ILIT2(2)) = OFFSET_Flt2
1088 baseRegOffset (FloatReg ILIT2(3)) = OFFSET_Flt3
1089 baseRegOffset (FloatReg ILIT2(4)) = OFFSET_Flt4
1090 baseRegOffset (DoubleReg ILIT2(1)) = OFFSET_Dbl1
1091 baseRegOffset (DoubleReg ILIT2(2)) = OFFSET_Dbl2
1092 baseRegOffset TagReg = OFFSET_Tag
1093 baseRegOffset RetReg = OFFSET_Ret
1094 baseRegOffset SpA = OFFSET_SpA
1095 baseRegOffset SuA = OFFSET_SuA
1096 baseRegOffset SpB = OFFSET_SpB
1097 baseRegOffset SuB = OFFSET_SuB
1098 baseRegOffset Hp = OFFSET_Hp
1099 baseRegOffset HpLim = OFFSET_HpLim
1100 baseRegOffset LivenessReg = OFFSET_Liveness
1101 baseRegOffset ActivityReg = OFFSET_Activity
1103 baseRegOffset BaseReg = panic "baseRegOffset:BaseReg"
1104 baseRegOffset StdUpdRetVecReg = panic "baseRegOffset:StgUpdRetVecReg"
1105 baseRegOffset StkStubReg = panic "baseRegOffset:StkStubReg"
1106 baseRegOffset CurCostCentre = panic "baseRegOffset:CurCostCentre"
1107 baseRegOffset VoidReg = panic "baseRegOffset:VoidReg"
1110 callerSaves :: MagicId -> Bool
1111 #ifdef CALLER_SAVES_Base
1112 callerSaves BaseReg = True
1114 #ifdef CALLER_SAVES_StkO
1115 callerSaves StkOReg = True
1117 #ifdef CALLER_SAVES_R1
1118 callerSaves (VanillaReg _ ILIT2(1)) = True
1120 #ifdef CALLER_SAVES_R2
1121 callerSaves (VanillaReg _ ILIT2(2)) = True
1123 #ifdef CALLER_SAVES_R3
1124 callerSaves (VanillaReg _ ILIT2(3)) = True
1126 #ifdef CALLER_SAVES_R4
1127 callerSaves (VanillaReg _ ILIT2(4)) = True
1129 #ifdef CALLER_SAVES_R5
1130 callerSaves (VanillaReg _ ILIT2(5)) = True
1132 #ifdef CALLER_SAVES_R6
1133 callerSaves (VanillaReg _ ILIT2(6)) = True
1135 #ifdef CALLER_SAVES_R7
1136 callerSaves (VanillaReg _ ILIT2(7)) = True
1138 #ifdef CALLER_SAVES_R8
1139 callerSaves (VanillaReg _ ILIT2(8)) = True
1141 #ifdef CALLER_SAVES_FltReg1
1142 callerSaves (FloatReg ILIT2(1)) = True
1144 #ifdef CALLER_SAVES_FltReg2
1145 callerSaves (FloatReg ILIT2(2)) = True
1147 #ifdef CALLER_SAVES_FltReg3
1148 callerSaves (FloatReg ILIT2(3)) = True
1150 #ifdef CALLER_SAVES_FltReg4
1151 callerSaves (FloatReg ILIT2(4)) = True
1153 #ifdef CALLER_SAVES_DblReg1
1154 callerSaves (DoubleReg ILIT2(1)) = True
1156 #ifdef CALLER_SAVES_DblReg2
1157 callerSaves (DoubleReg ILIT2(2)) = True
1159 #ifdef CALLER_SAVES_Tag
1160 callerSaves TagReg = True
1162 #ifdef CALLER_SAVES_Ret
1163 callerSaves RetReg = True
1165 #ifdef CALLER_SAVES_SpA
1166 callerSaves SpA = True
1168 #ifdef CALLER_SAVES_SuA
1169 callerSaves SuA = True
1171 #ifdef CALLER_SAVES_SpB
1172 callerSaves SpB = True
1174 #ifdef CALLER_SAVES_SuB
1175 callerSaves SuB = True
1177 #ifdef CALLER_SAVES_Hp
1178 callerSaves Hp = True
1180 #ifdef CALLER_SAVES_HpLim
1181 callerSaves HpLim = True
1183 #ifdef CALLER_SAVES_Liveness
1184 callerSaves LivenessReg = True
1186 #ifdef CALLER_SAVES_Activity
1187 callerSaves ActivityReg = True
1189 #ifdef CALLER_SAVES_StdUpdRetVec
1190 callerSaves StdUpdRetVecReg = True
1192 #ifdef CALLER_SAVES_StkStub
1193 callerSaves StkStubReg = True
1195 callerSaves _ = False
1197 stgRegMap :: MagicId -> Maybe Reg
1199 stgRegMap BaseReg = Just (FixedReg ILIT(REG_Base))
1202 stgRegMap StkOReg = Just (FixedReg ILIT(REG_StkOReg))
1205 stgRegMap (VanillaReg _ ILIT2(1)) = Just (FixedReg ILIT(REG_R1))
1208 stgRegMap (VanillaReg _ ILIT2(2)) = Just (FixedReg ILIT(REG_R2))
1211 stgRegMap (VanillaReg _ ILIT2(3)) = Just (FixedReg ILIT(REG_R3))
1214 stgRegMap (VanillaReg _ ILIT2(4)) = Just (FixedReg ILIT(REG_R4))
1217 stgRegMap (VanillaReg _ ILIT2(5)) = Just (FixedReg ILIT(REG_R5))
1220 stgRegMap (VanillaReg _ ILIT2(6)) = Just (FixedReg ILIT(REG_R6))
1223 stgRegMap (VanillaReg _ ILIT2(7)) = Just (FixedReg ILIT(REG_R7))
1226 stgRegMap (VanillaReg _ ILIT2(8)) = Just (FixedReg ILIT(REG_R8))
1229 stgRegMap (FloatReg ILIT2(1)) = Just (FixedReg ILIT(REG_Flt1))
1232 stgRegMap (FloatReg ILIT2(2)) = Just (FixedReg ILIT(REG_Flt2))
1235 stgRegMap (FloatReg ILIT2(3)) = Just (FixedReg ILIT(REG_Flt3))
1238 stgRegMap (FloatReg ILIT2(4)) = Just (FixedReg ILIT(REG_Flt4))
1241 stgRegMap (DoubleReg ILIT2(1)) = Just (FixedReg ILIT(REG_Dbl1))
1244 stgRegMap (DoubleReg ILIT2(2)) = Just (FixedReg ILIT(REG_Dbl2))
1247 stgRegMap TagReg = Just (FixedReg ILIT(REG_TagReg))
1250 stgRegMap RetReg = Just (FixedReg ILIT(REG_Ret))
1253 stgRegMap SpA = Just (FixedReg ILIT(REG_SpA))
1256 stgRegMap SuA = Just (FixedReg ILIT(REG_SuA))
1259 stgRegMap SpB = Just (FixedReg ILIT(REG_SpB))
1262 stgRegMap SuB = Just (FixedReg ILIT(REG_SuB))
1265 stgRegMap Hp = Just (FixedReg ILIT(REG_Hp))
1268 stgRegMap HpLim = Just (FixedReg ILIT(REG_HpLim))
1271 stgRegMap LivenessReg = Just (FixedReg ILIT(REG_Liveness))
1274 stgRegMap ActivityReg = Just (FixedReg ILIT(REG_Activity))
1276 #ifdef REG_StdUpdRetVec
1277 stgRegMap StdUpdRetVecReg = Just (FixedReg ILIT(REG_StdUpdRetVec))
1280 stgRegMap StkStubReg = Just (FixedReg ILIT(REG_StkStub))
1282 stgRegMap _ = Nothing
1286 Here is the list of registers we can use in register allocation.
1290 freeReg :: FAST_INT -> FAST_BOOL
1292 freeReg ILIT(g0) = _FALSE_ -- %g0 is always 0.
1293 freeReg ILIT(g5) = _FALSE_ -- %g5 is reserved (ABI).
1294 freeReg ILIT(g6) = _FALSE_ -- %g6 is reserved (ABI).
1295 freeReg ILIT(g7) = _FALSE_ -- %g7 is reserved (ABI).
1296 freeReg ILIT(i6) = _FALSE_ -- %i6 is our frame pointer.
1297 freeReg ILIT(o6) = _FALSE_ -- %o6 is our stack pointer.
1300 freeReg ILIT(REG_Base) = _FALSE_
1303 freeReg ILIT(REG_StkO) = _FALSE_
1306 freeReg ILIT(REG_R1) = _FALSE_
1309 freeReg ILIT(REG_R2) = _FALSE_
1312 freeReg ILIT(REG_R3) = _FALSE_
1315 freeReg ILIT(REG_R4) = _FALSE_
1318 freeReg ILIT(REG_R5) = _FALSE_
1321 freeReg ILIT(REG_R6) = _FALSE_
1324 freeReg ILIT(REG_R7) = _FALSE_
1327 freeReg ILIT(REG_R8) = _FALSE_
1330 freeReg ILIT(REG_Flt1) = _FALSE_
1333 freeReg ILIT(REG_Flt2) = _FALSE_
1336 freeReg ILIT(REG_Flt3) = _FALSE_
1339 freeReg ILIT(REG_Flt4) = _FALSE_
1342 freeReg ILIT(REG_Dbl1) = _FALSE_
1345 freeReg ILIT(REG_Dbl2) = _FALSE_
1348 freeReg ILIT(REG_Tag) = _FALSE_
1351 freeReg ILIT(REG_Ret) = _FALSE_
1354 freeReg ILIT(REG_SpA) = _FALSE_
1357 freeReg ILIT(REG_SuA) = _FALSE_
1360 freeReg ILIT(REG_SpB) = _FALSE_
1363 freeReg ILIT(REG_SuB) = _FALSE_
1366 freeReg ILIT(REG_Hp) = _FALSE_
1369 freeReg ILIT(REG_HpLim) = _FALSE_
1372 freeReg ILIT(REG_Liveness) = _FALSE_
1375 freeReg ILIT(REG_Activity) = _FALSE_
1377 #ifdef REG_StdUpdRetVec
1378 freeReg ILIT(REG_StdUpdRetVec) = _FALSE_
1381 freeReg ILIT(REG_StkStub) = _FALSE_
1385 | n _EQ_ (ILIT(REG_Dbl1) _ADD_ ILIT(1)) = _FALSE_
1388 | n _EQ_ (ILIT(REG_Dbl2) _ADD_ ILIT(1)) = _FALSE_
1390 | otherwise = _TRUE_
1392 reservedRegs :: [Int]
1393 reservedRegs = [NCG_Reserved_I1, NCG_Reserved_I2,
1394 NCG_Reserved_F1, NCG_Reserved_F2,
1395 NCG_Reserved_D1, NCG_Reserved_D2]