1 -- -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow 1993-2004
5 -- This is the top-level module in the native code generator.
7 -- -----------------------------------------------------------------------------
10 module AsmCodeGen ( nativeCodeGen ) where
12 #include "HsVersions.h"
13 #include "nativeGen/NCG.h"
21 import PositionIndependentCode
25 import qualified RegAllocColor as Color
26 import qualified GraphColor as Color
29 import CmmOpt ( cmmMiniInline, cmmMachOpFold )
30 import PprCmm ( pprStmt, pprCmms, pprCmm )
35 import Unique ( Unique, getUnique )
38 import List ( groupBy, sortBy )
39 import ErrUtils ( dumpIfSet_dyn )
41 import StaticFlags ( opt_Static, opt_PIC )
43 import Config ( cProjectVersion )
46 import qualified Pretty
55 import List ( intersperse )
65 The native-code generator has machine-independent and
66 machine-dependent modules.
68 This module ("AsmCodeGen") is the top-level machine-independent
69 module. Before entering machine-dependent land, we do some
70 machine-independent optimisations (defined below) on the
73 We convert to the machine-specific 'Instr' datatype with
74 'cmmCodeGen', assuming an infinite supply of registers. We then use
75 a machine-independent register allocator ('regAlloc') to rejoin
76 reality. Obviously, 'regAlloc' has machine-specific helper
77 functions (see about "RegAllocInfo" below).
79 Finally, we order the basic blocks of the function so as to minimise
80 the number of jumps between blocks, by utilising fallthrough wherever
83 The machine-dependent bits break down as follows:
85 * ["MachRegs"] Everything about the target platform's machine
86 registers (and immediate operands, and addresses, which tend to
87 intermingle/interact with registers).
89 * ["MachInstrs"] Includes the 'Instr' datatype (possibly should
90 have a module of its own), plus a miscellany of other things
91 (e.g., 'targetDoubleSize', 'smStablePtrTable', ...)
93 * ["MachCodeGen"] is where 'Cmm' stuff turns into
96 * ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
99 * ["RegAllocInfo"] In the register allocator, we manipulate
100 'MRegsState's, which are 'BitSet's, one bit per machine register.
101 When we want to say something about a specific machine register
102 (e.g., ``it gets clobbered by this instruction''), we set/unset
103 its bit. Obviously, we do this 'BitSet' thing for efficiency
106 The 'RegAllocInfo' module collects together the machine-specific
107 info needed to do register allocation.
109 * ["RegisterAlloc"] The (machine-independent) register allocator.
112 -- -----------------------------------------------------------------------------
113 -- Top-level of the native codegen
115 -- NB. We *lazilly* compile each block of code for space reasons.
118 nativeCodeGen :: DynFlags -> [RawCmm] -> UniqSupply -> IO Pretty.Doc
119 nativeCodeGen dflags cmms us
120 = let (res, _) = initUs us $
121 cgCmm (concat (map add_split cmms))
123 cgCmm :: [RawCmmTop] -> UniqSM ( [CmmNativeGenDump], Pretty.Doc, [CLabel])
125 lazyMapUs (cmmNativeGen dflags) tops `thenUs` \ results ->
126 case unzip3 results of { (dump,docs,imps) ->
127 returnUs (dump, my_vcat docs, concat imps)
130 case res of { (dump, insn_sdoc, imports) -> do
132 -- stripe across the outputs for each block so all the information for a
133 -- certain stage is concurrent in the dumps.
136 Opt_D_dump_opt_cmm "Optimised Cmm"
137 (pprCmm $ Cmm $ map cdCmmOpt dump)
140 Opt_D_dump_asm_native "(asm-native) Native code"
141 (vcat $ map (docToSDoc . pprNatCmmTop) $ concatMap cdNative dump)
144 Opt_D_dump_asm_liveness "(asm-liveness) Liveness info added"
145 (vcat $ map (ppr . cdLiveness) dump)
148 Opt_D_dump_asm_coalesce "(asm-coalesce) Register moves coalesced."
149 (vcat $ map (ppr . cdCoalesce) dump)
152 Opt_D_dump_asm_regalloc "(asm-regalloc) Registers allocated"
153 (vcat $ map (docToSDoc . pprNatCmmTop) $ concatMap cdAlloced dump)
155 -- with the graph coloring allocator, show the result of each build/spill stage
156 -- for each block in turn.
158 -> dumpIfSet_dyn dflags
159 Opt_D_dump_asm_regalloc_stages
160 "(asm-regalloc-stages)"
161 (vcat $ map (\(stage, (code, graph)) ->
162 ( text "-- Stage " <> int stage
164 $$ Color.dotGraph Color.regDotColor trivColorable graph))
165 (zip [0..] codeGraphs)))
166 $ map cdCodeGraphs dump
168 -- Build a global register conflict graph.
169 -- If you want to see the graph for just one basic block then use asm-regalloc-stages instead.
171 Opt_D_dump_asm_conflicts "(asm-conflicts) Register conflict graph"
172 $ Color.dotGraph Color.regDotColor trivColorable
173 $ foldl Color.union Color.initGraph
174 $ catMaybes $ map cdColoredGraph dump
177 return (insn_sdoc Pretty.$$ dyld_stubs imports
179 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
180 -- On recent versions of Darwin, the linker supports
181 -- dead-stripping of code and data on a per-symbol basis.
182 -- There's a hack to make this work in PprMach.pprNatCmmTop.
183 Pretty.$$ Pretty.text ".subsections_via_symbols"
185 #if HAVE_GNU_NONEXEC_STACK
186 -- On recent GNU ELF systems one can mark an object file
187 -- as not requiring an executable stack. If all objects
188 -- linked into a program have this note then the program
189 -- will not use an executable stack, which is good for
190 -- security. GHC generated code does not need an executable
191 -- stack so add the note in:
192 Pretty.$$ Pretty.text ".section .note.GNU-stack,\"\",@progbits"
194 #if !defined(darwin_TARGET_OS)
195 -- And just because every other compiler does, lets stick in
196 -- an identifier directive: .ident "GHC x.y.z"
197 Pretty.$$ let compilerIdent = Pretty.text "GHC" Pretty.<+>
198 Pretty.text cProjectVersion
199 in Pretty.text ".ident" Pretty.<+>
200 Pretty.doubleQuotes compilerIdent
208 | dopt Opt_SplitObjs dflags = split_marker : tops
211 split_marker = CmmProc [] mkSplitMarkerLabel [] []
213 -- Generate "symbol stubs" for all external symbols that might
214 -- come from a dynamic library.
215 {- dyld_stubs imps = Pretty.vcat $ map pprDyldSymbolStub $
216 map head $ group $ sort imps-}
218 -- (Hack) sometimes two Labels pretty-print the same, but have
219 -- different uniques; so we compare their text versions...
221 | needImportedSymbols
223 (pprGotDeclaration :) $
224 map (pprImportedSymbol . fst . head) $
225 groupBy (\(_,a) (_,b) -> a == b) $
226 sortBy (\(_,a) (_,b) -> compare a b) $
232 where doPpr lbl = (lbl, Pretty.render $ pprCLabel lbl astyle)
233 astyle = mkCodeStyle AsmStyle
236 my_vcat sds = Pretty.vcat sds
238 my_vcat sds = Pretty.vcat (
241 Pretty.$$ Pretty.ptext SLIT("# ___ncg_debug_marker")
242 Pretty.$$ Pretty.char ' '
249 -- Carries output of the code generator passes, for dumping.
250 -- Make sure to only fill the one's we're interested in to avoid
251 -- creating space leaks.
253 data CmmNativeGenDump
255 { cdCmmOpt :: RawCmmTop
256 , cdNative :: [NatCmmTop]
257 , cdLiveness :: [LiveCmmTop]
258 , cdCoalesce :: [LiveCmmTop]
259 , cdCodeGraphs :: [([LiveCmmTop], Color.Graph Reg RegClass Reg)]
260 , cdColoredGraph :: Maybe (Color.Graph Reg RegClass Reg)
261 , cdAlloced :: [NatCmmTop] }
263 dchoose dflags opt a b
264 | dopt opt dflags = a
268 -- | Complete native code generation phase for a single top-level chunk of Cmm.
269 -- Unless they're being dumped, intermediate data structures are squashed after
270 -- every stage to avoid creating space leaks.
272 cmmNativeGen :: DynFlags -> RawCmmTop -> UniqSM (CmmNativeGenDump, Pretty.Doc, [CLabel])
273 cmmNativeGen dflags cmm
277 <- {-# SCC "fixAssigns" #-}
280 ---- cmm to cmm optimisations
281 (cmm, imports, ppr_cmm)
283 -> {-# SCC "genericOpt" #-}
284 do let (cmm, imports) = cmmToCmm dflags fixed_cmm
288 , dchoose dflags Opt_D_dump_cmm cmm (CmmData Text []))
292 ---- generate native code from cmm
293 (native, lastMinuteImports, ppr_native)
295 -> {-# SCC "genMachCode" #-}
296 do (machCode, lastMinuteImports)
297 <- genMachCode dflags cmm
301 , dchoose dflags Opt_D_dump_asm_native machCode [])
305 ---- tag instructions with register liveness information
306 (withLiveness, ppr_withLiveness)
308 -> {-# SCC "regLiveness" #-}
310 withLiveness <- mapUs regLiveness native
312 return ( withLiveness
313 , dchoose dflags Opt_D_dump_asm_liveness withLiveness []))
316 ---- allocate registers
317 (alloced, ppr_alloced, ppr_coalesce, ppr_codeGraphs, ppr_coloredGraph)
319 -> {-# SCC "regAlloc" #-}
321 if dopt Opt_RegsGraph dflags
323 -- the regs usable for allocation
325 = foldr (\r -> plusUFM_C unionUniqSets
326 $ unitUFM (regClass r) (unitUniqSet r))
328 $ map RealReg allocatableRegs
330 -- aggressively coalesce moves between virtual regs
331 coalesced <- regCoalesce withLiveness
333 -- graph coloring register allocation
334 (alloced, codeGraphs)
337 (mkUniqSet [0..maxSpillSlots])
341 , dchoose dflags Opt_D_dump_asm_regalloc alloced []
342 , dchoose dflags Opt_D_dump_asm_coalesce coalesced []
343 , dchoose dflags Opt_D_dump_asm_regalloc_stages codeGraphs []
344 , dchoose dflags Opt_D_dump_asm_conflicts Nothing Nothing)
347 -- do linear register allocation
348 alloced <- mapUs regAlloc withLiveness
350 , dchoose dflags Opt_D_dump_asm_regalloc alloced []
357 ---- shortcut branches
359 {-# SCC "shortcutBranches" #-}
360 shortcutBranches dflags alloced
364 {-# SCC "sequenceBlocks" #-}
365 map sequenceTop shorted
368 let final_mach_code =
370 {-# SCC "x86fp_kludge" #-}
371 map x86fp_kludge sequenced
379 Pretty.vcat (map pprNatCmmTop final_mach_code)
384 , cdNative = ppr_native
385 , cdLiveness = ppr_withLiveness
386 , cdCoalesce = ppr_coalesce
387 , cdCodeGraphs = ppr_codeGraphs
388 , cdColoredGraph = ppr_coloredGraph
389 , cdAlloced = ppr_alloced }
391 returnUs (dump, final_sdoc Pretty.$$ Pretty.text "", lastMinuteImports ++ imports)
394 x86fp_kludge :: NatCmmTop -> NatCmmTop
395 x86fp_kludge top@(CmmData _ _) = top
396 x86fp_kludge top@(CmmProc info lbl params code) =
397 CmmProc info lbl params (map bb_i386_insert_ffrees code)
399 bb_i386_insert_ffrees (BasicBlock id instrs) =
400 BasicBlock id (i386_insert_ffrees instrs)
404 -- -----------------------------------------------------------------------------
405 -- Sequencing the basic blocks
407 -- Cmm BasicBlocks are self-contained entities: they always end in a
408 -- jump, either non-local or to another basic block in the same proc.
409 -- In this phase, we attempt to place the basic blocks in a sequence
410 -- such that as many of the local jumps as possible turn into
413 sequenceTop :: NatCmmTop -> NatCmmTop
414 sequenceTop top@(CmmData _ _) = top
415 sequenceTop (CmmProc info lbl params blocks) =
416 CmmProc info lbl params (makeFarBranches $ sequenceBlocks blocks)
418 -- The algorithm is very simple (and stupid): we make a graph out of
419 -- the blocks where there is an edge from one block to another iff the
420 -- first block ends by jumping to the second. Then we topologically
421 -- sort this graph. Then traverse the list: for each block, we first
422 -- output the block, then if it has an out edge, we move the
423 -- destination of the out edge to the front of the list, and continue.
425 sequenceBlocks :: [NatBasicBlock] -> [NatBasicBlock]
426 sequenceBlocks [] = []
427 sequenceBlocks (entry:blocks) =
428 seqBlocks (mkNode entry : reverse (flattenSCCs (sccBlocks blocks)))
429 -- the first block is the entry point ==> it must remain at the start.
431 sccBlocks :: [NatBasicBlock] -> [SCC (NatBasicBlock,Unique,[Unique])]
432 sccBlocks blocks = stronglyConnCompR (map mkNode blocks)
434 getOutEdges :: [Instr] -> [Unique]
435 getOutEdges instrs = case jumpDests (last instrs) [] of
436 [one] -> [getUnique one]
438 -- we're only interested in the last instruction of
439 -- the block, and only if it has a single destination.
441 mkNode block@(BasicBlock id instrs) = (block, getUnique id, getOutEdges instrs)
444 seqBlocks ((block,_,[]) : rest)
445 = block : seqBlocks rest
446 seqBlocks ((block@(BasicBlock id instrs),_,[next]) : rest)
447 | can_fallthrough = BasicBlock id (init instrs) : seqBlocks rest'
448 | otherwise = block : seqBlocks rest'
450 (can_fallthrough, rest') = reorder next [] rest
451 -- TODO: we should do a better job for cycles; try to maximise the
452 -- fallthroughs within a loop.
453 seqBlocks _ = panic "AsmCodegen:seqBlocks"
455 reorder id accum [] = (False, reverse accum)
456 reorder id accum (b@(block,id',out) : rest)
457 | id == id' = (True, (block,id,out) : reverse accum ++ rest)
458 | otherwise = reorder id (b:accum) rest
461 -- -----------------------------------------------------------------------------
462 -- Making far branches
464 -- Conditional branches on PowerPC are limited to +-32KB; if our Procs get too
465 -- big, we have to work around this limitation.
467 makeFarBranches :: [NatBasicBlock] -> [NatBasicBlock]
469 #if powerpc_TARGET_ARCH
470 makeFarBranches blocks
471 | last blockAddresses < nearLimit = blocks
472 | otherwise = zipWith handleBlock blockAddresses blocks
474 blockAddresses = scanl (+) 0 $ map blockLen blocks
475 blockLen (BasicBlock _ instrs) = length instrs
477 handleBlock addr (BasicBlock id instrs)
478 = BasicBlock id (zipWith makeFar [addr..] instrs)
480 makeFar addr (BCC ALWAYS tgt) = BCC ALWAYS tgt
481 makeFar addr (BCC cond tgt)
482 | abs (addr - targetAddr) >= nearLimit
486 where Just targetAddr = lookupUFM blockAddressMap tgt
487 makeFar addr other = other
489 nearLimit = 7000 -- 8192 instructions are allowed; let's keep some
490 -- distance, as we have a few pseudo-insns that are
491 -- pretty-printed as multiple instructions,
492 -- and it's just not worth the effort to calculate
495 blockAddressMap = listToUFM $ zip (map blockId blocks) blockAddresses
500 -- -----------------------------------------------------------------------------
503 shortcutBranches :: DynFlags -> [NatCmmTop] -> [NatCmmTop]
504 shortcutBranches dflags tops
505 | optLevel dflags < 1 = tops -- only with -O or higher
506 | otherwise = map (apply_mapping mapping) tops'
508 (tops', mappings) = mapAndUnzip build_mapping tops
509 mapping = foldr plusUFM emptyUFM mappings
511 build_mapping top@(CmmData _ _) = (top, emptyUFM)
512 build_mapping (CmmProc info lbl params [])
513 = (CmmProc info lbl params [], emptyUFM)
514 build_mapping (CmmProc info lbl params (head:blocks))
515 = (CmmProc info lbl params (head:others), mapping)
516 -- drop the shorted blocks, but don't ever drop the first one,
517 -- because it is pointed to by a global label.
519 -- find all the blocks that just consist of a jump that can be
521 (shortcut_blocks, others) = partitionWith split blocks
522 split (BasicBlock id [insn]) | Just dest <- canShortcut insn
524 split other = Right other
526 -- build a mapping from BlockId to JumpDest for shorting branches
527 mapping = foldl add emptyUFM shortcut_blocks
528 add ufm (id,dest) = addToUFM ufm id dest
530 apply_mapping ufm (CmmData sec statics)
531 = CmmData sec (map (shortcutStatic (lookupUFM ufm)) statics)
532 -- we need to get the jump tables, so apply the mapping to the entries
534 apply_mapping ufm (CmmProc info lbl params blocks)
535 = CmmProc info lbl params (map short_bb blocks)
537 short_bb (BasicBlock id insns) = BasicBlock id $! map short_insn insns
538 short_insn i = shortcutJump (lookupUFM ufm) i
539 -- shortcutJump should apply the mapping repeatedly,
540 -- just in case we can short multiple branches.
542 -- -----------------------------------------------------------------------------
543 -- Instruction selection
545 -- Native code instruction selection for a chunk of stix code. For
546 -- this part of the computation, we switch from the UniqSM monad to
547 -- the NatM monad. The latter carries not only a Unique, but also an
548 -- Int denoting the current C stack pointer offset in the generated
549 -- code; this is needed for creating correct spill offsets on
550 -- architectures which don't offer, or for which it would be
551 -- prohibitively expensive to employ, a frame pointer register. Viz,
554 -- The offset is measured in bytes, and indicates the difference
555 -- between the current (simulated) C stack-ptr and the value it was at
556 -- the beginning of the block. For stacks which grow down, this value
557 -- should be either zero or negative.
559 -- Switching between the two monads whilst carrying along the same
560 -- Unique supply breaks abstraction. Is that bad?
562 genMachCode :: DynFlags -> RawCmmTop -> UniqSM ([NatCmmTop], [CLabel])
564 genMachCode dflags cmm_top
565 = do { initial_us <- getUs
566 ; let initial_st = mkNatM_State initial_us 0 dflags
567 (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)
568 final_delta = natm_delta final_st
569 final_imports = natm_imports final_st
570 ; if final_delta == 0
571 then return (new_tops, final_imports)
572 else pprPanic "genMachCode: nonzero final delta" (int final_delta)
575 -- -----------------------------------------------------------------------------
576 -- Fixup assignments to global registers so that they assign to
577 -- locations within the RegTable, if appropriate.
579 -- Note that we currently don't fixup reads here: they're done by
580 -- the generic optimiser below, to avoid having two separate passes
583 fixAssignsTop :: RawCmmTop -> UniqSM RawCmmTop
584 fixAssignsTop top@(CmmData _ _) = returnUs top
585 fixAssignsTop (CmmProc info lbl params blocks) =
586 mapUs fixAssignsBlock blocks `thenUs` \ blocks' ->
587 returnUs (CmmProc info lbl params blocks')
589 fixAssignsBlock :: CmmBasicBlock -> UniqSM CmmBasicBlock
590 fixAssignsBlock (BasicBlock id stmts) =
591 fixAssigns stmts `thenUs` \ stmts' ->
592 returnUs (BasicBlock id stmts')
594 fixAssigns :: [CmmStmt] -> UniqSM [CmmStmt]
596 mapUs fixAssign stmts `thenUs` \ stmtss ->
597 returnUs (concat stmtss)
599 fixAssign :: CmmStmt -> UniqSM [CmmStmt]
600 fixAssign (CmmAssign (CmmGlobal reg) src)
601 | Left realreg <- reg_or_addr
602 = returnUs [CmmAssign (CmmGlobal reg) src]
603 | Right baseRegAddr <- reg_or_addr
604 = returnUs [CmmStore baseRegAddr src]
605 -- Replace register leaves with appropriate StixTrees for
606 -- the given target. GlobalRegs which map to a reg on this
607 -- arch are left unchanged. Assigning to BaseReg is always
608 -- illegal, so we check for that.
610 reg_or_addr = get_GlobalReg_reg_or_addr reg
612 fixAssign other_stmt = returnUs [other_stmt]
614 -- -----------------------------------------------------------------------------
615 -- Generic Cmm optimiser
621 (b) Simple inlining: a temporary which is assigned to and then
622 used, once, can be shorted.
623 (c) Replacement of references to GlobalRegs which do not have
624 machine registers by the appropriate memory load (eg.
625 Hp ==> *(BaseReg + 34) ).
626 (d) Position independent code and dynamic linking
627 (i) introduce the appropriate indirections
628 and position independent refs
629 (ii) compile a list of imported symbols
631 Ideas for other things we could do (ToDo):
633 - shortcut jumps-to-jumps
634 - eliminate dead code blocks
635 - simple CSE: if an expr is assigned to a temp, then replace later occs of
636 that expr with the temp, until the expr is no longer valid (can push through
637 temp assignments, and certain assigns to mem...)
640 cmmToCmm :: DynFlags -> RawCmmTop -> (RawCmmTop, [CLabel])
641 cmmToCmm _ top@(CmmData _ _) = (top, [])
642 cmmToCmm dflags (CmmProc info lbl params blocks) = runCmmOpt dflags $ do
643 blocks' <- mapM cmmBlockConFold (cmmMiniInline blocks)
644 return $ CmmProc info lbl params blocks'
646 newtype CmmOptM a = CmmOptM (([CLabel], DynFlags) -> (# a, [CLabel] #))
648 instance Monad CmmOptM where
649 return x = CmmOptM $ \(imports, _) -> (# x,imports #)
651 CmmOptM $ \(imports, dflags) ->
652 case f (imports, dflags) of
655 CmmOptM g' -> g' (imports', dflags)
657 addImportCmmOpt :: CLabel -> CmmOptM ()
658 addImportCmmOpt lbl = CmmOptM $ \(imports, dflags) -> (# (), lbl:imports #)
660 getDynFlagsCmmOpt :: CmmOptM DynFlags
661 getDynFlagsCmmOpt = CmmOptM $ \(imports, dflags) -> (# dflags, imports #)
663 runCmmOpt :: DynFlags -> CmmOptM a -> (a, [CLabel])
664 runCmmOpt dflags (CmmOptM f) = case f ([], dflags) of
665 (# result, imports #) -> (result, imports)
667 cmmBlockConFold :: CmmBasicBlock -> CmmOptM CmmBasicBlock
668 cmmBlockConFold (BasicBlock id stmts) = do
669 stmts' <- mapM cmmStmtConFold stmts
670 return $ BasicBlock id stmts'
675 -> do src' <- cmmExprConFold DataReference src
676 return $ case src' of
677 CmmReg reg' | reg == reg' -> CmmNop
678 new_src -> CmmAssign reg new_src
681 -> do addr' <- cmmExprConFold DataReference addr
682 src' <- cmmExprConFold DataReference src
683 return $ CmmStore addr' src'
686 -> do addr' <- cmmExprConFold JumpReference addr
687 return $ CmmJump addr' regs
689 CmmCall target regs args srt returns
690 -> do target' <- case target of
691 CmmCallee e conv -> do
692 e' <- cmmExprConFold CallReference e
693 return $ CmmCallee e' conv
694 other -> return other
695 args' <- mapM (\(arg, hint) -> do
696 arg' <- cmmExprConFold DataReference arg
697 return (arg', hint)) args
698 return $ CmmCall target' regs args' srt returns
700 CmmCondBranch test dest
701 -> do test' <- cmmExprConFold DataReference test
702 return $ case test' of
703 CmmLit (CmmInt 0 _) ->
704 CmmComment (mkFastString ("deleted: " ++
705 showSDoc (pprStmt stmt)))
707 CmmLit (CmmInt n _) -> CmmBranch dest
708 other -> CmmCondBranch test' dest
711 -> do expr' <- cmmExprConFold DataReference expr
712 return $ CmmSwitch expr' ids
718 cmmExprConFold referenceKind expr
721 -> do addr' <- cmmExprConFold DataReference addr
722 return $ CmmLoad addr' rep
725 -- For MachOps, we first optimize the children, and then we try
726 -- our hand at some constant-folding.
727 -> do args' <- mapM (cmmExprConFold DataReference) args
728 return $ cmmMachOpFold mop args'
730 CmmLit (CmmLabel lbl)
732 dflags <- getDynFlagsCmmOpt
733 cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
734 CmmLit (CmmLabelOff lbl off)
736 dflags <- getDynFlagsCmmOpt
737 dynRef <- cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
738 return $ cmmMachOpFold (MO_Add wordRep) [
740 (CmmLit $ CmmInt (fromIntegral off) wordRep)
743 #if powerpc_TARGET_ARCH
744 -- On powerpc (non-PIC), it's easier to jump directly to a label than
745 -- to use the register table, so we replace these registers
746 -- with the corresponding labels:
747 CmmReg (CmmGlobal GCEnter1)
749 -> cmmExprConFold referenceKind $
750 CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_enter_1")))
751 CmmReg (CmmGlobal GCFun)
753 -> cmmExprConFold referenceKind $
754 CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_fun")))
757 CmmReg (CmmGlobal mid)
758 -- Replace register leaves with appropriate StixTrees for
759 -- the given target. MagicIds which map to a reg on this
760 -- arch are left unchanged. For the rest, BaseReg is taken
761 -- to mean the address of the reg table in MainCapability,
762 -- and for all others we generate an indirection to its
763 -- location in the register table.
764 -> case get_GlobalReg_reg_or_addr mid of
765 Left realreg -> return expr
768 BaseReg -> cmmExprConFold DataReference baseRegAddr
769 other -> cmmExprConFold DataReference
770 (CmmLoad baseRegAddr (globalRegRep mid))
771 -- eliminate zero offsets
773 -> cmmExprConFold referenceKind (CmmReg reg)
775 CmmRegOff (CmmGlobal mid) offset
776 -- RegOf leaves are just a shorthand form. If the reg maps
777 -- to a real reg, we keep the shorthand, otherwise, we just
778 -- expand it and defer to the above code.
779 -> case get_GlobalReg_reg_or_addr mid of
780 Left realreg -> return expr
782 -> cmmExprConFold DataReference (CmmMachOp (MO_Add wordRep) [
783 CmmReg (CmmGlobal mid),
784 CmmLit (CmmInt (fromIntegral offset)
789 -- -----------------------------------------------------------------------------