0a15638cc427d7dc924b18608e5e99ea75898aa7
[ghc.git] / compiler / nativeGen / AsmCodeGen.hs
1 -- -----------------------------------------------------------------------------
2 --
3 -- (c) The University of Glasgow 1993-2004
4 --
5 -- This is the top-level module in the native code generator.
6 --
7 -- -----------------------------------------------------------------------------
8
9 {-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, UnboxedTuples #-}
10
11 module AsmCodeGen (
12 -- * Module entry point
13 nativeCodeGen
14
15 -- * Test-only exports: see trac #12744
16 -- used by testGraphNoSpills, which needs to access
17 -- the register allocator intermediate data structures
18 -- cmmNativeGen emits
19 , cmmNativeGen
20 , NcgImpl(..)
21 , x86NcgImpl
22 ) where
23
24 #include "HsVersions.h"
25 #include "nativeGen/NCG.h"
26
27
28 import qualified X86.CodeGen
29 import qualified X86.Regs
30 import qualified X86.Instr
31 import qualified X86.Ppr
32
33 import qualified SPARC.CodeGen
34 import qualified SPARC.Regs
35 import qualified SPARC.Instr
36 import qualified SPARC.Ppr
37 import qualified SPARC.ShortcutJump
38 import qualified SPARC.CodeGen.Expand
39
40 import qualified PPC.CodeGen
41 import qualified PPC.Regs
42 import qualified PPC.RegInfo
43 import qualified PPC.Instr
44 import qualified PPC.Ppr
45
46 import RegAlloc.Liveness
47 import qualified RegAlloc.Linear.Main as Linear
48
49 import qualified GraphColor as Color
50 import qualified RegAlloc.Graph.Main as Color
51 import qualified RegAlloc.Graph.Stats as Color
52 import qualified RegAlloc.Graph.TrivColorable as Color
53
54 import TargetReg
55 import Platform
56 import Config
57 import Instruction
58 import PIC
59 import Reg
60 import NCGMonad
61 import Dwarf
62 import Debug
63
64 import BlockId
65 import CgUtils ( fixStgRegisters )
66 import Cmm
67 import CmmUtils
68 import Hoopl
69 import CmmOpt ( cmmMachOpFold )
70 import PprCmm
71 import CLabel
72
73 import UniqFM
74 import UniqSupply
75 import DynFlags
76 import Util
77 import Unique
78
79 import BasicTypes ( Alignment )
80 import Digraph
81 import qualified Pretty
82 import BufWrite
83 import Outputable
84 import FastString
85 import UniqSet
86 import ErrUtils
87 import Module
88 import Stream (Stream)
89 import qualified Stream
90
91 -- DEBUGGING ONLY
92 --import OrdList
93
94 import Data.List
95 import Data.Maybe
96 import Data.Ord ( comparing )
97 import Control.Exception
98 import Control.Monad
99 import System.IO
100
101 {-
102 The native-code generator has machine-independent and
103 machine-dependent modules.
104
105 This module ("AsmCodeGen") is the top-level machine-independent
106 module. Before entering machine-dependent land, we do some
107 machine-independent optimisations (defined below) on the
108 'CmmStmts's.
109
110 We convert to the machine-specific 'Instr' datatype with
111 'cmmCodeGen', assuming an infinite supply of registers. We then use
112 a machine-independent register allocator ('regAlloc') to rejoin
113 reality. Obviously, 'regAlloc' has machine-specific helper
114 functions (see about "RegAllocInfo" below).
115
116 Finally, we order the basic blocks of the function so as to minimise
117 the number of jumps between blocks, by utilising fallthrough wherever
118 possible.
119
120 The machine-dependent bits break down as follows:
121
122 * ["MachRegs"] Everything about the target platform's machine
123 registers (and immediate operands, and addresses, which tend to
124 intermingle/interact with registers).
125
126 * ["MachInstrs"] Includes the 'Instr' datatype (possibly should
127 have a module of its own), plus a miscellany of other things
128 (e.g., 'targetDoubleSize', 'smStablePtrTable', ...)
129
130 * ["MachCodeGen"] is where 'Cmm' stuff turns into
131 machine instructions.
132
133 * ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
134 a 'SDoc').
135
136 * ["RegAllocInfo"] In the register allocator, we manipulate
137 'MRegsState's, which are 'BitSet's, one bit per machine register.
138 When we want to say something about a specific machine register
139 (e.g., ``it gets clobbered by this instruction''), we set/unset
140 its bit. Obviously, we do this 'BitSet' thing for efficiency
141 reasons.
142
143 The 'RegAllocInfo' module collects together the machine-specific
144 info needed to do register allocation.
145
146 * ["RegisterAlloc"] The (machine-independent) register allocator.
147 -}
148
149 -- -----------------------------------------------------------------------------
150 -- Top-level of the native codegen
151
152 data NcgImpl statics instr jumpDest = NcgImpl {
153 cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl statics instr],
154 generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr),
155 getJumpDestBlockId :: jumpDest -> Maybe BlockId,
156 canShortcut :: instr -> Maybe jumpDest,
157 shortcutStatics :: (BlockId -> Maybe jumpDest) -> statics -> statics,
158 shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr,
159 pprNatCmmDecl :: NatCmmDecl statics instr -> SDoc,
160 maxSpillSlots :: Int,
161 allocatableRegs :: [RealReg],
162 ncg_x86fp_kludge :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
163 ncgExpandTop :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
164 ncgAllocMoreStack :: Int -> NatCmmDecl statics instr -> UniqSM (NatCmmDecl statics instr),
165 ncgMakeFarBranches :: LabelMap CmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]
166 }
167
168 --------------------
169 nativeCodeGen :: DynFlags -> Module -> ModLocation -> Handle -> UniqSupply
170 -> Stream IO RawCmmGroup ()
171 -> IO UniqSupply
172 nativeCodeGen dflags this_mod modLoc h us cmms
173 = let platform = targetPlatform dflags
174 nCG' :: (Outputable statics, Outputable instr, Instruction instr)
175 => NcgImpl statics instr jumpDest -> IO UniqSupply
176 nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
177 in case platformArch platform of
178 ArchX86 -> nCG' (x86NcgImpl dflags)
179 ArchX86_64 -> nCG' (x86_64NcgImpl dflags)
180 ArchPPC -> nCG' (ppcNcgImpl dflags)
181 ArchSPARC -> nCG' (sparcNcgImpl dflags)
182 ArchSPARC64 -> panic "nativeCodeGen: No NCG for SPARC64"
183 ArchARM {} -> panic "nativeCodeGen: No NCG for ARM"
184 ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64"
185 ArchPPC_64 _ -> nCG' (ppcNcgImpl dflags)
186 ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha"
187 ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb"
188 ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel"
189 ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch"
190 ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript"
191
192 x86NcgImpl :: DynFlags -> NcgImpl (Alignment, CmmStatics) X86.Instr.Instr X86.Instr.JumpDest
193 x86NcgImpl dflags
194 = (x86_64NcgImpl dflags) { ncg_x86fp_kludge = map x86fp_kludge }
195
196 x86_64NcgImpl :: DynFlags -> NcgImpl (Alignment, CmmStatics) X86.Instr.Instr X86.Instr.JumpDest
197 x86_64NcgImpl dflags
198 = NcgImpl {
199 cmmTopCodeGen = X86.CodeGen.cmmTopCodeGen
200 ,generateJumpTableForInstr = X86.CodeGen.generateJumpTableForInstr dflags
201 ,getJumpDestBlockId = X86.Instr.getJumpDestBlockId
202 ,canShortcut = X86.Instr.canShortcut
203 ,shortcutStatics = X86.Instr.shortcutStatics
204 ,shortcutJump = X86.Instr.shortcutJump
205 ,pprNatCmmDecl = X86.Ppr.pprNatCmmDecl
206 ,maxSpillSlots = X86.Instr.maxSpillSlots dflags
207 ,allocatableRegs = X86.Regs.allocatableRegs platform
208 ,ncg_x86fp_kludge = id
209 ,ncgAllocMoreStack = X86.Instr.allocMoreStack platform
210 ,ncgExpandTop = id
211 ,ncgMakeFarBranches = const id
212 }
213 where platform = targetPlatform dflags
214
215 ppcNcgImpl :: DynFlags -> NcgImpl CmmStatics PPC.Instr.Instr PPC.RegInfo.JumpDest
216 ppcNcgImpl dflags
217 = NcgImpl {
218 cmmTopCodeGen = PPC.CodeGen.cmmTopCodeGen
219 ,generateJumpTableForInstr = PPC.CodeGen.generateJumpTableForInstr dflags
220 ,getJumpDestBlockId = PPC.RegInfo.getJumpDestBlockId
221 ,canShortcut = PPC.RegInfo.canShortcut
222 ,shortcutStatics = PPC.RegInfo.shortcutStatics
223 ,shortcutJump = PPC.RegInfo.shortcutJump
224 ,pprNatCmmDecl = PPC.Ppr.pprNatCmmDecl
225 ,maxSpillSlots = PPC.Instr.maxSpillSlots dflags
226 ,allocatableRegs = PPC.Regs.allocatableRegs platform
227 ,ncg_x86fp_kludge = id
228 ,ncgAllocMoreStack = PPC.Instr.allocMoreStack platform
229 ,ncgExpandTop = id
230 ,ncgMakeFarBranches = PPC.Instr.makeFarBranches
231 }
232 where platform = targetPlatform dflags
233
234 sparcNcgImpl :: DynFlags -> NcgImpl CmmStatics SPARC.Instr.Instr SPARC.ShortcutJump.JumpDest
235 sparcNcgImpl dflags
236 = NcgImpl {
237 cmmTopCodeGen = SPARC.CodeGen.cmmTopCodeGen
238 ,generateJumpTableForInstr = SPARC.CodeGen.generateJumpTableForInstr dflags
239 ,getJumpDestBlockId = SPARC.ShortcutJump.getJumpDestBlockId
240 ,canShortcut = SPARC.ShortcutJump.canShortcut
241 ,shortcutStatics = SPARC.ShortcutJump.shortcutStatics
242 ,shortcutJump = SPARC.ShortcutJump.shortcutJump
243 ,pprNatCmmDecl = SPARC.Ppr.pprNatCmmDecl
244 ,maxSpillSlots = SPARC.Instr.maxSpillSlots dflags
245 ,allocatableRegs = SPARC.Regs.allocatableRegs
246 ,ncg_x86fp_kludge = id
247 ,ncgAllocMoreStack = noAllocMoreStack
248 ,ncgExpandTop = map SPARC.CodeGen.Expand.expandTop
249 ,ncgMakeFarBranches = const id
250 }
251
252 --
253 -- Allocating more stack space for spilling is currently only
254 -- supported for the linear register allocator on x86/x86_64, the rest
255 -- default to the panic below. To support allocating extra stack on
256 -- more platforms provide a definition of ncgAllocMoreStack.
257 --
258 noAllocMoreStack :: Int -> NatCmmDecl statics instr -> UniqSM (NatCmmDecl statics instr)
259 noAllocMoreStack amount _
260 = panic $ "Register allocator: out of stack slots (need " ++ show amount ++ ")\n"
261 ++ " If you are trying to compile SHA1.hs from the crypto library then this\n"
262 ++ " is a known limitation in the linear allocator.\n"
263 ++ "\n"
264 ++ " Try enabling the graph colouring allocator with -fregs-graph instead."
265 ++ " You can still file a bug report if you like.\n"
266
267
268 -- | Data accumulated during code generation. Mostly about statistics,
269 -- but also collects debug data for DWARF generation.
270 data NativeGenAcc statics instr
271 = NGS { ngs_imports :: ![[CLabel]]
272 , ngs_natives :: ![[NatCmmDecl statics instr]]
273 -- ^ Native code generated, for statistics. This might
274 -- hold a lot of data, so it is important to clear this
275 -- field as early as possible if it isn't actually
276 -- required.
277 , ngs_colorStats :: ![[Color.RegAllocStats statics instr]]
278 , ngs_linearStats :: ![[Linear.RegAllocStats]]
279 , ngs_labels :: ![Label]
280 , ngs_debug :: ![DebugBlock]
281 , ngs_dwarfFiles :: !DwarfFiles
282 }
283
284 nativeCodeGen' :: (Outputable statics, Outputable instr, Instruction instr)
285 => DynFlags
286 -> Module -> ModLocation
287 -> NcgImpl statics instr jumpDest
288 -> Handle
289 -> UniqSupply
290 -> Stream IO RawCmmGroup ()
291 -> IO UniqSupply
292 nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
293 = do
294 -- BufHandle is a performance hack. We could hide it inside
295 -- Pretty if it weren't for the fact that we do lots of little
296 -- printDocs here (in order to do codegen in constant space).
297 bufh <- newBufHandle h
298 let ngs0 = NGS [] [] [] [] [] [] emptyUFM
299 (ngs, us') <- cmmNativeGenStream dflags this_mod modLoc ncgImpl bufh us
300 cmms ngs0
301 finishNativeGen dflags modLoc bufh us' ngs
302
303 finishNativeGen :: Instruction instr
304 => DynFlags
305 -> ModLocation
306 -> BufHandle
307 -> UniqSupply
308 -> NativeGenAcc statics instr
309 -> IO UniqSupply
310 finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
311 = do
312 -- Write debug data and finish
313 let emitDw = debugLevel dflags > 0 && not (gopt Opt_SplitObjs dflags)
314 us' <- if not emitDw then return us else do
315 (dwarf, us') <- dwarfGen dflags modLoc us (ngs_debug ngs)
316 emitNativeCode dflags bufh dwarf
317 return us'
318 bFlush bufh
319
320 -- dump global NCG stats for graph coloring allocator
321 let stats = concat (ngs_colorStats ngs)
322 when (not (null stats)) $ do
323
324 -- build the global register conflict graph
325 let graphGlobal
326 = foldl Color.union Color.initGraph
327 $ [ Color.raGraph stat
328 | stat@Color.RegAllocStatsStart{} <- stats]
329
330 dump_stats (Color.pprStats stats graphGlobal)
331
332 let platform = targetPlatform dflags
333 dumpIfSet_dyn dflags
334 Opt_D_dump_asm_conflicts "Register conflict graph"
335 $ Color.dotGraph
336 (targetRegDotColor platform)
337 (Color.trivColorable platform
338 (targetVirtualRegSqueeze platform)
339 (targetRealRegSqueeze platform))
340 $ graphGlobal
341
342
343 -- dump global NCG stats for linear allocator
344 let linearStats = concat (ngs_linearStats ngs)
345 when (not (null linearStats)) $
346 dump_stats (Linear.pprStats (concat (ngs_natives ngs)) linearStats)
347
348 -- write out the imports
349 Pretty.printDoc Pretty.LeftMode (pprCols dflags) h
350 $ withPprStyleDoc dflags (mkCodeStyle AsmStyle)
351 $ makeImportsDoc dflags (concat (ngs_imports ngs))
352 return us'
353 where
354 dump_stats = dumpSDoc dflags alwaysQualify Opt_D_dump_asm_stats "NCG stats"
355
356 cmmNativeGenStream :: (Outputable statics, Outputable instr, Instruction instr)
357 => DynFlags
358 -> Module -> ModLocation
359 -> NcgImpl statics instr jumpDest
360 -> BufHandle
361 -> UniqSupply
362 -> Stream IO RawCmmGroup ()
363 -> NativeGenAcc statics instr
364 -> IO (NativeGenAcc statics instr, UniqSupply)
365
366 cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
367 = do r <- Stream.runStream cmm_stream
368 case r of
369 Left () ->
370 return (ngs { ngs_imports = reverse $ ngs_imports ngs
371 , ngs_natives = reverse $ ngs_natives ngs
372 , ngs_colorStats = reverse $ ngs_colorStats ngs
373 , ngs_linearStats = reverse $ ngs_linearStats ngs
374 },
375 us)
376 Right (cmms, cmm_stream') -> do
377
378 -- Generate debug information
379 let debugFlag = debugLevel dflags > 0
380 !ndbgs | debugFlag = cmmDebugGen modLoc cmms
381 | otherwise = []
382 dbgMap = debugToMap ndbgs
383
384 -- Insert split marker, generate native code
385 let splitObjs = gopt Opt_SplitObjs dflags
386 split_marker = CmmProc mapEmpty mkSplitMarkerLabel [] $
387 ofBlockList (panic "split_marker_entry") []
388 cmms' | splitObjs = split_marker : cmms
389 | otherwise = cmms
390 (ngs',us') <- cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap us
391 cmms' ngs 0
392
393 -- Link native code information into debug blocks
394 let !ldbgs = cmmDebugLink (ngs_labels ngs') ndbgs
395 dumpIfSet_dyn dflags Opt_D_dump_debug "Debug Infos"
396 (vcat $ map ppr ldbgs)
397
398 -- Emit & clear DWARF information when generating split
399 -- object files, as we need it to land in the same object file
400 -- When using split sections, note that we do not split the debug
401 -- info but emit all the info at once in finishNativeGen.
402 (ngs'', us'') <-
403 if debugFlag && splitObjs
404 then do (dwarf, us'') <- dwarfGen dflags modLoc us ldbgs
405 emitNativeCode dflags h dwarf
406 return (ngs' { ngs_debug = []
407 , ngs_dwarfFiles = emptyUFM
408 , ngs_labels = [] },
409 us'')
410 else return (ngs' { ngs_debug = ngs_debug ngs' ++ ldbgs
411 , ngs_labels = [] },
412 us')
413
414 cmmNativeGenStream dflags this_mod modLoc ncgImpl h us''
415 cmm_stream' ngs''
416
417 -- | Do native code generation on all these cmms.
418 --
419 cmmNativeGens :: forall statics instr jumpDest.
420 (Outputable statics, Outputable instr, Instruction instr)
421 => DynFlags
422 -> Module -> ModLocation
423 -> NcgImpl statics instr jumpDest
424 -> BufHandle
425 -> LabelMap DebugBlock
426 -> UniqSupply
427 -> [RawCmmDecl]
428 -> NativeGenAcc statics instr
429 -> Int
430 -> IO (NativeGenAcc statics instr, UniqSupply)
431
432 cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go
433 where
434 go :: UniqSupply -> [RawCmmDecl] -> NativeGenAcc statics instr -> Int
435 -> IO (NativeGenAcc statics instr, UniqSupply)
436
437 go us [] ngs !_ =
438 return (ngs, us)
439
440 go us (cmm : cmms) ngs count = do
441 let fileIds = ngs_dwarfFiles ngs
442 (us', fileIds', native, imports, colorStats, linearStats)
443 <- {-# SCC "cmmNativeGen" #-}
444 cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap
445 cmm count
446
447 -- Generate .file directives for every new file that has been
448 -- used. Note that it is important that we generate these in
449 -- ascending order, as Clang's 3.6 assembler complains.
450 let newFileIds = sortBy (comparing snd) $
451 nonDetEltsUFM $ fileIds' `minusUFM` fileIds
452 -- See Note [Unique Determinism and code generation]
453 pprDecl (f,n) = text "\t.file " <> ppr n <+>
454 doubleQuotes (ftext f)
455
456 emitNativeCode dflags h $ vcat $
457 map pprDecl newFileIds ++
458 map (pprNatCmmDecl ncgImpl) native
459
460 -- force evaluation all this stuff to avoid space leaks
461 {-# SCC "seqString" #-} evaluate $ seqString (showSDoc dflags $ vcat $ map ppr imports)
462
463 let !labels' = if debugLevel dflags > 0
464 then cmmDebugLabels isMetaInstr native else []
465 !natives' = if dopt Opt_D_dump_asm_stats dflags
466 then native : ngs_natives ngs else []
467 mCon = maybe id (:)
468 ngs' = ngs{ ngs_imports = imports : ngs_imports ngs
469 , ngs_natives = natives'
470 , ngs_colorStats = colorStats `mCon` ngs_colorStats ngs
471 , ngs_linearStats = linearStats `mCon` ngs_linearStats ngs
472 , ngs_labels = ngs_labels ngs ++ labels'
473 , ngs_dwarfFiles = fileIds'
474 }
475 go us' cmms ngs' (count + 1)
476
477 seqString [] = ()
478 seqString (x:xs) = x `seq` seqString xs
479
480
481 emitNativeCode :: DynFlags -> BufHandle -> SDoc -> IO ()
482 emitNativeCode dflags h sdoc = do
483
484 {-# SCC "pprNativeCode" #-} Pretty.bufLeftRender h
485 $ withPprStyleDoc dflags (mkCodeStyle AsmStyle) sdoc
486
487 -- dump native code
488 dumpIfSet_dyn dflags
489 Opt_D_dump_asm "Asm code"
490 sdoc
491
492 -- | Complete native code generation phase for a single top-level chunk of Cmm.
493 -- Dumping the output of each stage along the way.
494 -- Global conflict graph and NGC stats
495 cmmNativeGen
496 :: (Outputable statics, Outputable instr, Instruction instr)
497 => DynFlags
498 -> Module -> ModLocation
499 -> NcgImpl statics instr jumpDest
500 -> UniqSupply
501 -> DwarfFiles
502 -> LabelMap DebugBlock
503 -> RawCmmDecl -- ^ the cmm to generate code for
504 -> Int -- ^ sequence number of this top thing
505 -> IO ( UniqSupply
506 , DwarfFiles
507 , [NatCmmDecl statics instr] -- native code
508 , [CLabel] -- things imported by this cmm
509 , Maybe [Color.RegAllocStats statics instr] -- stats for the coloring register allocator
510 , Maybe [Linear.RegAllocStats]) -- stats for the linear register allocators
511
512 cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
513 = do
514 let platform = targetPlatform dflags
515
516 -- rewrite assignments to global regs
517 let fixed_cmm =
518 {-# SCC "fixStgRegisters" #-}
519 fixStgRegisters dflags cmm
520
521 -- cmm to cmm optimisations
522 let (opt_cmm, imports) =
523 {-# SCC "cmmToCmm" #-}
524 cmmToCmm dflags this_mod fixed_cmm
525
526 dumpIfSet_dyn dflags
527 Opt_D_dump_opt_cmm "Optimised Cmm"
528 (pprCmmGroup [opt_cmm])
529
530 -- generate native code from cmm
531 let ((native, lastMinuteImports, fileIds'), usGen) =
532 {-# SCC "genMachCode" #-}
533 initUs us $ genMachCode dflags this_mod modLoc
534 (cmmTopCodeGen ncgImpl)
535 fileIds dbgMap opt_cmm
536
537 dumpIfSet_dyn dflags
538 Opt_D_dump_asm_native "Native code"
539 (vcat $ map (pprNatCmmDecl ncgImpl) native)
540
541 -- tag instructions with register liveness information
542 let (withLiveness, usLive) =
543 {-# SCC "regLiveness" #-}
544 initUs usGen
545 $ mapM (regLiveness platform)
546 $ map natCmmTopToLive native
547
548 dumpIfSet_dyn dflags
549 Opt_D_dump_asm_liveness "Liveness annotations added"
550 (vcat $ map ppr withLiveness)
551
552 -- allocate registers
553 (alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear) <-
554 if ( gopt Opt_RegsGraph dflags
555 || gopt Opt_RegsIterative dflags )
556 then do
557 -- the regs usable for allocation
558 let (alloc_regs :: UniqFM (UniqSet RealReg))
559 = foldr (\r -> plusUFM_C unionUniqSets
560 $ unitUFM (targetClassOfRealReg platform r) (unitUniqSet r))
561 emptyUFM
562 $ allocatableRegs ncgImpl
563
564 -- do the graph coloring register allocation
565 let ((alloced, regAllocStats), usAlloc)
566 = {-# SCC "RegAlloc-color" #-}
567 initUs usLive
568 $ Color.regAlloc
569 dflags
570 alloc_regs
571 (mkUniqSet [0 .. maxSpillSlots ncgImpl])
572 withLiveness
573
574 -- dump out what happened during register allocation
575 dumpIfSet_dyn dflags
576 Opt_D_dump_asm_regalloc "Registers allocated"
577 (vcat $ map (pprNatCmmDecl ncgImpl) alloced)
578
579 dumpIfSet_dyn dflags
580 Opt_D_dump_asm_regalloc_stages "Build/spill stages"
581 (vcat $ map (\(stage, stats)
582 -> text "# --------------------------"
583 $$ text "# cmm " <> int count <> text " Stage " <> int stage
584 $$ ppr stats)
585 $ zip [0..] regAllocStats)
586
587 let mPprStats =
588 if dopt Opt_D_dump_asm_stats dflags
589 then Just regAllocStats else Nothing
590
591 -- force evaluation of the Maybe to avoid space leak
592 mPprStats `seq` return ()
593
594 return ( alloced, usAlloc
595 , mPprStats
596 , Nothing)
597
598 else do
599 -- do linear register allocation
600 let reg_alloc proc = do
601 (alloced, maybe_more_stack, ra_stats) <-
602 Linear.regAlloc dflags proc
603 case maybe_more_stack of
604 Nothing -> return ( alloced, ra_stats )
605 Just amount -> do
606 alloced' <- ncgAllocMoreStack ncgImpl amount alloced
607 return (alloced', ra_stats )
608
609 let ((alloced, regAllocStats), usAlloc)
610 = {-# SCC "RegAlloc-linear" #-}
611 initUs usLive
612 $ liftM unzip
613 $ mapM reg_alloc withLiveness
614
615 dumpIfSet_dyn dflags
616 Opt_D_dump_asm_regalloc "Registers allocated"
617 (vcat $ map (pprNatCmmDecl ncgImpl) alloced)
618
619 let mPprStats =
620 if dopt Opt_D_dump_asm_stats dflags
621 then Just (catMaybes regAllocStats) else Nothing
622
623 -- force evaluation of the Maybe to avoid space leak
624 mPprStats `seq` return ()
625
626 return ( alloced, usAlloc
627 , Nothing
628 , mPprStats)
629
630 ---- x86fp_kludge. This pass inserts ffree instructions to clear
631 ---- the FPU stack on x86. The x86 ABI requires that the FPU stack
632 ---- is clear, and library functions can return odd results if it
633 ---- isn't.
634 ----
635 ---- NB. must happen before shortcutBranches, because that
636 ---- generates JXX_GBLs which we can't fix up in x86fp_kludge.
637 let kludged = {-# SCC "x86fp_kludge" #-} ncg_x86fp_kludge ncgImpl alloced
638
639 ---- generate jump tables
640 let tabled =
641 {-# SCC "generateJumpTables" #-}
642 generateJumpTables ncgImpl kludged
643
644 ---- shortcut branches
645 let shorted =
646 {-# SCC "shortcutBranches" #-}
647 shortcutBranches dflags ncgImpl tabled
648
649 ---- sequence blocks
650 let sequenced =
651 {-# SCC "sequenceBlocks" #-}
652 map (sequenceTop ncgImpl) shorted
653
654 ---- expansion of SPARC synthetic instrs
655 let expanded =
656 {-# SCC "sparc_expand" #-}
657 ncgExpandTop ncgImpl sequenced
658
659 dumpIfSet_dyn dflags
660 Opt_D_dump_asm_expanded "Synthetic instructions expanded"
661 (vcat $ map (pprNatCmmDecl ncgImpl) expanded)
662
663 return ( usAlloc
664 , fileIds'
665 , expanded
666 , lastMinuteImports ++ imports
667 , ppr_raStatsColor
668 , ppr_raStatsLinear)
669
670
671 x86fp_kludge :: NatCmmDecl (Alignment, CmmStatics) X86.Instr.Instr -> NatCmmDecl (Alignment, CmmStatics) X86.Instr.Instr
672 x86fp_kludge top@(CmmData _ _) = top
673 x86fp_kludge (CmmProc info lbl live (ListGraph code)) =
674 CmmProc info lbl live (ListGraph $ X86.Instr.i386_insert_ffrees code)
675
676
677 -- | Build a doc for all the imports.
678 --
679 makeImportsDoc :: DynFlags -> [CLabel] -> SDoc
680 makeImportsDoc dflags imports
681 = dyld_stubs imports
682 $$
683 -- On recent versions of Darwin, the linker supports
684 -- dead-stripping of code and data on a per-symbol basis.
685 -- There's a hack to make this work in PprMach.pprNatCmmDecl.
686 (if platformHasSubsectionsViaSymbols platform
687 then text ".subsections_via_symbols"
688 else Outputable.empty)
689 $$
690 -- On recent GNU ELF systems one can mark an object file
691 -- as not requiring an executable stack. If all objects
692 -- linked into a program have this note then the program
693 -- will not use an executable stack, which is good for
694 -- security. GHC generated code does not need an executable
695 -- stack so add the note in:
696 (if platformHasGnuNonexecStack platform
697 then text ".section .note.GNU-stack,\"\",@progbits"
698 else Outputable.empty)
699 $$
700 -- And just because every other compiler does, let's stick in
701 -- an identifier directive: .ident "GHC x.y.z"
702 (if platformHasIdentDirective platform
703 then let compilerIdent = text "GHC" <+> text cProjectVersion
704 in text ".ident" <+> doubleQuotes compilerIdent
705 else Outputable.empty)
706
707 where
708 platform = targetPlatform dflags
709 arch = platformArch platform
710 os = platformOS platform
711
712 -- Generate "symbol stubs" for all external symbols that might
713 -- come from a dynamic library.
714 dyld_stubs :: [CLabel] -> SDoc
715 {- dyld_stubs imps = vcat $ map pprDyldSymbolStub $
716 map head $ group $ sort imps-}
717 -- (Hack) sometimes two Labels pretty-print the same, but have
718 -- different uniques; so we compare their text versions...
719 dyld_stubs imps
720 | needImportedSymbols dflags arch os
721 = vcat $
722 (pprGotDeclaration dflags arch os :) $
723 map ( pprImportedSymbol dflags platform . fst . head) $
724 groupBy (\(_,a) (_,b) -> a == b) $
725 sortBy (\(_,a) (_,b) -> compare a b) $
726 map doPpr $
727 imps
728 | otherwise
729 = Outputable.empty
730
731 doPpr lbl = (lbl, renderWithStyle dflags (pprCLabel platform lbl) astyle)
732 astyle = mkCodeStyle AsmStyle
733
734
735 -- -----------------------------------------------------------------------------
736 -- Sequencing the basic blocks
737
738 -- Cmm BasicBlocks are self-contained entities: they always end in a
739 -- jump, either non-local or to another basic block in the same proc.
740 -- In this phase, we attempt to place the basic blocks in a sequence
741 -- such that as many of the local jumps as possible turn into
742 -- fallthroughs.
743
744 sequenceTop
745 :: Instruction instr
746 => NcgImpl statics instr jumpDest -> NatCmmDecl statics instr -> NatCmmDecl statics instr
747
748 sequenceTop _ top@(CmmData _ _) = top
749 sequenceTop ncgImpl (CmmProc info lbl live (ListGraph blocks)) =
750 CmmProc info lbl live (ListGraph $ ncgMakeFarBranches ncgImpl info $ sequenceBlocks info blocks)
751
752 -- The algorithm is very simple (and stupid): we make a graph out of
753 -- the blocks where there is an edge from one block to another iff the
754 -- first block ends by jumping to the second. Then we topologically
755 -- sort this graph. Then traverse the list: for each block, we first
756 -- output the block, then if it has an out edge, we move the
757 -- destination of the out edge to the front of the list, and continue.
758
759 -- FYI, the classic layout for basic blocks uses postorder DFS; this
760 -- algorithm is implemented in Hoopl.
761
762 sequenceBlocks
763 :: Instruction instr
764 => LabelMap i
765 -> [NatBasicBlock instr]
766 -> [NatBasicBlock instr]
767
768 sequenceBlocks _ [] = []
769 sequenceBlocks infos (entry:blocks) =
770 seqBlocks infos (mkNode entry : reverse (flattenSCCs (sccBlocks blocks)))
771 -- the first block is the entry point ==> it must remain at the start.
772
773
774 sccBlocks
775 :: Instruction instr
776 => [NatBasicBlock instr]
777 -> [SCC ( NatBasicBlock instr
778 , BlockId
779 , [BlockId])]
780
781 sccBlocks blocks = stronglyConnCompFromEdgedVerticesUniqR (map mkNode blocks)
782
783 -- we're only interested in the last instruction of
784 -- the block, and only if it has a single destination.
785 getOutEdges
786 :: Instruction instr
787 => [instr] -> [BlockId]
788
789 getOutEdges instrs
790 = case jumpDestsOfInstr (last instrs) of
791 [one] -> [one]
792 _many -> []
793
794 mkNode :: (Instruction t)
795 => GenBasicBlock t
796 -> (GenBasicBlock t, BlockId, [BlockId])
797 mkNode block@(BasicBlock id instrs) = (block, id, getOutEdges instrs)
798
799 seqBlocks :: LabelMap i -> [(GenBasicBlock t1, BlockId, [BlockId])]
800 -> [GenBasicBlock t1]
801 seqBlocks infos blocks = placeNext pullable0 todo0
802 where
803 -- pullable: Blocks that are not yet placed
804 -- todo: Original order of blocks, to be followed if we have no good
805 -- reason not to;
806 -- may include blocks that have already been placed, but then
807 -- these are not in pullable
808 pullable0 = listToUFM [ (i,(b,n)) | (b,i,n) <- blocks ]
809 todo0 = [i | (_,i,_) <- blocks ]
810
811 placeNext _ [] = []
812 placeNext pullable (i:rest)
813 | Just (block, pullable') <- lookupDeleteUFM pullable i
814 = place pullable' rest block
815 | otherwise
816 -- We already placed this block, so ignore
817 = placeNext pullable rest
818
819 place pullable todo (block,[])
820 = block : placeNext pullable todo
821 place pullable todo (block@(BasicBlock id instrs),[next])
822 | mapMember next infos
823 = block : placeNext pullable todo
824 | Just (nextBlock, pullable') <- lookupDeleteUFM pullable next
825 = BasicBlock id (init instrs) : place pullable' todo nextBlock
826 | otherwise
827 = block : placeNext pullable todo
828 place _ _ (_,tooManyNextNodes)
829 = pprPanic "seqBlocks" (ppr tooManyNextNodes)
830
831
832 lookupDeleteUFM :: Uniquable key => UniqFM elt -> key -> Maybe (elt, UniqFM elt)
833 lookupDeleteUFM m k = do -- Maybe monad
834 v <- lookupUFM m k
835 return (v, delFromUFM m k)
836
837 -- -----------------------------------------------------------------------------
838 -- Generate jump tables
839
840 -- Analyzes all native code and generates data sections for all jump
841 -- table instructions.
842 generateJumpTables
843 :: NcgImpl statics instr jumpDest
844 -> [NatCmmDecl statics instr] -> [NatCmmDecl statics instr]
845 generateJumpTables ncgImpl xs = concatMap f xs
846 where f p@(CmmProc _ _ _ (ListGraph xs)) = p : concatMap g xs
847 f p = [p]
848 g (BasicBlock _ xs) = catMaybes (map (generateJumpTableForInstr ncgImpl) xs)
849
850 -- -----------------------------------------------------------------------------
851 -- Shortcut branches
852
853 shortcutBranches
854 :: DynFlags
855 -> NcgImpl statics instr jumpDest
856 -> [NatCmmDecl statics instr]
857 -> [NatCmmDecl statics instr]
858
859 shortcutBranches dflags ncgImpl tops
860 | optLevel dflags < 1 = tops -- only with -O or higher
861 | otherwise = map (apply_mapping ncgImpl mapping) tops'
862 where
863 (tops', mappings) = mapAndUnzip (build_mapping ncgImpl) tops
864 mapping = foldr plusUFM emptyUFM mappings
865
866 build_mapping :: NcgImpl statics instr jumpDest
867 -> GenCmmDecl d (LabelMap t) (ListGraph instr)
868 -> (GenCmmDecl d (LabelMap t) (ListGraph instr), UniqFM jumpDest)
869 build_mapping _ top@(CmmData _ _) = (top, emptyUFM)
870 build_mapping _ (CmmProc info lbl live (ListGraph []))
871 = (CmmProc info lbl live (ListGraph []), emptyUFM)
872 build_mapping ncgImpl (CmmProc info lbl live (ListGraph (head:blocks)))
873 = (CmmProc info lbl live (ListGraph (head:others)), mapping)
874 -- drop the shorted blocks, but don't ever drop the first one,
875 -- because it is pointed to by a global label.
876 where
877 -- find all the blocks that just consist of a jump that can be
878 -- shorted.
879 -- Don't completely eliminate loops here -- that can leave a dangling jump!
880 (_, shortcut_blocks, others) =
881 foldl split (setEmpty :: LabelSet, [], []) blocks
882 split (s, shortcut_blocks, others) b@(BasicBlock id [insn])
883 | Just jd <- canShortcut ncgImpl insn,
884 Just dest <- getJumpDestBlockId ncgImpl jd,
885 not (has_info id),
886 (setMember dest s) || dest == id -- loop checks
887 = (s, shortcut_blocks, b : others)
888 split (s, shortcut_blocks, others) (BasicBlock id [insn])
889 | Just dest <- canShortcut ncgImpl insn,
890 not (has_info id)
891 = (setInsert id s, (id,dest) : shortcut_blocks, others)
892 split (s, shortcut_blocks, others) other = (s, shortcut_blocks, other : others)
893
894 -- do not eliminate blocks that have an info table
895 has_info l = mapMember l info
896
897 -- build a mapping from BlockId to JumpDest for shorting branches
898 mapping = foldl add emptyUFM shortcut_blocks
899 add ufm (id,dest) = addToUFM ufm id dest
900
901 apply_mapping :: NcgImpl statics instr jumpDest
902 -> UniqFM jumpDest
903 -> GenCmmDecl statics h (ListGraph instr)
904 -> GenCmmDecl statics h (ListGraph instr)
905 apply_mapping ncgImpl ufm (CmmData sec statics)
906 = CmmData sec (shortcutStatics ncgImpl (lookupUFM ufm) statics)
907 apply_mapping ncgImpl ufm (CmmProc info lbl live (ListGraph blocks))
908 = CmmProc info lbl live (ListGraph $ map short_bb blocks)
909 where
910 short_bb (BasicBlock id insns) = BasicBlock id $! map short_insn insns
911 short_insn i = shortcutJump ncgImpl (lookupUFM ufm) i
912 -- shortcutJump should apply the mapping repeatedly,
913 -- just in case we can short multiple branches.
914
915 -- -----------------------------------------------------------------------------
916 -- Instruction selection
917
918 -- Native code instruction selection for a chunk of stix code. For
919 -- this part of the computation, we switch from the UniqSM monad to
920 -- the NatM monad. The latter carries not only a Unique, but also an
921 -- Int denoting the current C stack pointer offset in the generated
922 -- code; this is needed for creating correct spill offsets on
923 -- architectures which don't offer, or for which it would be
924 -- prohibitively expensive to employ, a frame pointer register. Viz,
925 -- x86.
926
927 -- The offset is measured in bytes, and indicates the difference
928 -- between the current (simulated) C stack-ptr and the value it was at
929 -- the beginning of the block. For stacks which grow down, this value
930 -- should be either zero or negative.
931
932 -- Switching between the two monads whilst carrying along the same
933 -- Unique supply breaks abstraction. Is that bad?
934
935 genMachCode
936 :: DynFlags
937 -> Module -> ModLocation
938 -> (RawCmmDecl -> NatM [NatCmmDecl statics instr])
939 -> DwarfFiles
940 -> LabelMap DebugBlock
941 -> RawCmmDecl
942 -> UniqSM
943 ( [NatCmmDecl statics instr]
944 , [CLabel]
945 , DwarfFiles)
946
947 genMachCode dflags this_mod modLoc cmmTopCodeGen fileIds dbgMap cmm_top
948 = do { initial_us <- getUniqueSupplyM
949 ; let initial_st = mkNatM_State initial_us 0 dflags this_mod
950 modLoc fileIds dbgMap
951 (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)
952 final_delta = natm_delta final_st
953 final_imports = natm_imports final_st
954 ; if final_delta == 0
955 then return (new_tops, final_imports, natm_fileid final_st)
956 else pprPanic "genMachCode: nonzero final delta" (int final_delta)
957 }
958
959 -- -----------------------------------------------------------------------------
960 -- Generic Cmm optimiser
961
962 {-
963 Here we do:
964
965 (a) Constant folding
966 (c) Position independent code and dynamic linking
967 (i) introduce the appropriate indirections
968 and position independent refs
969 (ii) compile a list of imported symbols
970 (d) Some arch-specific optimizations
971
972 (a) will be moving to the new Hoopl pipeline, however, (c) and
973 (d) are only needed by the native backend and will continue to live
974 here.
975
976 Ideas for other things we could do (put these in Hoopl please!):
977
978 - shortcut jumps-to-jumps
979 - simple CSE: if an expr is assigned to a temp, then replace later occs of
980 that expr with the temp, until the expr is no longer valid (can push through
981 temp assignments, and certain assigns to mem...)
982 -}
983
984 cmmToCmm :: DynFlags -> Module -> RawCmmDecl -> (RawCmmDecl, [CLabel])
985 cmmToCmm _ _ top@(CmmData _ _) = (top, [])
986 cmmToCmm dflags this_mod (CmmProc info lbl live graph)
987 = runCmmOpt dflags this_mod $
988 do blocks' <- mapM cmmBlockConFold (toBlockList graph)
989 return $ CmmProc info lbl live (ofBlockList (g_entry graph) blocks')
990
991 newtype CmmOptM a = CmmOptM (DynFlags -> Module -> [CLabel] -> (# a, [CLabel] #))
992
993 instance Functor CmmOptM where
994 fmap = liftM
995
996 instance Applicative CmmOptM where
997 pure x = CmmOptM $ \_ _ imports -> (# x, imports #)
998 (<*>) = ap
999
1000 instance Monad CmmOptM where
1001 (CmmOptM f) >>= g =
1002 CmmOptM $ \dflags this_mod imports ->
1003 case f dflags this_mod imports of
1004 (# x, imports' #) ->
1005 case g x of
1006 CmmOptM g' -> g' dflags this_mod imports'
1007
1008 instance CmmMakeDynamicReferenceM CmmOptM where
1009 addImport = addImportCmmOpt
1010 getThisModule = CmmOptM $ \_ this_mod imports -> (# this_mod, imports #)
1011
1012 addImportCmmOpt :: CLabel -> CmmOptM ()
1013 addImportCmmOpt lbl = CmmOptM $ \_ _ imports -> (# (), lbl:imports #)
1014
1015 instance HasDynFlags CmmOptM where
1016 getDynFlags = CmmOptM $ \dflags _ imports -> (# dflags, imports #)
1017
1018 runCmmOpt :: DynFlags -> Module -> CmmOptM a -> (a, [CLabel])
1019 runCmmOpt dflags this_mod (CmmOptM f) = case f dflags this_mod [] of
1020 (# result, imports #) -> (result, imports)
1021
1022 cmmBlockConFold :: CmmBlock -> CmmOptM CmmBlock
1023 cmmBlockConFold block = do
1024 let (entry, middle, last) = blockSplit block
1025 stmts = blockToList middle
1026 stmts' <- mapM cmmStmtConFold stmts
1027 last' <- cmmStmtConFold last
1028 return $ blockJoin entry (blockFromList stmts') last'
1029
1030 -- This does three optimizations, but they're very quick to check, so we don't
1031 -- bother turning them off even when the Hoopl code is active. Since
1032 -- this is on the old Cmm representation, we can't reuse the code either:
1033 -- * reg = reg --> nop
1034 -- * if 0 then jump --> nop
1035 -- * if 1 then jump --> jump
1036 -- We might be tempted to skip this step entirely of not Opt_PIC, but
1037 -- there is some PowerPC code for the non-PIC case, which would also
1038 -- have to be separated.
1039 cmmStmtConFold :: CmmNode e x -> CmmOptM (CmmNode e x)
1040 cmmStmtConFold stmt
1041 = case stmt of
1042 CmmAssign reg src
1043 -> do src' <- cmmExprConFold DataReference src
1044 return $ case src' of
1045 CmmReg reg' | reg == reg' -> CmmComment (fsLit "nop")
1046 new_src -> CmmAssign reg new_src
1047
1048 CmmStore addr src
1049 -> do addr' <- cmmExprConFold DataReference addr
1050 src' <- cmmExprConFold DataReference src
1051 return $ CmmStore addr' src'
1052
1053 CmmCall { cml_target = addr }
1054 -> do addr' <- cmmExprConFold JumpReference addr
1055 return $ stmt { cml_target = addr' }
1056
1057 CmmUnsafeForeignCall target regs args
1058 -> do target' <- case target of
1059 ForeignTarget e conv -> do
1060 e' <- cmmExprConFold CallReference e
1061 return $ ForeignTarget e' conv
1062 PrimTarget _ ->
1063 return target
1064 args' <- mapM (cmmExprConFold DataReference) args
1065 return $ CmmUnsafeForeignCall target' regs args'
1066
1067 CmmCondBranch test true false likely
1068 -> do test' <- cmmExprConFold DataReference test
1069 return $ case test' of
1070 CmmLit (CmmInt 0 _) -> CmmBranch false
1071 CmmLit (CmmInt _ _) -> CmmBranch true
1072 _other -> CmmCondBranch test' true false likely
1073
1074 CmmSwitch expr ids
1075 -> do expr' <- cmmExprConFold DataReference expr
1076 return $ CmmSwitch expr' ids
1077
1078 other
1079 -> return other
1080
1081 cmmExprConFold :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr
1082 cmmExprConFold referenceKind expr = do
1083 dflags <- getDynFlags
1084
1085 -- With -O1 and greater, the cmmSink pass does constant-folding, so
1086 -- we don't need to do it again here.
1087 let expr' = if optLevel dflags >= 1
1088 then expr
1089 else cmmExprCon dflags expr
1090
1091 cmmExprNative referenceKind expr'
1092
1093 cmmExprCon :: DynFlags -> CmmExpr -> CmmExpr
1094 cmmExprCon dflags (CmmLoad addr rep) = CmmLoad (cmmExprCon dflags addr) rep
1095 cmmExprCon dflags (CmmMachOp mop args)
1096 = cmmMachOpFold dflags mop (map (cmmExprCon dflags) args)
1097 cmmExprCon _ other = other
1098
1099 -- handles both PIC and non-PIC cases... a very strange mixture
1100 -- of things to do.
1101 cmmExprNative :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr
1102 cmmExprNative referenceKind expr = do
1103 dflags <- getDynFlags
1104 let platform = targetPlatform dflags
1105 arch = platformArch platform
1106 case expr of
1107 CmmLoad addr rep
1108 -> do addr' <- cmmExprNative DataReference addr
1109 return $ CmmLoad addr' rep
1110
1111 CmmMachOp mop args
1112 -> do args' <- mapM (cmmExprNative DataReference) args
1113 return $ CmmMachOp mop args'
1114
1115 CmmLit (CmmBlock id)
1116 -> cmmExprNative referenceKind (CmmLit (CmmLabel (infoTblLbl id)))
1117 -- we must convert block Ids to CLabels here, because we
1118 -- might have to do the PIC transformation. Hence we must
1119 -- not modify BlockIds beyond this point.
1120
1121 CmmLit (CmmLabel lbl)
1122 -> do
1123 cmmMakeDynamicReference dflags referenceKind lbl
1124 CmmLit (CmmLabelOff lbl off)
1125 -> do
1126 dynRef <- cmmMakeDynamicReference dflags referenceKind lbl
1127 -- need to optimize here, since it's late
1128 return $ cmmMachOpFold dflags (MO_Add (wordWidth dflags)) [
1129 dynRef,
1130 (CmmLit $ CmmInt (fromIntegral off) (wordWidth dflags))
1131 ]
1132
1133 -- On powerpc (non-PIC), it's easier to jump directly to a label than
1134 -- to use the register table, so we replace these registers
1135 -- with the corresponding labels:
1136 CmmReg (CmmGlobal EagerBlackholeInfo)
1137 | arch == ArchPPC && not (gopt Opt_PIC dflags)
1138 -> cmmExprNative referenceKind $
1139 CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_EAGER_BLACKHOLE_info")))
1140 CmmReg (CmmGlobal GCEnter1)
1141 | arch == ArchPPC && not (gopt Opt_PIC dflags)
1142 -> cmmExprNative referenceKind $
1143 CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_gc_enter_1")))
1144 CmmReg (CmmGlobal GCFun)
1145 | arch == ArchPPC && not (gopt Opt_PIC dflags)
1146 -> cmmExprNative referenceKind $
1147 CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_gc_fun")))
1148
1149 other
1150 -> return other