[project @ 2002-03-27 12:09:00 by simonpj]
[ghc-hetmet.git] / ghc / compiler / nativeGen / MachRegs.lhs
index 904b612..90ba29d 100644 (file)
@@ -15,12 +15,12 @@ modules --- the pleasure has been foregone.)
 module MachRegs (
 
         RegClass(..), regClass,
-       Reg(..), isRealReg, isVirtualReg,
+       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, sp, g0, g1, g2, o0, f0, f6, f8, f26, f27
+       , fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f26, f27
        
 #endif
     ) where
@@ -55,14 +55,15 @@ 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}
 
@@ -73,9 +74,9 @@ 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
@@ -168,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}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -256,6 +259,26 @@ 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 
    | RcFloat
@@ -264,22 +287,29 @@ data RegClass
 
 data Reg
    = RealReg     Int
-   | VirtualRegI Unique
-   | VirtualRegF Unique
-   | VirtualRegD 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 sparc_TARGET_ARCH
    = case pk of
-        FloatRep  -> VirtualRegF u
-        DoubleRep -> VirtualRegD u
-        other     -> VirtualRegI u
+        FloatRep  -> VirtualRegF (VRegUniqueLo u)
+        DoubleRep -> VirtualRegD (VRegUniqueLo u)
+        other     -> VirtualRegI (VRegUniqueLo u)
 #else
-   = if isFloatingRep pk then VirtualRegD u else VirtualRegI u
+   = if isFloatingRep pk then VirtualRegD (VRegUniqueLo u) 
+                         else VirtualRegI (VRegUniqueLo u)
 #endif
 
 isVirtualReg (RealReg _)     = False
@@ -322,19 +352,13 @@ instance Ord Reg where
 
 
 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
+    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
-    getUnique (VirtualRegD u) = u
+    ppr r = Outputable.text (show r)
 \end{code}
 
 ** Machine-specific Reg stuff: **
@@ -454,7 +478,7 @@ showReg n
    | 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
+g0, g1, g2, fp, sp, o0, o1, f0, f1, f6, f8, f22, f26, f27 :: Reg
 
 f6  = RealReg (fReg 6)
 f8  = RealReg (fReg 8)
@@ -472,6 +496,7 @@ g2  = RealReg (gReg 2)
 fp  = RealReg (iReg 6)
 sp  = RealReg (oReg 6)
 o0  = RealReg (oReg 0)
+o1  = RealReg (oReg 1)
 f0  = RealReg (fReg 0)
 f1  = RealReg (fReg 1)
 
@@ -630,6 +655,7 @@ baseRegOffset Hp                 = OFFSET_Hp
 baseRegOffset HpLim                 = OFFSET_HpLim
 baseRegOffset CurrentTSO            = OFFSET_CurrentTSO
 baseRegOffset CurrentNursery        = OFFSET_CurrentNursery
+baseRegOffset HpAlloc               = OFFSET_HpAlloc
 #ifdef NCG_DEBUG
 baseRegOffset BaseReg               = panic "baseRegOffset:BaseReg"
 baseRegOffset CurCostCentre         = panic "baseRegOffset:CurCostCentre"