module MachRegs (
- Reg(..),
+ RegClass(..), regClass,
+ Reg(..), isRealReg, isVirtualReg,
+ allocatableRegs, argRegs, allArgRegs, callClobberedRegs,
+
Imm(..),
MachRegsAddr(..),
RegLoc(..),
- RegNo,
addrOffset,
- argRegs,
baseRegOffset,
- callClobberedRegs,
callerSaves,
- extractMappedRegNos,
- freeMappedRegs,
- freeReg, freeRegs,
+ freeReg,
getNewRegNCG,
+ mkVReg,
magicIdRegMaybe,
- mkReg,
- realReg,
- reservedRegs,
saveLoc,
spRel,
stgReg,
, fake0, fake1, fake2, fake3, fake4, fake5
#endif
#if sparc_TARGET_ARCH
- , allArgRegs
, fits13Bits
- , fPair, fpRel, gReg, iReg, lReg, oReg, largeOffsetError
- , fp, g0, o0, f0
+ , fpRel, gReg, iReg, lReg, oReg, largeOffsetError
+ , fp, sp, g0, g1, g2, o0, f0, f6, f8, f26, f27
#endif
) where
import AbsCSyn ( MagicId(..) )
import AbsCUtils ( magicIdPrimRep )
-import CLabel ( CLabel )
+import CLabel ( CLabel, mkMainRegTableLabel )
import PrimOp ( PrimOp(..) )
-import PrimRep ( PrimRep(..) )
-import Stix ( sStLitLbl, StixTree(..), StixReg(..) )
-import Unique ( mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
- Uniquable(..), Unique
- )
-import UniqSupply ( getUniqueUs, returnUs, thenUs, UniqSM )
+import PrimRep ( PrimRep(..), isFloatingRep )
+import Stix ( StixTree(..), StixReg(..),
+ getUniqueNat, returnNat, thenNat, NatM )
+import Unique ( mkPseudoUnique2, Uniquable(..), Unique )
import Outputable
+import FastTypes
\end{code}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
= ImmInt Int
| ImmInteger Integer -- Sigh.
| ImmCLbl CLabel -- AbstractC Label (with baggage)
- | ImmLab SDoc -- Simple string label (underscore-able)
+ | ImmLab Bool SDoc -- Simple string label (underscore-able)
+ -- Bool==True ==> in a different DLL
| ImmLit SDoc -- Simple string
| ImmIndex CLabel Int
+ | ImmFloat Rational
| ImmDouble Rational
IF_ARCH_sparc(
| LO Imm -- Possible restrictions...
| otherwise -> Nothing
where n2 = n + toInteger off
- AddrRegReg r (FixedReg ILIT(0))
+ AddrRegReg r (RealReg 0)
| fits13Bits off -> Just (AddrRegImm r (ImmInt off))
| otherwise -> Nothing
#endif
#if sparc_TARGET_ARCH
-{-# SPECIALIZE
- fits13Bits :: Int -> Bool
- #-}
-{-# SPECIALIZE
- fits13Bits :: Integer -> Bool
- #-}
+{-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-}
fits13Bits :: Integral a => a -> Bool
fits13Bits x = x >= -4096 && x < 4096
-----------------
largeOffsetError i
- = 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")
+ = 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")
#endif {-sparc-}
\end{code}
baseLoc = case (magicIdRegMaybe BaseReg) of
Just _ -> StReg (StixMagicId BaseReg)
- Nothing -> sStLitLbl SLIT("MainRegTable")
+ Nothing -> StCLbl mkMainRegTableLabel
nonReg = case x of
- BaseReg -> sStLitLbl SLIT("MainRegTable")
+ BaseReg -> StCLbl mkMainRegTableLabel
_ -> StInd (magicIdPrimRep x)
(StPrim IntAddOp [baseLoc,
%* *
%************************************************************************
-Static Registers correspond to actual machine registers. These should
-be avoided until the last possible moment.
-
-Dynamic registers are allocated on the fly, usually to represent a single
-value in the abstract assembly code (i.e. dynamic registers are usually
-single assignment). Ultimately, they are mapped to available machine
-registers before spitting out the code.
+RealRegs are machine regs which are available for allocation, in the
+usual way. We know what class they are, because that's part of the
+processor's architecture.
-\begin{code}
-data Reg
- = FixedReg FAST_INT -- A pre-allocated machine register
+VirtualRegs are virtual registers. The register allocator will
+eventually have to map them into RealRegs, or into spill slots.
+VirtualRegs are allocated on the fly, usually to represent a single
+value in the abstract assembly code (i.e. dynamic registers are
+usually single assignment). With the new register allocator, the
+single assignment restriction isn't necessary to get correct code,
+although a better register allocation will result if single assignment
+is used -- because the allocator maps a VirtualReg into a single
+RealReg, even if the VirtualReg has multiple live ranges.
- | MappedReg FAST_INT -- A dynamically allocated machine register
+Virtual regs can be of either class, so that info is attached.
- | MemoryReg Int PrimRep -- A machine "register" actually held in
- -- a memory allocated table of
- -- registers which didn't fit in real
- -- registers.
+\begin{code}
- | UnmappedReg Unique PrimRep -- One of an infinite supply of registers,
- -- always mapped to one of the earlier
- -- two (?) before we're done.
-mkReg :: Unique -> PrimRep -> Reg
-mkReg = UnmappedReg
+data RegClass
+ = RcInteger
+ | RcFloat
+ | RcDouble
+ deriving Eq
-getNewRegNCG :: PrimRep -> UniqSM Reg
-getNewRegNCG pk
- = getUniqueUs `thenUs` \ u ->
- returnUs (UnmappedReg u pk)
+data Reg
+ = RealReg Int
+ | VirtualRegI Unique
+ | VirtualRegF Unique
+ | VirtualRegD Unique
-instance Text Reg where
- showsPrec _ (FixedReg i) = showString "%" . shows IBOX(i)
- showsPrec _ (MappedReg i) = showString "%" . shows IBOX(i)
- showsPrec _ (MemoryReg i _) = showString "%M" . shows i
- showsPrec _ (UnmappedReg i _) = showString "%U" . shows i
+unRealReg (RealReg i) = i
+unRealReg vreg = pprPanic "unRealReg on VirtualReg" (ppr vreg)
-#ifdef DEBUG
-instance Outputable Reg where
- ppr r = text (show r)
+mkVReg :: Unique -> PrimRep -> Reg
+mkVReg u pk
+#if sparc_TARGET_ARCH
+ = case pk of
+ FloatRep -> VirtualRegF u
+ DoubleRep -> VirtualRegD u
+ other -> VirtualRegI u
+#else
+ = if isFloatingRep pk then VirtualRegD u else VirtualRegI u
#endif
-cmpReg (FixedReg i) (FixedReg i') = cmp_ihash i i'
-cmpReg (MappedReg i) (MappedReg i') = cmp_ihash i i'
-cmpReg (MemoryReg i _) (MemoryReg i' _) = i `compare` i'
-cmpReg (UnmappedReg u _) (UnmappedReg u' _) = compare u u'
-cmpReg r1 r2
- = let tag1 = tagReg r1
- tag2 = tagReg r2
- in
- if tag1 _LT_ tag2 then LT else GT
- where
- tagReg (FixedReg _) = (ILIT(1) :: FAST_INT)
- tagReg (MappedReg _) = ILIT(2)
- tagReg (MemoryReg _ _) = ILIT(3)
- tagReg (UnmappedReg _ _) = ILIT(4)
-
-cmp_ihash :: FAST_INT -> FAST_INT -> Ordering
-cmp_ihash a1 a2 = if a1 _EQ_ a2 then EQ else if a1 _LT_ a2 then LT else GT
+isVirtualReg (RealReg _) = False
+isVirtualReg (VirtualRegI _) = True
+isVirtualReg (VirtualRegF _) = True
+isVirtualReg (VirtualRegD _) = True
+isRealReg = not . isVirtualReg
+
+getNewRegNCG :: PrimRep -> NatM Reg
+getNewRegNCG pk
+ = getUniqueNat `thenNat` \ u -> returnNat (mkVReg u pk)
instance Eq Reg where
- a == b = case (a `compare` b) of { EQ -> True; _ -> False }
- a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
+ (==) (RealReg i1) (RealReg i2) = i1 == i2
+ (==) (VirtualRegI u1) (VirtualRegI u2) = u1 == u2
+ (==) (VirtualRegF u1) (VirtualRegF u2) = u1 == u2
+ (==) (VirtualRegD u1) (VirtualRegD u2) = u1 == u2
+ (==) reg1 reg2 = False
instance Ord Reg where
- a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
- a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
- a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
- a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
- compare a b = cmpReg a b
+ compare (RealReg i1) (RealReg i2) = compare i1 i2
+ compare (RealReg _) (VirtualRegI _) = LT
+ compare (RealReg _) (VirtualRegF _) = LT
+ compare (RealReg _) (VirtualRegD _) = LT
-instance Uniquable Reg where
- getUnique (UnmappedReg u _) = u
- getUnique (FixedReg i) = mkPseudoUnique1 IBOX(i)
- getUnique (MappedReg i) = mkPseudoUnique2 IBOX(i)
- getUnique (MemoryReg i _) = mkPseudoUnique3 i
-\end{code}
+ compare (VirtualRegI _) (RealReg _) = GT
+ compare (VirtualRegI u1) (VirtualRegI u2) = compare u1 u2
+ compare (VirtualRegI _) (VirtualRegF _) = LT
+ compare (VirtualRegI _) (VirtualRegD _) = LT
-\begin{code}
-type RegNo = Int
+ compare (VirtualRegF _) (RealReg _) = GT
+ compare (VirtualRegF _) (VirtualRegI _) = GT
+ compare (VirtualRegF u1) (VirtualRegF u2) = compare u1 u2
+ compare (VirtualRegF _) (VirtualRegD _) = LT
-realReg :: RegNo -> Reg
-realReg n@IBOX(i)
- = if _IS_TRUE_(freeReg i) then MappedReg i else FixedReg i
+ compare (VirtualRegD _) (RealReg _) = GT
+ compare (VirtualRegD _) (VirtualRegI _) = GT
+ compare (VirtualRegD _) (VirtualRegF _) = GT
+ compare (VirtualRegD u1) (VirtualRegD u2) = compare u1 u2
-extractMappedRegNos :: [Reg] -> [RegNo]
-extractMappedRegNos regs
- = foldr ex [] regs
- where
- ex (MappedReg i) acc = IBOX(i) : acc -- we'll take it
- ex _ acc = acc -- leave it out
+instance Show Reg where
+ showsPrec _ (RealReg i) = showString (showReg i)
+ showsPrec _ (VirtualRegI u) = showString "%vI_" . shows u
+ showsPrec _ (VirtualRegF u) = showString "%vF_" . shows u
+ showsPrec _ (VirtualRegD u) = showString "%vD_" . shows u
+
+instance Outputable Reg where
+ ppr r = text (show r)
+
+instance Uniquable Reg where
+ getUnique (RealReg i) = mkPseudoUnique2 i
+ getUnique (VirtualRegI u) = u
+ getUnique (VirtualRegF u) = u
+ getUnique (VirtualRegD u) = u
\end{code}
** Machine-specific Reg stuff: **
fp registers, and 3-operand insns for them, and we translate this into
real stack-based x86 fp code after register allocation.
+The fp registers are all Double registers; we don't have any RcFloat class
+regs. @regClass@ barfs if you give it a VirtualRegF, and mkVReg above should
+never generate them.
+
\begin{code}
#if i386_TARGET_ARCH
-gReg,fReg :: Int -> Int
-gReg x = x
-fReg x = (8 + x)
-
-fake0, fake1, fake2, fake3, fake4, fake5, eax, ebx, ecx, edx, esp :: Reg
-eax = realReg (gReg 0)
-ebx = realReg (gReg 1)
-ecx = realReg (gReg 2)
-edx = realReg (gReg 3)
-esi = realReg (gReg 4)
-edi = realReg (gReg 5)
-ebp = realReg (gReg 6)
-esp = realReg (gReg 7)
-fake0 = realReg (fReg 0)
-fake1 = realReg (fReg 1)
-fake2 = realReg (fReg 2)
-fake3 = realReg (fReg 3)
-fake4 = realReg (fReg 4)
-fake5 = realReg (fReg 5)
+fake0, fake1, fake2, fake3, fake4, fake5,
+ eax, ebx, ecx, edx, esp, ebp, esi, edi :: Reg
+eax = RealReg 0
+ebx = RealReg 1
+ecx = RealReg 2
+edx = RealReg 3
+esi = RealReg 4
+edi = RealReg 5
+ebp = RealReg 6
+esp = RealReg 7
+fake0 = RealReg 8
+fake1 = RealReg 9
+fake2 = RealReg 10
+fake3 = RealReg 11
+fake4 = RealReg 12
+fake5 = RealReg 13
+
+regClass (RealReg i) = if i < 8 then RcInteger else RcDouble
+regClass (VirtualRegI u) = RcInteger
+regClass (VirtualRegD u) = RcDouble
+regClass (VirtualRegF u) = pprPanic "regClass(x86):VirtualRegF"
+ (ppr (VirtualRegF u))
+
+regNames
+ = ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp",
+ "%fake0", "%fake1", "%fake2", "%fake3", "%fake4", "%fake5", "%fake6"]
+
+showReg :: Int -> String
+showReg n
+ = if n >= 0 && n < 14
+ then regNames !! n
+ else "%unknown_x86_real_reg_" ++ show n
+
#endif
\end{code}
machine registers is defined in StgRegs.h. We are, of course,
prepared for any eventuality.
+The whole fp-register pairing thing on sparcs is a huge nuisance. See
+fptools/ghc/includes/MachRegs.h for a description of what's going on
+here.
+
\begin{code}
#if sparc_TARGET_ARCH
iReg x = (24 + x)
fReg x = (32 + x)
-fPair :: Reg -> Reg
-fPair (FixedReg i) = FixedReg (i _ADD_ ILIT(1))
-fPair (MappedReg i) = MappedReg (i _ADD_ ILIT(1))
+nCG_FirstFloatReg :: Int
+nCG_FirstFloatReg = unRealReg NCG_FirstFloatReg
+
+regClass (VirtualRegI u) = RcInteger
+regClass (VirtualRegF u) = RcFloat
+regClass (VirtualRegD u) = RcDouble
+regClass (RealReg i) | i < 32 = RcInteger
+ | i < nCG_FirstFloatReg = RcDouble
+ | otherwise = RcFloat
+
+showReg :: Int -> String
+showReg n
+ | n >= 0 && n < 8 = "%g" ++ show n
+ | n >= 8 && n < 16 = "%o" ++ show (n-8)
+ | n >= 16 && n < 24 = "%l" ++ show (n-16)
+ | n >= 24 && n < 32 = "%i" ++ show (n-24)
+ | n >= 32 && n < 64 = "%f" ++ show (n-32)
+ | otherwise = "%unknown_sparc_real_reg_" ++ show n
+
+g0, g1, g2, fp, sp, o0, f0, f1, f6, f8, f22, f26, f27 :: Reg
+
+f6 = RealReg (fReg 6)
+f8 = RealReg (fReg 8)
+f22 = RealReg (fReg 22)
+f26 = RealReg (fReg 26)
+f27 = RealReg (fReg 27)
+
+
+-- g0 is useful for codegen; is always zero, and writes to it vanish.
+g0 = RealReg (gReg 0)
+g1 = RealReg (gReg 1)
+g2 = RealReg (gReg 2)
-g0, fp, sp, o0, f0 :: Reg
-g0 = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
-fp = case (iReg 6) of { IBOX(i6) -> FixedReg i6 }
-sp = case (oReg 6) of { IBOX(o6) -> FixedReg o6 }
-o0 = realReg (oReg 0)
-f0 = realReg (fReg 0)
+-- FP, SP, int and float return (from C) regs.
+fp = RealReg (iReg 6)
+sp = RealReg (oReg 6)
+o0 = RealReg (oReg 0)
+f0 = RealReg (fReg 0)
+f1 = RealReg (fReg 1)
#endif
\end{code}
#define i5 29
#define i6 30
#define i7 31
-#define f0 32
-#define f1 33
-#define f2 34
-#define f3 35
-#define f4 36
-#define f5 37
-#define f6 38
-#define f7 39
-#define f8 40
-#define f9 41
+
+#define f0 32
+#define f1 33
+#define f2 34
+#define f3 35
+#define f4 36
+#define f5 37
+#define f6 38
+#define f7 39
+#define f8 40
+#define f9 41
#define f10 42
#define f11 43
#define f12 44
#define f29 61
#define f30 62
#define f31 63
+
#endif
\end{code}
\begin{code}
baseRegOffset :: MagicId -> Int
-baseRegOffset (VanillaReg _ ILIT(1)) = OFFSET_R1
-baseRegOffset (VanillaReg _ ILIT(2)) = OFFSET_R2
-baseRegOffset (VanillaReg _ ILIT(3)) = OFFSET_R3
-baseRegOffset (VanillaReg _ ILIT(4)) = OFFSET_R4
-baseRegOffset (VanillaReg _ ILIT(5)) = OFFSET_R5
-baseRegOffset (VanillaReg _ ILIT(6)) = OFFSET_R6
-baseRegOffset (VanillaReg _ ILIT(7)) = OFFSET_R7
-baseRegOffset (VanillaReg _ ILIT(8)) = OFFSET_R8
-baseRegOffset (VanillaReg _ ILIT(9)) = OFFSET_R9
-baseRegOffset (VanillaReg _ ILIT(10)) = OFFSET_R10
-baseRegOffset (FloatReg ILIT(1)) = OFFSET_F1
-baseRegOffset (FloatReg ILIT(2)) = OFFSET_F2
-baseRegOffset (FloatReg ILIT(3)) = OFFSET_F3
-baseRegOffset (FloatReg ILIT(4)) = OFFSET_F4
-baseRegOffset (DoubleReg ILIT(1)) = OFFSET_D1
-baseRegOffset (DoubleReg ILIT(2)) = OFFSET_D2
+baseRegOffset (VanillaReg _ 1#) = OFFSET_R1
+baseRegOffset (VanillaReg _ 2#) = OFFSET_R2
+baseRegOffset (VanillaReg _ 3#) = OFFSET_R3
+baseRegOffset (VanillaReg _ 4#) = OFFSET_R4
+baseRegOffset (VanillaReg _ 5#) = OFFSET_R5
+baseRegOffset (VanillaReg _ 6#) = OFFSET_R6
+baseRegOffset (VanillaReg _ 7#) = OFFSET_R7
+baseRegOffset (VanillaReg _ 8#) = OFFSET_R8
+baseRegOffset (VanillaReg _ 9#) = OFFSET_R9
+baseRegOffset (VanillaReg _ 10#) = OFFSET_R10
+baseRegOffset (FloatReg 1#) = OFFSET_F1
+baseRegOffset (FloatReg 2#) = OFFSET_F2
+baseRegOffset (FloatReg 3#) = OFFSET_F3
+baseRegOffset (FloatReg 4#) = OFFSET_F4
+baseRegOffset (DoubleReg 1#) = OFFSET_D1
+baseRegOffset (DoubleReg 2#) = OFFSET_D2
baseRegOffset Sp = OFFSET_Sp
baseRegOffset Su = OFFSET_Su
baseRegOffset SpLim = OFFSET_SpLim
#ifdef OFFSET_Lng1
-baseRegOffset (LongReg _ ILIT(1)) = OFFSET_Lng1
+baseRegOffset (LongReg _ 1)) = OFFSET_Lng1
#endif
#ifdef OFFSET_Lng2
-baseRegOffset (LongReg _ ILIT(2)) = OFFSET_Lng2
+baseRegOffset (LongReg _ 2)) = OFFSET_Lng2
#endif
baseRegOffset Hp = OFFSET_Hp
baseRegOffset HpLim = OFFSET_HpLim
-#ifdef DEBUG
+baseRegOffset CurrentTSO = OFFSET_CurrentTSO
+baseRegOffset CurrentNursery = OFFSET_CurrentNursery
+#ifdef NCG_DEBUG
baseRegOffset BaseReg = panic "baseRegOffset:BaseReg"
baseRegOffset CurCostCentre = panic "baseRegOffset:CurCostCentre"
baseRegOffset VoidReg = panic "baseRegOffset:VoidReg"
#ifdef CALLER_SAVES_HpLim
callerSaves HpLim = True
#endif
+#ifdef CALLER_SAVES_CurrentTSO
+callerSaves CurrentTSO = True
+#endif
+#ifdef CALLER_SAVES_CurrentNursery
+callerSaves CurrentNursery = True
+#endif
callerSaves _ = False
\end{code}
magicIdRegMaybe :: MagicId -> Maybe Reg
#ifdef REG_Base
-magicIdRegMaybe BaseReg = Just (FixedReg ILIT(REG_Base))
+magicIdRegMaybe BaseReg = Just (RealReg REG_Base)
#endif
#ifdef REG_R1
-magicIdRegMaybe (VanillaReg _ ILIT(1)) = Just (FixedReg ILIT(REG_R1))
+magicIdRegMaybe (VanillaReg _ 1#) = Just (RealReg REG_R1)
#endif
#ifdef REG_R2
-magicIdRegMaybe (VanillaReg _ ILIT(2)) = Just (FixedReg ILIT(REG_R2))
+magicIdRegMaybe (VanillaReg _ ILIT(2)) = Just (RealReg REG_R2)
#endif
#ifdef REG_R3
-magicIdRegMaybe (VanillaReg _ ILIT(3)) = Just (FixedReg ILIT(REG_R3))
+magicIdRegMaybe (VanillaReg _ ILIT(3)) = Just (RealReg REG_R3)
#endif
#ifdef REG_R4
-magicIdRegMaybe (VanillaReg _ ILIT(4)) = Just (FixedReg ILIT(REG_R4))
+magicIdRegMaybe (VanillaReg _ ILIT(4)) = Just (RealReg REG_R4)
#endif
#ifdef REG_R5
-magicIdRegMaybe (VanillaReg _ ILIT(5)) = Just (FixedReg ILIT(REG_R5))
+magicIdRegMaybe (VanillaReg _ ILIT(5)) = Just (RealReg REG_R5)
#endif
#ifdef REG_R6
-magicIdRegMaybe (VanillaReg _ ILIT(6)) = Just (FixedReg ILIT(REG_R6))
+magicIdRegMaybe (VanillaReg _ ILIT(6)) = Just (RealReg REG_R6)
#endif
#ifdef REG_R7
-magicIdRegMaybe (VanillaReg _ ILIT(7)) = Just (FixedReg ILIT(REG_R7))
+magicIdRegMaybe (VanillaReg _ ILIT(7)) = Just (RealReg REG_R7)
#endif
#ifdef REG_R8
-magicIdRegMaybe (VanillaReg _ ILIT(8)) = Just (FixedReg ILIT(REG_R8))
+magicIdRegMaybe (VanillaReg _ ILIT(8)) = Just (RealReg REG_R8)
+#endif
+#ifdef REG_R9
+magicIdRegMaybe (VanillaReg _ ILIT(9)) = Just (RealReg REG_R9)
+#endif
+#ifdef REG_R10
+magicIdRegMaybe (VanillaReg _ ILIT(10)) = Just (RealReg REG_R10)
#endif
#ifdef REG_F1
-magicIdRegMaybe (FloatReg ILIT(1)) = Just (FixedReg ILIT(REG_F1))
+magicIdRegMaybe (FloatReg ILIT(1)) = Just (RealReg REG_F1)
#endif
#ifdef REG_F2
-magicIdRegMaybe (FloatReg ILIT(2)) = Just (FixedReg ILIT(REG_F2))
+magicIdRegMaybe (FloatReg ILIT(2)) = Just (RealReg REG_F2)
#endif
#ifdef REG_F3
-magicIdRegMaybe (FloatReg ILIT(3)) = Just (FixedReg ILIT(REG_F3))
+magicIdRegMaybe (FloatReg ILIT(3)) = Just (RealReg REG_F3)
#endif
#ifdef REG_F4
-magicIdRegMaybe (FloatReg ILIT(4)) = Just (FixedReg ILIT(REG_F4))
+magicIdRegMaybe (FloatReg ILIT(4)) = Just (RealReg REG_F4)
#endif
#ifdef REG_D1
-magicIdRegMaybe (DoubleReg ILIT(1)) = Just (FixedReg ILIT(REG_D1))
+magicIdRegMaybe (DoubleReg ILIT(1)) = Just (RealReg REG_D1)
#endif
#ifdef REG_D2
-magicIdRegMaybe (DoubleReg ILIT(2)) = Just (FixedReg ILIT(REG_D2))
+magicIdRegMaybe (DoubleReg ILIT(2)) = Just (RealReg REG_D2)
#endif
#ifdef REG_Sp
-magicIdRegMaybe Sp = Just (FixedReg ILIT(REG_Sp))
+magicIdRegMaybe Sp = Just (RealReg REG_Sp)
#endif
#ifdef REG_Lng1
-magicIdRegMaybe (LongReg _ ILIT(1)) = Just (FixedReg ILIT(REG_Lng1))
+magicIdRegMaybe (LongReg _ ILIT(1)) = Just (RealReg REG_Lng1)
#endif
#ifdef REG_Lng2
-magicIdRegMaybe (LongReg _ ILIT(2)) = Just (FixedReg ILIT(REG_Lng2))
+magicIdRegMaybe (LongReg _ ILIT(2)) = Just (RealReg REG_Lng2)
#endif
#ifdef REG_Su
-magicIdRegMaybe Su = Just (FixedReg ILIT(REG_Su))
+magicIdRegMaybe Su = Just (RealReg REG_Su)
#endif
#ifdef REG_SpLim
-magicIdRegMaybe SpLim = Just (FixedReg ILIT(REG_SpLim))
+magicIdRegMaybe SpLim = Just (RealReg REG_SpLim)
#endif
#ifdef REG_Hp
-magicIdRegMaybe Hp = Just (FixedReg ILIT(REG_Hp))
+magicIdRegMaybe Hp = Just (RealReg REG_Hp)
#endif
#ifdef REG_HpLim
-magicIdRegMaybe HpLim = Just (FixedReg ILIT(REG_HpLim))
+magicIdRegMaybe HpLim = Just (RealReg REG_HpLim)
+#endif
+#ifdef REG_CurrentTSO
+magicIdRegMaybe CurrentTSO = Just (RealReg REG_CurrentTSO)
+#endif
+#ifdef REG_CurrentNursery
+magicIdRegMaybe CurrentNursery = Just (RealReg REG_CurrentNursery)
#endif
magicIdRegMaybe _ = Nothing
\end{code}
-%************************************************************************
-%* *
-\subsection{Free, reserved, call-clobbered, and argument registers}
-%* *
-%************************************************************************
-
-@freeRegs@ is the list of registers we can use in register allocation.
-@freeReg@ (below) says if a particular register is free.
-
-With a per-instruction clobber list, we might be able to get some of
-these back, but it's probably not worth the hassle.
-
-@callClobberedRegs@ ... the obvious.
-
-@argRegs@: assuming a call with N arguments, what registers will be
-used to hold arguments? (NB: it doesn't know whether the arguments
-are integer or floating-point...)
-
\begin{code}
-reservedRegs :: [RegNo]
-reservedRegs
-#if alpha_TARGET_ARCH
- = [NCG_Reserved_I1, NCG_Reserved_I2,
- NCG_Reserved_F1, NCG_Reserved_F2]
-#endif
-#if i386_TARGET_ARCH
- = [{-certainly cannot afford any!-}]
-#endif
-#if sparc_TARGET_ARCH
- = [NCG_Reserved_I1, NCG_Reserved_I2,
- NCG_Reserved_F1, NCG_Reserved_F2,
- NCG_Reserved_D1, NCG_Reserved_D2]
-#endif
-
-------------------------------
-freeRegs :: [Reg]
-freeRegs
- = freeMappedRegs IF_ARCH_alpha( [0..63],
- IF_ARCH_i386( [0..13],
- IF_ARCH_sparc( [0..63],)))
+-- allMachRegs is the complete set of machine regs.
+allMachRegNos :: [Int]
+allMachRegNos
+ = IF_ARCH_alpha( [0..63],
+ IF_ARCH_i386( [0..13],
+ IF_ARCH_sparc( ([0..31]
+ ++ [f0,f2 .. nCG_FirstFloatReg-1]
+ ++ [nCG_FirstFloatReg .. f31]),
+ )))
+-- allocatableRegs is allMachRegNos with the fixed-use regs removed.
+-- i.e., these are the regs for which we are prepared to allow the
+-- register allocator to attempt to map VRegs to.
+allocatableRegs :: [Reg]
+allocatableRegs
+ = let isFree i = _IS_TRUE_(freeReg i)
+ in map RealReg (filter isFree allMachRegNos)
-------------------------------
+-- these are the regs which we cannot assume stay alive over a
+-- C call.
callClobberedRegs :: [Reg]
callClobberedRegs
- = freeMappedRegs
+ =
#if alpha_TARGET_ARCH
[0, 1, 2, 3, 4, 5, 6, 7, 8,
16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
#endif {- alpha_TARGET_ARCH -}
#if i386_TARGET_ARCH
- [{-none-}]
+ -- caller-saves registers
+ map RealReg [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5]
#endif {- i386_TARGET_ARCH -}
#if sparc_TARGET_ARCH
- ( oReg 7 :
- [oReg i | i <- [0..5]] ++
- [gReg i | i <- [1..7]] ++
- [fReg i | i <- [0..31]] )
+ map RealReg
+ ( oReg 7 :
+ [oReg i | i <- [0..5]] ++
+ [gReg i | i <- [1..7]] ++
+ [fReg i | i <- [0..31]] )
#endif {- sparc_TARGET_ARCH -}
-------------------------------
+-- argRegs is the set of regs which are read for an n-argument call to C.
+-- For archs which pass all args on the stack (x86), is empty.
+-- Sparc passes up to the first 6 args in regs.
+-- Dunno about Alpha.
argRegs :: Int -> [Reg]
-argRegs 0 = []
#if i386_TARGET_ARCH
-argRegs _ = panic "MachRegs.argRegs: doesn't work on I386"
-#else
+argRegs _ = panic "MachRegs.argRegs(x86): should not be used!"
+#endif
+
#if alpha_TARGET_ARCH
+argRegs 0 = []
argRegs 1 = freeMappedRegs [16, fReg 16]
argRegs 2 = freeMappedRegs [16, 17, fReg 16, fReg 17]
argRegs 3 = freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18]
argRegs 4 = freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19]
argRegs 5 = freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20]
argRegs 6 = freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21]
+argRegs _ = panic "MachRegs.argRegs(alpha): don't know about >6 arguments!"
#endif {- alpha_TARGET_ARCH -}
+
#if sparc_TARGET_ARCH
-argRegs 1 = freeMappedRegs (map oReg [0])
-argRegs 2 = freeMappedRegs (map oReg [0,1])
-argRegs 3 = freeMappedRegs (map oReg [0,1,2])
-argRegs 4 = freeMappedRegs (map oReg [0,1,2,3])
-argRegs 5 = freeMappedRegs (map oReg [0,1,2,3,4])
-argRegs 6 = freeMappedRegs (map oReg [0,1,2,3,4,5])
+argRegs 0 = []
+argRegs 1 = map (RealReg . oReg) [0]
+argRegs 2 = map (RealReg . oReg) [0,1]
+argRegs 3 = map (RealReg . oReg) [0,1,2]
+argRegs 4 = map (RealReg . oReg) [0,1,2,3]
+argRegs 5 = map (RealReg . oReg) [0,1,2,3,4]
+argRegs 6 = map (RealReg . oReg) [0,1,2,3,4,5]
+argRegs _ = panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
#endif {- sparc_TARGET_ARCH -}
-argRegs _ = panic "MachRegs.argRegs: don't know about >6 arguments!"
-#endif {- i386_TARGET_ARCH -}
-------------------------------
-
+-- all of the arg regs ??
#if alpha_TARGET_ARCH
allArgRegs :: [(Reg, Reg)]
-
allArgRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
#endif {- alpha_TARGET_ARCH -}
#if sparc_TARGET_ARCH
allArgRegs :: [Reg]
-
-allArgRegs = map realReg [oReg i | i <- [0..5]]
+allArgRegs = map RealReg [oReg i | i <- [0..5]]
#endif {- sparc_TARGET_ARCH -}
--------------------------------
-freeMappedRegs :: [Int] -> [Reg]
-
-freeMappedRegs nums
- = foldr free [] nums
- where
- free IBOX(i) acc
- = if _IS_TRUE_(freeReg i) then (MappedReg i) : acc else acc
+#if i386_TARGET_ARCH
+allArgRegs :: [Reg]
+allArgRegs = panic "MachRegs.allArgRegs(x86): should not be used!"
+#endif
\end{code}
\begin{code}
-freeReg :: FAST_INT -> FAST_BOOL
+freeReg :: Int -> FastBool
#if alpha_TARGET_ARCH
-freeReg ILIT(26) = _FALSE_ -- return address (ra)
-freeReg ILIT(28) = _FALSE_ -- reserved for the assembler (at)
-freeReg ILIT(29) = _FALSE_ -- global pointer (gp)
-freeReg ILIT(30) = _FALSE_ -- stack pointer (sp)
-freeReg ILIT(31) = _FALSE_ -- always zero (zeroh)
-freeReg ILIT(63) = _FALSE_ -- always zero (f31)
+freeReg 26 = fastBool False -- return address (ra)
+freeReg 28 = fastBool False -- reserved for the assembler (at)
+freeReg 29 = fastBool False -- global pointer (gp)
+freeReg 30 = fastBool False -- stack pointer (sp)
+freeReg 31 = fastBool False -- always zero (zeroh)
+freeReg 63 = fastBool False -- always zero (f31)
#endif
#if i386_TARGET_ARCH
-freeReg ILIT(esp) = _FALSE_ -- %esp is the C stack pointer
+freeReg esp = fastBool False -- %esp is the C stack pointer
#endif
#if sparc_TARGET_ARCH
-freeReg ILIT(g0) = _FALSE_ -- %g0 is always 0.
-freeReg ILIT(g5) = _FALSE_ -- %g5 is reserved (ABI).
-freeReg ILIT(g6) = _FALSE_ -- %g6 is reserved (ABI).
-freeReg ILIT(g7) = _FALSE_ -- %g7 is reserved (ABI).
-freeReg ILIT(i6) = _FALSE_ -- %i6 is our frame pointer.
-freeReg ILIT(o6) = _FALSE_ -- %o6 is our stack pointer.
+freeReg g0 = fastBool False -- %g0 is always 0.
+freeReg g5 = fastBool False -- %g5 is reserved (ABI).
+freeReg g6 = fastBool False -- %g6 is reserved (ABI).
+freeReg g7 = fastBool False -- %g7 is reserved (ABI).
+freeReg i6 = fastBool False -- %i6 is our frame pointer.
+freeReg o6 = fastBool False -- %o6 is our stack pointer.
+freeReg f0 = fastBool False -- %f0/%f1 are the C fp return registers.
+freeReg f1 = fastBool False
#endif
#ifdef REG_Base
-freeReg ILIT(REG_Base) = _FALSE_
+freeReg REG_Base = fastBool False
#endif
#ifdef REG_R1
-freeReg ILIT(REG_R1) = _FALSE_
+freeReg REG_R1 = fastBool False
#endif
#ifdef REG_R2
-freeReg ILIT(REG_R2) = _FALSE_
+freeReg REG_R2 = fastBool False
#endif
#ifdef REG_R3
-freeReg ILIT(REG_R3) = _FALSE_
+freeReg REG_R3 = fastBool False
#endif
#ifdef REG_R4
-freeReg ILIT(REG_R4) = _FALSE_
+freeReg REG_R4 = fastBool False
#endif
#ifdef REG_R5
-freeReg ILIT(REG_R5) = _FALSE_
+freeReg REG_R5 = fastBool False
#endif
#ifdef REG_R6
-freeReg ILIT(REG_R6) = _FALSE_
+freeReg REG_R6 = fastBool False
#endif
#ifdef REG_R7
-freeReg ILIT(REG_R7) = _FALSE_
+freeReg REG_R7 = fastBool False
#endif
#ifdef REG_R8
-freeReg ILIT(REG_R8) = _FALSE_
+freeReg REG_R8 = fastBool False
#endif
#ifdef REG_F1
-freeReg ILIT(REG_F1) = _FALSE_
+freeReg REG_F1 = fastBool False
#endif
#ifdef REG_F2
-freeReg ILIT(REG_F2) = _FALSE_
+freeReg REG_F2 = fastBool False
#endif
#ifdef REG_F3
-freeReg ILIT(REG_F3) = _FALSE_
+freeReg REG_F3 = fastBool False
#endif
#ifdef REG_F4
-freeReg ILIT(REG_F4) = _FALSE_
+freeReg REG_F4 = fastBool False
#endif
#ifdef REG_D1
-freeReg ILIT(REG_D1) = _FALSE_
+freeReg REG_D1 = fastBool False
#endif
#ifdef REG_D2
-freeReg ILIT(REG_D2) = _FALSE_
+freeReg REG_D2 = fastBool False
#endif
#ifdef REG_Sp
-freeReg ILIT(REG_Sp) = _FALSE_
+freeReg REG_Sp = fastBool False
#endif
#ifdef REG_Su
-freeReg ILIT(REG_Su) = _FALSE_
+freeReg REG_Su = fastBool False
#endif
#ifdef REG_SpLim
-freeReg ILIT(REG_SpLim) = _FALSE_
+freeReg REG_SpLim = fastBool False
#endif
#ifdef REG_Hp
-freeReg ILIT(REG_Hp) = _FALSE_
+freeReg REG_Hp = fastBool False
#endif
#ifdef REG_HpLim
-freeReg ILIT(REG_HpLim) = _FALSE_
-#endif
-freeReg n
- -- we hang onto two double regs for dedicated
- -- use; this is not necessary on Alphas and
- -- may not be on other non-SPARCs.
-#ifdef REG_D1
- | n _EQ_ (ILIT(REG_D1) _ADD_ ILIT(1)) = _FALSE_
-#endif
-#ifdef REG_D2
- | n _EQ_ (ILIT(REG_D2) _ADD_ ILIT(1)) = _FALSE_
+freeReg REG_HpLim = fastBool False
#endif
- | otherwise = _TRUE_
+freeReg n = fastBool True
\end{code}
projects / ghc-hetmet.git / blobdiff