compiler/cmm/OldCmmUtils.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Old-style Cmm utilities.
   4 --
   5 -- (c) The University of Glasgow 2004-2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module OldCmmUtils(
  10         CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
  11         isNopStmt,
  12
  13         maybeAssignTemp, loadArgsIntoTemps,
  14
  15         module CmmUtils,
  16   ) where
  17
  18 #include "HsVersions.h"
  19
  20 import OldCmm
  21 import CmmUtils
  22 import OrdList
  23 import Unique
  24
  25 ---------------------------------------------------
  26 --
  27 --      CmmStmts
  28 --
  29 ---------------------------------------------------
  30
  31 type CmmStmts = OrdList CmmStmt
  32
  33 noStmts :: CmmStmts
  34 noStmts = nilOL
  35
  36 oneStmt :: CmmStmt -> CmmStmts
  37 oneStmt = unitOL
  38
  39 mkStmts :: [CmmStmt] -> CmmStmts
  40 mkStmts = toOL
  41
  42 plusStmts :: CmmStmts -> CmmStmts -> CmmStmts
  43 plusStmts = appOL
  44
  45 stmtList :: CmmStmts -> [CmmStmt]
  46 stmtList = fromOL
  47
  48
  49 ---------------------------------------------------
  50 --
  51 --      CmmStmt
  52 --
  53 ---------------------------------------------------
  54
  55 isNopStmt :: CmmStmt -> Bool
  56 -- If isNopStmt returns True, the stmt is definitely a no-op;
  57 -- but it might be a no-op even if isNopStmt returns False
  58 isNopStmt CmmNop                       = True
  59 isNopStmt (CmmAssign r e)              = cheapEqReg r e
  60 isNopStmt (CmmStore e1 (CmmLoad e2 _)) = cheapEqExpr e1 e2
  61 isNopStmt _                            = False
  62
  63 cheapEqExpr :: CmmExpr -> CmmExpr -> Bool
  64 cheapEqExpr (CmmReg r)      e                 = cheapEqReg r e
  65 cheapEqExpr (CmmRegOff r 0) e                 = cheapEqReg r e
  66 cheapEqExpr (CmmRegOff r n) (CmmRegOff r' n') = r==r' && n==n'
  67 cheapEqExpr _               _                 = False
  68
  69 cheapEqReg :: CmmReg -> CmmExpr -> Bool
  70 cheapEqReg r (CmmReg r')      = r==r'
  71 cheapEqReg r (CmmRegOff r' 0) = r==r'
  72 cheapEqReg _ _                = False
  73
  74 ---------------------------------------------------
  75 --
  76 --      Helpers for foreign call arguments
  77 --
  78 ---------------------------------------------------
  79
  80 loadArgsIntoTemps :: [Unique]
  81                   -> [HintedCmmActual]
  82                   -> ([Unique], [CmmStmt], [HintedCmmActual])
  83 loadArgsIntoTemps uniques [] = (uniques, [], [])
  84 loadArgsIntoTemps uniques ((CmmHinted e hint):args) =
  85     (uniques'',
  86      new_stmts ++ remaining_stmts,
  87      (CmmHinted new_e hint) : remaining_e)
  88     where
  89       (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
  90       (uniques'', remaining_stmts, remaining_e) =
  91           loadArgsIntoTemps uniques' args
  92
  93
  94 maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
  95 maybeAssignTemp uniques e
  96     | hasNoGlobalRegs e = (uniques, [], e)
  97     | otherwise         = (tail uniques, [CmmAssign local e], CmmReg local)
  98     where local = CmmLocal (LocalReg (head uniques) (cmmExprType e))