X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FAsmCodeGen.lhs;h=507d96b0cb3082c922fda9d5900917a68ed5e39b;hb=b01110d1352de5d972d8fb63f28c244d2c1ff99b;hp=0966404da98036ba7d857db6f0fc5880e9c73a4e;hpb=16a2f6a8a381af31c23b6a41a851951da9bc1803;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 0966404..507d96b 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -196,9 +196,9 @@ cmmNativeGens dflags h us (cmm : cmms) impAcc profAcc
 			then native
 			else []
 
-	-- force evaulation of imports and lsPprNative to avoid space leak
+	-- force evaulation all this stuff to avoid space leaks
 	seqString (showSDoc $ vcat $ map ppr imports) `seq` return ()
-	lsPprNative `seq` return ()
+	lsPprNative 	`seq` return ()
 
 	cmmNativeGens dflags h us' cmms
 			(imports : impAcc)
@@ -214,15 +214,16 @@ cmmNativeGens dflags h us (cmm : cmms) impAcc profAcc
 cmmNativeGen 
 	:: DynFlags
 	-> UniqSupply
-	-> RawCmmTop
+	-> RawCmmTop				-- ^ the cmm to generate code for
 	-> IO	( UniqSupply
-		, [NatCmmTop]
-		, [CLabel]
-		, Maybe [Color.RegAllocStats]
-		, Maybe [Linear.RegAllocStats])
+		, [NatCmmTop]			-- native code
+		, [CLabel]			-- things imported by this cmm
+		, Maybe [Color.RegAllocStats]	-- stats for the coloring register allocator
+		, Maybe [Linear.RegAllocStats])	-- stats for the linear register allocators
 
 cmmNativeGen dflags us cmm
  = do
+
 	-- rewrite assignments to global regs
  	let (fixed_cmm, usFix)	=
 		{-# SCC "fixAssignsTop" #-}
@@ -259,7 +260,8 @@ cmmNativeGen dflags us cmm
 		
 	-- allocate registers
 	(alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear) <-
-	 if dopt Opt_RegsGraph dflags
+	 if ( dopt Opt_RegsGraph dflags
+	   || dopt Opt_RegsIterative dflags)
 	  then do
 	  	-- the regs usable for allocation
 		let alloc_regs
@@ -268,20 +270,12 @@ cmmNativeGen dflags us cmm
 				emptyUFM
 			$ map RealReg allocatableRegs
 
-	 	-- if any of these dump flags are turned on we want to hang on to
-		--	intermediate structures in the allocator - otherwise tell the
-		--	allocator to ditch them early so we don't end up creating space leaks.
-		let generateRegAllocStats = or
-			[ dopt Opt_D_dump_asm_regalloc_stages dflags
-			, dopt Opt_D_dump_asm_stats dflags
-			, dopt Opt_D_dump_asm_conflicts dflags ]
-
 		-- graph coloring register allocation
 		let ((alloced, regAllocStats), usAlloc)
 			= {-# SCC "RegAlloc" #-}
 			  initUs usLive
 			  $ Color.regAlloc
-				generateRegAllocStats
+				dflags
 				alloc_regs
 				(mkUniqSet [0..maxSpillSlots])
 				withLiveness
@@ -294,7 +288,7 @@ cmmNativeGen dflags us cmm
 		dumpIfSet_dyn dflags
 			Opt_D_dump_asm_regalloc_stages "Build/spill stages"
 			(vcat 	$ map (\(stage, stats)
-					-> text "-- Stage " <> int stage
+					-> text " Stage " <> int stage
 					$$ ppr stats)
 				$ zip [0..] regAllocStats)