[project @ 1998-12-02 13:17:09 by simonm]

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

diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs
index e650837..50d5709 100644 (file)
--- a/ghc/compiler/nativeGen/RegAllocInfo.lhs
+++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs
@@ -1,12 +1,11 @@
 %
-% (c) The AQUA Project, Glasgow University, 1996
+% (c) The AQUA Project, Glasgow University, 1996-1998
 %
 \section[RegAllocInfo]{Machine-specific info used for register allocation}
 
 The (machine-independent) allocator itself is in @AsmRegAlloc@.
 
 \begin{code}
-#include "HsVersions.h"
 #include "nativeGen/NCG.h"
 
 module RegAllocInfo (
@@ -24,8 +23,8 @@ module RegAllocInfo (
        regUsage,
 
        FutureLive(..),
-       RegAssignment(..),
-       RegConflicts(..),
+       RegAssignment,
+       RegConflicts,
        RegFuture(..),
        RegHistory(..),
        RegInfo(..),
@@ -37,7 +36,7 @@ module RegAllocInfo (
        regLiveness,
        spillReg,
 
-       RegSet(..),
+       RegSet,
        elementOfRegSet,
        emptyRegSet,
        isEmptyRegSet,
@@ -51,21 +50,20 @@ module RegAllocInfo (
        freeRegSet
     ) where
 
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
 
+import List            ( partition )
 import MachMisc
 import MachRegs
-import MachCode                ( InstrList(..) )
+import MachCode                ( InstrList )
 
-import AbsCSyn         ( MagicId )
 import BitSet          ( unitBS, mkBS, minusBS, unionBS, listBS, BitSet )
 import CLabel          ( pprCLabel_asm, CLabel{-instance Ord-} )
-import FiniteMap       ( addToFM, lookupFM )
-import OrdList         ( mkUnitList, OrdList )
+import FiniteMap       ( addToFM, lookupFM, FiniteMap )
+import OrdList         ( mkUnitList )
 import PrimRep         ( PrimRep(..) )
-import Stix            ( StixTree, CodeSegment )
 import UniqSet         -- quite a bit of it
-import Unpretty                ( uppShow )
+import Outputable
 \end{code}
 
 %************************************************************************
@@ -368,9 +366,9 @@ regUsage instr = case instr of
     XOR  sz src dst    -> usage2 src dst
     NOT  sz op         -> usage1 op
     NEGI sz op         -> usage1 op
-    SHL  sz imm dst    -> usage1 dst -- imm has to be an Imm
-    SAR  sz imm dst    -> usage1 dst -- imm has to be an Imm
-    SHR  sz imm dst    -> usage1 dst -- imm has to be an Imm
+    SHL  sz dst len    -> usage2 dst len -- len is either an Imm or ecx.
+    SAR  sz dst len    -> usage2 dst len -- len is either an Imm or ecx.
+    SHR  sz len dst    -> usage2 dst len -- len is either an Imm or ecx.
     PUSH sz op         -> usage (opToReg op) []
     POP  sz op         -> usage [] (opToReg op)
     TEST sz src dst    -> usage (opToReg src ++ opToReg dst) []
@@ -419,7 +417,7 @@ regUsage instr = case instr of
     FISUBR sz asrc     -> usage (addrToRegs asrc) [st0]
     FTST               -> usage [st0] []
     FCOMP sz op                -> usage (st0:opToReg op) [st0] -- allFPRegs
-    FUCOMPP            -> usage [st0, st1] [] --  allFPRegs
+    FUCOMPP            -> usage [st0, st1] [st0, st1] --  allFPRegs
     FXCH               -> usage [st0, st1] [st0, st1]
     FNSTSW             -> usage [] [eax]
     _                  -> noUsage
@@ -442,7 +440,7 @@ regUsage instr = case instr of
     opToReg (OpImm imm)   = []
     opToReg (OpAddr  ea)  = addrToRegs ea
 
-    addrToRegs (Addr base index _) = baseToReg base ++ indexToReg index
+    addrToRegs (AddrBaseIndex base index _) = baseToReg base ++ indexToReg index
       where  baseToReg Nothing       = []
             baseToReg (Just r)      = [r]
             indexToReg Nothing      = []
@@ -532,8 +530,8 @@ regLiveness instr info@(RL live future@(FL all env))
        lookup lbl
          = case (lookupFM env lbl) of
            Just rs -> rs
-           Nothing -> trace ("Missing " ++ (uppShow 80 (pprCLabel_asm lbl)) ++
-                             " in future?") emptyRegSet
+           Nothing -> pprTrace "Missing" (pprCLabel_asm lbl <+> text "in future?") 
+                      emptyRegSet
     in
     case instr of -- the rest is machine-specific...
 
@@ -665,9 +663,9 @@ patchRegs instr env = case instr of
     XOR  sz src dst    -> patch2 (XOR  sz) src dst
     NOT  sz op                 -> patch1 (NOT  sz) op
     NEGI sz op         -> patch1 (NEGI sz) op
-    SHL  sz imm dst    -> patch1 (SHL  sz imm) dst
-    SAR  sz imm dst    -> patch1 (SAR  sz imm) dst
-    SHR  sz imm dst    -> patch1 (SHR  sz imm) dst
+    SHL  sz imm dst    -> patch2 (SHL  sz) imm dst
+    SAR  sz imm dst    -> patch2 (SAR  sz) imm dst
+    SHR  sz imm dst    -> patch2 (SHR  sz) imm dst
     TEST sz src dst    -> patch2 (TEST sz) src dst
     CMP  sz src dst    -> patch2 (CMP  sz) src dst
     PUSH sz op         -> patch1 (PUSH sz) op
@@ -709,8 +707,8 @@ patchRegs instr env = case instr of
     patchOp (OpAddr ea)  = OpAddr (lookupAddr ea)
 
     lookupAddr (ImmAddr imm off) = ImmAddr imm off
-    lookupAddr (Addr base index disp)
-      = Addr (lookupBase base) (lookupIndex index) disp
+    lookupAddr (AddrBaseIndex base index disp)
+      = AddrBaseIndex (lookupBase base) (lookupIndex index) disp
       where
        lookupBase Nothing       = Nothing
        lookupBase (Just r)      = Just (env r)