[project @ 2000-08-21 15:40:14 by sewardj]

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

diff --git a/ghc/compiler/nativeGen/AsmRegAlloc.lhs b/ghc/compiler/nativeGen/AsmRegAlloc.lhs
index 3a947cb..02c5649 100644 (file)
--- a/ghc/compiler/nativeGen/AsmRegAlloc.lhs
+++ b/ghc/compiler/nativeGen/AsmRegAlloc.lhs
@@ -10,16 +10,13 @@ module AsmRegAlloc ( runRegAllocate ) where
 
 import MachCode                ( InstrBlock )
 import MachMisc                ( Instr(..) )
-import PprMach         ( pprUserReg, pprInstr ) -- debugging
 import MachRegs
 import RegAllocInfo
 
 import FiniteMap       ( FiniteMap, emptyFM, addListToFM, delListFromFM, 
                          lookupFM, keysFM, eltsFM, mapFM, addToFM_C, addToFM,
                          listToFM, fmToList, lookupWithDefaultFM )
-import Maybes          ( maybeToBool )
 import Unique          ( mkBuiltinUnique )
-import Util            ( mapAccumB )
 import OrdList         ( unitOL, appOL, fromOL, concatOL )
 import Outputable
 import Unique          ( Unique, Uniquable(..), mkPseudoUnique3 )
@@ -59,11 +56,13 @@ runRegAllocate
     -> [Instr]
 
 runRegAllocate regs find_reserve_regs instrs
-  = case simpleAlloc of
+  = --trace ("runRegAllocate: " ++ show regs) (
+    case simpleAlloc of
        Just simple -> --trace "SIMPLE" 
                       simple
        Nothing     -> --trace "GENERAL"
                       (tryGeneral reserves)
+    --)
   where
     tryGeneral [] 
        = error "nativeGen: spilling failed.  Workaround: compile with -fvia-C.\n"
@@ -137,7 +136,8 @@ doSimpleAlloc available_real_regs instrs
                                             (i2:ris_done) is
                        where
                           isFloatingOrReal reg
-                             = isRealReg reg || regClass reg == RcFloating
+                             = isRealReg reg || regClass reg == RcFloat
+                                             || regClass reg == RcDouble
 
                           rds_l = regSetToList rds
                           wrs_l = regSetToList wrs
@@ -222,7 +222,7 @@ doGeneralAlloc all_regs reserve_regs instrs
               ++ " using " 
               ++ showSDoc (hsep (map ppr reserve_regs))
 
-#        ifdef DEBUG
+#        ifdef NCG_DEBUG
          maybetrace msg x = trace msg x
 #        else
          maybetrace msg x = x
@@ -320,9 +320,10 @@ patchInstr vreg_to_slot_map (delta,ctr) instr
         mkTmpReg vreg
            | isVirtualReg vreg
            = case [vi | (vreg', vi) <- vreg_env, vreg' == vreg] of
-                [i] -> if   regClass vreg == RcInteger
-                       then VirtualRegI (mkPseudoUnique3 i)
-                       else VirtualRegF (mkPseudoUnique3 i)
+                [i] -> case regClass vreg of
+                          RcInteger -> VirtualRegI (mkPseudoUnique3 i)
+                          RcFloat   -> VirtualRegF (mkPseudoUnique3 i)
+                          RcDouble  -> VirtualRegD (mkPseudoUnique3 i)
                 _   -> pprPanic "patchInstr: unmapped VReg" (ppr vreg)
            | otherwise
            = vreg
@@ -770,8 +771,8 @@ find_flow_edges insns
                  Branch lab -- jmps to lab; add fe i_num -> i_target
                     -> let i_target = find_label lab
                        in 
-                       mk_succ_map i_num_1 ((i_num, [i_target]): rsucc_map)
-                                           is
+                       mk_succ_map i_num_1 ((i_num, [i_target]): rsucc_map) is
+
                  NextOrBranch lab
                     |  null is   -- jmps to label, or falls through, and this is
                                  -- the last insn (a meaningless scenario); 
@@ -784,6 +785,13 @@ find_flow_edges insns
                        in
                        mk_succ_map i_num_1 ((i_num, [i_num_1, i_target]):rsucc_map)
                                            is
+                 MultiFuture labels
+                    -> -- A jump, whose targets are listed explicitly.  
+                       -- (Generated from table-based switch translations).
+                       -- Add fes  i_num -> x  for each x in labels
+                       let is_target = nub (map find_label labels)
+                       in
+                       mk_succ_map i_num_1 ((i_num, is_target):rsucc_map) is
 
          -- Third phase: invert the successor map to get the predecessor
          -- map, using an algorithm which is quadratic in the worst case,