X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FAsmCodeGen.lhs;h=a99d60ac9db036030353f0693e8a589faad5e466;hb=388e3356f71daffa62f1d4157e1e07e4c68f218a;hp=d4fa1025917b16d1ef2d26fd8da5e1f062e4ffc8;hpb=20c0e6ccf28b0961d2c5f6516b57e52fa2c13b33;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index d4fa102..a99d60a 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -25,7 +25,6 @@ import Alpha.CodeGen
 import Alpha.Regs
 import Alpha.RegInfo
 import Alpha.Instr
-import Alpha.Ppr
 
 #elif i386_TARGET_ARCH || x86_64_TARGET_ARCH
 import X86.CodeGen
@@ -37,12 +36,13 @@ import X86.Ppr
 #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
@@ -62,12 +62,14 @@ import qualified RegAlloc.Graph.Stats		as Color
 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
@@ -79,7 +81,6 @@ import State
 import UniqFM
 import Unique		( Unique, getUnique )
 import UniqSupply
-import List		( groupBy, sortBy )
 import DynFlags
 #if powerpc_TARGET_ARCH
 import StaticFlags	( opt_Static, opt_PIC )
@@ -195,7 +196,11 @@ nativeCodeGen dflags h us cmms
 
 		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)
 
 
@@ -231,19 +236,19 @@ cmmNativeGens dflags h us (cmm : cmms) impAcc profAcc count
 	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)
@@ -311,13 +316,14 @@ cmmNativeGen dflags us cmm count
 	   || 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
@@ -385,7 +391,7 @@ cmmNativeGen dflags us cmm count
 	 	map sequenceTop shorted
 
 	---- x86fp_kludge
-	let final_mach_code =
+	let kludged =
 #if i386_TARGET_ARCH
 	 	{-# SCC "x86fp_kludge" #-}
 	 	map x86fp_kludge sequenced
@@ -393,8 +399,22 @@ cmmNativeGen dflags us cmm count
 		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)
@@ -476,9 +496,8 @@ makeImportsDoc dflags imports
 -- fallthroughs.
 
 sequenceTop 
-	:: Instruction instr
-	=> NatCmmTop instr
-	-> NatCmmTop instr
+	:: NatCmmTop Instr
+	-> NatCmmTop Instr
 
 sequenceTop top@(CmmData _ _) = top
 sequenceTop (CmmProc info lbl params (ListGraph blocks)) = 
@@ -552,9 +571,8 @@ reorder id accum (b@(block,id',out) : rest)
 -- 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