f954d524c9ef056eae015fd7f9ec44e64b1474e2
[ghc.git] / compiler / nativeGen / AsmCodeGen.lhs
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 \begin{code}
10 module AsmCodeGen ( nativeCodeGen ) where
11
12 #include "HsVersions.h"
13 #include "nativeGen/NCG.h"
14
15 import MachInstrs
16 import MachRegs
17 import MachCodeGen
18 import PprMach
19 import RegisterAlloc
20 import RegAllocInfo
21 import NCGMonad
22 import PositionIndependentCode
23
24 import Cmm
25 import CmmOpt           ( cmmMiniInline, cmmMachOpFold )
26 import PprCmm           ( pprStmt, pprCmms )
27 import MachOp
28 import CLabel
29
30 import UniqFM
31 import Unique           ( Unique, getUnique )
32 import UniqSupply
33 import FastTypes
34 import List             ( groupBy, sortBy )
35 import ErrUtils         ( dumpIfSet_dyn )
36 import DynFlags
37 import StaticFlags      ( opt_Static, opt_PIC )
38 import Util
39 import Config           ( cProjectVersion )
40
41 import Digraph
42 import qualified Pretty
43 import Outputable
44 import FastString
45
46 -- DEBUGGING ONLY
47 --import OrdList
48
49 #ifdef NCG_DEBUG
50 import List             ( intersperse )
51 #endif
52
53 import Data.Int
54 import Data.Word
55 import Data.Bits
56 import GHC.Exts
57
58 {-
59 The native-code generator has machine-independent and
60 machine-dependent modules.
61
62 This module ("AsmCodeGen") is the top-level machine-independent
63 module.  Before entering machine-dependent land, we do some
64 machine-independent optimisations (defined below) on the
65 'CmmStmts's.
66
67 We convert to the machine-specific 'Instr' datatype with
68 'cmmCodeGen', assuming an infinite supply of registers.  We then use
69 a machine-independent register allocator ('regAlloc') to rejoin
70 reality.  Obviously, 'regAlloc' has machine-specific helper
71 functions (see about "RegAllocInfo" below).
72
73 Finally, we order the basic blocks of the function so as to minimise
74 the number of jumps between blocks, by utilising fallthrough wherever
75 possible.
76
77 The machine-dependent bits break down as follows:
78
79   * ["MachRegs"]  Everything about the target platform's machine
80     registers (and immediate operands, and addresses, which tend to
81     intermingle/interact with registers).
82
83   * ["MachInstrs"]  Includes the 'Instr' datatype (possibly should
84     have a module of its own), plus a miscellany of other things
85     (e.g., 'targetDoubleSize', 'smStablePtrTable', ...)
86
87   * ["MachCodeGen"]  is where 'Cmm' stuff turns into
88     machine instructions.
89
90   * ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
91     a 'Doc').
92
93   * ["RegAllocInfo"] In the register allocator, we manipulate
94     'MRegsState's, which are 'BitSet's, one bit per machine register.
95     When we want to say something about a specific machine register
96     (e.g., ``it gets clobbered by this instruction''), we set/unset
97     its bit.  Obviously, we do this 'BitSet' thing for efficiency
98     reasons.
99
100     The 'RegAllocInfo' module collects together the machine-specific
101     info needed to do register allocation.
102
103    * ["RegisterAlloc"] The (machine-independent) register allocator.
104 -}
105
106 -- -----------------------------------------------------------------------------
107 -- Top-level of the native codegen
108
109 -- NB. We *lazilly* compile each block of code for space reasons.
110
111 nativeCodeGen :: DynFlags -> [RawCmm] -> UniqSupply -> IO Pretty.Doc
112 nativeCodeGen dflags cmms us
113   = let (res, _) = initUs us $
114            cgCmm (concat (map add_split cmms))
115
116         cgCmm :: [RawCmmTop] -> UniqSM (RawCmm, Pretty.Doc, [CLabel])
117         cgCmm tops = 
118            lazyMapUs (cmmNativeGen dflags) tops  `thenUs` \ results -> 
119            case unzip3 results of { (cmms,docs,imps) ->
120            returnUs (Cmm cmms, my_vcat docs, concat imps)
121            }
122     in 
123     case res of { (ppr_cmms, insn_sdoc, imports) -> do
124     dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm" (pprCmms [ppr_cmms])
125     return (insn_sdoc Pretty.$$ dyld_stubs imports
126 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
127                 -- On recent versions of Darwin, the linker supports
128                 -- dead-stripping of code and data on a per-symbol basis.
129                 -- There's a hack to make this work in PprMach.pprNatCmmTop.
130             Pretty.$$ Pretty.text ".subsections_via_symbols"
131 #endif
132 #if HAVE_GNU_NONEXEC_STACK
133                 -- On recent GNU ELF systems one can mark an object file
134                 -- as not requiring an executable stack. If all objects
135                 -- linked into a program have this note then the program
136                 -- will not use an executable stack, which is good for
137                 -- security. GHC generated code does not need an executable
138                 -- stack so add the note in:
139             Pretty.$$ Pretty.text ".section .note.GNU-stack,\"\",@progbits"
140 #endif
141 #if !defined(darwin_TARGET_OS)
142                 -- And just because every other compiler does, lets stick in
143                 -- an identifier directive: .ident "GHC x.y.z"
144             Pretty.$$ let compilerIdent = Pretty.text "GHC" Pretty.<+>
145                                           Pretty.text cProjectVersion
146                        in Pretty.text ".ident" Pretty.<+>
147                           Pretty.doubleQuotes compilerIdent
148 #endif
149             )
150    }
151
152   where
153
154     add_split (Cmm tops)
155         | dopt Opt_SplitObjs dflags = split_marker : tops
156         | otherwise                 = tops
157
158     split_marker = CmmProc [] mkSplitMarkerLabel [] []
159
160          -- Generate "symbol stubs" for all external symbols that might
161          -- come from a dynamic library.
162 {-    dyld_stubs imps = Pretty.vcat $ map pprDyldSymbolStub $
163                                     map head $ group $ sort imps-}
164                                     
165         -- (Hack) sometimes two Labels pretty-print the same, but have
166         -- different uniques; so we compare their text versions...
167     dyld_stubs imps 
168         | needImportedSymbols
169           = Pretty.vcat $
170             (pprGotDeclaration :) $
171             map (pprImportedSymbol . fst . head) $
172             groupBy (\(_,a) (_,b) -> a == b) $
173             sortBy (\(_,a) (_,b) -> compare a b) $
174             map doPpr $
175             imps
176         | otherwise
177           = Pretty.empty
178         
179         where doPpr lbl = (lbl, Pretty.render $ pprCLabel lbl astyle)
180               astyle = mkCodeStyle AsmStyle
181
182 #ifndef NCG_DEBUG
183     my_vcat sds = Pretty.vcat sds
184 #else
185     my_vcat sds = Pretty.vcat (
186                       intersperse (
187                          Pretty.char ' ' 
188                             Pretty.$$ Pretty.ptext SLIT("# ___ncg_debug_marker")
189                             Pretty.$$ Pretty.char ' '
190                       ) 
191                       sds
192                    )
193 #endif
194
195
196 -- Complete native code generation phase for a single top-level chunk
197 -- of Cmm.
198
199 cmmNativeGen :: DynFlags -> RawCmmTop -> UniqSM (RawCmmTop, Pretty.Doc, [CLabel])
200 cmmNativeGen dflags cmm
201    = {-# SCC "fixAssigns"       #-} 
202         fixAssignsTop cmm            `thenUs` \ fixed_cmm ->
203      {-# SCC "genericOpt"       #-} 
204         cmmToCmm fixed_cmm           `bind`   \ (cmm, imports) ->
205         (if dopt Opt_D_dump_opt_cmm dflags  -- space leak avoidance
206            then cmm 
207            else CmmData Text [])     `bind`   \ ppr_cmm ->
208      {-# SCC "genMachCode"      #-}
209         genMachCode cmm              `thenUs` \ (pre_regalloc, lastMinuteImports) ->
210      {-# SCC "regAlloc"         #-}
211         mapUs regAlloc pre_regalloc `thenUs`   \ with_regs ->
212      {-# SCC "shortcutBranches"   #-}
213         shortcutBranches dflags with_regs `bind` \ shorted -> 
214      {-# SCC "sequenceBlocks"   #-}
215         map sequenceTop shorted        `bind`   \ sequenced ->
216      {-# SCC "x86fp_kludge"     #-}
217         map x86fp_kludge sequenced   `bind`   \ final_mach_code ->
218      {-# SCC "vcat"             #-}
219         Pretty.vcat (map pprNatCmmTop final_mach_code)  `bind`   \ final_sdoc ->
220
221         returnUs (ppr_cmm, final_sdoc Pretty.$$ Pretty.text "", lastMinuteImports ++ imports)
222      where
223         x86fp_kludge :: NatCmmTop -> NatCmmTop
224         x86fp_kludge top@(CmmData _ _) = top
225 #if i386_TARGET_ARCH
226         x86fp_kludge top@(CmmProc info lbl params code) = 
227                 CmmProc info lbl params (map bb_i386_insert_ffrees code)
228                 where
229                   bb_i386_insert_ffrees (BasicBlock id instrs) =
230                         BasicBlock id (i386_insert_ffrees instrs)
231 #else
232         x86fp_kludge top =  top
233 #endif
234
235 -- -----------------------------------------------------------------------------
236 -- Sequencing the basic blocks
237
238 -- Cmm BasicBlocks are self-contained entities: they always end in a
239 -- jump, either non-local or to another basic block in the same proc.
240 -- In this phase, we attempt to place the basic blocks in a sequence
241 -- such that as many of the local jumps as possible turn into
242 -- fallthroughs.
243
244 sequenceTop :: NatCmmTop -> NatCmmTop
245 sequenceTop top@(CmmData _ _) = top
246 sequenceTop (CmmProc info lbl params blocks) = 
247   CmmProc info lbl params (makeFarBranches $ sequenceBlocks blocks)
248
249 -- The algorithm is very simple (and stupid): we make a graph out of
250 -- the blocks where there is an edge from one block to another iff the
251 -- first block ends by jumping to the second.  Then we topologically
252 -- sort this graph.  Then traverse the list: for each block, we first
253 -- output the block, then if it has an out edge, we move the
254 -- destination of the out edge to the front of the list, and continue.
255
256 sequenceBlocks :: [NatBasicBlock] -> [NatBasicBlock]
257 sequenceBlocks [] = []
258 sequenceBlocks (entry:blocks) = 
259   seqBlocks (mkNode entry : reverse (flattenSCCs (sccBlocks blocks)))
260   -- the first block is the entry point ==> it must remain at the start.
261
262 sccBlocks :: [NatBasicBlock] -> [SCC (NatBasicBlock,Unique,[Unique])]
263 sccBlocks blocks = stronglyConnCompR (map mkNode blocks)
264
265 getOutEdges :: [Instr] -> [Unique]
266 getOutEdges instrs = case jumpDests (last instrs) [] of
267                         [one] -> [getUnique one]
268                         _many -> []
269                 -- we're only interested in the last instruction of
270                 -- the block, and only if it has a single destination.
271
272 mkNode block@(BasicBlock id instrs) = (block, getUnique id, getOutEdges instrs)
273
274 seqBlocks [] = []
275 seqBlocks ((block,_,[]) : rest)
276   = block : seqBlocks rest
277 seqBlocks ((block@(BasicBlock id instrs),_,[next]) : rest)
278   | can_fallthrough = BasicBlock id (init instrs) : seqBlocks rest'
279   | otherwise       = block : seqBlocks rest'
280   where
281         (can_fallthrough, rest') = reorder next [] rest
282           -- TODO: we should do a better job for cycles; try to maximise the
283           -- fallthroughs within a loop.
284 seqBlocks _ = panic "AsmCodegen:seqBlocks"
285
286 reorder id accum [] = (False, reverse accum)
287 reorder id accum (b@(block,id',out) : rest)
288   | id == id'  = (True, (block,id,out) : reverse accum ++ rest)
289   | otherwise  = reorder id (b:accum) rest
290
291
292 -- -----------------------------------------------------------------------------
293 -- Making far branches
294
295 -- Conditional branches on PowerPC are limited to +-32KB; if our Procs get too
296 -- big, we have to work around this limitation.
297
298 makeFarBranches :: [NatBasicBlock] -> [NatBasicBlock]
299
300 #if powerpc_TARGET_ARCH
301 makeFarBranches blocks
302     | last blockAddresses < nearLimit = blocks
303     | otherwise = zipWith handleBlock blockAddresses blocks
304     where
305         blockAddresses = scanl (+) 0 $ map blockLen blocks
306         blockLen (BasicBlock _ instrs) = length instrs
307         
308         handleBlock addr (BasicBlock id instrs)
309                 = BasicBlock id (zipWith makeFar [addr..] instrs)
310         
311         makeFar addr (BCC ALWAYS tgt) = BCC ALWAYS tgt
312         makeFar addr (BCC cond tgt)
313             | abs (addr - targetAddr) >= nearLimit
314             = BCCFAR cond tgt
315             | otherwise
316             = BCC cond tgt
317             where Just targetAddr = lookupUFM blockAddressMap tgt
318         makeFar addr other            = other
319         
320         nearLimit = 7000 -- 8192 instructions are allowed; let's keep some
321                          -- distance, as we have a few pseudo-insns that are
322                          -- pretty-printed as multiple instructions,
323                          -- and it's just not worth the effort to calculate
324                          -- things exactly
325         
326         blockAddressMap = listToUFM $ zip (map blockId blocks) blockAddresses
327 #else
328 makeFarBranches = id
329 #endif
330
331 -- -----------------------------------------------------------------------------
332 -- Shortcut branches
333
334 shortcutBranches :: DynFlags -> [NatCmmTop] -> [NatCmmTop]
335 shortcutBranches dflags tops
336   | optLevel dflags < 1 = tops    -- only with -O or higher
337   | otherwise           = map (apply_mapping mapping) tops'
338   where
339     (tops', mappings) = mapAndUnzip build_mapping tops
340     mapping = foldr plusUFM emptyUFM mappings
341
342 build_mapping top@(CmmData _ _) = (top, emptyUFM)
343 build_mapping (CmmProc info lbl params [])
344   = (CmmProc info lbl params [], emptyUFM)
345 build_mapping (CmmProc info lbl params (head:blocks))
346   = (CmmProc info lbl params (head:others), mapping)
347         -- drop the shorted blocks, but don't ever drop the first one,
348         -- because it is pointed to by a global label.
349   where
350     -- find all the blocks that just consist of a jump that can be
351     -- shorted.
352     (shortcut_blocks, others) = partitionWith split blocks
353     split (BasicBlock id [insn]) | Just dest <- canShortcut insn 
354                                  = Left (id,dest)
355     split other = Right other
356
357     -- build a mapping from BlockId to JumpDest for shorting branches
358     mapping = foldl add emptyUFM shortcut_blocks
359     add ufm (id,dest) = addToUFM ufm id dest
360     
361 apply_mapping ufm (CmmData sec statics) 
362   = CmmData sec (map (shortcutStatic (lookupUFM ufm)) statics)
363   -- we need to get the jump tables, so apply the mapping to the entries
364   -- of a CmmData too.
365 apply_mapping ufm (CmmProc info lbl params blocks)
366   = CmmProc info lbl params (map short_bb blocks)
367   where
368     short_bb (BasicBlock id insns) = BasicBlock id $! map short_insn insns
369     short_insn i = shortcutJump (lookupUFM ufm) i
370                  -- shortcutJump should apply the mapping repeatedly,
371                  -- just in case we can short multiple branches.
372
373 -- -----------------------------------------------------------------------------
374 -- Instruction selection
375
376 -- Native code instruction selection for a chunk of stix code.  For
377 -- this part of the computation, we switch from the UniqSM monad to
378 -- the NatM monad.  The latter carries not only a Unique, but also an
379 -- Int denoting the current C stack pointer offset in the generated
380 -- code; this is needed for creating correct spill offsets on
381 -- architectures which don't offer, or for which it would be
382 -- prohibitively expensive to employ, a frame pointer register.  Viz,
383 -- x86.
384
385 -- The offset is measured in bytes, and indicates the difference
386 -- between the current (simulated) C stack-ptr and the value it was at
387 -- the beginning of the block.  For stacks which grow down, this value
388 -- should be either zero or negative.
389
390 -- Switching between the two monads whilst carrying along the same
391 -- Unique supply breaks abstraction.  Is that bad?
392
393 genMachCode :: RawCmmTop -> UniqSM ([NatCmmTop], [CLabel])
394
395 genMachCode cmm_top
396   = do  { initial_us <- getUs
397         ; let initial_st           = mkNatM_State initial_us 0
398               (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)
399               final_us             = natm_us final_st
400               final_delta          = natm_delta final_st
401               final_imports        = natm_imports final_st
402         ; if   final_delta == 0
403           then return (new_tops, final_imports)
404           else pprPanic "genMachCode: nonzero final delta" (int final_delta)
405     }
406
407 -- -----------------------------------------------------------------------------
408 -- Fixup assignments to global registers so that they assign to 
409 -- locations within the RegTable, if appropriate.
410
411 -- Note that we currently don't fixup reads here: they're done by
412 -- the generic optimiser below, to avoid having two separate passes
413 -- over the Cmm.
414
415 fixAssignsTop :: RawCmmTop -> UniqSM RawCmmTop
416 fixAssignsTop top@(CmmData _ _) = returnUs top
417 fixAssignsTop (CmmProc info lbl params blocks) =
418   mapUs fixAssignsBlock blocks `thenUs` \ blocks' ->
419   returnUs (CmmProc info lbl params blocks')
420
421 fixAssignsBlock :: CmmBasicBlock -> UniqSM CmmBasicBlock
422 fixAssignsBlock (BasicBlock id stmts) =
423   fixAssigns stmts `thenUs` \ stmts' ->
424   returnUs (BasicBlock id stmts')
425
426 fixAssigns :: [CmmStmt] -> UniqSM [CmmStmt]
427 fixAssigns stmts =
428   mapUs fixAssign stmts `thenUs` \ stmtss ->
429   returnUs (concat stmtss)
430
431 fixAssign :: CmmStmt -> UniqSM [CmmStmt]
432 fixAssign (CmmAssign (CmmGlobal BaseReg) src)
433    = panic "cmmStmtConFold: assignment to BaseReg";
434
435 fixAssign (CmmAssign (CmmGlobal reg) src)
436   | Left  realreg <- reg_or_addr
437   = returnUs [CmmAssign (CmmGlobal reg) src]
438   | Right baseRegAddr <- reg_or_addr
439   = returnUs [CmmStore baseRegAddr src]
440            -- Replace register leaves with appropriate StixTrees for
441            -- the given target. GlobalRegs which map to a reg on this
442            -- arch are left unchanged.  Assigning to BaseReg is always
443            -- illegal, so we check for that.
444   where
445         reg_or_addr = get_GlobalReg_reg_or_addr reg
446
447 {-
448 fixAssign (CmmCall target results args)
449   = mapAndUnzipUs fixResult results `thenUs` \ (results',stores) ->
450     returnUs (CmmCall target results' args :
451               concat stores)
452   where
453         fixResult g@(CmmGlobal reg,hint) = 
454           case get_GlobalReg_reg_or_addr reg of
455                 Left realreg -> returnUs (g, [])
456                 Right baseRegAddr ->
457                     getUniqueUs `thenUs` \ uq ->
458                     let local = CmmLocal (LocalReg uq (globalRegRep reg)) in
459                     returnUs ((local,hint), 
460                               [CmmStore baseRegAddr (CmmReg local)])
461         fixResult other =
462           returnUs (other,[])
463 -}
464
465 fixAssign other_stmt = returnUs [other_stmt]
466
467 -- -----------------------------------------------------------------------------
468 -- Generic Cmm optimiser
469
470 {-
471 Here we do:
472
473   (a) Constant folding
474   (b) Simple inlining: a temporary which is assigned to and then
475       used, once, can be shorted.
476   (c) Replacement of references to GlobalRegs which do not have
477       machine registers by the appropriate memory load (eg.
478       Hp ==>  *(BaseReg + 34) ).
479   (d) Position independent code and dynamic linking
480         (i)  introduce the appropriate indirections
481              and position independent refs
482         (ii) compile a list of imported symbols
483
484 Ideas for other things we could do (ToDo):
485
486   - shortcut jumps-to-jumps
487   - eliminate dead code blocks
488   - simple CSE: if an expr is assigned to a temp, then replace later occs of
489     that expr with the temp, until the expr is no longer valid (can push through
490     temp assignments, and certain assigns to mem...)
491 -}
492
493 cmmToCmm :: RawCmmTop -> (RawCmmTop, [CLabel])
494 cmmToCmm top@(CmmData _ _) = (top, [])
495 cmmToCmm (CmmProc info lbl params blocks) = runCmmOpt $ do
496   blocks' <- mapM cmmBlockConFold (cmmMiniInline blocks)
497   return $ CmmProc info lbl params blocks'
498
499 newtype CmmOptM a = CmmOptM ([CLabel] -> (# a, [CLabel] #))
500
501 instance Monad CmmOptM where
502   return x = CmmOptM $ \imports -> (# x,imports #)
503   (CmmOptM f) >>= g =
504     CmmOptM $ \imports ->
505                 case f imports of
506                   (# x, imports' #) ->
507                     case g x of
508                       CmmOptM g' -> g' imports'
509
510 addImportCmmOpt :: CLabel -> CmmOptM ()
511 addImportCmmOpt lbl = CmmOptM $ \imports -> (# (), lbl:imports #)
512
513 runCmmOpt :: CmmOptM a -> (a, [CLabel])
514 runCmmOpt (CmmOptM f) = case f [] of
515                         (# result, imports #) -> (result, imports)
516
517 cmmBlockConFold :: CmmBasicBlock -> CmmOptM CmmBasicBlock
518 cmmBlockConFold (BasicBlock id stmts) = do
519   stmts' <- mapM cmmStmtConFold stmts
520   return $ BasicBlock id stmts'
521
522 cmmStmtConFold stmt
523    = case stmt of
524         CmmAssign reg src
525            -> do src' <- cmmExprConFold DataReference src
526                  return $ case src' of
527                    CmmReg reg' | reg == reg' -> CmmNop
528                    new_src -> CmmAssign reg new_src
529
530         CmmStore addr src
531            -> do addr' <- cmmExprConFold DataReference addr
532                  src'  <- cmmExprConFold DataReference src
533                  return $ CmmStore addr' src'
534
535         CmmJump addr regs
536            -> do addr' <- cmmExprConFold JumpReference addr
537                  return $ CmmJump addr' regs
538
539         CmmCall target regs args srt
540            -> do target' <- case target of
541                               CmmForeignCall e conv -> do
542                                 e' <- cmmExprConFold CallReference e
543                                 return $ CmmForeignCall e' conv
544                               other -> return other
545                  args' <- mapM (\(arg, hint) -> do
546                                   arg' <- cmmExprConFold DataReference arg
547                                   return (arg', hint)) args
548                  return $ CmmCall target' regs args' srt
549
550         CmmCondBranch test dest
551            -> do test' <- cmmExprConFold DataReference test
552                  return $ case test' of
553                    CmmLit (CmmInt 0 _) -> 
554                      CmmComment (mkFastString ("deleted: " ++ 
555                                         showSDoc (pprStmt stmt)))
556
557                    CmmLit (CmmInt n _) -> CmmBranch dest
558                    other -> CmmCondBranch test' dest
559
560         CmmSwitch expr ids
561            -> do expr' <- cmmExprConFold DataReference expr
562                  return $ CmmSwitch expr' ids
563
564         other
565            -> return other
566
567
568 cmmExprConFold referenceKind expr
569    = case expr of
570         CmmLoad addr rep
571            -> do addr' <- cmmExprConFold DataReference addr
572                  return $ CmmLoad addr' rep
573
574         CmmMachOp mop args
575            -- For MachOps, we first optimize the children, and then we try 
576            -- our hand at some constant-folding.
577            -> do args' <- mapM (cmmExprConFold DataReference) args
578                  return $ cmmMachOpFold mop args'
579
580         CmmLit (CmmLabel lbl)
581            -> cmmMakeDynamicReference addImportCmmOpt referenceKind lbl
582         CmmLit (CmmLabelOff lbl off)
583            -> do dynRef <- cmmMakeDynamicReference addImportCmmOpt referenceKind lbl
584                  return $ cmmMachOpFold (MO_Add wordRep) [
585                      dynRef,
586                      (CmmLit $ CmmInt (fromIntegral off) wordRep)
587                    ]
588
589 #if powerpc_TARGET_ARCH
590            -- On powerpc (non-PIC), it's easier to jump directly to a label than
591            -- to use the register table, so we replace these registers
592            -- with the corresponding labels:
593         CmmReg (CmmGlobal GCEnter1)
594           | not opt_PIC
595           -> cmmExprConFold referenceKind $
596              CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_enter_1"))) 
597         CmmReg (CmmGlobal GCFun)
598           | not opt_PIC
599           -> cmmExprConFold referenceKind $
600              CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_fun")))
601 #endif
602
603         CmmReg (CmmGlobal mid)
604            -- Replace register leaves with appropriate StixTrees for
605            -- the given target.  MagicIds which map to a reg on this
606            -- arch are left unchanged.  For the rest, BaseReg is taken
607            -- to mean the address of the reg table in MainCapability,
608            -- and for all others we generate an indirection to its
609            -- location in the register table.
610            -> case get_GlobalReg_reg_or_addr mid of
611                  Left  realreg -> return expr
612                  Right baseRegAddr 
613                     -> case mid of 
614                           BaseReg -> cmmExprConFold DataReference baseRegAddr
615                           other   -> cmmExprConFold DataReference
616                                         (CmmLoad baseRegAddr (globalRegRep mid))
617            -- eliminate zero offsets
618         CmmRegOff reg 0
619            -> cmmExprConFold referenceKind (CmmReg reg)
620
621         CmmRegOff (CmmGlobal mid) offset
622            -- RegOf leaves are just a shorthand form. If the reg maps
623            -- to a real reg, we keep the shorthand, otherwise, we just
624            -- expand it and defer to the above code. 
625            -> case get_GlobalReg_reg_or_addr mid of
626                 Left  realreg -> return expr
627                 Right baseRegAddr
628                    -> cmmExprConFold DataReference (CmmMachOp (MO_Add wordRep) [
629                                         CmmReg (CmmGlobal mid),
630                                         CmmLit (CmmInt (fromIntegral offset)
631                                                        wordRep)])
632         other
633            -> return other
634
635 -- -----------------------------------------------------------------------------
636 -- Utils
637
638 bind f x = x $! f
639
640 \end{code}
641