import MachCode ( InstrBlock )
import MachMisc ( Instr(..) )
+import PprMach ( pprInstr ) -- Just for debugging
import MachRegs
import RegAllocInfo
-import FiniteMap ( FiniteMap, emptyFM, addListToFM, delListFromFM,
- lookupFM, keysFM, eltsFM, mapFM, addToFM_C, addToFM,
- listToFM, fmToList, lookupWithDefaultFM )
-import Unique ( mkBuiltinUnique )
-import OrdList ( unitOL, appOL, fromOL, concatOL )
+import FiniteMap ( FiniteMap, emptyFM,
+ lookupFM, eltsFM, addToFM_C, addToFM,
+ listToFM, fmToList )
+import OrdList ( fromOL )
import Outputable
-import Unique ( Unique, Uniquable(..), mkPseudoUnique3 )
+import Unique ( mkPseudoUnique3 )
import CLabel ( CLabel, pprCLabel )
+import FastTypes
import List ( mapAccumL, nub, sort )
import Array ( Array, array, (!), bounds )
--)
where
tryGeneral []
- = error "nativeGen: spilling failed. Workaround: compile with -fvia-C.\n"
+ = pprPanic "nativeGen: spilling failed. Workaround: compile with -fvia-C.\n"
+ ( (text "reserves = " <> ppr reserves)
+ $$
+ (text "code = ")
+ $$
+ (vcat (map (docToSDoc.pprInstr) flatInstrs))
+ )
tryGeneral (resv:resvs)
= case generalAlloc resv of
Just success -> success
doGeneralAlloc all_regs reserve_regs instrs
-- succeeded without spilling
- | prespill_ok = Just prespill_insns
+ | prespill_ok
+ = Just prespill_insns
+
-- failed, and no spill regs avail, so pointless to attempt spilling
| null reserve_regs = Nothing
-- success after spilling
++ " using "
++ showSDoc (hsep (map ppr reserve_regs))
-# if 1 /* ifdef DEBUG */
+# ifdef NCG_DEBUG
maybetrace msg x = trace msg x
# else
maybetrace msg x = x
insertSpillCode :: [Instr] -> [Instr]
insertSpillCode insns
= let uniques_in_insns
- = map getUnique
+ = map getVRegUnique
(regSetToList
(foldl unionRegSets emptyRegSet
(map vregs_in_insn insns)))
= case regUsage i of
RU rds wrs -> filterRegSet isVirtualReg
(rds `unionRegSets` wrs)
- vreg_to_slot_map :: FiniteMap Unique Int
+ vreg_to_slot_map :: FiniteMap VRegUnique Int
vreg_to_slot_map
= listToFM (zip uniques_in_insns [0..])
-- to the stack pointer, as opposed to the frame pointer. The other is a
-- counter, used to manufacture new temporary register names.
-patchInstr :: FiniteMap Unique Int -> (Int,Int) -> Instr -> ((Int,Int), [Instr])
+patchInstr :: FiniteMap VRegUnique Int -> (Int,Int) -> Instr -> ((Int,Int), [Instr])
patchInstr vreg_to_slot_map (delta,ctr) instr
| null memSrcs && null memDsts
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 (pseudoVReg i)
+ RcFloat -> VirtualRegF (pseudoVReg i)
+ RcDouble -> VirtualRegD (pseudoVReg i)
_ -> pprPanic "patchInstr: unmapped VReg" (ppr vreg)
| otherwise
= vreg
+ pseudoVReg i = VRegUniqueLo (mkPseudoUnique3 i)
+
memSrcs = filter isVirtualReg (regSetToList srcs)
memDsts = filter isVirtualReg (regSetToList dsts)
= let wrs
= case regUsage i of RU rrr www -> www
new_fes
- = [case ino of { I# inoh ->
- case ino_succ of { I# ino_succh ->
+ = [case iUnbox ino of { inoh ->
+ case iUnbox ino_succ of { ino_succh ->
MkFE inoh ino_succh
}}
| ino_succ <- succ_map ! ino]
= approx
| otherwise
= let fes_to_futures
- = [case ino of { I# inoh ->
- case future_ino of { I# future_inoh ->
+ = [case iUnbox ino of { inoh ->
+ case iUnbox future_ino of { future_inoh ->
MkFE inoh future_inoh
}}
| future_ino <- succ_map ! ino]
= foldr unionRegSets emptyRegSet future_lives
fes_from_histories
- = [case history_ino of { I# history_inoh ->
- case ino of { I# inoh ->
+ = [case iUnbox history_ino of { history_inoh ->
+ case iUnbox ino of { inoh ->
MkFE history_inoh inoh
}}
| history_ino <- pred_map ! ino]
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);
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,
-- A data type for flow edges
data FE
- = MkFE Int# Int# deriving (Eq, Ord)
+ = MkFE FastInt FastInt deriving (Eq, Ord)
-- deriving Show on types with unboxed fields doesn't work
instance Show FE where
showsPrec _ (MkFE s d)
- = showString "MkFE" . shows (I# s) . shows ' ' . shows (I# d)
+ = showString "MkFE" . shows (iBox s) . shows ' ' . shows (iBox d)
-- Blargh. Use ghc stuff soon! Or: perhaps that's not such a good
-- idea. Most of these sets are either empty or very small, and it