Merge in new code generator branch.

[ghc-hetmet.git] / compiler / cmm / OldCmmUtils.hs

diff --git a/compiler/cmm/OldCmmUtils.hs b/compiler/cmm/OldCmmUtils.hs
new file mode 100644 (file)
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))