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