X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCgUtils.hs;h=63d99a629fa4c4bec6984d56e006dd96d179e2f0;hp=d22fee1e7581d80b280d127c5e6c8eab893ab45c;hb=c0687066474aa4ce4912f31a5c09c1bcd673fb06;hpb=49a8e5c021009430d373d6224b29004c7d18c408

diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index d22fee1..63d99a6 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -20,16 +20,16 @@ module CgUtils (
         emitRODataLits, mkRODataLits,
         emitIf, emitIfThenElse,
 	emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult,
-	assignTemp, newTemp,
+	assignTemp, assignTemp_, newTemp,
 	emitSimultaneously,
 	emitSwitch, emitLitSwitch,
 	tagToClosure,
 
-        callerSaveVolatileRegs, get_GlobalReg_addr,
+        callerSaves, callerSaveVolatileRegs, get_GlobalReg_addr,
 	activeStgRegs, fixStgRegisters,
 
 	cmmAndWord, cmmOrWord, cmmNegate, cmmEqWord, cmmNeWord,
-        cmmUGtWord,
+        cmmUGtWord, cmmSubWord, cmmMulWord, cmmAddWord, cmmUShrWord,
 	cmmOffsetExprW, cmmOffsetExprB,
 	cmmRegOffW, cmmRegOffB,
 	cmmLabelOffW, cmmLabelOffB,
@@ -61,10 +61,9 @@ import Id
 import IdInfo
 import Constants
 import SMRep
-import PprCmm		( {- instances -} )
-import Cmm
+import OldCmm
+import OldCmmUtils
 import CLabel
-import CmmUtils
 import ForeignCall
 import ClosureInfo
 import StgSyn (SRT(..))
@@ -181,8 +180,10 @@ cmmULtWord e1 e2 = CmmMachOp mo_wordULt [e1, e2]
 cmmUGeWord e1 e2 = CmmMachOp mo_wordUGe [e1, e2]
 cmmUGtWord e1 e2 = CmmMachOp mo_wordUGt [e1, e2]
 --cmmShlWord e1 e2 = CmmMachOp mo_wordShl [e1, e2]
---cmmUShrWord e1 e2 = CmmMachOp mo_wordUShr [e1, e2]
+cmmUShrWord e1 e2 = CmmMachOp mo_wordUShr [e1, e2]
+cmmAddWord e1 e2 = CmmMachOp mo_wordAdd [e1, e2]
 cmmSubWord e1 e2 = CmmMachOp mo_wordSub [e1, e2]
+cmmMulWord e1 e2 = CmmMachOp mo_wordMul [e1, e2]
 
 cmmNegate :: CmmExpr -> CmmExpr
 cmmNegate (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)
@@ -588,6 +589,9 @@ mkByteStringCLit bytes
 --
 -------------------------------------------------------------------------
 
+-- | If the expression is trivial, return it.  Otherwise, assign the
+-- expression to a temporary register and return an expression
+-- referring to this register.
 assignTemp :: CmmExpr -> FCode CmmExpr
 -- For a non-trivial expression, e, create a local
 -- variable and assign the expression to it
@@ -597,6 +601,18 @@ assignTemp e
 			    ; stmtC (CmmAssign (CmmLocal reg) e)
 			    ; return (CmmReg (CmmLocal reg)) }
 
+-- | If the expression is trivial and doesn't refer to a global
+-- register, return it.  Otherwise, assign the expression to a
+-- temporary register and return an expression referring to this
+-- register.
+assignTemp_ :: CmmExpr -> FCode CmmExpr
+assignTemp_ e
+    | isTrivialCmmExpr e && hasNoGlobalRegs e = return e
+    | otherwise = do
+        reg <- newTemp (cmmExprType e)
+        stmtC (CmmAssign (CmmLocal reg) e)
+        return (CmmReg (CmmLocal reg))
+
 newTemp :: CmmType -> FCode LocalReg
 newTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep) }
 
@@ -1081,9 +1097,9 @@ get_Regtable_addr_from_offset rep offset =
 fixStgRegisters :: RawCmmTop -> RawCmmTop
 fixStgRegisters top@(CmmData _ _) = top
 
-fixStgRegisters (CmmProc info lbl params (ListGraph blocks)) =
+fixStgRegisters (CmmProc info lbl (ListGraph blocks)) =
   let blocks' = map fixStgRegBlock blocks
-  in CmmProc info lbl params $ ListGraph blocks'
+  in CmmProc info lbl $ ListGraph blocks'
 
 fixStgRegBlock :: CmmBasicBlock -> CmmBasicBlock
 fixStgRegBlock (BasicBlock id stmts) =