[project @ 2002-07-18 09:16:12 by simonmar]
[ghc-hetmet.git] / ghc / compiler / nativeGen / MachRegs.lhs
index cb8006a..90ba29d 100644 (file)
@@ -15,12 +15,12 @@ modules --- the pleasure has been foregone.)
 module MachRegs (
 
         RegClass(..), regClass,
-       Reg(..), isRealReg, isVirtualReg,
-        allocatableRegs,
+       VRegUnique(..), pprVRegUnique, getHiVRegFromLo, 
+       Reg(..), isRealReg, isVirtualReg, getVRegUnique,
+        allocatableRegs, argRegs, allArgRegs, callClobberedRegs,
 
        Imm(..),
        MachRegsAddr(..),
-       RegLoc(..),
 
        addrOffset,
        baseRegOffset,
@@ -28,10 +28,10 @@ module MachRegs (
        freeReg,
        getNewRegNCG,
        mkVReg,
-       magicIdRegMaybe,
-       saveLoc,
+        get_MagicId_reg_or_addr,
+        get_MagicId_addr,
+        get_Regtable_addr_from_offset,
        spRel,
-       stgReg,
        strImmLit
 
 #if alpha_TARGET_ARCH
@@ -47,7 +47,7 @@ module MachRegs (
 #if sparc_TARGET_ARCH
        , fits13Bits
        , fpRel, gReg, iReg, lReg, oReg, largeOffsetError
-       , fp, g0, o0, f0
+       , fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f26, f27
        
 #endif
     ) where
@@ -55,14 +55,16 @@ module MachRegs (
 #include "HsVersions.h"
 
 import AbsCSyn         ( MagicId(..) )
-import AbsCUtils       ( magicIdPrimRep )
-import CLabel           ( CLabel, mkMainRegTableLabel )
-import PrimOp          ( PrimOp(..) )
+import CLabel           ( CLabel, mkMainCapabilityLabel )
+import MachOp          ( MachOp(..) )
 import PrimRep         ( PrimRep(..), isFloatingRep )
-import Stix            ( StixTree(..), StixReg(..),
+import Stix            ( StixExpr(..), StixReg(..),
                           getUniqueNat, returnNat, thenNat, NatM )
 import Unique          ( mkPseudoUnique2, Uniquable(..), Unique )
-import Outputable
+import Pretty
+import Outputable      ( Outputable(..), pprPanic, panic )
+import qualified Outputable
+import FastTypes
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -72,10 +74,11 @@ data Imm
   = ImmInt     Int
   | ImmInteger Integer     -- Sigh.
   | ImmCLbl    CLabel      -- AbstractC Label (with baggage)
-  | ImmLab     Bool SDoc    -- Simple string label (underscore-able)
+  | ImmLab     Bool Doc    -- Simple string label (underscore-able)
                              -- Bool==True ==> in a different DLL
-  | ImmLit     SDoc    -- Simple string
+  | ImmLit     Doc    -- Simple string
   | ImmIndex    CLabel Int
+  | ImmFloat   Rational
   | ImmDouble  Rational
   IF_ARCH_sparc(
   | LO Imm                 -- Possible restrictions...
@@ -150,13 +153,8 @@ fits8Bits i = i >= -256 && i < 256
 #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
 
@@ -171,42 +169,44 @@ largeOffsetError i
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
-@stgReg@: we map STG registers onto appropriate Stix Trees.  First, we
-handle the two constants, @STK_STUB_closure@ and @vtbl_StdUpdFrame@.
-The rest are either in real machine registers or stored as offsets
-from BaseReg.
+@stgReg@: we map STG registers onto appropriate Stix Trees.  Either
+they map to real machine registers or stored as offsets from BaseReg.
+Given a MagicId, get_MagicId_reg_or_addr produces either the real
+register it is in, on this platform, or a StixExpr denoting the
+address in the register table holding it.  get_MagicId_addr always
+produces the register table address for it.
 
 \begin{code}
-data RegLoc = Save StixTree | Always StixTree
-\end{code}
-
-Trees for register save locations:
-\begin{code}
-saveLoc :: MagicId -> StixTree
-
-saveLoc reg = case (stgReg reg) of {Always loc -> loc; Save loc -> loc}
-\end{code}
-
-\begin{code}
-stgReg :: MagicId -> RegLoc
-
-stgReg x
-  = case (magicIdRegMaybe x) of
-       Just _  -> Save   nonReg
-       Nothing -> Always nonReg
-  where
-    offset = baseRegOffset x
-
-    baseLoc = case (magicIdRegMaybe BaseReg) of
-      Just _  -> StReg (StixMagicId BaseReg)
-      Nothing -> StCLbl mkMainRegTableLabel
-
-    nonReg = case x of
-      BaseReg -> StCLbl mkMainRegTableLabel
-
-      _ -> StInd (magicIdPrimRep x)
-                (StPrim IntAddOp [baseLoc,
-                       StInt (toInteger (offset*BYTES_PER_WORD))])
+get_MagicId_reg_or_addr       :: MagicId -> Either Reg StixExpr
+get_MagicId_addr              :: MagicId -> StixExpr
+get_Regtable_addr_from_offset :: Int -> StixExpr
+
+get_MagicId_reg_or_addr mid
+   = case magicIdRegMaybe mid of
+        Just rr -> Left rr
+        Nothing -> Right (get_MagicId_addr mid)
+
+get_MagicId_addr BaseReg
+   = -- This arch doesn't have BaseReg in a register, so we have to 
+     -- use &MainRegTable.r instead.
+     StIndex PtrRep (StCLbl mkMainCapabilityLabel)
+                    (StInt (toInteger OFFW_Capability_r))
+get_MagicId_addr mid
+   = get_Regtable_addr_from_offset (baseRegOffset mid)
+
+get_Regtable_addr_from_offset offset_in_words
+   = let ptr_to_RegTable
+            = case magicIdRegMaybe BaseReg of
+                 Nothing 
+                    -> -- This arch doesn't have BaseReg in a register, so we have to 
+                       -- use &MainRegTable.r instead.
+                       StIndex PtrRep (StCLbl mkMainCapabilityLabel)
+                                      (StInt (toInteger OFFW_Capability_r))
+                 Just _
+                    -> -- It's in a reg, so leave it as it is
+                       StReg (StixMagicId BaseReg)
+     in
+         StIndex PtrRep ptr_to_RegTable (StInt (toInteger offset_in_words))
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -259,60 +259,106 @@ Virtual regs can be of either class, so that info is attached.
 
 \begin{code}
 
+data VRegUnique
+   = VRegUniqueLo Unique               -- lower part of a split quantity
+   | VRegUniqueHi Unique               -- upper part thereof
+     deriving (Eq, Ord)
+
+instance Show VRegUnique where
+   show (VRegUniqueLo u) = show u
+   show (VRegUniqueHi u) = "_hi_" ++ show u
+
+pprVRegUnique :: VRegUnique -> Outputable.SDoc
+pprVRegUnique 
+   = Outputable.text . show
+
+-- Determine the upper-half vreg for a 64-bit quantity on a 32-bit platform
+-- when supplied with the vreg for the lower-half of the quantity.
+getHiVRegFromLo (VirtualRegI (VRegUniqueLo u)) 
+   = VirtualRegI (VRegUniqueHi u)
+getHiVRegFromLo other 
+   = pprPanic "getHiVRegFromLo" (ppr other)
+
 data RegClass 
    = RcInteger 
-   | RcFloating
+   | RcFloat
+   | RcDouble
      deriving Eq
 
 data Reg
    = RealReg     Int
-   | VirtualRegI Unique
-   | VirtualRegF Unique
+   | VirtualRegI VRegUnique
+   | VirtualRegF VRegUnique
+   | VirtualRegD VRegUnique
+
+unRealReg (RealReg i) = i
+unRealReg vreg        = pprPanic "unRealReg on VirtualReg" (ppr vreg)
+
+getVRegUnique :: Reg -> VRegUnique
+getVRegUnique (VirtualRegI vu) = vu
+getVRegUnique (VirtualRegF vu) = vu
+getVRegUnique (VirtualRegD vu) = vu
+getVRegUnique rreg             = pprPanic "getVRegUnique on RealReg" (ppr rreg)
 
 mkVReg :: Unique -> PrimRep -> Reg
 mkVReg u pk
-   = if isFloatingRep pk then VirtualRegF u else VirtualRegI u
+#if sparc_TARGET_ARCH
+   = case pk of
+        FloatRep  -> VirtualRegF (VRegUniqueLo u)
+        DoubleRep -> VirtualRegD (VRegUniqueLo u)
+        other     -> VirtualRegI (VRegUniqueLo u)
+#else
+   = if isFloatingRep pk then VirtualRegD (VRegUniqueLo u) 
+                         else VirtualRegI (VRegUniqueLo u)
+#endif
 
 isVirtualReg (RealReg _)     = False
 isVirtualReg (VirtualRegI _) = True
 isVirtualReg (VirtualRegF _) = True
+isVirtualReg (VirtualRegD _) = True
 isRealReg = not . isVirtualReg
 
 getNewRegNCG :: PrimRep -> NatM Reg
 getNewRegNCG pk
-   = if   isFloatingRep pk 
-     then getUniqueNat `thenNat` \ u -> returnNat (VirtualRegF u)
-     else getUniqueNat `thenNat` \ u -> returnNat (VirtualRegI u)
+   = getUniqueNat `thenNat` \ u -> returnNat (mkVReg u pk)
 
 instance Eq Reg where
    (==) (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
    compare (RealReg i1)     (RealReg i2)     = compare i1 i2
    compare (RealReg _)      (VirtualRegI _)  = LT
    compare (RealReg _)      (VirtualRegF _)  = LT
+   compare (RealReg _)      (VirtualRegD _)  = LT
+
    compare (VirtualRegI _)  (RealReg _)      = GT
    compare (VirtualRegI u1) (VirtualRegI u2) = compare u1 u2
    compare (VirtualRegI _)  (VirtualRegF _)  = LT
+   compare (VirtualRegI _)  (VirtualRegD _)  = LT
+
    compare (VirtualRegF _)  (RealReg _)      = GT
    compare (VirtualRegF _)  (VirtualRegI _)  = GT
    compare (VirtualRegF u1) (VirtualRegF u2) = compare u1 u2
+   compare (VirtualRegF _)  (VirtualRegD _)  = LT
+
+   compare (VirtualRegD _)  (RealReg _)      = GT
+   compare (VirtualRegD _)  (VirtualRegI _)  = GT
+   compare (VirtualRegD _)  (VirtualRegF _)  = GT
+   compare (VirtualRegD u1) (VirtualRegD u2) = compare u1 u2
+
 
 instance Show Reg where
-    showsPrec _ (RealReg i)     = showString (showReg i)
-    showsPrec _ (VirtualRegI u) = showString "%vI_"  . shows u
-    showsPrec _ (VirtualRegF u) = showString "%vF_"  . shows u
+    show (RealReg i)     = showReg i
+    show (VirtualRegI u) = "%vI_" ++ show u
+    show (VirtualRegF u) = "%vF_" ++ show u
+    show (VirtualRegD u) = "%vD_" ++ show 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
+    ppr r = Outputable.text (show r)
 \end{code}
 
 ** Machine-specific Reg stuff: **
@@ -351,6 +397,10 @@ Intel x86 architecture:
   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
 
@@ -371,9 +421,11 @@ fake3 = RealReg 11
 fake4 = RealReg 12
 fake5 = RealReg 13
 
-regClass (RealReg i)     = if i < 8 then RcInteger else RcFloating
+regClass (RealReg i)     = if i < 8 then RcInteger else RcDouble
 regClass (VirtualRegI u) = RcInteger
-regClass (VirtualRegF u) = RcFloating
+regClass (VirtualRegD u) = RcDouble
+regClass (VirtualRegF u) = pprPanic "regClass(x86):VirtualRegF" 
+                                    (ppr (VirtualRegF u))
 
 regNames 
    = ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp", 
@@ -391,9 +443,11 @@ showReg n
 The SPARC has 64 registers of interest; 32 integer registers and 32
 floating point registers.  The mapping of STG registers to SPARC
 machine registers is defined in StgRegs.h.  We are, of course,
-prepared for any eventuality.  When (if?) the sparc nativegen is 
-ever revived, we should just treat it as if it has 16 floating
-regs, and use them in pairs.  
+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
@@ -405,24 +459,46 @@ lReg x = (16 + x)
 iReg x = (24 + x)
 fReg x = (32 + x)
 
--- CHECK THIS
-regClass (RealReg i)     = if i < 32 then RcInteger else RcFloating
+nCG_FirstFloatReg :: Int
+nCG_FirstFloatReg = unRealReg NCG_FirstFloatReg
+
 regClass (VirtualRegI u) = RcInteger
-regClass (VirtualRegF u) = RcFloating
+regClass (VirtualRegF u) = RcFloat
+regClass (VirtualRegD u) = RcDouble
+regClass (RealReg i) | i < 32                = RcInteger 
+                     | i < nCG_FirstFloatReg = RcDouble
+                     | otherwise             = RcFloat
 
--- FIX THIS
 showReg :: Int -> String
 showReg n
-   = if   n >= 0 && n < 64
-     then "%sparc_real_reg_" ++ show n
-     else "%unknown_sparc_real_reg_" ++ show 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, o1, 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, fp, sp, o0, f0 :: Reg
-g0 = RealReg (gReg 0)
-fp = RealReg (iReg 6)
-sp = RealReg (oReg 6)
-o0 = RealReg (oReg 0)
-f0 = RealReg (fReg 0)
+
+-- 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)
+
+-- FP, SP, int and float return (from C) regs.
+fp  = RealReg (iReg 6)
+sp  = RealReg (oReg 6)
+o0  = RealReg (oReg 0)
+o1  = RealReg (oReg 1)
+f0  = RealReg (fReg 0)
+f1  = RealReg (fReg 1)
 
 #endif
 \end{code}
@@ -513,16 +589,17 @@ names in the header files.  Gag me with a spoon, eh?
 #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
@@ -545,42 +622,41 @@ names in the header files.  Gag me with a spoon, eh?
 #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
-#endif
-#ifdef OFFSET_Lng2
-baseRegOffset (LongReg _ ILIT(2))    = OFFSET_Lng2
+#ifdef OFFSET_L1
+baseRegOffset (LongReg _ 1#)         = OFFSET_L1
 #endif
 baseRegOffset Hp                    = OFFSET_Hp
 baseRegOffset HpLim                 = OFFSET_HpLim
 baseRegOffset CurrentTSO            = OFFSET_CurrentTSO
 baseRegOffset CurrentNursery        = OFFSET_CurrentNursery
-#ifdef DEBUG
+baseRegOffset HpAlloc               = OFFSET_HpAlloc
+#ifdef NCG_DEBUG
 baseRegOffset BaseReg               = panic "baseRegOffset:BaseReg"
 baseRegOffset CurCostCentre         = panic "baseRegOffset:CurCostCentre"
 baseRegOffset VoidReg               = panic "baseRegOffset:VoidReg"
@@ -618,22 +694,22 @@ callerSaves (VanillaReg _ ILIT(7))        = True
 callerSaves (VanillaReg _ ILIT(8))     = True
 #endif
 #ifdef CALLER_SAVES_F1
-callerSaves (FloatReg ILIT(1))         = True
+callerSaves (FloatReg 1#)              = True
 #endif
 #ifdef CALLER_SAVES_F2
-callerSaves (FloatReg ILIT(2))         = True
+callerSaves (FloatReg 2#)              = True
 #endif
 #ifdef CALLER_SAVES_F3
-callerSaves (FloatReg ILIT(3))         = True
+callerSaves (FloatReg 3#)              = True
 #endif
 #ifdef CALLER_SAVES_F4
-callerSaves (FloatReg ILIT(4))         = True
+callerSaves (FloatReg 4#)              = True
 #endif
 #ifdef CALLER_SAVES_D1
-callerSaves (DoubleReg ILIT(1))                = True
+callerSaves (DoubleReg 1#)             = True
 #endif
 #ifdef CALLER_SAVES_D2
-callerSaves (DoubleReg ILIT(2))                = True
+callerSaves (DoubleReg 2#)             = True
 #endif
 #ifdef CALLER_SAVES_L1
 callerSaves (LongReg _ ILIT(1))                = True
@@ -669,52 +745,52 @@ magicIdRegMaybe :: MagicId -> Maybe Reg
 magicIdRegMaybe BaseReg                        = Just (RealReg REG_Base)
 #endif
 #ifdef REG_R1
-magicIdRegMaybe (VanillaReg _ ILIT(1))         = Just (RealReg REG_R1)
+magicIdRegMaybe (VanillaReg _ 1#)      = Just (RealReg REG_R1)
 #endif 
 #ifdef REG_R2 
-magicIdRegMaybe (VanillaReg _ ILIT(2))         = Just (RealReg REG_R2)
+magicIdRegMaybe (VanillaReg _ 2#)      = Just (RealReg REG_R2)
 #endif 
 #ifdef REG_R3 
-magicIdRegMaybe (VanillaReg _ ILIT(3))         = Just (RealReg REG_R3)
+magicIdRegMaybe (VanillaReg _ 3#)      = Just (RealReg REG_R3)
 #endif 
 #ifdef REG_R4 
-magicIdRegMaybe (VanillaReg _ ILIT(4))         = Just (RealReg REG_R4)
+magicIdRegMaybe (VanillaReg _ 4#)      = Just (RealReg REG_R4)
 #endif 
 #ifdef REG_R5 
-magicIdRegMaybe (VanillaReg _ ILIT(5))         = Just (RealReg REG_R5)
+magicIdRegMaybe (VanillaReg _ 5#)      = Just (RealReg REG_R5)
 #endif 
 #ifdef REG_R6 
-magicIdRegMaybe (VanillaReg _ ILIT(6))         = Just (RealReg REG_R6)
+magicIdRegMaybe (VanillaReg _ 6#)      = Just (RealReg REG_R6)
 #endif 
 #ifdef REG_R7 
-magicIdRegMaybe (VanillaReg _ ILIT(7))         = Just (RealReg REG_R7)
+magicIdRegMaybe (VanillaReg _ 7#)      = Just (RealReg REG_R7)
 #endif 
 #ifdef REG_R8 
-magicIdRegMaybe (VanillaReg _ ILIT(8))         = Just (RealReg REG_R8)
+magicIdRegMaybe (VanillaReg _ 8#)      = Just (RealReg REG_R8)
 #endif
 #ifdef REG_R9 
-magicIdRegMaybe (VanillaReg _ ILIT(9))         = Just (RealReg REG_R9)
+magicIdRegMaybe (VanillaReg _ 9#)      = Just (RealReg REG_R9)
 #endif
 #ifdef REG_R10 
-magicIdRegMaybe (VanillaReg _ ILIT(10))        = Just (RealReg REG_R10)
+magicIdRegMaybe (VanillaReg _ 10#)     = Just (RealReg REG_R10)
 #endif
 #ifdef REG_F1
-magicIdRegMaybe (FloatReg ILIT(1))     = Just (RealReg REG_F1)
+magicIdRegMaybe (FloatReg 1#)  = Just (RealReg REG_F1)
 #endif                                 
 #ifdef REG_F2                          
-magicIdRegMaybe (FloatReg ILIT(2))     = Just (RealReg REG_F2)
+magicIdRegMaybe (FloatReg 2#)  = Just (RealReg REG_F2)
 #endif                                 
 #ifdef REG_F3                          
-magicIdRegMaybe (FloatReg ILIT(3))     = Just (RealReg REG_F3)
+magicIdRegMaybe (FloatReg 3#)  = Just (RealReg REG_F3)
 #endif                                 
 #ifdef REG_F4                          
-magicIdRegMaybe (FloatReg ILIT(4))     = Just (RealReg REG_F4)
+magicIdRegMaybe (FloatReg 4#)  = Just (RealReg REG_F4)
 #endif                                 
 #ifdef REG_D1                          
-magicIdRegMaybe (DoubleReg ILIT(1))    = Just (RealReg REG_D1)
+magicIdRegMaybe (DoubleReg 1#) = Just (RealReg REG_D1)
 #endif                                 
 #ifdef REG_D2                          
-magicIdRegMaybe (DoubleReg ILIT(2))    = Just (RealReg REG_D2)
+magicIdRegMaybe (DoubleReg 2#) = Just (RealReg REG_D2)
 #endif
 #ifdef REG_Sp      
 magicIdRegMaybe Sp                     = Just (RealReg REG_Sp)
@@ -748,31 +824,29 @@ magicIdRegMaybe _                 = Nothing
 
 \begin{code}
 -------------------------------
-#if 0
-freeRegs :: [Reg]
-freeRegs
-  = freeMappedRegs IF_ARCH_alpha( [0..63],
-                  IF_ARCH_i386(  [0..13],
-                  IF_ARCH_sparc( [0..63],)))
-#endif
 -- 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..63],)))
+     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 (RealReg (I# i)) = _IS_TRUE_(freeReg i)
-     in  filter isFree (map RealReg allMachRegNos)
-
+   = let isFree i = isFastTrue (freeReg i)
+     in  map RealReg (filter isFree allMachRegNos)
 
 -------------------------------
-#if 0
+-- 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,
@@ -781,155 +855,156 @@ callClobberedRegs
      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 -}
-#endif
 
 -------------------------------
-#if 0
+-- 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 -}
-#endif
 
 -------------------------------
-
-#if 0
+-- 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 -}
+
+#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 i7 = fastBool False  --        %i7 tends to have ret-addr-ish things
+freeReg o6 = fastBool False  --        %o6 is our stack pointer.
+freeReg o7 = fastBool False  --        %o7 holds ret addrs (???)
+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}