X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FOldCmmUtils.hs;fp=compiler%2Fcmm%2FOldCmmUtils.hs;h=ea9ef8a54a63f224d81ce47c1d768f7b74327036;hb=889c084e943779e76d19f2ef5e970ff655f511eb;hp=0000000000000000000000000000000000000000;hpb=f1a90f54590e5a7a32a9c3ef2950740922b1f425;p=ghc-hetmet.git

diff --git a/compiler/cmm/OldCmmUtils.hs b/compiler/cmm/OldCmmUtils.hs
new file mode 100644
index 0000000..ea9ef8a
--- /dev/null
+++ b/compiler/cmm/OldCmmUtils.hs
@@ -0,0 +1,98 @@
+-----------------------------------------------------------------------------
+--
+-- Old-style Cmm utilities.
+--
+-- (c) The University of Glasgow 2004-2006
+--
+-----------------------------------------------------------------------------
+
+module OldCmmUtils(
+        CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
+        isNopStmt,
+
+        maybeAssignTemp, loadArgsIntoTemps,
+
+        module CmmUtils,
+  ) where
+
+#include "HsVersions.h"
+
+import OldCmm
+import CmmUtils
+import OrdList
+import Unique
+
+---------------------------------------------------
+--
+--      CmmStmts
+--
+---------------------------------------------------
+
+type CmmStmts = OrdList CmmStmt
+
+noStmts :: CmmStmts
+noStmts = nilOL
+
+oneStmt :: CmmStmt -> CmmStmts
+oneStmt = unitOL
+
+mkStmts :: [CmmStmt] -> CmmStmts
+mkStmts = toOL
+
+plusStmts :: CmmStmts -> CmmStmts -> CmmStmts
+plusStmts = appOL
+
+stmtList :: CmmStmts -> [CmmStmt]
+stmtList = fromOL
+
+
+---------------------------------------------------
+--
+--      CmmStmt
+--
+---------------------------------------------------
+
+isNopStmt :: CmmStmt -> Bool
+-- If isNopStmt returns True, the stmt is definitely a no-op;
+-- but it might be a no-op even if isNopStmt returns False
+isNopStmt CmmNop                       = True
+isNopStmt (CmmAssign r e)              = cheapEqReg r e
+isNopStmt (CmmStore e1 (CmmLoad e2 _)) = cheapEqExpr e1 e2
+isNopStmt _                            = False
+
+cheapEqExpr :: CmmExpr -> CmmExpr -> Bool
+cheapEqExpr (CmmReg r)      e                 = cheapEqReg r e
+cheapEqExpr (CmmRegOff r 0) e                 = cheapEqReg r e
+cheapEqExpr (CmmRegOff r n) (CmmRegOff r' n') = r==r' && n==n'
+cheapEqExpr _               _                 = False
+
+cheapEqReg :: CmmReg -> CmmExpr -> Bool
+cheapEqReg r (CmmReg r')      = r==r'
+cheapEqReg r (CmmRegOff r' 0) = r==r'
+cheapEqReg _ _                = False
+
+---------------------------------------------------
+--
+--      Helpers for foreign call arguments
+--
+---------------------------------------------------
+
+loadArgsIntoTemps :: [Unique]
+                  -> HintedCmmActuals
+                  -> ([Unique], [CmmStmt], HintedCmmActuals)
+loadArgsIntoTemps uniques [] = (uniques, [], [])
+loadArgsIntoTemps uniques ((CmmHinted e hint):args) =
+    (uniques'',
+     new_stmts ++ remaining_stmts,
+     (CmmHinted new_e hint) : remaining_e)
+    where
+      (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
+      (uniques'', remaining_stmts, remaining_e) =
+          loadArgsIntoTemps uniques' args
+
+
+maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
+maybeAssignTemp uniques e
+    | hasNoGlobalRegs e = (uniques, [], e)
+    | otherwise         = (tail uniques, [CmmAssign local e], CmmReg local)
+    where local = CmmLocal (LocalReg (head uniques) (cmmExprType e))