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