1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
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))
|
