X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FnativeGen%2FRegSpill.hs;h=9987522004c869233bfd8ade90008fb94ee4d141;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hp=5d0396ba89df42e4c2212582eff80de81380c9c8;hpb=475940d68ab79a5f352ccaca485baa17a2df0765;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegSpill.hs b/compiler/nativeGen/RegSpill.hs
index 5d0396b..9987522 100644
--- a/compiler/nativeGen/RegSpill.hs
+++ b/compiler/nativeGen/RegSpill.hs
@@ -1,8 +1,15 @@
 
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- for details
+
 module RegSpill (
 	regSpill,
 	SpillStats(..),
-	accSpillLS
+	accSpillSL
 )
 
 where
@@ -75,16 +82,9 @@ regSpill_block regSlotMap (BasicBlock i instrs)
  = do	instrss'	<- mapM (regSpill_instr regSlotMap) instrs
  	return	$ BasicBlock i (concat instrss')
 
-
-regSpill_instr _ 	li@(Instr (DELTA delta) _)
- = do
- 	setDelta delta
-	return [li]
-
 regSpill_instr _	li@(Instr _ Nothing)
  = do	return [li]
 
-
 regSpill_instr regSlotMap
 	(Instr instr (Just live))
  = do
@@ -135,49 +135,40 @@ regSpill_instr regSlotMap
 
 spillRead regSlotMap instr reg
 	| Just slot	<- lookupUFM regSlotMap reg
-	= do	delta		<- getDelta
-	 	(instr', nReg)	<- patchInstr reg instr
-
-		let pre	 	= [ COMMENT FSLIT("spill load")
-				  , mkLoadInstr nReg delta slot ]
+	= do 	(instr', nReg)	<- patchInstr reg instr
 
 		modify $ \s -> s
-			{ stateSpillLS 	= addToUFM_C accSpillLS (stateSpillLS s) reg (reg, 1, 0) }
+			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
 
-	 	return	( instr', (pre, []))
+	 	return	( instr'
+			, ( [RELOAD slot nReg]
+			  , []) )
 
 	| otherwise	= panic "RegSpill.spillRead: no slot defined for spilled reg"
 
 spillWrite regSlotMap instr reg
 	| Just slot	<- lookupUFM regSlotMap reg
-	= do	delta		<- getDelta
-	 	(instr', nReg)	<- patchInstr reg instr
-
-		let post	= [ COMMENT FSLIT("spill store")
-				  , mkSpillInstr nReg delta slot ]
+	= do 	(instr', nReg)	<- patchInstr reg instr
 
 		modify $ \s -> s
-			{ stateSpillLS 	= addToUFM_C accSpillLS (stateSpillLS s) reg (reg, 0, 1) }
+			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
 
-	 	return	( instr', ([], post))
+	 	return	( instr'
+			, ( []
+			  , [SPILL nReg slot]))
 
 	| otherwise	= panic "RegSpill.spillWrite: no slot defined for spilled reg"
 
 spillModify regSlotMap instr reg
 	| Just slot	<- lookupUFM regSlotMap reg
-	= do	delta		<- getDelta
-		(instr', nReg)	<- patchInstr reg instr
-
-		let pre		= [ COMMENT FSLIT("spill mod load")
-				  , mkLoadInstr  nReg delta slot ]
-
-		let post	= [ COMMENT FSLIT("spill mod store")
-				  , mkSpillInstr nReg delta slot ]
+	= do	(instr', nReg)	<- patchInstr reg instr
 
 		modify $ \s -> s
-			{ stateSpillLS 	= addToUFM_C accSpillLS (stateSpillLS s) reg (reg, 1, 1) }
+			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
 
-		return	( instr', (pre, post))
+		return	( instr'
+			, ( [RELOAD slot nReg]
+			  , [SPILL nReg slot]))
 
 	| otherwise	= panic "RegSpill.spillModify: no slot defined for spilled reg"
 
@@ -204,25 +195,16 @@ patchReg1 old new instr
 
 data SpillS
 	= SpillS
-	{ stateDelta	:: Int
-	, stateUS	:: UniqSupply
-	, stateSpillLS	:: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored
+	{ stateUS	:: UniqSupply
+	, stateSpillSL	:: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored
 
 initSpillS uniqueSupply
 	= SpillS
-	{ stateDelta	= 0
-	, stateUS	= uniqueSupply
-	, stateSpillLS	= emptyUFM }
+	{ stateUS	= uniqueSupply
+	, stateSpillSL	= emptyUFM }
 
 type SpillM a	= State SpillS a
 
-setDelta :: Int -> SpillM ()
-setDelta delta
-	= modify $ \s -> s { stateDelta = delta }
-
-getDelta  :: SpillM Int
-getDelta = gets stateDelta
-
 newUnique :: SpillM Unique
 newUnique
  = do	us	<- gets stateUS
@@ -232,9 +214,8 @@ newUnique
 	  	modify $ \s -> s { stateUS = us2 }
 		return uniq
 
-accSpillLS (r1, l1, s1) (r2, l2, s2)
-	= (r1, l1 + l2, s1 + s2)
-
+accSpillSL (r1, s1, l1) (r2, s2, l2)
+	= (r1, s1 + s2, l1 + l2)
 
 
 ----------------------------------------------------
@@ -242,15 +223,15 @@ accSpillLS (r1, l1, s1) (r2, l2, s2)
 
 data SpillStats
 	= SpillStats
-	{ spillLoadStore	:: UniqFM (Reg, Int, Int) }
+	{ spillStoreLoad	:: UniqFM (Reg, Int, Int) }
 
 makeSpillStats :: SpillS -> SpillStats
 makeSpillStats s
 	= SpillStats
-	{ spillLoadStore	= stateSpillLS s }
+	{ spillStoreLoad	= stateSpillSL s }
 
 instance Outputable SpillStats where
- ppr s
- 	= (vcat $ map (\(r, l, s) -> ppr r <+> int l <+> int s)
-			$ eltsUFM (spillLoadStore s))
+ ppr stats
+ 	= (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
+			$ eltsUFM (spillStoreLoad stats))