Big tidy-up of deriving code
[ghc-hetmet.git] / compiler / nativeGen / PositionIndependentCode.hs
1 module PositionIndependentCode (
2         cmmMakeDynamicReference,
3         ReferenceKind(..),
4         needImportedSymbols,
5         pprImportedSymbol,
6         pprGotDeclaration,
7         initializePicBase
8      ) where
9
10 {-
11   This module handles generation of position independent code and
12   dynamic-linking related issues for the native code generator.
13   
14   Things outside this module which are related to this:
15   
16   + module CLabel
17     - PIC base label (pretty printed as local label 1)
18     - DynamicLinkerLabels - several kinds:
19         CodeStub, SymbolPtr, GotSymbolPtr, GotSymbolOffset
20     - labelDynamic predicate
21   + module Cmm
22     - The GlobalReg datatype has a PicBaseReg constructor
23     - The CmmLit datatype has a CmmLabelDiffOff constructor
24   + codeGen & RTS
25     - When tablesNextToCode, no absolute addresses are stored in info tables
26       any more. Instead, offsets from the info label are used.
27     - For Win32 only, SRTs might contain addresses of __imp_ symbol pointers
28       because Win32 doesn't support external references in data sections.
29       TODO: make sure this still works, it might be bitrotted
30   + NCG
31     - The cmmToCmm pass in AsmCodeGen calls cmmMakeDynamicReference for all
32       labels.
33     - nativeCodeGen calls pprImportedSymbol and pprGotDeclaration to output
34       all the necessary stuff for imported symbols.
35     - The NCG monad keeps track of a list of imported symbols.
36     - MachCodeGen invokes initializePicBase to generate code to initialize
37       the PIC base register when needed.
38     - MachCodeGen calls cmmMakeDynamicReference whenever it uses a CLabel
39       that wasn't in the original Cmm code (e.g. floating point literals).
40   + The Mangler
41     - The mangler converts absolure refs to relative refs in info tables
42     - Symbol pointers, stub code and PIC calculations that are generated
43       by GCC are left intact by the mangler (so far only on ppc-darwin
44       and ppc-linux).
45 -}
46      
47 #include "HsVersions.h"
48 #include "nativeGen/NCG.h"
49
50 import Cmm
51 import MachOp           ( MachOp(MO_Add), wordRep )
52 import CLabel           ( CLabel, pprCLabel,
53                           mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
54                           dynamicLinkerLabelInfo, mkPicBaseLabel,
55                           labelDynamic, externallyVisibleCLabel )
56
57 #if linux_TARGET_OS
58 import CLabel           ( mkForeignLabel )
59 #endif
60
61 import MachRegs
62 import MachInstrs
63 import NCGMonad         ( NatM, getNewRegNat, getNewLabelNat )
64
65 import StaticFlags      ( opt_PIC, opt_Static )
66
67 import Pretty
68 import qualified Outputable
69
70 import Panic            ( panic )
71
72
73 -- The most important function here is cmmMakeDynamicReference.
74
75 -- It gets called by the cmmToCmm pass for every CmmLabel in the Cmm
76 -- code. It does The Right Thing(tm) to convert the CmmLabel into a
77 -- position-independent, dynamic-linking-aware reference to the thing
78 -- in question.
79 -- Note that this also has to be called from MachCodeGen in order to
80 -- access static data like floating point literals (labels that were
81 -- created after the cmmToCmm pass).
82 -- The function must run in a monad that can keep track of imported symbols
83 -- A function for recording an imported symbol must be passed in:
84 -- - addImportCmmOpt for the CmmOptM monad
85 -- - addImportNat for the NatM monad.
86
87 data ReferenceKind = DataReference
88                    | CallReference
89                    | JumpReference
90                    deriving(Eq)
91
92 cmmMakeDynamicReference
93   :: Monad m => (CLabel -> m ())  -- a monad & a function
94                                   -- used for recording imported symbols
95              -> ReferenceKind     -- whether this is the target of a jump
96              -> CLabel            -- the label
97              -> m CmmExpr
98   
99 cmmMakeDynamicReference addImport referenceKind lbl
100   | Just _ <- dynamicLinkerLabelInfo lbl
101   = return $ CmmLit $ CmmLabel lbl   -- already processed it, pass through
102   | otherwise = case howToAccessLabel referenceKind lbl of
103         AccessViaStub -> do
104               let stub = mkDynamicLinkerLabel CodeStub lbl
105               addImport stub
106               return $ CmmLit $ CmmLabel stub
107         AccessViaSymbolPtr -> do
108               let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
109               addImport symbolPtr
110               return $ CmmLoad (cmmMakePicReference symbolPtr) wordRep
111         AccessDirectly -> case referenceKind of
112                 -- for data, we might have to make some calculations:
113               DataReference -> return $ cmmMakePicReference lbl  
114                 -- all currently supported processors support
115                 -- PC-relative branch and call instructions,
116                 -- so just jump there if it's a call or a jump
117               _ -> return $ CmmLit $ CmmLabel lbl
118   
119 -- -------------------------------------------------------------------
120   
121 -- Create a position independent reference to a label.
122 -- (but do not bother with dynamic linking).
123 -- We calculate the label's address by adding some (platform-dependent)
124 -- offset to our base register; this offset is calculated by
125 -- the function picRelative in the platform-dependent part below.
126
127 cmmMakePicReference :: CLabel -> CmmExpr
128   
129 #if !mingw32_TARGET_OS
130         -- Windows doesn't need PIC,
131         -- everything gets relocated at runtime
132
133 cmmMakePicReference lbl
134     | opt_PIC && absoluteLabel lbl = CmmMachOp (MO_Add wordRep) [
135             CmmReg (CmmGlobal PicBaseReg),
136             CmmLit $ picRelative lbl
137         ]
138     where
139         absoluteLabel lbl = case dynamicLinkerLabelInfo lbl of
140                                 Just (GotSymbolPtr, _) -> False
141                                 Just (GotSymbolOffset, _) -> False
142                                 _ -> True
143
144 #endif
145 cmmMakePicReference lbl = CmmLit $ CmmLabel lbl
146
147 -- ===================================================================
148 -- Platform dependent stuff
149 -- ===================================================================
150
151 -- Knowledge about how special dynamic linker labels like symbol
152 -- pointers, code stubs and GOT offsets look like is located in the
153 -- module CLabel.
154
155 -- -------------------------------------------------------------------
156
157 -- We have to decide which labels need to be accessed
158 -- indirectly or via a piece of stub code.
159
160 data LabelAccessStyle = AccessViaStub
161                       | AccessViaSymbolPtr
162                       | AccessDirectly
163
164 howToAccessLabel :: ReferenceKind -> CLabel -> LabelAccessStyle
165
166 #if mingw32_TARGET_OS
167 -- Windows
168 -- 
169 -- We need to use access *exactly* those things that
170 -- are imported from a DLL via an __imp_* label.
171 -- There are no stubs for imported code.
172
173 howToAccessLabel _ lbl | labelDynamic lbl = AccessViaSymbolPtr
174                        | otherwise        = AccessDirectly
175 #elif darwin_TARGET_OS
176 -- Mach-O (Darwin, Mac OS X)
177 --
178 -- Indirect access is required in the following cases:
179 --  * things imported from a dynamic library
180 --  * (not on x86_64) data from a different module, if we're generating PIC code
181 -- It is always possible to access something indirectly,
182 -- even when it's not necessary.
183
184 howToAccessLabel DataReference lbl
185       -- data access to a dynamic library goes via a symbol pointer
186     | labelDynamic lbl = AccessViaSymbolPtr
187     
188 #if !x86_64_TARGET_ARCH
189       -- when generating PIC code, all cross-module data references must
190       -- must go via a symbol pointer, too, because the assembler
191       -- cannot generate code for a label difference where one
192       -- label is undefined. Doesn't apply t x86_64.
193       -- Unfortunately, we don't know whether it's cross-module,
194       -- so we do it for all externally visible labels.
195       -- This is a slight waste of time and space, but otherwise
196       -- we'd need to pass the current Module all the way in to
197       -- this function.
198     | opt_PIC && externallyVisibleCLabel lbl = AccessViaSymbolPtr
199 #endif
200     | otherwise = AccessDirectly
201
202
203 #if x86_TARGET_ARCH || x86_64_TARGET_ARCH
204     -- dyld code stubs don't work for tailcalls because the
205     -- stack alignment is only right for regular calls.
206     -- Therefore, we have to go via a symbol pointer:
207 howToAccessLabel JumpReference lbl
208     | labelDynamic lbl
209     = AccessViaSymbolPtr
210 #endif
211
212 howToAccessLabel _ lbl
213 #if !x86_64_TARGET_ARCH
214     -- Code stubs are the usual method of choice for imported code;
215     -- not needed on x86_64 because Apple's new linker, ld64, generates
216     -- them automatically.
217     | labelDynamic lbl
218     = AccessViaStub
219 #endif
220     | otherwise
221     = AccessDirectly
222
223
224 #elif linux_TARGET_OS && powerpc64_TARGET_ARCH
225 -- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC
226
227 howToAccessLabel DataReference lbl = AccessViaSymbolPtr
228 howToAccessLabel _ lbl = AccessDirectly -- actually, .label instead of label
229
230 #elif linux_TARGET_OS
231 -- ELF (Linux)
232 --
233 -- ELF tries to pretend to the main application code that dynamic linking does 
234 -- not exist. While this may sound convenient, it tends to mess things up in
235 -- very bad ways, so we have to be careful when we generate code for the main
236 -- program (-dynamic but no -fPIC).
237 --
238 -- Indirect access is required for references to imported symbols
239 -- from position independent code. It is also required from the main program
240 -- when dynamic libraries containing Haskell code are used.
241
242 howToAccessLabel _ lbl
243         -- no PIC -> the dynamic linker does everything for us;
244         --           if we don't dynamically link to Haskell code,
245         --           it actually manages to do so without messing thins up.
246     | not opt_PIC && opt_Static = AccessDirectly
247    
248 howToAccessLabel DataReference lbl
249         -- A dynamic label needs to be accessed via a symbol pointer.
250     | labelDynamic lbl = AccessViaSymbolPtr
251 #if powerpc_TARGET_ARCH
252         -- For PowerPC32 -fPIC, we have to access even static data
253         -- via a symbol pointer (see below for an explanation why
254         -- PowerPC32 Linux is especially broken).
255     | opt_PIC = AccessViaSymbolPtr
256 #endif
257     | otherwise = AccessDirectly
258
259
260 -- In most cases, we have to avoid symbol stubs on ELF, for the following reasons:
261 -- * on i386, the position-independent symbol stubs in the Procedure Linkage Table
262 --   require the address of the GOT to be loaded into register %ebx on entry.
263 -- * The linker will take any reference to the symbol stub as a hint that
264 --   the label in question is a code label. When linking executables, this
265 --   will cause the linker to replace even data references to the label with
266 --   references to the symbol stub.
267
268 -- This leaves calling a (foreign) function from non-PIC code
269 -- (AccessDirectly, because we get an implicit symbol stub)
270 -- and calling functions from PIC code on non-i386 platforms (via a symbol stub) 
271
272 howToAccessLabel CallReference lbl
273     | labelDynamic lbl && not opt_PIC
274     = AccessDirectly
275 #if !i386_TARGET_ARCH
276     | labelDynamic lbl && opt_PIC
277     = AccessViaStub
278 #endif
279
280 howToAccessLabel _ lbl
281     | labelDynamic lbl = AccessViaSymbolPtr
282     | otherwise = AccessDirectly
283 #else
284 --
285 -- all other platforms
286 --
287 howToAccessLabel _ _
288         | not opt_PIC = AccessDirectly
289         | otherwise   = panic "howToAccessLabel: PIC not defined for this platform"
290 #endif
291
292 -- -------------------------------------------------------------------
293
294 -- What do we have to add to our 'PIC base register' in order to
295 -- get the address of a label?
296
297 picRelative :: CLabel -> CmmLit
298 #if darwin_TARGET_OS && !x86_64_TARGET_ARCH
299 -- Darwin, but not x86_64:
300 -- The PIC base register points to the PIC base label at the beginning
301 -- of the current CmmTop. We just have to use a label difference to
302 -- get the offset.
303 -- We have already made sure that all labels that are not from the current
304 -- module are accessed indirectly ('as' can't calculate differences between
305 -- undefined labels).
306
307 picRelative lbl
308   = CmmLabelDiffOff lbl mkPicBaseLabel 0
309
310 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
311 -- PowerPC Linux:
312 -- The PIC base register points to our fake GOT. Use a label difference
313 -- to get the offset.
314 -- We have made sure that *everything* is accessed indirectly, so this
315 -- is only used for offsets from the GOT to symbol pointers inside the
316 -- GOT.
317 picRelative lbl
318   = CmmLabelDiffOff lbl gotLabel 0
319
320 #elif linux_TARGET_OS || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
321 -- Most Linux versions:
322 -- The PIC base register points to the GOT. Use foo@got for symbol
323 -- pointers, and foo@gotoff for everything else.
324 -- Linux and Darwin on x86_64:
325 -- The PIC base register is %rip, we use foo@gotpcrel for symbol pointers,
326 -- and a GotSymbolOffset label for other things.
327 -- For reasons of tradition, the symbol offset label is written as a plain label.
328
329 picRelative lbl
330   | Just (SymbolPtr, lbl') <- dynamicLinkerLabelInfo lbl
331   = CmmLabel $ mkDynamicLinkerLabel GotSymbolPtr lbl'
332   | otherwise
333   = CmmLabel $ mkDynamicLinkerLabel GotSymbolOffset lbl
334
335 #else
336 picRelative lbl = panic "PositionIndependentCode.picRelative"
337 #endif
338
339 -- -------------------------------------------------------------------
340
341 -- What do we have to add to every assembly file we generate?
342
343 -- utility function for pretty-printing asm-labels,
344 -- copied from PprMach
345 asmSDoc d = Outputable.withPprStyleDoc (
346               Outputable.mkCodeStyle Outputable.AsmStyle) d
347 pprCLabel_asm l = asmSDoc (pprCLabel l)
348
349
350 #if darwin_TARGET_OS && !x86_64_TARGET_ARCH
351
352 needImportedSymbols = True
353
354 -- We don't need to declare any offset tables.
355 -- However, for PIC on x86, we need a small helper function.
356 #if i386_TARGET_ARCH
357 pprGotDeclaration
358     | opt_PIC
359     = vcat [
360         ptext SLIT(".section __TEXT,__textcoal_nt,coalesced,no_toc"),
361         ptext SLIT(".weak_definition ___i686.get_pc_thunk.ax"),
362         ptext SLIT(".private_extern ___i686.get_pc_thunk.ax"),
363         ptext SLIT("___i686.get_pc_thunk.ax:"),
364             ptext SLIT("\tmovl (%esp), %eax"),
365             ptext SLIT("\tret")
366     ]
367     | otherwise = Pretty.empty
368 #else
369 pprGotDeclaration = Pretty.empty
370 #endif
371
372 -- On Darwin, we have to generate our own stub code for lazy binding..
373 -- For each processor architecture, there are two versions, one for PIC
374 -- and one for non-PIC.
375 pprImportedSymbol importedLbl
376 #if powerpc_TARGET_ARCH
377     | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
378     = case opt_PIC of
379         False ->
380             vcat [
381                 ptext SLIT(".symbol_stub"),
382                 ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
383                     ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
384                     ptext SLIT("\tlis r11,ha16(L") <> pprCLabel_asm lbl
385                         <> ptext SLIT("$lazy_ptr)"),
386                     ptext SLIT("\tlwz r12,lo16(L") <> pprCLabel_asm lbl
387                         <> ptext SLIT("$lazy_ptr)(r11)"),
388                     ptext SLIT("\tmtctr r12"),
389                     ptext SLIT("\taddi r11,r11,lo16(L") <> pprCLabel_asm lbl
390                         <> ptext SLIT("$lazy_ptr)"),
391                     ptext SLIT("\tbctr")
392             ]
393         True ->
394             vcat [
395                 ptext SLIT(".section __TEXT,__picsymbolstub1,")
396                   <> ptext SLIT("symbol_stubs,pure_instructions,32"),
397                 ptext SLIT("\t.align 2"),
398                 ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
399                     ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
400                     ptext SLIT("\tmflr r0"),
401                     ptext SLIT("\tbcl 20,31,L0$") <> pprCLabel_asm lbl,
402                 ptext SLIT("L0$") <> pprCLabel_asm lbl <> char ':',
403                     ptext SLIT("\tmflr r11"),
404                     ptext SLIT("\taddis r11,r11,ha16(L") <> pprCLabel_asm lbl
405                         <> ptext SLIT("$lazy_ptr-L0$") <> pprCLabel_asm lbl <> char ')',
406                     ptext SLIT("\tmtlr r0"),
407                     ptext SLIT("\tlwzu r12,lo16(L") <> pprCLabel_asm lbl
408                         <> ptext SLIT("$lazy_ptr-L0$") <> pprCLabel_asm lbl
409                         <> ptext SLIT(")(r11)"),
410                     ptext SLIT("\tmtctr r12"),
411                     ptext SLIT("\tbctr")
412             ]
413     $+$ vcat [
414         ptext SLIT(".lazy_symbol_pointer"),
415         ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$lazy_ptr:"),
416             ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
417             ptext SLIT("\t.long dyld_stub_binding_helper")
418     ]
419 #elif i386_TARGET_ARCH
420     | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
421     = case opt_PIC of
422         False ->
423             vcat [
424                 ptext SLIT(".symbol_stub"),
425                 ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
426                     ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
427                     ptext SLIT("\tjmp *L") <> pprCLabel_asm lbl
428                         <> ptext SLIT("$lazy_ptr"),
429                 ptext SLIT("L") <> pprCLabel_asm lbl
430                     <> ptext SLIT("$stub_binder:"),
431                     ptext SLIT("\tpushl $L") <> pprCLabel_asm lbl
432                         <> ptext SLIT("$lazy_ptr"),
433                     ptext SLIT("\tjmp dyld_stub_binding_helper")
434             ]
435         True ->
436             vcat [
437                 ptext SLIT(".section __TEXT,__picsymbolstub2,")
438                     <> ptext SLIT("symbol_stubs,pure_instructions,25"),
439                 ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
440                     ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
441                     ptext SLIT("\tcall ___i686.get_pc_thunk.ax"),
442                 ptext SLIT("1:"),
443                     ptext SLIT("\tmovl L") <> pprCLabel_asm lbl
444                         <> ptext SLIT("$lazy_ptr-1b(%eax),%edx"),
445                     ptext SLIT("\tjmp %edx"),
446                 ptext SLIT("L") <> pprCLabel_asm lbl
447                     <> ptext SLIT("$stub_binder:"),
448                     ptext SLIT("\tlea L") <> pprCLabel_asm lbl
449                         <> ptext SLIT("$lazy_ptr-1b(%eax),%eax"),
450                     ptext SLIT("\tpushl %eax"),
451                     ptext SLIT("\tjmp dyld_stub_binding_helper")
452             ]
453     $+$ vcat [        ptext SLIT(".section __DATA, __la_sym_ptr")
454                     <> (if opt_PIC then int 2 else int 3)
455                     <> ptext SLIT(",lazy_symbol_pointers"),
456         ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$lazy_ptr:"),
457             ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
458             ptext SLIT("\t.long L") <> pprCLabel_asm lbl
459                     <> ptext SLIT("$stub_binder")
460     ]
461 #endif
462 -- We also have to declare our symbol pointers ourselves:
463     | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
464     = vcat [
465         ptext SLIT(".non_lazy_symbol_pointer"),
466         char 'L' <> pprCLabel_asm lbl <> ptext SLIT("$non_lazy_ptr:"),
467             ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
468             ptext SLIT("\t.long\t0")
469     ]
470
471     | otherwise = empty
472
473 #elif linux_TARGET_OS && !powerpc64_TARGET_ARCH
474
475 -- ELF / Linux
476 --
477 -- In theory, we don't need to generate any stubs or symbol pointers
478 -- by hand for Linux.
479 --
480 -- Reality differs from this in two areas.
481 --
482 -- 1) If we just use a dynamically imported symbol directly in a read-only
483 --    section of the main executable (as GCC does), ld generates R_*_COPY
484 --    relocations, which are fundamentally incompatible with reversed info
485 --    tables. Therefore, we need a table of imported addresses in a writable
486 --    section.
487 --    The "official" GOT mechanism (label@got) isn't intended to be used
488 --    in position dependent code, so we have to create our own "fake GOT"
489 --    when not opt_PCI && not opt_Static.
490 --
491 -- 2) PowerPC Linux is just plain broken.
492 --    While it's theoretically possible to use GOT offsets larger
493 --    than 16 bit, the standard crt*.o files don't, which leads to
494 --    linker errors as soon as the GOT size exceeds 16 bit.
495 --    Also, the assembler doesn't support @gotoff labels.
496 --    In order to be able to use a larger GOT, we have to circumvent the
497 --    entire GOT mechanism and do it ourselves (this is also what GCC does).
498
499
500 -- When needImportedSymbols is defined,
501 -- the NCG will keep track of all DynamicLinkerLabels it uses
502 -- and output each of them using pprImportedSymbol.
503 #if powerpc_TARGET_ARCH
504     -- PowerPC Linux: -fPIC or -dynamic
505 needImportedSymbols = opt_PIC || not opt_Static
506 #else
507     -- i386 (and others?): -dynamic but not -fPIC
508 needImportedSymbols = not opt_Static && not opt_PIC
509 #endif
510
511 -- gotLabel
512 -- The label used to refer to our "fake GOT" from
513 -- position-independent code.
514 gotLabel = mkForeignLabel -- HACK: it's not really foreign
515                            FSLIT(".LCTOC1") Nothing False
516
517 -- pprGotDeclaration
518 -- Output whatever needs to be output once per .s file.
519 -- The .LCTOC1 label is defined to point 32768 bytes into the table,
520 -- to make the most of the PPC's 16-bit displacements.
521 -- Only needed for PIC.
522
523 pprGotDeclaration
524     | not opt_PIC = Pretty.empty
525     | otherwise = vcat [
526         ptext SLIT(".section \".got2\",\"aw\""),
527         ptext SLIT(".LCTOC1 = .+32768")
528     ]
529
530 -- We generate one .long literal for every symbol we import;
531 -- the dynamic linker will relocate those addresses.
532
533 pprImportedSymbol importedLbl
534     | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
535     = vcat [
536         ptext SLIT(".section \".got2\", \"aw\""),
537         ptext SLIT(".LC_") <> pprCLabel_asm lbl <> char ':',
538         ptext SLIT("\t.long") <+> pprCLabel_asm lbl
539     ]
540
541 -- PLT code stubs are generated automatically be the dynamic linker.
542     | otherwise = empty
543
544 #else
545
546 -- For all other currently supported platforms, we don't need to do
547 -- anything at all.
548
549 needImportedSymbols = False
550 pprGotDeclaration = Pretty.empty
551 pprImportedSymbol _ = empty
552 #endif
553
554 -- -------------------------------------------------------------------
555
556 -- Generate code to calculate the address that should be put in the
557 -- PIC base register.
558 -- This is called by MachCodeGen for every CmmProc that accessed the
559 -- PIC base register. It adds the appropriate instructions to the
560 -- top of the CmmProc.
561
562 -- It is assumed that the first NatCmmTop in the input list is a Proc
563 -- and the rest are CmmDatas.
564
565 initializePicBase :: Reg -> [NatCmmTop] -> NatM [NatCmmTop]
566
567 #if darwin_TARGET_OS
568
569 -- Darwin is simple: just fetch the address of a local label.
570 -- The FETCHPC pseudo-instruction is expanded to multiple instructions
571 -- during pretty-printing so that we don't have to deal with the
572 -- local label:
573
574 -- PowerPC version:
575 --          bcl 20,31,1f.
576 --      1:  mflr picReg
577
578 -- i386 version:
579 --          call 1f
580 --      1:  popl %picReg
581
582 initializePicBase picReg (CmmProc info lab params blocks : statics)
583     = return (CmmProc info lab params (b':tail blocks) : statics)
584     where BasicBlock bID insns = head blocks
585           b' = BasicBlock bID (FETCHPC picReg : insns)
586
587 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
588
589 -- Get a pointer to our own fake GOT, which is defined on a per-module basis.
590 -- This is exactly how GCC does it, and it's quite horrible:
591 -- We first fetch the address of a local label (mkPicBaseLabel).
592 -- Then we add a 16-bit offset to that to get the address of a .long that we
593 -- define in .text space right next to the proc. This .long literal contains
594 -- the (32-bit) offset from our local label to our global offset table
595 -- (.LCTOC1 aka gotOffLabel).
596 initializePicBase picReg
597     (CmmProc info lab params blocks : statics)
598     = do
599         gotOffLabel <- getNewLabelNat
600         tmp <- getNewRegNat wordRep
601         let 
602             gotOffset = CmmData Text [
603                             CmmDataLabel gotOffLabel,
604                             CmmStaticLit (CmmLabelDiffOff gotLabel
605                                                           mkPicBaseLabel
606                                                           0)
607                         ]
608             offsetToOffset = ImmConstantDiff (ImmCLbl gotOffLabel)
609                                              (ImmCLbl mkPicBaseLabel)
610             BasicBlock bID insns = head blocks
611             b' = BasicBlock bID (FETCHPC picReg
612                                : LD wordRep tmp
613                                     (AddrRegImm picReg offsetToOffset)
614                                : ADD picReg picReg (RIReg tmp)
615                                : insns)
616         return (CmmProc info lab params (b' : tail blocks) : gotOffset : statics)
617 #elif i386_TARGET_ARCH && linux_TARGET_OS
618
619 -- We cheat a bit here by defining a pseudo-instruction named FETCHGOT
620 -- which pretty-prints as:
621 --              call 1f
622 -- 1:           popl %picReg
623 --              addl __GLOBAL_OFFSET_TABLE__+.-1b, %picReg
624 -- (See PprMach.lhs)
625
626 initializePicBase picReg (CmmProc info lab params blocks : statics)
627     = return (CmmProc info lab params (b':tail blocks) : statics)
628     where BasicBlock bID insns = head blocks
629           b' = BasicBlock bID (FETCHGOT picReg : insns)
630
631 #else
632 initializePicBase picReg proc = panic "initializePicBase"
633
634 -- mingw32_TARGET_OS: not needed, won't be called
635 #endif