PageRenderTime 59ms CodeModel.GetById 26ms RepoModel.GetById 0ms app.codeStats 1ms

/compiler/cmm/CmmSink.hs

https://github.com/crdueck/ghc
Haskell | 592 lines | 245 code | 86 blank | 261 comment | 15 complexity | d0d4248376b4889870fb86c75332512e MD5 | raw file
  1. {-# LANGUAGE GADTs #-}
  2. module CmmSink (
  3. cmmSink
  4. ) where
  5. import CodeGen.Platform (callerSaves)
  6. import Cmm
  7. import CmmOpt
  8. import BlockId
  9. import CmmLive
  10. import CmmUtils
  11. import Hoopl
  12. import DynFlags
  13. import UniqFM
  14. import PprCmm ()
  15. import Data.List (partition)
  16. import qualified Data.Set as Set
  17. -- -----------------------------------------------------------------------------
  18. -- Sinking and inlining
  19. -- This is an optimisation pass that
  20. -- (a) moves assignments closer to their uses, to reduce register pressure
  21. -- (b) pushes assignments into a single branch of a conditional if possible
  22. -- (c) inlines assignments to registers that are mentioned only once
  23. -- (d) discards dead assignments
  24. --
  25. -- This tightens up lots of register-heavy code. It is particularly
  26. -- helpful in the Cmm generated by the Stg->Cmm code generator, in
  27. -- which every function starts with a copyIn sequence like:
  28. --
  29. -- x1 = R1
  30. -- x2 = Sp[8]
  31. -- x3 = Sp[16]
  32. -- if (Sp - 32 < SpLim) then L1 else L2
  33. --
  34. -- we really want to push the x1..x3 assignments into the L2 branch.
  35. --
  36. -- Algorithm:
  37. --
  38. -- * Start by doing liveness analysis.
  39. --
  40. -- * Keep a list of assignments A; earlier ones may refer to later ones
  41. --
  42. -- * Walk forwards through the graph, look at each node N:
  43. -- * If any assignments in A (1) occur only once in N, and (2) are
  44. -- not live after N, inline the assignment and remove it
  45. -- from A.
  46. -- * If N is an assignment:
  47. -- * If the register is not live after N, discard it
  48. -- * otherwise pick up the assignment and add it to A
  49. -- * If N is a non-assignment node:
  50. -- * remove any assignments from A that conflict with N, and
  51. -- place them before N in the current block. (we call this
  52. -- "dropping" the assignments).
  53. -- * An assignment conflicts with N if it:
  54. -- - assigns to a register mentioned in N
  55. -- - mentions a register assigned by N
  56. -- - reads from memory written by N
  57. -- * do this recursively, dropping dependent assignments
  58. -- * At a multi-way branch:
  59. -- * drop any assignments that are live on more than one branch
  60. -- * if any successor has more than one predecessor (a
  61. -- join-point), drop everything live in that successor
  62. --
  63. -- As a side-effect we'll delete some dead assignments (transitively,
  64. -- even). This isn't as good as removeDeadAssignments, but it's much
  65. -- cheaper.
  66. -- If we do this *before* stack layout, we might be able to avoid
  67. -- saving some things across calls/procpoints.
  68. --
  69. -- *but*, that will invalidate the liveness analysis, and we'll have
  70. -- to re-do it.
  71. -- -----------------------------------------------------------------------------
  72. -- things that we aren't optimising very well yet.
  73. --
  74. -- -----------
  75. -- (1) From GHC's FastString.hashStr:
  76. --
  77. -- s2ay:
  78. -- if ((_s2an::I64 == _s2ao::I64) >= 1) goto c2gn; else goto c2gp;
  79. -- c2gn:
  80. -- R1 = _s2au::I64;
  81. -- call (I64[Sp])(R1) args: 8, res: 0, upd: 8;
  82. -- c2gp:
  83. -- _s2cO::I64 = %MO_S_Rem_W64(%MO_UU_Conv_W8_W64(I8[_s2aq::I64 + (_s2an::I64 << 0)]) + _s2au::I64 * 128,
  84. -- 4091);
  85. -- _s2an::I64 = _s2an::I64 + 1;
  86. -- _s2au::I64 = _s2cO::I64;
  87. -- goto s2ay;
  88. --
  89. -- a nice loop, but we didn't eliminate the silly assignment at the end.
  90. -- See Note [dependent assignments], which would probably fix this.
  91. --
  92. -- -----------
  93. -- (2) From stg_atomically_frame in PrimOps.cmm
  94. --
  95. -- We have a diamond control flow:
  96. --
  97. -- x = ...
  98. -- |
  99. -- / \
  100. -- A B
  101. -- \ /
  102. -- |
  103. -- use of x
  104. --
  105. -- Now x won't be sunk down to its use, because we won't push it into
  106. -- both branches of the conditional. We certainly do have to check
  107. -- that we can sink it past all the code in both A and B, but having
  108. -- discovered that, we could sink it to its use.
  109. --
  110. -- -----------------------------------------------------------------------------
  111. type Assignment = (LocalReg, CmmExpr, AbsMem)
  112. -- Assignment caches AbsMem, an abstraction of the memory read by
  113. -- the RHS of the assignment.
  114. cmmSink :: DynFlags -> CmmGraph -> CmmGraph
  115. cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
  116. where
  117. liveness = cmmLocalLiveness dflags graph
  118. getLive l = mapFindWithDefault Set.empty l liveness
  119. blocks = postorderDfs graph
  120. join_pts = findJoinPoints blocks
  121. sink :: BlockEnv [Assignment] -> [CmmBlock] -> [CmmBlock]
  122. sink _ [] = []
  123. sink sunk (b:bs) =
  124. -- pprTrace "sink" (ppr lbl) $
  125. blockJoin first final_middle final_last : sink sunk' bs
  126. where
  127. lbl = entryLabel b
  128. (first, middle, last) = blockSplit b
  129. succs = successors last
  130. -- Annotate the middle nodes with the registers live *after*
  131. -- the node. This will help us decide whether we can inline
  132. -- an assignment in the current node or not.
  133. live = Set.unions (map getLive succs)
  134. live_middle = gen_kill dflags last live
  135. ann_middles = annotate dflags live_middle (blockToList middle)
  136. -- Now sink and inline in this block
  137. (middle', assigs) = walk dflags ann_middles (mapFindWithDefault [] lbl sunk)
  138. fold_last = constantFold dflags last
  139. (final_last, assigs') = tryToInline dflags live fold_last assigs
  140. -- We cannot sink into join points (successors with more than
  141. -- one predecessor), so identify the join points and the set
  142. -- of registers live in them.
  143. (joins, nonjoins) = partition (`mapMember` join_pts) succs
  144. live_in_joins = Set.unions (map getLive joins)
  145. -- We do not want to sink an assignment into multiple branches,
  146. -- so identify the set of registers live in multiple successors.
  147. -- This is made more complicated because when we sink an assignment
  148. -- into one branch, this might change the set of registers that are
  149. -- now live in multiple branches.
  150. init_live_sets = map getLive nonjoins
  151. live_in_multi live_sets r =
  152. case filter (Set.member r) live_sets of
  153. (_one:_two:_) -> True
  154. _ -> False
  155. -- Now, drop any assignments that we will not sink any further.
  156. (dropped_last, assigs'') = dropAssignments dflags drop_if init_live_sets assigs'
  157. drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets')
  158. where
  159. should_drop = conflicts dflags a final_last
  160. || not (isTrivial rhs) && live_in_multi live_sets r
  161. || r `Set.member` live_in_joins
  162. live_sets' | should_drop = live_sets
  163. | otherwise = map upd live_sets
  164. upd set | r `Set.member` set = set `Set.union` live_rhs
  165. | otherwise = set
  166. live_rhs = foldRegsUsed dflags extendRegSet emptyRegSet rhs
  167. final_middle = foldl blockSnoc middle' dropped_last
  168. sunk' = mapUnion sunk $
  169. mapFromList [ (l, filterAssignments dflags (getLive l) assigs'')
  170. | l <- succs ]
  171. {- TODO: enable this later, when we have some good tests in place to
  172. measure the effect and tune it.
  173. -- small: an expression we don't mind duplicating
  174. isSmall :: CmmExpr -> Bool
  175. isSmall (CmmReg (CmmLocal _)) = True -- not globals, we want to coalesce them instead
  176. isSmall (CmmLit _) = True
  177. isSmall (CmmMachOp (MO_Add _) [x,y]) = isTrivial x && isTrivial y
  178. isSmall (CmmRegOff (CmmLocal _) _) = True
  179. isSmall _ = False
  180. -}
  181. isTrivial :: CmmExpr -> Bool
  182. isTrivial (CmmReg (CmmLocal _)) = True
  183. -- isTrivial (CmmLit _) = True
  184. isTrivial _ = False
  185. --
  186. -- annotate each node with the set of registers live *after* the node
  187. --
  188. annotate :: DynFlags -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)]
  189. annotate dflags live nodes = snd $ foldr ann (live,[]) nodes
  190. where ann n (live,nodes) = (gen_kill dflags n live, (live,n) : nodes)
  191. --
  192. -- Find the blocks that have multiple successors (join points)
  193. --
  194. findJoinPoints :: [CmmBlock] -> BlockEnv Int
  195. findJoinPoints blocks = mapFilter (>1) succ_counts
  196. where
  197. all_succs = concatMap successors blocks
  198. succ_counts :: BlockEnv Int
  199. succ_counts = foldr (\l -> mapInsertWith (+) l 1) mapEmpty all_succs
  200. --
  201. -- filter the list of assignments to remove any assignments that
  202. -- are not live in a continuation.
  203. --
  204. filterAssignments :: DynFlags -> LocalRegSet -> [Assignment] -> [Assignment]
  205. filterAssignments dflags live assigs = reverse (go assigs [])
  206. where go [] kept = kept
  207. go (a@(r,_,_):as) kept | needed = go as (a:kept)
  208. | otherwise = go as kept
  209. where
  210. needed = r `Set.member` live
  211. || any (conflicts dflags a) (map toNode kept)
  212. -- Note that we must keep assignments that are
  213. -- referred to by other assignments we have
  214. -- already kept.
  215. -- -----------------------------------------------------------------------------
  216. -- Walk through the nodes of a block, sinking and inlining assignments
  217. -- as we go.
  218. walk :: DynFlags
  219. -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with
  220. -- the set of registers live *after*
  221. -- this node.
  222. -> [Assignment] -- The current list of
  223. -- assignments we are sinking.
  224. -- Later assignments may refer
  225. -- to earlier ones.
  226. -> ( Block CmmNode O O -- The new block
  227. , [Assignment] -- Assignments to sink further
  228. )
  229. walk dflags nodes assigs = go nodes emptyBlock assigs
  230. where
  231. go [] block as = (block, as)
  232. go ((live,node):ns) block as
  233. | shouldDiscard node live = go ns block as
  234. | Just a <- shouldSink dflags node2 = go ns block (a : as1)
  235. | otherwise = go ns block' as'
  236. where
  237. node1 = constantFold dflags node
  238. (node2, as1) = tryToInline dflags live node1 as
  239. (dropped, as') = dropAssignmentsSimple dflags
  240. (\a -> conflicts dflags a node2) as1
  241. block' = foldl blockSnoc block dropped `blockSnoc` node2
  242. constantFold :: DynFlags -> CmmNode e x -> CmmNode e x
  243. constantFold dflags node = mapExpDeep f node
  244. where f (CmmMachOp op args) = cmmMachOpFold dflags op args
  245. f (CmmRegOff r 0) = CmmReg r
  246. f e = e
  247. --
  248. -- Heuristic to decide whether to pick up and sink an assignment
  249. -- Currently we pick up all assignments to local registers. It might
  250. -- be profitable to sink assignments to global regs too, but the
  251. -- liveness analysis doesn't track those (yet) so we can't.
  252. --
  253. shouldSink :: DynFlags -> CmmNode e x -> Maybe Assignment
  254. shouldSink dflags (CmmAssign (CmmLocal r) e) | no_local_regs = Just (r, e, exprMem dflags e)
  255. where no_local_regs = True -- foldRegsUsed (\_ _ -> False) True e
  256. shouldSink _ _other = Nothing
  257. --
  258. -- discard dead assignments. This doesn't do as good a job as
  259. -- removeDeadAsssignments, because it would need multiple passes
  260. -- to get all the dead code, but it catches the common case of
  261. -- superfluous reloads from the stack that the stack allocator
  262. -- leaves behind.
  263. --
  264. -- Also we catch "r = r" here. You might think it would fall
  265. -- out of inlining, but the inliner will see that r is live
  266. -- after the instruction and choose not to inline r in the rhs.
  267. --
  268. shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool
  269. shouldDiscard node live
  270. = case node of
  271. CmmAssign r (CmmReg r') | r == r' -> True
  272. CmmAssign (CmmLocal r) _ -> not (r `Set.member` live)
  273. _otherwise -> False
  274. toNode :: Assignment -> CmmNode O O
  275. toNode (r,rhs,_) = CmmAssign (CmmLocal r) rhs
  276. dropAssignmentsSimple :: DynFlags -> (Assignment -> Bool) -> [Assignment]
  277. -> ([CmmNode O O], [Assignment])
  278. dropAssignmentsSimple dflags f = dropAssignments dflags (\a _ -> (f a, ())) ()
  279. dropAssignments :: DynFlags -> (Assignment -> s -> (Bool, s)) -> s -> [Assignment]
  280. -> ([CmmNode O O], [Assignment])
  281. dropAssignments dflags should_drop state assigs
  282. = (dropped, reverse kept)
  283. where
  284. (dropped,kept) = go state assigs [] []
  285. go _ [] dropped kept = (dropped, kept)
  286. go state (assig : rest) dropped kept
  287. | conflict = go state' rest (toNode assig : dropped) kept
  288. | otherwise = go state' rest dropped (assig:kept)
  289. where
  290. (dropit, state') = should_drop assig state
  291. conflict = dropit || any (conflicts dflags assig) dropped
  292. -- -----------------------------------------------------------------------------
  293. -- Try to inline assignments into a node.
  294. tryToInline
  295. :: DynFlags
  296. -> LocalRegSet -- set of registers live after this
  297. -- node. We cannot inline anything
  298. -- that is live after the node, unless
  299. -- it is small enough to duplicate.
  300. -> CmmNode O x -- The node to inline into
  301. -> [Assignment] -- Assignments to inline
  302. -> (
  303. CmmNode O x -- New node
  304. , [Assignment] -- Remaining assignments
  305. )
  306. tryToInline dflags live node assigs = go usages node [] assigs
  307. where
  308. usages :: UniqFM Int
  309. usages = foldRegsUsed dflags addUsage emptyUFM node
  310. go _usages node _skipped [] = (node, [])
  311. go usages node skipped (a@(l,rhs,_) : rest)
  312. | cannot_inline = dont_inline
  313. | occurs_once = inline_and_discard
  314. | isTrivial rhs = inline_and_keep
  315. | otherwise = dont_inline
  316. where
  317. inline_and_discard = go usages' inl_node skipped rest
  318. where usages' = foldRegsUsed dflags addUsage usages rhs
  319. dont_inline = keep node -- don't inline the assignment, keep it
  320. inline_and_keep = keep inl_node -- inline the assignment, keep it
  321. keep node' = (final_node, a : rest')
  322. where (final_node, rest') = go usages' node' (l:skipped) rest
  323. usages' = foldLocalRegsUsed dflags (\m r -> addToUFM m r 2) usages rhs
  324. -- we must not inline anything that is mentioned in the RHS
  325. -- of a binding that we have already skipped, so we set the
  326. -- usages of the regs on the RHS to 2.
  327. cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments]
  328. || l `elem` skipped
  329. || not (okToInline dflags rhs node)
  330. occurs_once = not (l `elemRegSet` live)
  331. && lookupUFM usages l == Just 1
  332. inl_node = mapExpDeep inline node -- mapExpDeep is where the inlining actually takes place!
  333. where inline (CmmReg (CmmLocal l')) | l == l' = rhs
  334. inline (CmmRegOff (CmmLocal l') off) | l == l'
  335. = cmmOffset dflags rhs off
  336. -- re-constant fold after inlining
  337. inline (CmmMachOp op args) = cmmMachOpFold dflags op args
  338. inline other = other
  339. -- Note [dependent assignments]
  340. --
  341. -- If our assignment list looks like
  342. --
  343. -- [ y = e, x = ... y ... ]
  344. --
  345. -- We cannot inline x. Remember this list is really in reverse order,
  346. -- so it means x = ... y ...; y = e
  347. --
  348. -- Hence if we inline x, the outer assignment to y will capture the
  349. -- reference in x's right hand side.
  350. --
  351. -- In this case we should rename the y in x's right-hand side,
  352. -- i.e. change the list to [ y = e, x = ... y1 ..., y1 = y ]
  353. -- Now we can go ahead and inline x.
  354. --
  355. -- For now we do nothing, because this would require putting
  356. -- everything inside UniqSM.
  357. --
  358. -- One more variant of this (#7366):
  359. --
  360. -- [ y = e, y = z ]
  361. --
  362. -- If we don't want to inline y = e, because y is used many times, we
  363. -- might still be tempted to inline y = z (because we always inline
  364. -- trivial rhs's). But of course we can't, because y is equal to e,
  365. -- not z.
  366. addUsage :: UniqFM Int -> LocalReg -> UniqFM Int
  367. addUsage m r = addToUFM_C (+) m r 1
  368. regsUsedIn :: [LocalReg] -> CmmExpr -> Bool
  369. regsUsedIn [] _ = False
  370. regsUsedIn ls e = wrapRecExpf f e False
  371. where f (CmmReg (CmmLocal l)) _ | l `elem` ls = True
  372. f (CmmRegOff (CmmLocal l) _) _ | l `elem` ls = True
  373. f _ z = z
  374. -- we don't inline into CmmUnsafeForeignCall if the expression refers
  375. -- to global registers. This is a HACK to avoid global registers
  376. -- clashing with C argument-passing registers, really the back-end
  377. -- ought to be able to handle it properly, but currently neither PprC
  378. -- nor the NCG can do it. See Note [Register parameter passing]
  379. -- See also StgCmmForeign:load_args_into_temps.
  380. okToInline :: DynFlags -> CmmExpr -> CmmNode e x -> Bool
  381. okToInline dflags expr CmmUnsafeForeignCall{} = not (anyCallerSavesRegs dflags expr)
  382. okToInline _ _ _ = True
  383. -- -----------------------------------------------------------------------------
  384. -- | @conflicts (r,e) stmt@ is @False@ if and only if the assignment
  385. -- @r = e@ can be safely commuted past @stmt@.
  386. --
  387. -- We only sink "r = G" assignments right now, so conflicts is very simple:
  388. --
  389. conflicts :: DynFlags -> Assignment -> CmmNode O x -> Bool
  390. conflicts dflags (r, rhs, addr) node
  391. -- (1) an assignment to a register conflicts with a use of the register
  392. | CmmAssign reg _ <- node, reg `regUsedIn` rhs = True
  393. | foldRegsUsed dflags (\b r' -> r == r' || b) False node = True
  394. -- (2) a store to an address conflicts with a read of the same memory
  395. | CmmStore addr' e <- node
  396. , memConflicts addr (loadAddr dflags addr' (cmmExprWidth dflags e)) = True
  397. -- (3) an assignment to Hp/Sp conflicts with a heap/stack read respectively
  398. | HeapMem <- addr, CmmAssign (CmmGlobal Hp) _ <- node = True
  399. | StackMem <- addr, CmmAssign (CmmGlobal Sp) _ <- node = True
  400. | SpMem{} <- addr, CmmAssign (CmmGlobal Sp) _ <- node = True
  401. -- (4) assignments that read caller-saves GlobalRegs conflict with a
  402. -- foreign call. See Note [foreign calls clobber GlobalRegs].
  403. | CmmUnsafeForeignCall{} <- node, anyCallerSavesRegs dflags rhs = True
  404. -- (5) foreign calls clobber heap: see Note [foreign calls clobber heap]
  405. | CmmUnsafeForeignCall{} <- node, memConflicts addr AnyMem = True
  406. -- (6) native calls clobber any memory
  407. | CmmCall{} <- node, memConflicts addr AnyMem = True
  408. -- (7) otherwise, no conflict
  409. | otherwise = False
  410. anyCallerSavesRegs :: DynFlags -> CmmExpr -> Bool
  411. anyCallerSavesRegs dflags e = wrapRecExpf f e False
  412. where f (CmmReg (CmmGlobal r)) _
  413. | callerSaves (targetPlatform dflags) r = True
  414. f _ z = z
  415. -- An abstraction of memory read or written.
  416. data AbsMem
  417. = NoMem -- no memory accessed
  418. | AnyMem -- arbitrary memory
  419. | HeapMem -- definitely heap memory
  420. | StackMem -- definitely stack memory
  421. | SpMem -- <size>[Sp+n]
  422. {-# UNPACK #-} !Int
  423. {-# UNPACK #-} !Int
  424. -- Having SpMem is important because it lets us float loads from Sp
  425. -- past stores to Sp as long as they don't overlap, and this helps to
  426. -- unravel some long sequences of
  427. -- x1 = [Sp + 8]
  428. -- x2 = [Sp + 16]
  429. -- ...
  430. -- [Sp + 8] = xi
  431. -- [Sp + 16] = xj
  432. --
  433. -- Note that SpMem is invalidated if Sp is changed, but the definition
  434. -- of 'conflicts' above handles that.
  435. -- ToDo: this won't currently fix the following commonly occurring code:
  436. -- x1 = [R1 + 8]
  437. -- x2 = [R1 + 16]
  438. -- ..
  439. -- [Hp - 8] = x1
  440. -- [Hp - 16] = x2
  441. -- ..
  442. -- because [R1 + 8] and [Hp - 8] are both HeapMem. We know that
  443. -- assignments to [Hp + n] do not conflict with any other heap memory,
  444. -- but this is tricky to nail down. What if we had
  445. --
  446. -- x = Hp + n
  447. -- [x] = ...
  448. --
  449. -- the store to [x] should be "new heap", not "old heap".
  450. -- Furthermore, you could imagine that if we started inlining
  451. -- functions in Cmm then there might well be reads of heap memory
  452. -- that was written in the same basic block. To take advantage of
  453. -- non-aliasing of heap memory we will have to be more clever.
  454. -- Note [foreign calls clobber]
  455. --
  456. -- It is tempting to say that foreign calls clobber only
  457. -- non-heap/stack memory, but unfortunately we break this invariant in
  458. -- the RTS. For example, in stg_catch_retry_frame we call
  459. -- stmCommitNestedTransaction() which modifies the contents of the
  460. -- TRec it is passed (this actually caused incorrect code to be
  461. -- generated).
  462. --
  463. -- Since the invariant is true for the majority of foreign calls,
  464. -- perhaps we ought to have a special annotation for calls that can
  465. -- modify heap/stack memory. For now we just use the conservative
  466. -- definition here.
  467. bothMems :: AbsMem -> AbsMem -> AbsMem
  468. bothMems NoMem x = x
  469. bothMems x NoMem = x
  470. bothMems HeapMem HeapMem = HeapMem
  471. bothMems StackMem StackMem = StackMem
  472. bothMems (SpMem o1 w1) (SpMem o2 w2)
  473. | o1 == o2 = SpMem o1 (max w1 w2)
  474. | otherwise = StackMem
  475. bothMems SpMem{} StackMem = StackMem
  476. bothMems StackMem SpMem{} = StackMem
  477. bothMems _ _ = AnyMem
  478. memConflicts :: AbsMem -> AbsMem -> Bool
  479. memConflicts NoMem _ = False
  480. memConflicts _ NoMem = False
  481. memConflicts HeapMem StackMem = False
  482. memConflicts StackMem HeapMem = False
  483. memConflicts SpMem{} HeapMem = False
  484. memConflicts HeapMem SpMem{} = False
  485. memConflicts (SpMem o1 w1) (SpMem o2 w2)
  486. | o1 < o2 = o1 + w1 > o2
  487. | otherwise = o2 + w2 > o1
  488. memConflicts _ _ = True
  489. exprMem :: DynFlags -> CmmExpr -> AbsMem
  490. exprMem dflags (CmmLoad addr w) = bothMems (loadAddr dflags addr (typeWidth w)) (exprMem dflags addr)
  491. exprMem dflags (CmmMachOp _ es) = foldr bothMems NoMem (map (exprMem dflags) es)
  492. exprMem _ _ = NoMem
  493. loadAddr :: DynFlags -> CmmExpr -> Width -> AbsMem
  494. loadAddr dflags e w =
  495. case e of
  496. CmmReg r -> regAddr dflags r 0 w
  497. CmmRegOff r i -> regAddr dflags r i w
  498. _other | CmmGlobal Sp `regUsedIn` e -> StackMem
  499. | otherwise -> AnyMem
  500. regAddr :: DynFlags -> CmmReg -> Int -> Width -> AbsMem
  501. regAddr _ (CmmGlobal Sp) i w = SpMem i (widthInBytes w)
  502. regAddr _ (CmmGlobal Hp) _ _ = HeapMem
  503. regAddr _ (CmmGlobal CurrentTSO) _ _ = HeapMem -- important for PrimOps
  504. regAddr dflags r _ _ | isGcPtrType (cmmRegType dflags r) = HeapMem -- yay! GCPtr pays for itself
  505. regAddr _ _ _ _ = AnyMem