X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FMachRegs.lhs;h=06cbae164e99a85a9ef23fbf70dfd8e000ccc374;hb=23c94851fb2c98d345d913d35a5a12bbc3a346bd;hp=a2af7420cea3dd8218171e9bad1e2ba928a68390;hpb=9c26739695219d8343505a88457cb55c76b65449;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs
index a2af742..06cbae1 100644
--- a/ghc/compiler/nativeGen/MachRegs.lhs
+++ b/ghc/compiler/nativeGen/MachRegs.lhs
@@ -10,16 +10,15 @@ often/usually quite entangled with registers.
 modules --- the pleasure has been foregone.)
 
 \begin{code}
-#include "HsVersions.h"
 #include "nativeGen/NCG.h"
 
 module MachRegs (
 
 	Reg(..),
 	Imm(..),
-	Addr(..),
+	MachRegsAddr(..),
 	RegLoc(..),
-	SYN_IE(RegNo),
+	RegNo,
 
 	addrOffset,
 	argRegs,
@@ -59,29 +58,21 @@ module MachRegs (
 #endif
     ) where
 
-#if __GLASGOW_HASKELL__ >= 202
-import GlaExts hiding (Addr)
-import FastString
-#else
-IMP_Ubiq(){-uitous-}
-#endif
+#include "HsVersions.h"
 
 import AbsCSyn		( MagicId(..) )
 import AbsCUtils	( magicIdPrimRep )
 import CLabel           ( CLabel )
-import Outputable       ( Outputable(..) )
-import Pretty		( Doc, text, rational )
 import PrimOp		( PrimOp(..) )
 import PrimRep		( PrimRep(..) )
 import Stix		( sStLitLbl, StixTree(..), StixReg(..),
 			  CodeSegment
 			)
 import Unique		( mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
-			  Unique{-instance Ord3-}
+			  Uniquable(..), Unique
 			)
-import UniqSupply	( getUnique, returnUs, thenUs, SYN_IE(UniqSM) )
-import UniqFM		( Uniquable(..) )
-import Util		( panic, Ord3(..) )
+import UniqSupply	( getUnique, returnUs, thenUs, UniqSM )
+import Outputable
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -91,26 +82,25 @@ data Imm
   = ImmInt	Int
   | ImmInteger	Integer	    -- Sigh.
   | ImmCLbl	CLabel	    -- AbstractC Label (with baggage)
-  | ImmLab	Doc    -- Simple string label (underscore-able)
-  | ImmLit	Doc    -- Simple string
+  | ImmLab	SDoc    -- Simple string label (underscore-able)
+  | ImmLit	SDoc    -- Simple string
   IF_ARCH_sparc(
   | LO Imm		    -- Possible restrictions...
   | HI Imm
   ,)
-
 strImmLit s = ImmLit (text s)
 dblImmLit r
   = strImmLit (
 	 IF_ARCH_alpha({-prepend nothing-}
 	,IF_ARCH_i386( '0' : 'd' :
 	,IF_ARCH_sparc('0' : 'r' :,)))
-	show (rational r))
+	showSDoc (rational r))
 \end{code}
 
 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
 \begin{code}
-data Addr
+data MachRegsAddr
 #if alpha_TARGET_ARCH
   = AddrImm	Imm
   | AddrReg	Reg
@@ -118,8 +108,8 @@ data Addr
 #endif
 
 #if i386_TARGET_ARCH
-  = Addr	Base Index Displacement
-  | ImmAddr	Imm Int
+  = AddrBaseIndex	Base Index Displacement
+  | ImmAddr		Imm Int
 
 type Base         = Maybe Reg
 type Index        = Maybe (Reg, Int)	-- Int is 2, 4 or 8
@@ -131,7 +121,7 @@ type Displacement = Imm
   | AddrRegImm	Reg Imm
 #endif
 
-addrOffset :: Addr -> Int -> Maybe Addr
+addrOffset :: MachRegsAddr -> Int -> Maybe MachRegsAddr
 
 addrOffset addr off
   = case addr of
@@ -140,9 +130,9 @@ addrOffset addr off
 #endif
 #if i386_TARGET_ARCH
       ImmAddr i off0	  -> Just (ImmAddr i (off0 + off))
-      Addr r i (ImmInt n) -> Just (Addr r i (ImmInt (n + off)))
-      Addr r i (ImmInteger n)
-	-> Just (Addr r i (ImmInt (fromInteger (n + toInteger off))))
+      AddrBaseIndex r i (ImmInt n) -> Just (AddrBaseIndex r i (ImmInt (n + off)))
+      AddrBaseIndex r i (ImmInteger n)
+	-> Just (AddrBaseIndex r i (ImmInt (fromInteger (n + toInteger off))))
       _ -> Nothing
 #endif
 #if sparc_TARGET_ARCH
@@ -228,9 +218,16 @@ stgReg x
       BaseReg		-> sStLitLbl SLIT("MainRegTable")
 	-- these Hp&HpLim cases perhaps should
 	-- not be here for i386 (???) WDP 96/03
+#ifndef i386_TARGET_ARCH
+	-- Yup, Hp&HpLim are not mapped into registers for x86's at the mo, so
+	-- fetching Hp off BaseReg is the sensible option, since that's
+	-- where gcc generated code stuffs/expects it (RTBL_Hp & RTBL_HpLim).
+	--  SOF 97/09
+	-- In fact, why use StorageMgrInfo at all?
       Hp		-> StInd PtrRep (sStLitLbl SLIT("StorageMgrInfo"))
       HpLim		-> StInd PtrRep (sStLitLbl
 				(_PK_ ("StorageMgrInfo+" ++ BYTES_PER_WORD_STR)))
+#endif
       TagReg		-> StInd IntRep (StPrim IntSubOp [infoptr,
 				StInt (1*BYTES_PER_WORD)])
 			where
@@ -251,17 +248,17 @@ applicable, is the same but for the frame pointer.
 
 \begin{code}
 spRel :: Int	-- desired stack offset in words, positive or negative
-      -> Addr
+      -> MachRegsAddr
 
 spRel n
 #if i386_TARGET_ARCH
-  = Addr (Just esp) Nothing (ImmInt (n * BYTES_PER_WORD))
+  = AddrBaseIndex (Just esp) Nothing (ImmInt (n * BYTES_PER_WORD))
 #else
   = AddrRegImm sp (ImmInt (n * BYTES_PER_WORD))
 #endif
 
 #if sparc_TARGET_ARCH
-fpRel :: Int -> Addr
+fpRel :: Int -> MachRegsAddr
     -- Duznae work for offsets greater than 13 bits; we just hope for
     -- the best
 fpRel n
@@ -297,7 +294,6 @@ data Reg
   | 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
 
@@ -314,43 +310,37 @@ instance Text Reg where
 
 #ifdef DEBUG
 instance Outputable Reg where
-    ppr sty r = text (show r)
+    ppr 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 (UnmappedReg u _) (UnmappedReg u' _) = cmp u u'
+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_
+	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_i :: Int -> Int -> TAG_
-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
+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
 
 instance Eq Reg where
-    a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
-    a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True  }
+    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
+    a /= b = case (a `compare` b) of { EQ -> False; _ -> True  }
 
 instance Ord Reg where
-    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 }
+    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
 
 instance Uniquable Reg where
     uniqueOf (UnmappedReg u _) = u