import Alpha.Regs
import Alpha.RegInfo
import Alpha.Instr
-import Alpha.Ppr
#elif i386_TARGET_ARCH || x86_64_TARGET_ARCH
import X86.CodeGen
#elif sparc_TARGET_ARCH
import SPARC.CodeGen
import SPARC.Regs
-import SPARC.RegInfo
import SPARC.Instr
import SPARC.Ppr
+import SPARC.ShortcutJump
#elif powerpc_TARGET_ARCH
import PPC.CodeGen
+import PPC.Cond
import PPC.Regs
import PPC.RegInfo
import PPC.Instr
import qualified RegAlloc.Graph.Coalesce as Color
import qualified RegAlloc.Graph.TrivColorable as Color
-import qualified TargetReg as Target
+import qualified SPARC.CodeGen.Expand as SPARC
+import TargetReg
import Platform
import Instruction
import PIC
import Reg
+import RegClass
import NCGMonad
import Cmm
import UniqFM
import Unique ( Unique, getUnique )
import UniqSupply
-import List ( groupBy, sortBy )
import DynFlags
#if powerpc_TARGET_ARCH
import StaticFlags ( opt_Static, opt_PIC )
dumpIfSet_dyn dflags
Opt_D_dump_asm_conflicts "Register conflict graph"
- $ Color.dotGraph Target.targetRegDotColor (Color.trivColorable Target.targetRegClass)
+ $ Color.dotGraph
+ targetRegDotColor
+ (Color.trivColorable
+ targetVirtualRegSqueeze
+ targetRealRegSqueeze)
$ graphGlobal)
Pretty.bufLeftRender h
$ {-# SCC "pprNativeCode" #-} Pretty.vcat $ map pprNatCmmTop native
- let lsPprNative =
+ -- carefully evaluate this strictly. Binding it with 'let'
+ -- and then using 'seq' doesn't work, because the let
+ -- apparently gets inlined first.
+ lsPprNative <- return $!
if dopt Opt_D_dump_asm dflags
|| dopt Opt_D_dump_asm_stats dflags
then native
else []
- let count' = count + 1;
-
+ count' <- return $! count + 1;
-- force evaulation all this stuff to avoid space leaks
seqString (showSDoc $ vcat $ map ppr imports) `seq` return ()
- lsPprNative `seq` return ()
- count' `seq` return ()
cmmNativeGens dflags h us' cmms
(imports : impAcc)
|| dopt Opt_RegsIterative dflags)
then do
-- the regs usable for allocation
- let alloc_regs
+ let (alloc_regs :: UniqFM (UniqSet RealReg))
= foldr (\r -> plusUFM_C unionUniqSets
- $ unitUFM (regClass r) (unitUniqSet r))
+ $ unitUFM (targetClassOfRealReg r) (unitUniqSet r))
emptyUFM
- $ map RealReg allocatableRegs
+ $ allocatableRegs
+
- -- graph coloring register allocation
+ -- do the graph coloring register allocation
let ((alloced, regAllocStats), usAlloc)
= {-# SCC "RegAlloc" #-}
initUs usLive
map sequenceTop shorted
---- x86fp_kludge
- let final_mach_code =
+ let kludged =
#if i386_TARGET_ARCH
{-# SCC "x86fp_kludge" #-}
map x86fp_kludge sequenced
sequenced
#endif
+ ---- expansion of SPARC synthetic instrs
+#if sparc_TARGET_ARCH
+ let expanded =
+ {-# SCC "sparc_expand" #-}
+ map SPARC.expandTop kludged
+
+ dumpIfSet_dyn dflags
+ Opt_D_dump_asm_expanded "Synthetic instructions expanded"
+ (vcat $ map (docToSDoc . pprNatCmmTop) expanded)
+#else
+ let expanded =
+ kludged
+#endif
+
return ( usAlloc
- , final_mach_code
+ , expanded
, lastMinuteImports ++ imports
, ppr_raStatsColor
, ppr_raStatsLinear)
#if i386_TARGET_ARCH
-x86fp_kludge :: NatCmmTop -> NatCmmTop
+x86fp_kludge :: NatCmmTop Instr -> NatCmmTop Instr
x86fp_kludge top@(CmmData _ _) = top
x86fp_kludge top@(CmmProc info lbl params (ListGraph code)) =
CmmProc info lbl params (ListGraph $ i386_insert_ffrees code)
-- fallthroughs.
sequenceTop
- :: Instruction instr
- => NatCmmTop instr
- -> NatCmmTop instr
+ :: NatCmmTop Instr
+ -> NatCmmTop Instr
sequenceTop top@(CmmData _ _) = top
sequenceTop (CmmProc info lbl params (ListGraph blocks)) =
-- big, we have to work around this limitation.
makeFarBranches
- :: Instruction instr
- => [NatBasicBlock instr]
- -> [NatBasicBlock instr]
+ :: [NatBasicBlock Instr]
+ -> [NatBasicBlock Instr]
#if powerpc_TARGET_ARCH
makeFarBranches blocks