[project @ 1997-05-19 00:12:10 by sof]

[ghc-hetmet.git] / ghc / compiler / nativeGen / MachRegs.lhs

diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs
index 156dab3..2baaf71 100644 (file)
--- a/ghc/compiler/nativeGen/MachRegs.lhs
+++ b/ghc/compiler/nativeGen/MachRegs.lhs
@@ -19,7 +19,7 @@ module MachRegs (
        Imm(..),
        Addr(..),
        RegLoc(..),
-       RegNo(..),
+       SYN_IE(RegNo),
 
        addrOffset,
        argRegs,
@@ -44,7 +44,7 @@ module MachRegs (
        , allArgRegs
        , fits8Bits
        , fReg
-       , gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zero
+       , gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zeroh
 #endif
 #if i386_TARGET_ARCH
        , eax, ebx, ecx, edx, esi, esp
@@ -59,11 +59,19 @@ module MachRegs (
 #endif
     ) where
 
-import Ubiq{-uitous-}
+#if __GLASGOW_HASKELL__ >= 202
+import GlaExts hiding (Addr)
+import FastString
+import Ubiq
+#else
+IMP_Ubiq(){-uitous-}
+#endif
 
 import AbsCSyn         ( MagicId(..) )
 import AbsCUtils       ( magicIdPrimRep )
-import Pretty          ( ppStr, ppRational, ppShow )
+import CLabel           ( CLabel )
+import Outputable       ( Outputable(..) )
+import Pretty          ( Doc, text, rational )
 import PrimOp          ( PrimOp(..) )
 import PrimRep         ( PrimRep(..) )
 import Stix            ( sStLitLbl, StixTree(..), StixReg(..),
@@ -72,9 +80,8 @@ import Stix           ( sStLitLbl, StixTree(..), StixReg(..),
 import Unique          ( mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
                          Unique{-instance Ord3-}
                        )
-import UniqSupply      ( getUnique, returnUs, thenUs, UniqSM(..) )
-import Unpretty                ( uppStr, Unpretty(..) )
-import Util            ( panic )
+import UniqSupply      ( getUnique, returnUs, thenUs, SYN_IE(UniqSM) )
+import Util            ( panic, Ord3(..) )
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -84,20 +91,20 @@ data Imm
   = ImmInt     Int
   | ImmInteger Integer     -- Sigh.
   | ImmCLbl    CLabel      -- AbstractC Label (with baggage)
-  | ImmLab     Unpretty    -- Simple string label (underscore-able)
-  | ImmLit     Unpretty    -- Simple string
+  | ImmLab     Doc    -- Simple string label (underscore-able)
+  | ImmLit     Doc    -- Simple string
   IF_ARCH_sparc(
   | LO Imm                 -- Possible restrictions...
   | HI Imm
   ,)
 
-strImmLit s = ImmLit (uppStr s)
+strImmLit s = ImmLit (text s)
 dblImmLit r
   = strImmLit (
         IF_ARCH_alpha({-prepend nothing-}
        ,IF_ARCH_i386( '0' : 'd' :
        ,IF_ARCH_sparc('0' : 'r' :,)))
-       ppShow 80 (ppRational r))
+       show (rational r))
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -307,12 +314,12 @@ instance Text Reg where
 
 #ifdef DEBUG
 instance Outputable Reg where
-    ppr sty r = ppStr (show r)
+    ppr sty r = text (show r)
 #endif
 
-cmpReg (FixedReg i) (FixedReg i') = cmp_ihash i i'
-cmpReg (MappedReg i) (MappedReg i') = cmp_ihash i i'
-cmpReg (MemoryReg i _) (MemoryReg i' _) = cmp_i i i'
+cmpReg (FixedReg i)      (FixedReg i')      = cmp_ihash i i'
+cmpReg (MappedReg i)     (MappedReg i')     = cmp_ihash i i'
+cmpReg (MemoryReg i _)   (MemoryReg i' _)   = cmp_i i i'
 cmpReg (UnmappedReg u _) (UnmappedReg u' _) = cmp u u'
 cmpReg r1 r2
   = let tag1 = tagReg r1
@@ -331,16 +338,19 @@ cmp_i a1 a2 = if a1 == a2 then EQ_ else if a1 < a2 then LT_ else GT_
 cmp_ihash :: FAST_INT -> FAST_INT -> TAG_
 cmp_ihash a1 a2 = if a1 _EQ_ a2 then EQ_ else if a1 _LT_ a2 then LT_ else GT_
 
+instance Ord3 Reg where
+    cmp = cmpReg
+
 instance Eq Reg where
-    a == b = case cmpReg a b of { EQ_ -> True;  _ -> False }
-    a /= b = case cmpReg a b of { EQ_ -> False; _ -> True  }
+    a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
+    a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True  }
 
 instance Ord Reg where
-    a <= b = case cmpReg a b of { LT_ -> True; EQ_ -> True;  GT__ -> False }
-    a <         b = case cmpReg a b of { LT_ -> True;  EQ_ -> False; GT__ -> False }
-    a >= b = case cmpReg a b of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
-    a >         b = case cmpReg a b of { LT_ -> False; EQ_ -> False; GT__ -> True  }
-    _tagCmp a b = case cmpReg a b of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
+    a <= b = case (a `cmp` b) of { LT_ -> True;        EQ_ -> True;  GT__ -> False }
+    a <         b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
+    a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
+    a >         b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
+    _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
 
 instance Uniquable Reg where
     uniqueOf (UnmappedReg u _) = u
@@ -375,14 +385,14 @@ is defined in StgRegs.h.  We are, of course, prepared for any eventuality.
 fReg :: Int -> Int
 fReg x = (32 + x)
 
-v0, f0, ra, pv, gp, sp, zero :: Reg
-v0   = realReg 0
-f0   = realReg (fReg 0)
-ra   = FixedReg ILIT(26)
-pv   = t12
-gp   = FixedReg ILIT(29)
-sp   = FixedReg ILIT(30)
-zero = FixedReg ILIT(31)
+v0, f0, ra, pv, gp, sp, zeroh :: Reg
+v0    = realReg 0
+f0    = realReg (fReg 0)
+ra    = FixedReg ILIT(26)
+pv    = t12
+gp    = FixedReg ILIT(29)
+sp    = FixedReg ILIT(30)
+zeroh = FixedReg ILIT(31) -- "zero" is used in 1.3 (MonadZero method)
 
 t9, t10, t11, t12 :: Reg
 t9  = realReg 23
@@ -907,7 +917,7 @@ 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 (zero)
+freeReg ILIT(31) = _FALSE_  -- always zero (zeroh)
 freeReg ILIT(63) = _FALSE_  -- always zero (f31)
 #endif