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,
18 baseRegOffset, stgRegMap, callerSaves,
24 g0, o0, f0, fp, sp, argRegs,
26 freeRegs, reservedRegs
28 -- and, for self-sufficiency ...
33 import AbsCSyn ( MagicId(..) )
34 import AsmRegAlloc ( MachineCode(..), MachineRegisters(..), FutureLive(..),
35 Reg(..), RegUsage(..), RegLiveness(..)
38 import CgCompInfo ( mAX_Double_REG, mAX_Float_REG, mAX_Vanilla_REG )
39 import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel, charToC )
41 import Maybes ( Maybe(..), maybeToBool )
42 import OrdList ( OrdList, mkUnitList, flattenOrdList )
50 %************************************************************************
52 \subsection[SparcReg]{The Native (Sparc) Machine Register Table}
54 %************************************************************************
56 The sparc has 64 registers of interest; 32 integer registers and 32 floating
57 point registers. The mapping of STG registers to sparc machine registers
58 is defined in StgRegs.h. We are, of course, prepared for any eventuality.
60 ToDo: Deal with stg registers that live as offsets from BaseReg!(JSM)
64 gReg,lReg,iReg,oReg,fReg :: Int -> Int
72 fPair (FixedReg i) = FixedReg (i _ADD_ ILIT(1))
73 fPair (MappedReg i) = MappedReg (i _ADD_ ILIT(1))
75 g0, fp, sp, o0, f0 :: Reg
76 g0 = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
77 fp = case (iReg 6) of { IBOX(i6) -> FixedReg i6 }
78 sp = case (oReg 6) of { IBOX(o6) -> FixedReg o6 }
83 argRegs = map realReg [oReg i | i <- [0..5]]
85 realReg n@IBOX(i) = if _IS_TRUE_(freeReg i) then MappedReg i else FixedReg i
89 %************************************************************************
91 \subsection[TheSparcCode]{The datatype for sparc assembly language}
93 %************************************************************************
95 Here is a definition of the Sparc assembly language.
100 | ImmInteger Integer -- Sigh.
101 | ImmCLbl CLabel -- AbstractC Label (with baggage)
102 | ImmLab Unpretty -- Simple string label (underscored)
103 | ImmLit Unpretty -- Simple string
104 | LO Imm -- Possible restrictions
108 strImmLit s = ImmLit (uppStr s)
110 data Addr = AddrRegReg Reg Reg
137 riZero (RIImm (ImmInt 0)) = True
138 riZero (RIImm (ImmInteger 0)) = True
139 riZero (RIReg (FixedReg ILIT(0))) = True
156 LD Size Addr Reg -- size, src, dst
157 | ST Size Reg Addr -- size, src, dst
161 | ADD Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
162 | SUB Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
164 -- Simple bit-twiddling.
166 | AND Bool Reg RI Reg -- cc?, src1, src2, dst
167 | ANDN Bool Reg RI Reg -- cc?, src1, src2, dst
168 | OR Bool Reg RI Reg -- cc?, src1, src2, dst
169 | ORN Bool Reg RI Reg -- cc?, src1, src2, dst
170 | XOR Bool Reg RI Reg -- cc?, src1, src2, dst
171 | XNOR Bool Reg RI Reg -- cc?, src1, src2, dst
172 | SLL Reg RI Reg -- src1, src2, dst
173 | SRL Reg RI Reg -- src1, src2, dst
174 | SRA Reg RI Reg -- src1, src2, dst
175 | SETHI Imm Reg -- src, dst
176 | NOP -- Really SETHI 0, %g0, but worth an alias
180 -- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single instructions
181 -- right up until we spit them out.
183 | FABS Size Reg Reg -- src dst
184 | FADD Size Reg Reg Reg -- src1, src2, dst
185 | FCMP Bool Size Reg Reg -- exception?, src1, src2, dst
186 | FDIV Size Reg Reg Reg -- src1, src2, dst
187 | FMOV Size Reg Reg -- src, dst
188 | FMUL Size Reg Reg Reg -- src1, src2, dst
189 | FNEG Size Reg Reg -- src, dst
190 | FSQRT Size Reg Reg -- src, dst
191 | FSUB Size Reg Reg Reg -- src1, src2, dst
192 | FxTOy Size Size Reg Reg -- src, dst
196 | BI Cond Bool Imm -- cond, annul?, target
197 | BF Cond Bool Imm -- cond, annul?, target
200 | CALL Imm Int Bool -- target, args, terminal
205 | COMMENT FAST_STRING
206 | SEGMENT CodeSegment
207 | ASCII Bool String -- needs backslash conversion?
210 type SparcCode = OrdList SparcInstr
214 %************************************************************************
216 \subsection[TheSparcPretty]{Pretty-printing the Sparc Assembly Language}
218 %************************************************************************
222 printLabeledCodes :: PprStyle -> [SparcInstr] -> Unpretty
223 printLabeledCodes sty codes = uppAboves (map (pprSparcInstr sty) codes)
227 Printing the pieces...
231 pprReg :: Reg -> Unpretty
233 pprReg (FixedReg i) = pprSparcReg i
234 pprReg (MappedReg i) = pprSparcReg i
235 pprReg other = uppStr (show other) -- should only happen when debugging
237 pprSparcReg :: FAST_INT -> Unpretty
238 pprSparcReg i = uppPStr
240 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
241 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
242 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
243 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
244 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
245 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
246 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
247 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
248 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
249 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
250 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
251 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
252 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
253 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
254 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
255 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
256 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
257 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
258 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
259 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
260 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
261 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
262 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
263 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
264 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
265 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
266 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
267 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
268 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
269 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
270 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
271 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
272 _ -> SLIT("very naughty sparc register")
275 pprCond :: Cond -> Unpretty
278 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
279 GEU -> SLIT("geu"); LU -> SLIT("lu");
280 EQ -> SLIT("e"); GT -> SLIT("g");
281 GE -> SLIT("ge"); GU -> SLIT("gu");
282 LT -> SLIT("l"); LE -> SLIT("le");
283 LEU -> SLIT("leu"); NE -> SLIT("ne");
284 NEG -> SLIT("neg"); POS -> SLIT("pos");
285 VC -> SLIT("vc"); VS -> SLIT("vs")
288 pprImm :: PprStyle -> Imm -> Unpretty
290 pprImm sty (ImmInt i) = uppInt i
291 pprImm sty (ImmInteger i) = uppInteger i
300 #ifdef USE_FAST_STRINGS
301 pp_lo = uppPStr (_packCString (A# "%lo("#))
303 pp_lo = uppStr "%lo("
313 #ifdef USE_FAST_STRINGS
314 pp_hi = uppPStr (_packCString (A# "%hi("#))
316 pp_hi = uppStr "%hi("
319 pprImm sty (ImmCLbl l) = pprCLabel sty l
321 pprImm (PprForAsm _ False _) (ImmLab s) = s
322 pprImm _ (ImmLab s) = uppBeside (uppChar '_') s
324 pprImm sty (ImmLit s) = s
326 pprAddr :: PprStyle -> Addr -> Unpretty
327 pprAddr sty (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
329 pprAddr sty (AddrRegReg r1 r2) =
336 pprAddr sty (AddrRegImm r1 (ImmInt i))
338 | i < -4096 || i > 4095 = large_offset_error i
346 pprAddr sty (AddrRegImm r1 (ImmInteger i))
348 | i < -4096 || i > 4095 = large_offset_error i
356 pprAddr sty (AddrRegImm r1 imm) =
364 = error ("ERROR: SPARC native-code generator cannot handle large offset ("++show i++");\nprobably because of large constant data structures;\nworkaround: use -fvia-C on this module.\n")
366 pprRI :: PprStyle -> RI -> Unpretty
367 pprRI sty (RIReg r) = pprReg r
368 pprRI sty (RIImm r) = pprImm sty r
370 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Unpretty
371 pprSizeRegReg name size reg1 reg2 =
376 F -> uppPStr SLIT("s\t")
377 DF -> uppPStr SLIT("d\t")),
383 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
384 pprSizeRegRegReg name size reg1 reg2 reg3 =
389 F -> uppPStr SLIT("s\t")
390 DF -> uppPStr SLIT("d\t")),
398 pprRegRIReg :: PprStyle -> FAST_STRING -> Bool -> Reg -> RI -> Reg -> Unpretty
399 pprRegRIReg sty name b reg1 ri reg2 =
403 if b then uppPStr SLIT("cc\t") else uppChar '\t',
411 pprRIReg :: PprStyle -> FAST_STRING -> Bool -> RI -> Reg -> Unpretty
412 pprRIReg sty name b ri reg1 =
416 if b then uppPStr SLIT("cc\t") else uppChar '\t',
422 pprSize :: Size -> Unpretty
435 #ifdef USE_FAST_STRINGS
436 pp_ld_lbracket = uppPStr (_packCString (A# "\tld\t["#))
437 pp_rbracket_comma = uppPStr (_packCString (A# "],"#))
438 pp_comma_lbracket = uppPStr (_packCString (A# ",["#))
439 pp_comma_a = uppPStr (_packCString (A# ",a"#))
441 pp_ld_lbracket = uppStr "\tld\t["
442 pp_rbracket_comma = uppStr "],"
443 pp_comma_lbracket = uppStr ",["
444 pp_comma_a = uppStr ",a"
447 pprSparcInstr :: PprStyle -> SparcInstr -> Unpretty
449 -- a clumsy hack for now, to handle possible alignment problems
451 pprSparcInstr sty (LD DF addr reg) | maybeToBool addrOff =
465 addrOff = offset addr 4
466 addr2 = case addrOff of Just x -> x
468 pprSparcInstr sty (LD size addr reg) =
470 uppPStr SLIT("\tld"),
479 -- The same clumsy hack as above
481 pprSparcInstr sty (ST DF reg addr) | maybeToBool addrOff =
483 uppPStr SLIT("\tst\t"),
488 uppPStr SLIT("]\n\tst\t"),
495 addrOff = offset addr 4
496 addr2 = case addrOff of Just x -> x
498 pprSparcInstr sty (ST size reg addr) =
500 uppPStr SLIT("\tst"),
509 pprSparcInstr sty (ADD x cc reg1 ri reg2)
510 | not x && not cc && riZero ri =
512 uppPStr SLIT("\tmov\t"),
517 | otherwise = pprRegRIReg sty (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
519 pprSparcInstr sty (SUB x cc reg1 ri reg2)
520 | not x && cc && reg2 == g0 =
522 uppPStr SLIT("\tcmp\t"),
527 | not x && not cc && riZero ri =
529 uppPStr SLIT("\tmov\t"),
534 | otherwise = pprRegRIReg sty (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
536 pprSparcInstr sty (AND b reg1 ri reg2) = pprRegRIReg sty SLIT("and") b reg1 ri reg2
537 pprSparcInstr sty (ANDN b reg1 ri reg2) = pprRegRIReg sty SLIT("andn") b reg1 ri reg2
539 pprSparcInstr sty (OR b reg1 ri reg2)
540 | not b && reg1 == g0 =
542 uppPStr SLIT("\tmov\t"),
547 | otherwise = pprRegRIReg sty SLIT("or") b reg1 ri reg2
549 pprSparcInstr sty (ORN b reg1 ri reg2) = pprRegRIReg sty SLIT("orn") b reg1 ri reg2
551 pprSparcInstr sty (XOR b reg1 ri reg2) = pprRegRIReg sty SLIT("xor") b reg1 ri reg2
552 pprSparcInstr sty (XNOR b reg1 ri reg2) = pprRegRIReg sty SLIT("xnor") b reg1 ri reg2
554 pprSparcInstr sty (SLL reg1 ri reg2) = pprRegRIReg sty SLIT("sll") False reg1 ri reg2
555 pprSparcInstr sty (SRL reg1 ri reg2) = pprRegRIReg sty SLIT("srl") False reg1 ri reg2
556 pprSparcInstr sty (SRA reg1 ri reg2) = pprRegRIReg sty SLIT("sra") False reg1 ri reg2
558 pprSparcInstr sty (SETHI imm reg) =
560 uppPStr SLIT("\tsethi\t"),
566 pprSparcInstr sty (NOP) = uppPStr SLIT("\tnop")
568 pprSparcInstr sty (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
569 pprSparcInstr sty (FABS DF reg1 reg2) =
570 uppBeside (pprSizeRegReg SLIT("fabs") F reg1 reg2)
571 (if (reg1 == reg2) then uppNil
572 else uppBeside (uppChar '\n')
573 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
575 pprSparcInstr sty (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
576 pprSparcInstr sty (FCMP e size reg1 reg2) =
577 pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
578 pprSparcInstr sty (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
580 pprSparcInstr sty (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
581 pprSparcInstr sty (FMOV DF reg1 reg2) =
582 uppBeside (pprSizeRegReg SLIT("fmov") F reg1 reg2)
583 (if (reg1 == reg2) then uppNil
584 else uppBeside (uppChar '\n')
585 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
587 pprSparcInstr sty (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
589 pprSparcInstr sty (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
590 pprSparcInstr sty (FNEG DF reg1 reg2) =
591 uppBeside (pprSizeRegReg SLIT("fneg") F reg1 reg2)
592 (if (reg1 == reg2) then uppNil
593 else uppBeside (uppChar '\n')
594 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
596 pprSparcInstr sty (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
597 pprSparcInstr sty (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
598 pprSparcInstr sty (FxTOy size1 size2 reg1 reg2) =
617 pprSparcInstr sty (BI cond b lab) =
619 uppPStr SLIT("\tb"), pprCond cond,
620 if b then pp_comma_a else uppNil,
625 pprSparcInstr sty (BF cond b lab) =
627 uppPStr SLIT("\tfb"), pprCond cond,
628 if b then pp_comma_a else uppNil,
633 pprSparcInstr sty (JMP addr) = uppBeside (uppPStr SLIT("\tjmp\t")) (pprAddr sty addr)
635 pprSparcInstr sty (CALL imm n _) =
637 uppPStr SLIT("\tcall\t"),
643 pprSparcInstr sty (LABEL clab) =
645 if (externallyVisibleCLabel clab) then
646 uppBesides [uppPStr SLIT("\t.global\t"), pprLab, uppChar '\n']
652 where pprLab = pprCLabel sty clab
654 pprSparcInstr sty (COMMENT s) = uppBeside (uppPStr SLIT("! ")) (uppPStr s)
656 pprSparcInstr sty (SEGMENT TextSegment)
657 = uppPStr SLIT("\t.text\n\t.align 4")
659 pprSparcInstr sty (SEGMENT DataSegment)
660 = uppPStr SLIT("\t.data\n\t.align 8") -- Less than 8 will break double constants
662 pprSparcInstr sty (ASCII False str) =
664 uppStr "\t.asciz \"",
669 pprSparcInstr sty (ASCII True str) = uppBeside (uppStr "\t.ascii \"") (asciify str 60)
671 asciify :: String -> Int -> Unpretty
672 asciify [] _ = uppStr ("\\0\"")
673 asciify s n | n <= 0 = uppBeside (uppStr "\"\n\t.ascii \"") (asciify s 60)
674 asciify ('\\':cs) n = uppBeside (uppStr "\\\\") (asciify cs (n-1))
675 asciify ('\"':cs) n = uppBeside (uppStr "\\\"") (asciify cs (n-1))
676 asciify (c:cs) n | isPrint c = uppBeside (uppChar c) (asciify cs (n-1))
677 asciify [c] _ = uppBeside (uppStr (charToC c)) (uppStr ("\\0\""))
678 asciify (c:(cs@(d:_))) n | isDigit d =
679 uppBeside (uppStr (charToC c)) (asciify cs 0)
681 uppBeside (uppStr (charToC c)) (asciify cs (n-1))
683 pprSparcInstr sty (DATA s xs) = uppInterleave (uppChar '\n') (map pp_item xs)
684 where pp_item x = case s of
685 SB -> uppBeside (uppPStr SLIT("\t.byte\t")) (pprImm sty x)
686 UB -> uppBeside (uppPStr SLIT("\t.byte\t")) (pprImm sty x)
687 W -> uppBeside (uppPStr SLIT("\t.word\t")) (pprImm sty x)
688 DF -> uppBeside (uppPStr SLIT("\t.double\t")) (pprImm sty x)
692 %************************************************************************
694 \subsection[Schedule]{Register allocation information}
696 %************************************************************************
698 Getting the conflicts right is a bit tedious for doubles. We'd have to
699 add a conflict function to the MachineRegisters class, and we'd have to
700 put a PrimRep in the MappedReg datatype, or use some kludge (e.g. register
701 64 + n is really the same as 32 + n, except that it's used for a double,
702 so it also conflicts with 33 + n) to deal with it. It's just not worth the
703 bother, so we just partition the free floating point registers into two
704 sets: one for single precision and one for double precision. We never seem
705 to run out of floating point registers anyway.
709 data SparcRegs = SRegs BitSet BitSet BitSet
711 instance MachineRegisters SparcRegs where
712 mkMRegs xs = SRegs (mkBS ints) (mkBS singles') (mkBS doubles')
714 (ints, floats) = partition (< 32) xs
715 (singles, doubles) = partition (< 48) floats
716 singles' = map (subtract 32) singles
717 doubles' = map (subtract 32) (filter even doubles)
719 possibleMRegs FloatRep (SRegs _ singles _) = [ x + 32 | x <- listBS singles]
720 possibleMRegs DoubleRep (SRegs _ _ doubles) = [ x + 32 | x <- listBS doubles]
721 possibleMRegs _ (SRegs ints _ _) = listBS ints
723 useMReg (SRegs ints singles doubles) n =
724 if n _LT_ ILIT(32) then SRegs (ints `minusBS` singletonBS IBOX(n)) singles doubles
725 else if n _LT_ ILIT(48) then SRegs ints (singles `minusBS` singletonBS (IBOX(n _SUB_ ILIT(32)))) doubles
726 else SRegs ints singles (doubles `minusBS` singletonBS (IBOX(n _SUB_ ILIT(32))))
728 useMRegs (SRegs ints singles doubles) xs =
729 SRegs (ints `minusBS` ints')
730 (singles `minusBS` singles')
731 (doubles `minusBS` doubles')
733 SRegs ints' singles' doubles' = mkMRegs xs
735 freeMReg (SRegs ints singles doubles) n =
736 if n _LT_ ILIT(32) then SRegs (ints `unionBS` singletonBS IBOX(n)) singles doubles
737 else if n _LT_ ILIT(48) then SRegs ints (singles `unionBS` singletonBS (IBOX(n _SUB_ ILIT(32)))) doubles
738 else SRegs ints singles (doubles `unionBS` singletonBS (IBOX(n _SUB_ ILIT(32))))
740 freeMRegs (SRegs ints singles doubles) xs =
741 SRegs (ints `unionBS` ints')
742 (singles `unionBS` singles')
743 (doubles `unionBS` doubles')
745 SRegs ints' singles' doubles' = mkMRegs xs
747 instance MachineCode SparcInstr where
748 regUsage = sparcRegUsage
749 regLiveness = sparcRegLiveness
750 patchRegs = sparcPatchRegs
752 -- We spill just below the frame pointer, leaving two words per spill location.
753 spillReg dyn (MemoryReg i pk) = mkUnitList (ST (kindToSize pk) dyn (fpRel (-2 * i)))
754 loadReg (MemoryReg i pk) dyn = mkUnitList (LD (kindToSize pk) (fpRel (-2 * i)) dyn)
756 -- Duznae work for offsets greater than 13 bits; we just hope for the best
758 fpRel n = AddrRegImm fp (ImmInt (n * 4))
760 kindToSize :: PrimRep -> Size
761 kindToSize PtrRep = W
762 kindToSize CodePtrRep = W
763 kindToSize DataPtrRep = W
764 kindToSize RetRep = W
765 kindToSize CostCentreRep = W
766 kindToSize CharRep = UB
767 kindToSize IntRep = W
768 kindToSize WordRep = W
769 kindToSize AddrRep = W
770 kindToSize FloatRep = F
771 kindToSize DoubleRep = DF
772 kindToSize ArrayRep = W
773 kindToSize ByteArrayRep = W
774 kindToSize StablePtrRep = W
775 kindToSize MallocPtrRep = W
779 @sparcRegUsage@ returns the sets of src and destination registers used by
780 a particular instruction. Machine registers that are pre-allocated
781 to stgRegs are filtered out, because they are uninteresting from a
782 register allocation standpoint. (We wouldn't want them to end up on
787 sparcRegUsage :: SparcInstr -> RegUsage
788 sparcRegUsage instr = case instr of
789 LD sz addr reg -> usage (regAddr addr, [reg])
790 ST sz reg addr -> usage (reg : regAddr addr, [])
791 ADD x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
792 SUB x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
793 AND b r1 ar r2 -> usage (r1 : regRI ar, [r2])
794 ANDN b r1 ar r2 -> usage (r1 : regRI ar, [r2])
795 OR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
796 ORN b r1 ar r2 -> usage (r1 : regRI ar, [r2])
797 XOR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
798 XNOR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
799 SLL r1 ar r2 -> usage (r1 : regRI ar, [r2])
800 SRL r1 ar r2 -> usage (r1 : regRI ar, [r2])
801 SRA r1 ar r2 -> usage (r1 : regRI ar, [r2])
802 SETHI imm reg -> usage ([], [reg])
803 FABS s r1 r2 -> usage ([r1], [r2])
804 FADD s r1 r2 r3 -> usage ([r1, r2], [r3])
805 FCMP e s r1 r2 -> usage ([r1, r2], [])
806 FDIV s r1 r2 r3 -> usage ([r1, r2], [r3])
807 FMOV s r1 r2 -> usage ([r1], [r2])
808 FMUL s r1 r2 r3 -> usage ([r1, r2], [r3])
809 FNEG s r1 r2 -> usage ([r1], [r2])
810 FSQRT s r1 r2 -> usage ([r1], [r2])
811 FSUB s r1 r2 r3 -> usage ([r1, r2], [r3])
812 FxTOy s1 s2 r1 r2 -> usage ([r1], [r2])
814 -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
815 JMP addr -> RU (mkUniqSet (filter interesting (regAddr addr))) freeSet
817 CALL _ n True -> endUsage
818 CALL _ n False -> RU (argSet n) callClobberedSet
823 usage (src, dst) = RU (mkUniqSet (filter interesting src))
824 (mkUniqSet (filter interesting dst))
826 interesting (FixedReg _) = False
829 regAddr (AddrRegReg r1 r2) = [r1, r2]
830 regAddr (AddrRegImm r1 _) = [r1]
832 regRI (RIReg r) = [r]
836 freeRegs = freeMappedRegs (\ x -> x) [0..63]
838 freeMappedRegs :: (Int -> Int) -> [Int] -> [Reg]
840 freeMappedRegs modify nums
845 modified_i = case (modify n) of { IBOX(x) -> x }
847 if _IS_TRUE_(freeReg modified_i) then (MappedReg modified_i) : acc else acc
849 freeSet :: UniqSet Reg
850 freeSet = mkUniqSet freeRegs
853 noUsage = RU emptyUniqSet emptyUniqSet
856 endUsage = RU emptyUniqSet freeSet
859 argSet :: Int -> UniqSet Reg
860 argSet 0 = emptyUniqSet
861 argSet 1 = mkUniqSet (freeMappedRegs oReg [0])
862 argSet 2 = mkUniqSet (freeMappedRegs oReg [0,1])
863 argSet 3 = mkUniqSet (freeMappedRegs oReg [0,1,2])
864 argSet 4 = mkUniqSet (freeMappedRegs oReg [0,1,2,3])
865 argSet 5 = mkUniqSet (freeMappedRegs oReg [0,1,2,3,4])
866 argSet 6 = mkUniqSet (freeMappedRegs oReg [0,1,2,3,4,5])
868 callClobberedSet :: UniqSet Reg
869 callClobberedSet = mkUniqSet callClobberedRegs
871 callClobberedRegs = freeMappedRegs (\x -> x)
873 [oReg i | i <- [0..5]] ++
874 [gReg i | i <- [1..7]] ++
875 [fReg i | i <- [0..31]] )
879 @sparcRegLiveness@ takes future liveness information and modifies it according to
880 the semantics of branches and labels. (An out-of-line branch clobbers the liveness
881 passed back by the following instruction; a forward local branch passes back the
882 liveness from the target label; a conditional branch merges the liveness from the
883 target and the liveness from its successor; a label stashes away the current liveness
884 in the future liveness environment).
887 sparcRegLiveness :: SparcInstr -> RegLiveness -> RegLiveness
888 sparcRegLiveness instr info@(RL live future@(FL all env)) = case instr of
890 -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
892 BI ALWAYS _ (ImmCLbl lbl) -> RL (lookup lbl) future
893 BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionUniqSets` live) future
894 BF ALWAYS _ (ImmCLbl lbl) -> RL (lookup lbl) future
895 BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionUniqSets` live) future
896 JMP _ -> RL emptyUniqSet future
897 CALL _ i True -> RL emptyUniqSet future
898 CALL _ i False -> RL live future
899 LABEL lbl -> RL live (FL (all `unionUniqSets` live) (addToFM env lbl live))
903 lookup lbl = case lookupFM env lbl of
905 Nothing -> trace ("Missing " ++ (uppShow 80 (pprCLabel (PprForAsm (\_->False) False id) lbl)) ++
906 " in future?") emptyUniqSet
910 @sparcPatchRegs@ takes an instruction (possibly with MemoryReg/UnmappedReg registers) and
911 changes all register references according to the supplied environment.
915 sparcPatchRegs :: SparcInstr -> (Reg -> Reg) -> SparcInstr
916 sparcPatchRegs instr env = case instr of
917 LD sz addr reg -> LD sz (fixAddr addr) (env reg)
918 ST sz reg addr -> ST sz (env reg) (fixAddr addr)
919 ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
920 SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
921 AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2)
922 ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2)
923 OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2)
924 ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2)
925 XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2)
926 XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2)
927 SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
928 SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
929 SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
930 SETHI imm reg -> SETHI imm (env reg)
931 FABS s r1 r2 -> FABS s (env r1) (env r2)
932 FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
933 FCMP e s r1 r2 -> FCMP e s (env r1) (env r2)
934 FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
935 FMOV s r1 r2 -> FMOV s (env r1) (env r2)
936 FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
937 FNEG s r1 r2 -> FNEG s (env r1) (env r2)
938 FSQRT s r1 r2 -> FSQRT s (env r1) (env r2)
939 FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
940 FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2)
941 JMP addr -> JMP (fixAddr addr)
945 fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
946 fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
948 fixRI (RIReg r) = RIReg (env r)
952 Sometimes, we want to be able to modify addresses at compile time.
953 (Okay, just for chrCode of a fetch.)
957 is13Bits :: Int -> Bool
960 is13Bits :: Integer -> Bool
963 is13Bits :: Integral a => a -> Bool
964 is13Bits x = x >= -4096 && x < 4096
966 offset :: Addr -> Int -> Maybe Addr
968 offset (AddrRegImm reg (ImmInt n)) off
969 | is13Bits n2 = Just (AddrRegImm reg (ImmInt n2))
970 | otherwise = Nothing
973 offset (AddrRegImm reg (ImmInteger n)) off
974 | is13Bits n2 = Just (AddrRegImm reg (ImmInt (fromInteger n2)))
975 | otherwise = Nothing
976 where n2 = n + toInteger off
978 offset (AddrRegReg reg (FixedReg ILIT(0))) off
979 | is13Bits off = Just (AddrRegImm reg (ImmInt off))
980 | otherwise = Nothing
986 If you value your sanity, do not venture below this line.
990 -- platform.h is generate and tells us what the target architecture is
991 #include "../../includes/platform.h"
992 #include "../../includes/MachRegs.h"
994 #include "../../includes/sparc-sun-sunos4.h"
996 #include "../../includes/sparc-sun-solaris2.h"
999 -- Redefine the literals used for Sparc register names in the header
1000 -- files. Gag me with a spoon, eh?
1067 baseRegOffset :: MagicId -> Int
1068 baseRegOffset StkOReg = OFFSET_StkO
1069 baseRegOffset (VanillaReg _ ILIT2(1)) = OFFSET_R1
1070 baseRegOffset (VanillaReg _ ILIT2(2)) = OFFSET_R2
1071 baseRegOffset (VanillaReg _ ILIT2(3)) = OFFSET_R3
1072 baseRegOffset (VanillaReg _ ILIT2(4)) = OFFSET_R4
1073 baseRegOffset (VanillaReg _ ILIT2(5)) = OFFSET_R5
1074 baseRegOffset (VanillaReg _ ILIT2(6)) = OFFSET_R6
1075 baseRegOffset (VanillaReg _ ILIT2(7)) = OFFSET_R7
1076 baseRegOffset (VanillaReg _ ILIT2(8)) = OFFSET_R8
1077 baseRegOffset (FloatReg ILIT2(1)) = OFFSET_Flt1
1078 baseRegOffset (FloatReg ILIT2(2)) = OFFSET_Flt2
1079 baseRegOffset (FloatReg ILIT2(3)) = OFFSET_Flt3
1080 baseRegOffset (FloatReg ILIT2(4)) = OFFSET_Flt4
1081 baseRegOffset (DoubleReg ILIT2(1)) = OFFSET_Dbl1
1082 baseRegOffset (DoubleReg ILIT2(2)) = OFFSET_Dbl2
1083 baseRegOffset TagReg = OFFSET_Tag
1084 baseRegOffset RetReg = OFFSET_Ret
1085 baseRegOffset SpA = OFFSET_SpA
1086 baseRegOffset SuA = OFFSET_SuA
1087 baseRegOffset SpB = OFFSET_SpB
1088 baseRegOffset SuB = OFFSET_SuB
1089 baseRegOffset Hp = OFFSET_Hp
1090 baseRegOffset HpLim = OFFSET_HpLim
1091 baseRegOffset LivenessReg = OFFSET_Liveness
1092 --baseRegOffset ActivityReg = OFFSET_Activity
1094 baseRegOffset BaseReg = panic "baseRegOffset:BaseReg"
1095 baseRegOffset StdUpdRetVecReg = panic "baseRegOffset:StgUpdRetVecReg"
1096 baseRegOffset StkStubReg = panic "baseRegOffset:StkStubReg"
1097 baseRegOffset CurCostCentre = panic "baseRegOffset:CurCostCentre"
1098 baseRegOffset VoidReg = panic "baseRegOffset:VoidReg"
1101 callerSaves :: MagicId -> Bool
1102 #ifdef CALLER_SAVES_Base
1103 callerSaves BaseReg = True
1105 #ifdef CALLER_SAVES_StkO
1106 callerSaves StkOReg = True
1108 #ifdef CALLER_SAVES_R1
1109 callerSaves (VanillaReg _ ILIT2(1)) = True
1111 #ifdef CALLER_SAVES_R2
1112 callerSaves (VanillaReg _ ILIT2(2)) = True
1114 #ifdef CALLER_SAVES_R3
1115 callerSaves (VanillaReg _ ILIT2(3)) = True
1117 #ifdef CALLER_SAVES_R4
1118 callerSaves (VanillaReg _ ILIT2(4)) = True
1120 #ifdef CALLER_SAVES_R5
1121 callerSaves (VanillaReg _ ILIT2(5)) = True
1123 #ifdef CALLER_SAVES_R6
1124 callerSaves (VanillaReg _ ILIT2(6)) = True
1126 #ifdef CALLER_SAVES_R7
1127 callerSaves (VanillaReg _ ILIT2(7)) = True
1129 #ifdef CALLER_SAVES_R8
1130 callerSaves (VanillaReg _ ILIT2(8)) = True
1132 #ifdef CALLER_SAVES_FltReg1
1133 callerSaves (FloatReg ILIT2(1)) = True
1135 #ifdef CALLER_SAVES_FltReg2
1136 callerSaves (FloatReg ILIT2(2)) = True
1138 #ifdef CALLER_SAVES_FltReg3
1139 callerSaves (FloatReg ILIT2(3)) = True
1141 #ifdef CALLER_SAVES_FltReg4
1142 callerSaves (FloatReg ILIT2(4)) = True
1144 #ifdef CALLER_SAVES_DblReg1
1145 callerSaves (DoubleReg ILIT2(1)) = True
1147 #ifdef CALLER_SAVES_DblReg2
1148 callerSaves (DoubleReg ILIT2(2)) = True
1150 #ifdef CALLER_SAVES_Tag
1151 callerSaves TagReg = True
1153 #ifdef CALLER_SAVES_Ret
1154 callerSaves RetReg = True
1156 #ifdef CALLER_SAVES_SpA
1157 callerSaves SpA = True
1159 #ifdef CALLER_SAVES_SuA
1160 callerSaves SuA = True
1162 #ifdef CALLER_SAVES_SpB
1163 callerSaves SpB = True
1165 #ifdef CALLER_SAVES_SuB
1166 callerSaves SuB = True
1168 #ifdef CALLER_SAVES_Hp
1169 callerSaves Hp = True
1171 #ifdef CALLER_SAVES_HpLim
1172 callerSaves HpLim = True
1174 #ifdef CALLER_SAVES_Liveness
1175 callerSaves LivenessReg = True
1177 #ifdef CALLER_SAVES_Activity
1178 --callerSaves ActivityReg = True
1180 #ifdef CALLER_SAVES_StdUpdRetVec
1181 callerSaves StdUpdRetVecReg = True
1183 #ifdef CALLER_SAVES_StkStub
1184 callerSaves StkStubReg = True
1186 callerSaves _ = False
1188 stgRegMap :: MagicId -> Maybe Reg
1190 stgRegMap BaseReg = Just (FixedReg ILIT(REG_Base))
1193 stgRegMap StkOReg = Just (FixedReg ILIT(REG_StkOReg))
1196 stgRegMap (VanillaReg _ ILIT2(1)) = Just (FixedReg ILIT(REG_R1))
1199 stgRegMap (VanillaReg _ ILIT2(2)) = Just (FixedReg ILIT(REG_R2))
1202 stgRegMap (VanillaReg _ ILIT2(3)) = Just (FixedReg ILIT(REG_R3))
1205 stgRegMap (VanillaReg _ ILIT2(4)) = Just (FixedReg ILIT(REG_R4))
1208 stgRegMap (VanillaReg _ ILIT2(5)) = Just (FixedReg ILIT(REG_R5))
1211 stgRegMap (VanillaReg _ ILIT2(6)) = Just (FixedReg ILIT(REG_R6))
1214 stgRegMap (VanillaReg _ ILIT2(7)) = Just (FixedReg ILIT(REG_R7))
1217 stgRegMap (VanillaReg _ ILIT2(8)) = Just (FixedReg ILIT(REG_R8))
1220 stgRegMap (FloatReg ILIT2(1)) = Just (FixedReg ILIT(REG_Flt1))
1223 stgRegMap (FloatReg ILIT2(2)) = Just (FixedReg ILIT(REG_Flt2))
1226 stgRegMap (FloatReg ILIT2(3)) = Just (FixedReg ILIT(REG_Flt3))
1229 stgRegMap (FloatReg ILIT2(4)) = Just (FixedReg ILIT(REG_Flt4))
1232 stgRegMap (DoubleReg ILIT2(1)) = Just (FixedReg ILIT(REG_Dbl1))
1235 stgRegMap (DoubleReg ILIT2(2)) = Just (FixedReg ILIT(REG_Dbl2))
1238 stgRegMap TagReg = Just (FixedReg ILIT(REG_TagReg))
1241 stgRegMap RetReg = Just (FixedReg ILIT(REG_Ret))
1244 stgRegMap SpA = Just (FixedReg ILIT(REG_SpA))
1247 stgRegMap SuA = Just (FixedReg ILIT(REG_SuA))
1250 stgRegMap SpB = Just (FixedReg ILIT(REG_SpB))
1253 stgRegMap SuB = Just (FixedReg ILIT(REG_SuB))
1256 stgRegMap Hp = Just (FixedReg ILIT(REG_Hp))
1259 stgRegMap HpLim = Just (FixedReg ILIT(REG_HpLim))
1262 stgRegMap LivenessReg = Just (FixedReg ILIT(REG_Liveness))
1265 --stgRegMap ActivityReg = Just (FixedReg ILIT(REG_Activity))
1267 #ifdef REG_StdUpdRetVec
1268 stgRegMap StdUpdRetVecReg = Just (FixedReg ILIT(REG_StdUpdRetVec))
1271 stgRegMap StkStubReg = Just (FixedReg ILIT(REG_StkStub))
1273 stgRegMap _ = Nothing
1277 Here is the list of registers we can use in register allocation.
1281 freeReg :: FAST_INT -> FAST_BOOL
1283 freeReg ILIT(g0) = _FALSE_ -- %g0 is always 0.
1284 freeReg ILIT(g5) = _FALSE_ -- %g5 is reserved (ABI).
1285 freeReg ILIT(g6) = _FALSE_ -- %g6 is reserved (ABI).
1286 freeReg ILIT(g7) = _FALSE_ -- %g7 is reserved (ABI).
1287 freeReg ILIT(i6) = _FALSE_ -- %i6 is our frame pointer.
1288 freeReg ILIT(o6) = _FALSE_ -- %o6 is our stack pointer.
1291 freeReg ILIT(REG_Base) = _FALSE_
1294 freeReg ILIT(REG_StkO) = _FALSE_
1297 freeReg ILIT(REG_R1) = _FALSE_
1300 freeReg ILIT(REG_R2) = _FALSE_
1303 freeReg ILIT(REG_R3) = _FALSE_
1306 freeReg ILIT(REG_R4) = _FALSE_
1309 freeReg ILIT(REG_R5) = _FALSE_
1312 freeReg ILIT(REG_R6) = _FALSE_
1315 freeReg ILIT(REG_R7) = _FALSE_
1318 freeReg ILIT(REG_R8) = _FALSE_
1321 freeReg ILIT(REG_Flt1) = _FALSE_
1324 freeReg ILIT(REG_Flt2) = _FALSE_
1327 freeReg ILIT(REG_Flt3) = _FALSE_
1330 freeReg ILIT(REG_Flt4) = _FALSE_
1333 freeReg ILIT(REG_Dbl1) = _FALSE_
1336 freeReg ILIT(REG_Dbl2) = _FALSE_
1339 freeReg ILIT(REG_Tag) = _FALSE_
1342 freeReg ILIT(REG_Ret) = _FALSE_
1345 freeReg ILIT(REG_SpA) = _FALSE_
1348 freeReg ILIT(REG_SuA) = _FALSE_
1351 freeReg ILIT(REG_SpB) = _FALSE_
1354 freeReg ILIT(REG_SuB) = _FALSE_
1357 freeReg ILIT(REG_Hp) = _FALSE_
1360 freeReg ILIT(REG_HpLim) = _FALSE_
1363 freeReg ILIT(REG_Liveness) = _FALSE_
1366 --freeReg ILIT(REG_Activity) = _FALSE_
1368 #ifdef REG_StdUpdRetVec
1369 freeReg ILIT(REG_StdUpdRetVec) = _FALSE_
1372 freeReg ILIT(REG_StkStub) = _FALSE_
1376 | n _EQ_ (ILIT(REG_Dbl1) _ADD_ ILIT(1)) = _FALSE_
1379 | n _EQ_ (ILIT(REG_Dbl2) _ADD_ ILIT(1)) = _FALSE_
1381 | otherwise = _TRUE_
1383 reservedRegs :: [Int]
1384 reservedRegs = [NCG_Reserved_I1, NCG_Reserved_I2,
1385 NCG_Reserved_F1, NCG_Reserved_F2,
1386 NCG_Reserved_D1, NCG_Reserved_D2]