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