1 -- -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow 1993-2004
5 -- This is the top-level module in the native code generator.
7 -- -----------------------------------------------------------------------------
10 {-# OPTIONS_GHC -w #-}
11 -- The above warning supression flag is a temporary kludge.
12 -- While working on this module you are encouraged to remove it and fix
13 -- any warnings in the module. See
14 -- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
17 module AsmCodeGen ( nativeCodeGen ) where
19 #include "HsVersions.h"
20 #include "nativeGen/NCG.h"
28 import PositionIndependentCode
31 import qualified RegAllocLinear as Linear
32 import qualified RegAllocColor as Color
33 import qualified RegAllocStats as Color
34 import qualified GraphColor as Color
37 import CmmOpt ( cmmMiniInline, cmmMachOpFold )
38 import PprCmm ( pprStmt, pprCmms, pprCmm )
44 import Unique ( Unique, getUnique )
47 import List ( groupBy, sortBy )
48 import ErrUtils ( dumpIfSet_dyn )
50 import StaticFlags ( opt_Static, opt_PIC )
52 import Config ( cProjectVersion )
56 import qualified Pretty
74 The native-code generator has machine-independent and
75 machine-dependent modules.
77 This module ("AsmCodeGen") is the top-level machine-independent
78 module. Before entering machine-dependent land, we do some
79 machine-independent optimisations (defined below) on the
82 We convert to the machine-specific 'Instr' datatype with
83 'cmmCodeGen', assuming an infinite supply of registers. We then use
84 a machine-independent register allocator ('regAlloc') to rejoin
85 reality. Obviously, 'regAlloc' has machine-specific helper
86 functions (see about "RegAllocInfo" below).
88 Finally, we order the basic blocks of the function so as to minimise
89 the number of jumps between blocks, by utilising fallthrough wherever
92 The machine-dependent bits break down as follows:
94 * ["MachRegs"] Everything about the target platform's machine
95 registers (and immediate operands, and addresses, which tend to
96 intermingle/interact with registers).
98 * ["MachInstrs"] Includes the 'Instr' datatype (possibly should
99 have a module of its own), plus a miscellany of other things
100 (e.g., 'targetDoubleSize', 'smStablePtrTable', ...)
102 * ["MachCodeGen"] is where 'Cmm' stuff turns into
103 machine instructions.
105 * ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
108 * ["RegAllocInfo"] In the register allocator, we manipulate
109 'MRegsState's, which are 'BitSet's, one bit per machine register.
110 When we want to say something about a specific machine register
111 (e.g., ``it gets clobbered by this instruction''), we set/unset
112 its bit. Obviously, we do this 'BitSet' thing for efficiency
115 The 'RegAllocInfo' module collects together the machine-specific
116 info needed to do register allocation.
118 * ["RegisterAlloc"] The (machine-independent) register allocator.
121 -- -----------------------------------------------------------------------------
122 -- Top-level of the native codegen
124 -- NB. We *lazilly* compile each block of code for space reasons.
127 nativeCodeGen :: DynFlags -> [RawCmm] -> UniqSupply -> IO Pretty.Doc
128 nativeCodeGen dflags cmms us
130 -- do native code generation on all these cmm things
132 <- mapAccumLM (cmmNativeGen dflags) us
133 $ concat $ map add_split cmms
135 let (native, imports, mColorStats, mLinearStats)
138 -- dump global NCG stats for graph coloring allocator
139 (case concat $ catMaybes mColorStats of
142 -- build the global register conflict graph
144 = foldl Color.union Color.initGraph
145 $ [ Color.raGraph stat
146 | stat@Color.RegAllocStatsStart{} <- stats]
148 dumpSDoc dflags Opt_D_dump_asm_stats "NCG stats"
149 $ Color.pprStats stats graphGlobal
152 Opt_D_dump_asm_conflicts "Register conflict graph"
153 $ Color.dotGraph Color.regDotColor trivColorable
157 -- dump global NCG stats for linear allocator
158 (case catMaybes mLinearStats of
160 stats -> dumpSDoc dflags Opt_D_dump_asm_stats "NCG stats"
161 $ Linear.pprStats (concat native) (concat stats))
163 return $ makeAsmDoc (concat native) (concat imports)
165 where add_split (Cmm tops)
166 | dopt Opt_SplitObjs dflags = split_marker : tops
169 split_marker = CmmProc [] mkSplitMarkerLabel [] []
172 -- | Complete native code generation phase for a single top-level chunk of Cmm.
173 -- Dumping the output of each stage along the way.
174 -- Global conflict graph and NGC stats
182 , Maybe [Color.RegAllocStats]
183 , Maybe [Linear.RegAllocStats]))
185 cmmNativeGen dflags us cmm
187 -- rewrite assignments to global regs
188 let (fixed_cmm, usFix) =
189 initUs us $ fixAssignsTop cmm
191 -- cmm to cmm optimisations
192 let (opt_cmm, imports) =
193 cmmToCmm dflags fixed_cmm
196 Opt_D_dump_opt_cmm "Optimised Cmm"
197 (pprCmm $ Cmm [opt_cmm])
200 -- generate native code from cmm
201 let ((native, lastMinuteImports), usGen) =
202 initUs usFix $ genMachCode dflags opt_cmm
205 Opt_D_dump_asm_native "Native code"
206 (vcat $ map (docToSDoc . pprNatCmmTop) native)
209 -- tag instructions with register liveness information
210 let (withLiveness, usLive) =
211 initUs usGen $ mapUs regLiveness native
214 Opt_D_dump_asm_liveness "Liveness annotations added"
215 (vcat $ map ppr withLiveness)
218 -- allocate registers
219 (alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear) <-
220 if dopt Opt_RegsGraph dflags
222 -- the regs usable for allocation
224 = foldr (\r -> plusUFM_C unionUniqSets
225 $ unitUFM (regClass r) (unitUniqSet r))
227 $ map RealReg allocatableRegs
229 -- aggressively coalesce moves between virtual regs
230 let (coalesced, usCoalesce)
231 = initUs usLive $ regCoalesce withLiveness
234 Opt_D_dump_asm_coalesce "Reg-Reg moves coalesced"
235 (vcat $ map ppr coalesced)
237 -- if any of these dump flags are turned on we want to hang on to
238 -- intermediate structures in the allocator - otherwise ditch
239 -- them early so we don't end up creating space leaks.
240 let generateRegAllocStats = or
241 [ dopt Opt_D_dump_asm_regalloc_stages dflags
242 , dopt Opt_D_dump_asm_stats dflags
243 , dopt Opt_D_dump_asm_conflicts dflags ]
245 -- graph coloring register allocation
246 let ((alloced, regAllocStats), usAlloc)
249 generateRegAllocStats
251 (mkUniqSet [0..maxSpillSlots])
254 -- dump out what happened during register allocation
256 Opt_D_dump_asm_regalloc "Registers allocated"
257 (vcat $ map (docToSDoc . pprNatCmmTop) alloced)
260 Opt_D_dump_asm_regalloc_stages "Build/spill stages"
261 (vcat $ map (\(stage, stats)
262 -> text "-- Stage " <> int stage
264 $ zip [0..] regAllocStats)
266 return ( alloced, usAlloc
267 , if dopt Opt_D_dump_asm_stats dflags
268 then Just regAllocStats else Nothing
272 -- do linear register allocation
273 let ((alloced, regAllocStats), usAlloc)
276 $ mapUs Linear.regAlloc withLiveness
279 Opt_D_dump_asm_regalloc "Registers allocated"
280 (vcat $ map (docToSDoc . pprNatCmmTop) alloced)
282 return ( alloced, usAlloc
284 , if dopt Opt_D_dump_asm_stats dflags
285 then Just (catMaybes regAllocStats) else Nothing)
287 ---- shortcut branches
289 {-# SCC "shortcutBranches" #-}
290 shortcutBranches dflags alloced
294 {-# SCC "sequenceBlocks" #-}
295 map sequenceTop shorted
298 let final_mach_code =
300 {-# SCC "x86fp_kludge" #-}
301 map x86fp_kludge sequenced
308 , lastMinuteImports ++ imports
310 , ppr_raStatsLinear) )
314 x86fp_kludge :: NatCmmTop -> NatCmmTop
315 x86fp_kludge top@(CmmData _ _) = top
316 x86fp_kludge top@(CmmProc info lbl params code) =
317 CmmProc info lbl params (map bb_i386_insert_ffrees code)
319 bb_i386_insert_ffrees (BasicBlock id instrs) =
320 BasicBlock id (i386_insert_ffrees instrs)
324 -- | Build assembler source file from native code and its imports.
326 makeAsmDoc :: [NatCmmTop] -> [CLabel] -> Pretty.Doc
327 makeAsmDoc native imports
328 = Pretty.vcat (map pprNatCmmTop native)
329 Pretty.$$ (Pretty.text "")
330 Pretty.$$ dyld_stubs imports
332 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
333 -- On recent versions of Darwin, the linker supports
334 -- dead-stripping of code and data on a per-symbol basis.
335 -- There's a hack to make this work in PprMach.pprNatCmmTop.
336 Pretty.$$ Pretty.text ".subsections_via_symbols"
338 #if HAVE_GNU_NONEXEC_STACK
339 -- On recent GNU ELF systems one can mark an object file
340 -- as not requiring an executable stack. If all objects
341 -- linked into a program have this note then the program
342 -- will not use an executable stack, which is good for
343 -- security. GHC generated code does not need an executable
344 -- stack so add the note in:
345 Pretty.$$ Pretty.text ".section .note.GNU-stack,\"\",@progbits"
347 #if !defined(darwin_TARGET_OS)
348 -- And just because every other compiler does, lets stick in
349 -- an identifier directive: .ident "GHC x.y.z"
350 Pretty.$$ let compilerIdent = Pretty.text "GHC" Pretty.<+>
351 Pretty.text cProjectVersion
352 in Pretty.text ".ident" Pretty.<+>
353 Pretty.doubleQuotes compilerIdent
357 -- Generate "symbol stubs" for all external symbols that might
358 -- come from a dynamic library.
359 dyld_stubs :: [CLabel] -> Pretty.Doc
360 {- dyld_stubs imps = Pretty.vcat $ map pprDyldSymbolStub $
361 map head $ group $ sort imps-}
363 -- (Hack) sometimes two Labels pretty-print the same, but have
364 -- different uniques; so we compare their text versions...
366 | needImportedSymbols
368 (pprGotDeclaration :) $
369 map (pprImportedSymbol . fst . head) $
370 groupBy (\(_,a) (_,b) -> a == b) $
371 sortBy (\(_,a) (_,b) -> compare a b) $
377 doPpr lbl = (lbl, Pretty.render $ pprCLabel lbl astyle)
378 astyle = mkCodeStyle AsmStyle
381 -- -----------------------------------------------------------------------------
382 -- Sequencing the basic blocks
384 -- Cmm BasicBlocks are self-contained entities: they always end in a
385 -- jump, either non-local or to another basic block in the same proc.
386 -- In this phase, we attempt to place the basic blocks in a sequence
387 -- such that as many of the local jumps as possible turn into
390 sequenceTop :: NatCmmTop -> NatCmmTop
391 sequenceTop top@(CmmData _ _) = top
392 sequenceTop (CmmProc info lbl params blocks) =
393 CmmProc info lbl params (makeFarBranches $ sequenceBlocks blocks)
395 -- The algorithm is very simple (and stupid): we make a graph out of
396 -- the blocks where there is an edge from one block to another iff the
397 -- first block ends by jumping to the second. Then we topologically
398 -- sort this graph. Then traverse the list: for each block, we first
399 -- output the block, then if it has an out edge, we move the
400 -- destination of the out edge to the front of the list, and continue.
402 sequenceBlocks :: [NatBasicBlock] -> [NatBasicBlock]
403 sequenceBlocks [] = []
404 sequenceBlocks (entry:blocks) =
405 seqBlocks (mkNode entry : reverse (flattenSCCs (sccBlocks blocks)))
406 -- the first block is the entry point ==> it must remain at the start.
408 sccBlocks :: [NatBasicBlock] -> [SCC (NatBasicBlock,Unique,[Unique])]
409 sccBlocks blocks = stronglyConnCompR (map mkNode blocks)
411 getOutEdges :: [Instr] -> [Unique]
412 getOutEdges instrs = case jumpDests (last instrs) [] of
413 [one] -> [getUnique one]
415 -- we're only interested in the last instruction of
416 -- the block, and only if it has a single destination.
418 mkNode block@(BasicBlock id instrs) = (block, getUnique id, getOutEdges instrs)
421 seqBlocks ((block,_,[]) : rest)
422 = block : seqBlocks rest
423 seqBlocks ((block@(BasicBlock id instrs),_,[next]) : rest)
424 | can_fallthrough = BasicBlock id (init instrs) : seqBlocks rest'
425 | otherwise = block : seqBlocks rest'
427 (can_fallthrough, rest') = reorder next [] rest
428 -- TODO: we should do a better job for cycles; try to maximise the
429 -- fallthroughs within a loop.
430 seqBlocks _ = panic "AsmCodegen:seqBlocks"
432 reorder id accum [] = (False, reverse accum)
433 reorder id accum (b@(block,id',out) : rest)
434 | id == id' = (True, (block,id,out) : reverse accum ++ rest)
435 | otherwise = reorder id (b:accum) rest
438 -- -----------------------------------------------------------------------------
439 -- Making far branches
441 -- Conditional branches on PowerPC are limited to +-32KB; if our Procs get too
442 -- big, we have to work around this limitation.
444 makeFarBranches :: [NatBasicBlock] -> [NatBasicBlock]
446 #if powerpc_TARGET_ARCH
447 makeFarBranches blocks
448 | last blockAddresses < nearLimit = blocks
449 | otherwise = zipWith handleBlock blockAddresses blocks
451 blockAddresses = scanl (+) 0 $ map blockLen blocks
452 blockLen (BasicBlock _ instrs) = length instrs
454 handleBlock addr (BasicBlock id instrs)
455 = BasicBlock id (zipWith makeFar [addr..] instrs)
457 makeFar addr (BCC ALWAYS tgt) = BCC ALWAYS tgt
458 makeFar addr (BCC cond tgt)
459 | abs (addr - targetAddr) >= nearLimit
463 where Just targetAddr = lookupUFM blockAddressMap tgt
464 makeFar addr other = other
466 nearLimit = 7000 -- 8192 instructions are allowed; let's keep some
467 -- distance, as we have a few pseudo-insns that are
468 -- pretty-printed as multiple instructions,
469 -- and it's just not worth the effort to calculate
472 blockAddressMap = listToUFM $ zip (map blockId blocks) blockAddresses
477 -- -----------------------------------------------------------------------------
480 shortcutBranches :: DynFlags -> [NatCmmTop] -> [NatCmmTop]
481 shortcutBranches dflags tops
482 | optLevel dflags < 1 = tops -- only with -O or higher
483 | otherwise = map (apply_mapping mapping) tops'
485 (tops', mappings) = mapAndUnzip build_mapping tops
486 mapping = foldr plusUFM emptyUFM mappings
488 build_mapping top@(CmmData _ _) = (top, emptyUFM)
489 build_mapping (CmmProc info lbl params [])
490 = (CmmProc info lbl params [], emptyUFM)
491 build_mapping (CmmProc info lbl params (head:blocks))
492 = (CmmProc info lbl params (head:others), mapping)
493 -- drop the shorted blocks, but don't ever drop the first one,
494 -- because it is pointed to by a global label.
496 -- find all the blocks that just consist of a jump that can be
498 (shortcut_blocks, others) = partitionWith split blocks
499 split (BasicBlock id [insn]) | Just dest <- canShortcut insn
501 split other = Right other
503 -- build a mapping from BlockId to JumpDest for shorting branches
504 mapping = foldl add emptyUFM shortcut_blocks
505 add ufm (id,dest) = addToUFM ufm id dest
507 apply_mapping ufm (CmmData sec statics)
508 = CmmData sec (map (shortcutStatic (lookupUFM ufm)) statics)
509 -- we need to get the jump tables, so apply the mapping to the entries
511 apply_mapping ufm (CmmProc info lbl params blocks)
512 = CmmProc info lbl params (map short_bb blocks)
514 short_bb (BasicBlock id insns) = BasicBlock id $! map short_insn insns
515 short_insn i = shortcutJump (lookupUFM ufm) i
516 -- shortcutJump should apply the mapping repeatedly,
517 -- just in case we can short multiple branches.
519 -- -----------------------------------------------------------------------------
520 -- Instruction selection
522 -- Native code instruction selection for a chunk of stix code. For
523 -- this part of the computation, we switch from the UniqSM monad to
524 -- the NatM monad. The latter carries not only a Unique, but also an
525 -- Int denoting the current C stack pointer offset in the generated
526 -- code; this is needed for creating correct spill offsets on
527 -- architectures which don't offer, or for which it would be
528 -- prohibitively expensive to employ, a frame pointer register. Viz,
531 -- The offset is measured in bytes, and indicates the difference
532 -- between the current (simulated) C stack-ptr and the value it was at
533 -- the beginning of the block. For stacks which grow down, this value
534 -- should be either zero or negative.
536 -- Switching between the two monads whilst carrying along the same
537 -- Unique supply breaks abstraction. Is that bad?
539 genMachCode :: DynFlags -> RawCmmTop -> UniqSM ([NatCmmTop], [CLabel])
541 genMachCode dflags cmm_top
542 = do { initial_us <- getUs
543 ; let initial_st = mkNatM_State initial_us 0 dflags
544 (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)
545 final_delta = natm_delta final_st
546 final_imports = natm_imports final_st
547 ; if final_delta == 0
548 then return (new_tops, final_imports)
549 else pprPanic "genMachCode: nonzero final delta" (int final_delta)
552 -- -----------------------------------------------------------------------------
553 -- Fixup assignments to global registers so that they assign to
554 -- locations within the RegTable, if appropriate.
556 -- Note that we currently don't fixup reads here: they're done by
557 -- the generic optimiser below, to avoid having two separate passes
560 fixAssignsTop :: RawCmmTop -> UniqSM RawCmmTop
561 fixAssignsTop top@(CmmData _ _) = returnUs top
562 fixAssignsTop (CmmProc info lbl params blocks) =
563 mapUs fixAssignsBlock blocks `thenUs` \ blocks' ->
564 returnUs (CmmProc info lbl params blocks')
566 fixAssignsBlock :: CmmBasicBlock -> UniqSM CmmBasicBlock
567 fixAssignsBlock (BasicBlock id stmts) =
568 fixAssigns stmts `thenUs` \ stmts' ->
569 returnUs (BasicBlock id stmts')
571 fixAssigns :: [CmmStmt] -> UniqSM [CmmStmt]
573 mapUs fixAssign stmts `thenUs` \ stmtss ->
574 returnUs (concat stmtss)
576 fixAssign :: CmmStmt -> UniqSM [CmmStmt]
577 fixAssign (CmmAssign (CmmGlobal reg) src)
578 | Left realreg <- reg_or_addr
579 = returnUs [CmmAssign (CmmGlobal reg) src]
580 | Right baseRegAddr <- reg_or_addr
581 = returnUs [CmmStore baseRegAddr src]
582 -- Replace register leaves with appropriate StixTrees for
583 -- the given target. GlobalRegs which map to a reg on this
584 -- arch are left unchanged. Assigning to BaseReg is always
585 -- illegal, so we check for that.
587 reg_or_addr = get_GlobalReg_reg_or_addr reg
589 fixAssign other_stmt = returnUs [other_stmt]
591 -- -----------------------------------------------------------------------------
592 -- Generic Cmm optimiser
598 (b) Simple inlining: a temporary which is assigned to and then
599 used, once, can be shorted.
600 (c) Replacement of references to GlobalRegs which do not have
601 machine registers by the appropriate memory load (eg.
602 Hp ==> *(BaseReg + 34) ).
603 (d) Position independent code and dynamic linking
604 (i) introduce the appropriate indirections
605 and position independent refs
606 (ii) compile a list of imported symbols
608 Ideas for other things we could do (ToDo):
610 - shortcut jumps-to-jumps
611 - eliminate dead code blocks
612 - simple CSE: if an expr is assigned to a temp, then replace later occs of
613 that expr with the temp, until the expr is no longer valid (can push through
614 temp assignments, and certain assigns to mem...)
617 cmmToCmm :: DynFlags -> RawCmmTop -> (RawCmmTop, [CLabel])
618 cmmToCmm _ top@(CmmData _ _) = (top, [])
619 cmmToCmm dflags (CmmProc info lbl params blocks) = runCmmOpt dflags $ do
620 blocks' <- mapM cmmBlockConFold (cmmMiniInline blocks)
621 return $ CmmProc info lbl params blocks'
623 newtype CmmOptM a = CmmOptM (([CLabel], DynFlags) -> (# a, [CLabel] #))
625 instance Monad CmmOptM where
626 return x = CmmOptM $ \(imports, _) -> (# x,imports #)
628 CmmOptM $ \(imports, dflags) ->
629 case f (imports, dflags) of
632 CmmOptM g' -> g' (imports', dflags)
634 addImportCmmOpt :: CLabel -> CmmOptM ()
635 addImportCmmOpt lbl = CmmOptM $ \(imports, dflags) -> (# (), lbl:imports #)
637 getDynFlagsCmmOpt :: CmmOptM DynFlags
638 getDynFlagsCmmOpt = CmmOptM $ \(imports, dflags) -> (# dflags, imports #)
640 runCmmOpt :: DynFlags -> CmmOptM a -> (a, [CLabel])
641 runCmmOpt dflags (CmmOptM f) = case f ([], dflags) of
642 (# result, imports #) -> (result, imports)
644 cmmBlockConFold :: CmmBasicBlock -> CmmOptM CmmBasicBlock
645 cmmBlockConFold (BasicBlock id stmts) = do
646 stmts' <- mapM cmmStmtConFold stmts
647 return $ BasicBlock id stmts'
652 -> do src' <- cmmExprConFold DataReference src
653 return $ case src' of
654 CmmReg reg' | reg == reg' -> CmmNop
655 new_src -> CmmAssign reg new_src
658 -> do addr' <- cmmExprConFold DataReference addr
659 src' <- cmmExprConFold DataReference src
660 return $ CmmStore addr' src'
663 -> do addr' <- cmmExprConFold JumpReference addr
664 return $ CmmJump addr' regs
666 CmmCall target regs args srt returns
667 -> do target' <- case target of
668 CmmCallee e conv -> do
669 e' <- cmmExprConFold CallReference e
670 return $ CmmCallee e' conv
671 other -> return other
672 args' <- mapM (\(arg, hint) -> do
673 arg' <- cmmExprConFold DataReference arg
674 return (arg', hint)) args
675 return $ CmmCall target' regs args' srt returns
677 CmmCondBranch test dest
678 -> do test' <- cmmExprConFold DataReference test
679 return $ case test' of
680 CmmLit (CmmInt 0 _) ->
681 CmmComment (mkFastString ("deleted: " ++
682 showSDoc (pprStmt stmt)))
684 CmmLit (CmmInt n _) -> CmmBranch dest
685 other -> CmmCondBranch test' dest
688 -> do expr' <- cmmExprConFold DataReference expr
689 return $ CmmSwitch expr' ids
695 cmmExprConFold referenceKind expr
698 -> do addr' <- cmmExprConFold DataReference addr
699 return $ CmmLoad addr' rep
702 -- For MachOps, we first optimize the children, and then we try
703 -- our hand at some constant-folding.
704 -> do args' <- mapM (cmmExprConFold DataReference) args
705 return $ cmmMachOpFold mop args'
707 CmmLit (CmmLabel lbl)
709 dflags <- getDynFlagsCmmOpt
710 cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
711 CmmLit (CmmLabelOff lbl off)
713 dflags <- getDynFlagsCmmOpt
714 dynRef <- cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
715 return $ cmmMachOpFold (MO_Add wordRep) [
717 (CmmLit $ CmmInt (fromIntegral off) wordRep)
720 #if powerpc_TARGET_ARCH
721 -- On powerpc (non-PIC), it's easier to jump directly to a label than
722 -- to use the register table, so we replace these registers
723 -- with the corresponding labels:
724 CmmReg (CmmGlobal GCEnter1)
726 -> cmmExprConFold referenceKind $
727 CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_enter_1")))
728 CmmReg (CmmGlobal GCFun)
730 -> cmmExprConFold referenceKind $
731 CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_fun")))
734 CmmReg (CmmGlobal mid)
735 -- Replace register leaves with appropriate StixTrees for
736 -- the given target. MagicIds which map to a reg on this
737 -- arch are left unchanged. For the rest, BaseReg is taken
738 -- to mean the address of the reg table in MainCapability,
739 -- and for all others we generate an indirection to its
740 -- location in the register table.
741 -> case get_GlobalReg_reg_or_addr mid of
742 Left realreg -> return expr
745 BaseReg -> cmmExprConFold DataReference baseRegAddr
746 other -> cmmExprConFold DataReference
747 (CmmLoad baseRegAddr (globalRegRep mid))
748 -- eliminate zero offsets
750 -> cmmExprConFold referenceKind (CmmReg reg)
752 CmmRegOff (CmmGlobal mid) offset
753 -- RegOf leaves are just a shorthand form. If the reg maps
754 -- to a real reg, we keep the shorthand, otherwise, we just
755 -- expand it and defer to the above code.
756 -> case get_GlobalReg_reg_or_addr mid of
757 Left realreg -> return expr
759 -> cmmExprConFold DataReference (CmmMachOp (MO_Add wordRep) [
760 CmmReg (CmmGlobal mid),
761 CmmLit (CmmInt (fromIntegral offset)
766 -- -----------------------------------------------------------------------------