Remove dead generics-related code from OccName
[ghc.git] / compiler / nativeGen / PIC.hs
1 {-
2 This module handles generation of position independent code and
3 dynamic-linking related issues for the native code generator.
4
5 This depends both the architecture and OS, so we define it here
6 instead of in one of the architecture specific modules.
7
8 Things outside this module which are related to this:
9
10 + module CLabel
11 - PIC base label (pretty printed as local label 1)
12 - DynamicLinkerLabels - several kinds:
13 CodeStub, SymbolPtr, GotSymbolPtr, GotSymbolOffset
14 - labelDynamic predicate
15 + module Cmm
16 - The GlobalReg datatype has a PicBaseReg constructor
17 - The CmmLit datatype has a CmmLabelDiffOff constructor
18 + codeGen & RTS
19 - When tablesNextToCode, no absolute addresses are stored in info tables
20 any more. Instead, offsets from the info label are used.
21 - For Win32 only, SRTs might contain addresses of __imp_ symbol pointers
22 because Win32 doesn't support external references in data sections.
23 TODO: make sure this still works, it might be bitrotted
24 + NCG
25 - The cmmToCmm pass in AsmCodeGen calls cmmMakeDynamicReference for all
26 labels.
27 - nativeCodeGen calls pprImportedSymbol and pprGotDeclaration to output
28 all the necessary stuff for imported symbols.
29 - The NCG monad keeps track of a list of imported symbols.
30 - MachCodeGen invokes initializePicBase to generate code to initialize
31 the PIC base register when needed.
32 - MachCodeGen calls cmmMakeDynamicReference whenever it uses a CLabel
33 that wasn't in the original Cmm code (e.g. floating point literals).
34 -}
35
36 module PIC (
37 cmmMakeDynamicReference,
38 CmmMakeDynamicReferenceM(..),
39 ReferenceKind(..),
40 needImportedSymbols,
41 pprImportedSymbol,
42 pprGotDeclaration,
43
44 initializePicBase_ppc,
45 initializePicBase_x86
46 )
47
48 where
49
50 import qualified PPC.Instr as PPC
51 import qualified PPC.Regs as PPC
52
53 import qualified X86.Instr as X86
54
55 import Platform
56 import Instruction
57 import Reg
58 import NCGMonad
59
60
61 import Hoopl
62 import Cmm
63 import CLabel ( CLabel, ForeignLabelSource(..), pprCLabel,
64 mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
65 dynamicLinkerLabelInfo, mkPicBaseLabel,
66 labelDynamic, externallyVisibleCLabel )
67
68 import CLabel ( mkForeignLabel )
69
70
71 import BasicTypes
72 import Module
73
74 import Outputable
75
76 import DynFlags
77 import FastString
78
79
80
81 --------------------------------------------------------------------------------
82 -- It gets called by the cmmToCmm pass for every CmmLabel in the Cmm
83 -- code. It does The Right Thing(tm) to convert the CmmLabel into a
84 -- position-independent, dynamic-linking-aware reference to the thing
85 -- in question.
86 -- Note that this also has to be called from MachCodeGen in order to
87 -- access static data like floating point literals (labels that were
88 -- created after the cmmToCmm pass).
89 -- The function must run in a monad that can keep track of imported symbols
90 -- A function for recording an imported symbol must be passed in:
91 -- - addImportCmmOpt for the CmmOptM monad
92 -- - addImportNat for the NatM monad.
93
94 data ReferenceKind
95 = DataReference
96 | CallReference
97 | JumpReference
98 deriving(Eq)
99
100 class Monad m => CmmMakeDynamicReferenceM m where
101 addImport :: CLabel -> m ()
102 getThisModule :: m Module
103
104 instance CmmMakeDynamicReferenceM NatM where
105 addImport = addImportNat
106 getThisModule = getThisModuleNat
107
108 cmmMakeDynamicReference
109 :: CmmMakeDynamicReferenceM m
110 => DynFlags
111 -> ReferenceKind -- whether this is the target of a jump
112 -> CLabel -- the label
113 -> m CmmExpr
114
115 cmmMakeDynamicReference dflags referenceKind lbl
116 | Just _ <- dynamicLinkerLabelInfo lbl
117 = return $ CmmLit $ CmmLabel lbl -- already processed it, pass through
118
119 | otherwise
120 = do this_mod <- getThisModule
121 case howToAccessLabel
122 dflags
123 (platformArch $ targetPlatform dflags)
124 (platformOS $ targetPlatform dflags)
125 this_mod
126 referenceKind lbl of
127
128 AccessViaStub -> do
129 let stub = mkDynamicLinkerLabel CodeStub lbl
130 addImport stub
131 return $ CmmLit $ CmmLabel stub
132
133 AccessViaSymbolPtr -> do
134 let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
135 addImport symbolPtr
136 return $ CmmLoad (cmmMakePicReference dflags symbolPtr) (bWord dflags)
137
138 AccessDirectly -> case referenceKind of
139 -- for data, we might have to make some calculations:
140 DataReference -> return $ cmmMakePicReference dflags lbl
141 -- all currently supported processors support
142 -- PC-relative branch and call instructions,
143 -- so just jump there if it's a call or a jump
144 _ -> return $ CmmLit $ CmmLabel lbl
145
146
147 -- -----------------------------------------------------------------------------
148 -- Create a position independent reference to a label.
149 -- (but do not bother with dynamic linking).
150 -- We calculate the label's address by adding some (platform-dependent)
151 -- offset to our base register; this offset is calculated by
152 -- the function picRelative in the platform-dependent part below.
153
154 cmmMakePicReference :: DynFlags -> CLabel -> CmmExpr
155 cmmMakePicReference dflags lbl
156
157 -- Windows doesn't need PIC,
158 -- everything gets relocated at runtime
159 | OSMinGW32 <- platformOS $ targetPlatform dflags
160 = CmmLit $ CmmLabel lbl
161
162 | OSAIX <- platformOS $ targetPlatform dflags
163 = CmmMachOp (MO_Add W32)
164 [ CmmReg (CmmGlobal PicBaseReg)
165 , CmmLit $ picRelative
166 (platformArch $ targetPlatform dflags)
167 (platformOS $ targetPlatform dflags)
168 lbl ]
169
170 -- both ABI versions default to medium code model
171 | ArchPPC_64 _ <- platformArch $ targetPlatform dflags
172 = CmmMachOp (MO_Add W32) -- code model medium
173 [ CmmReg (CmmGlobal PicBaseReg)
174 , CmmLit $ picRelative
175 (platformArch $ targetPlatform dflags)
176 (platformOS $ targetPlatform dflags)
177 lbl ]
178
179 | (gopt Opt_PIC dflags || WayDyn `elem` ways dflags) && absoluteLabel lbl
180 = CmmMachOp (MO_Add (wordWidth dflags))
181 [ CmmReg (CmmGlobal PicBaseReg)
182 , CmmLit $ picRelative
183 (platformArch $ targetPlatform dflags)
184 (platformOS $ targetPlatform dflags)
185 lbl ]
186
187 | otherwise
188 = CmmLit $ CmmLabel lbl
189
190
191 absoluteLabel :: CLabel -> Bool
192 absoluteLabel lbl
193 = case dynamicLinkerLabelInfo lbl of
194 Just (GotSymbolPtr, _) -> False
195 Just (GotSymbolOffset, _) -> False
196 _ -> True
197
198
199 --------------------------------------------------------------------------------
200 -- Knowledge about how special dynamic linker labels like symbol
201 -- pointers, code stubs and GOT offsets look like is located in the
202 -- module CLabel.
203
204 -- We have to decide which labels need to be accessed
205 -- indirectly or via a piece of stub code.
206 data LabelAccessStyle
207 = AccessViaStub
208 | AccessViaSymbolPtr
209 | AccessDirectly
210
211 howToAccessLabel
212 :: DynFlags -> Arch -> OS -> Module -> ReferenceKind -> CLabel -> LabelAccessStyle
213
214
215 -- Windows
216 -- In Windows speak, a "module" is a set of objects linked into the
217 -- same Portable Exectuable (PE) file. (both .exe and .dll files are PEs).
218 --
219 -- If we're compiling a multi-module program then symbols from other modules
220 -- are accessed by a symbol pointer named __imp_SYMBOL. At runtime we have the
221 -- following.
222 --
223 -- (in the local module)
224 -- __imp_SYMBOL: addr of SYMBOL
225 --
226 -- (in the other module)
227 -- SYMBOL: the real function / data.
228 --
229 -- To access the function at SYMBOL from our local module, we just need to
230 -- dereference the local __imp_SYMBOL.
231 --
232 -- If not compiling with -dynamic we assume that all our code will be linked
233 -- into the same .exe file. In this case we always access symbols directly,
234 -- and never use __imp_SYMBOL.
235 --
236 howToAccessLabel dflags _ OSMinGW32 this_mod _ lbl
237
238 -- Assume all symbols will be in the same PE, so just access them directly.
239 | WayDyn `notElem` ways dflags
240 = AccessDirectly
241
242 -- If the target symbol is in another PE we need to access it via the
243 -- appropriate __imp_SYMBOL pointer.
244 | labelDynamic dflags (thisPackage dflags) this_mod lbl
245 = AccessViaSymbolPtr
246
247 -- Target symbol is in the same PE as the caller, so just access it directly.
248 | otherwise
249 = AccessDirectly
250
251
252 -- Mach-O (Darwin, Mac OS X)
253 --
254 -- Indirect access is required in the following cases:
255 -- * things imported from a dynamic library
256 -- * (not on x86_64) data from a different module, if we're generating PIC code
257 -- It is always possible to access something indirectly,
258 -- even when it's not necessary.
259 --
260 howToAccessLabel dflags arch OSDarwin this_mod DataReference lbl
261 -- data access to a dynamic library goes via a symbol pointer
262 | labelDynamic dflags (thisPackage dflags) this_mod lbl
263 = AccessViaSymbolPtr
264
265 -- when generating PIC code, all cross-module data references must
266 -- must go via a symbol pointer, too, because the assembler
267 -- cannot generate code for a label difference where one
268 -- label is undefined. Doesn't apply t x86_64.
269 -- Unfortunately, we don't know whether it's cross-module,
270 -- so we do it for all externally visible labels.
271 -- This is a slight waste of time and space, but otherwise
272 -- we'd need to pass the current Module all the way in to
273 -- this function.
274 | arch /= ArchX86_64
275 , gopt Opt_PIC dflags && externallyVisibleCLabel lbl
276 = AccessViaSymbolPtr
277
278 | otherwise
279 = AccessDirectly
280
281 howToAccessLabel dflags arch OSDarwin this_mod JumpReference lbl
282 -- dyld code stubs don't work for tailcalls because the
283 -- stack alignment is only right for regular calls.
284 -- Therefore, we have to go via a symbol pointer:
285 | arch == ArchX86 || arch == ArchX86_64
286 , labelDynamic dflags (thisPackage dflags) this_mod lbl
287 = AccessViaSymbolPtr
288
289
290 howToAccessLabel dflags arch OSDarwin this_mod _ lbl
291 -- Code stubs are the usual method of choice for imported code;
292 -- not needed on x86_64 because Apple's new linker, ld64, generates
293 -- them automatically.
294 | arch /= ArchX86_64
295 , labelDynamic dflags (thisPackage dflags) this_mod lbl
296 = AccessViaStub
297
298 | otherwise
299 = AccessDirectly
300
301
302 ----------------------------------------------------------------------------
303 -- AIX
304
305 -- quite simple (for now)
306 howToAccessLabel _dflags _arch OSAIX _this_mod kind _lbl
307 = case kind of
308 DataReference -> AccessViaSymbolPtr
309 CallReference -> AccessDirectly
310 JumpReference -> AccessDirectly
311
312 -- ELF (Linux)
313 --
314 -- ELF tries to pretend to the main application code that dynamic linking does
315 -- not exist. While this may sound convenient, it tends to mess things up in
316 -- very bad ways, so we have to be careful when we generate code for the main
317 -- program (-dynamic but no -fPIC).
318 --
319 -- Indirect access is required for references to imported symbols
320 -- from position independent code. It is also required from the main program
321 -- when dynamic libraries containing Haskell code are used.
322
323 howToAccessLabel _ (ArchPPC_64 _) os _ kind _
324 | osElfTarget os
325 = case kind of
326 -- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC
327 DataReference -> AccessViaSymbolPtr
328 -- RTLD does not generate stubs for function descriptors
329 -- in tail calls. Create a symbol pointer and generate
330 -- the code to load the function descriptor at the call site.
331 JumpReference -> AccessViaSymbolPtr
332 -- regular calls are handled by the runtime linker
333 _ -> AccessDirectly
334
335 howToAccessLabel dflags _ os _ _ _
336 -- no PIC -> the dynamic linker does everything for us;
337 -- if we don't dynamically link to Haskell code,
338 -- it actually manages to do so without messing things up.
339 | osElfTarget os
340 , not (gopt Opt_PIC dflags) && WayDyn `notElem` ways dflags
341 = AccessDirectly
342
343 howToAccessLabel dflags arch os this_mod DataReference lbl
344 | osElfTarget os
345 = case () of
346 -- A dynamic label needs to be accessed via a symbol pointer.
347 _ | labelDynamic dflags (thisPackage dflags) this_mod lbl
348 -> AccessViaSymbolPtr
349
350 -- For PowerPC32 -fPIC, we have to access even static data
351 -- via a symbol pointer (see below for an explanation why
352 -- PowerPC32 Linux is especially broken).
353 | arch == ArchPPC
354 , gopt Opt_PIC dflags
355 -> AccessViaSymbolPtr
356
357 | otherwise
358 -> AccessDirectly
359
360
361 -- In most cases, we have to avoid symbol stubs on ELF, for the following reasons:
362 -- on i386, the position-independent symbol stubs in the Procedure Linkage Table
363 -- require the address of the GOT to be loaded into register %ebx on entry.
364 -- The linker will take any reference to the symbol stub as a hint that
365 -- the label in question is a code label. When linking executables, this
366 -- will cause the linker to replace even data references to the label with
367 -- references to the symbol stub.
368
369 -- This leaves calling a (foreign) function from non-PIC code
370 -- (AccessDirectly, because we get an implicit symbol stub)
371 -- and calling functions from PIC code on non-i386 platforms (via a symbol stub)
372
373 howToAccessLabel dflags arch os this_mod CallReference lbl
374 | osElfTarget os
375 , labelDynamic dflags (thisPackage dflags) this_mod lbl && not (gopt Opt_PIC dflags)
376 = AccessDirectly
377
378 | osElfTarget os
379 , arch /= ArchX86
380 , labelDynamic dflags (thisPackage dflags) this_mod lbl && gopt Opt_PIC dflags
381 = AccessViaStub
382
383 howToAccessLabel dflags _ os this_mod _ lbl
384 | osElfTarget os
385 = if labelDynamic dflags (thisPackage dflags) this_mod lbl
386 then AccessViaSymbolPtr
387 else AccessDirectly
388
389 -- all other platforms
390 howToAccessLabel dflags _ _ _ _ _
391 | not (gopt Opt_PIC dflags)
392 = AccessDirectly
393
394 | otherwise
395 = panic "howToAccessLabel: PIC not defined for this platform"
396
397
398
399 -- -------------------------------------------------------------------
400 -- | Says what we we have to add to our 'PIC base register' in order to
401 -- get the address of a label.
402
403 picRelative :: Arch -> OS -> CLabel -> CmmLit
404
405 -- Darwin, but not x86_64:
406 -- The PIC base register points to the PIC base label at the beginning
407 -- of the current CmmDecl. We just have to use a label difference to
408 -- get the offset.
409 -- We have already made sure that all labels that are not from the current
410 -- module are accessed indirectly ('as' can't calculate differences between
411 -- undefined labels).
412 picRelative arch OSDarwin lbl
413 | arch /= ArchX86_64
414 = CmmLabelDiffOff lbl mkPicBaseLabel 0
415
416 -- On AIX we use an indirect local TOC anchored by 'gotLabel'.
417 -- This way we use up only one global TOC entry per compilation-unit
418 -- (this is quite similiar to GCC's @-mminimal-toc@ compilation mode)
419 picRelative _ OSAIX lbl
420 = CmmLabelDiffOff lbl gotLabel 0
421
422 -- PowerPC Linux:
423 -- The PIC base register points to our fake GOT. Use a label difference
424 -- to get the offset.
425 -- We have made sure that *everything* is accessed indirectly, so this
426 -- is only used for offsets from the GOT to symbol pointers inside the
427 -- GOT.
428 picRelative ArchPPC os lbl
429 | osElfTarget os
430 = CmmLabelDiffOff lbl gotLabel 0
431
432
433 -- Most Linux versions:
434 -- The PIC base register points to the GOT. Use foo@got for symbol
435 -- pointers, and foo@gotoff for everything else.
436 -- Linux and Darwin on x86_64:
437 -- The PIC base register is %rip, we use foo@gotpcrel for symbol pointers,
438 -- and a GotSymbolOffset label for other things.
439 -- For reasons of tradition, the symbol offset label is written as a plain label.
440 picRelative arch os lbl
441 | osElfTarget os || (os == OSDarwin && arch == ArchX86_64)
442 = let result
443 | Just (SymbolPtr, lbl') <- dynamicLinkerLabelInfo lbl
444 = CmmLabel $ mkDynamicLinkerLabel GotSymbolPtr lbl'
445
446 | otherwise
447 = CmmLabel $ mkDynamicLinkerLabel GotSymbolOffset lbl
448
449 in result
450
451 picRelative _ _ _
452 = panic "PositionIndependentCode.picRelative undefined for this platform"
453
454
455
456 --------------------------------------------------------------------------------
457
458 needImportedSymbols :: DynFlags -> Arch -> OS -> Bool
459 needImportedSymbols dflags arch os
460 | os == OSDarwin
461 , arch /= ArchX86_64
462 = True
463
464 | os == OSAIX
465 = True
466
467 -- PowerPC Linux: -fPIC or -dynamic
468 | osElfTarget os
469 , arch == ArchPPC
470 = gopt Opt_PIC dflags || WayDyn `elem` ways dflags
471
472 -- PowerPC 64 Linux: always
473 | osElfTarget os
474 , arch == ArchPPC_64 ELF_V1 || arch == ArchPPC_64 ELF_V2
475 = True
476
477 -- i386 (and others?): -dynamic but not -fPIC
478 | osElfTarget os
479 , arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
480 = WayDyn `elem` ways dflags && not (gopt Opt_PIC dflags)
481
482 | otherwise
483 = False
484
485 -- gotLabel
486 -- The label used to refer to our "fake GOT" from
487 -- position-independent code.
488 gotLabel :: CLabel
489 gotLabel
490 -- HACK: this label isn't really foreign
491 = mkForeignLabel
492 (fsLit ".LCTOC1")
493 Nothing ForeignLabelInThisPackage IsData
494
495
496
497 --------------------------------------------------------------------------------
498 -- We don't need to declare any offset tables.
499 -- However, for PIC on x86, we need a small helper function.
500 pprGotDeclaration :: DynFlags -> Arch -> OS -> SDoc
501 pprGotDeclaration dflags ArchX86 OSDarwin
502 | gopt Opt_PIC dflags
503 = vcat [
504 text ".section __TEXT,__textcoal_nt,coalesced,no_toc",
505 text ".weak_definition ___i686.get_pc_thunk.ax",
506 text ".private_extern ___i686.get_pc_thunk.ax",
507 text "___i686.get_pc_thunk.ax:",
508 text "\tmovl (%esp), %eax",
509 text "\tret" ]
510
511 pprGotDeclaration _ _ OSDarwin
512 = empty
513
514 -- Emit XCOFF TOC section
515 pprGotDeclaration _ _ OSAIX
516 = vcat $ [ text ".toc"
517 , text ".tc ghc_toc_table[TC],.LCTOC1"
518 , text ".csect ghc_toc_table[RW]"
519 -- See Note [.LCTOC1 in PPC PIC code]
520 , text ".set .LCTOC1,$+0x8000"
521 ]
522
523
524 -- PPC 64 ELF v1needs a Table Of Contents (TOC) on Linux
525 pprGotDeclaration _ (ArchPPC_64 ELF_V1) OSLinux
526 = text ".section \".toc\",\"aw\""
527 -- In ELF v2 we also need to tell the assembler that we want ABI
528 -- version 2. This would normally be done at the top of the file
529 -- right after a file directive, but I could not figure out how
530 -- to do that.
531 pprGotDeclaration _ (ArchPPC_64 ELF_V2) OSLinux
532 = vcat [ text ".abiversion 2",
533 text ".section \".toc\",\"aw\""
534 ]
535 pprGotDeclaration _ (ArchPPC_64 _) _
536 = panic "pprGotDeclaration: ArchPPC_64 only Linux supported"
537
538 -- Emit GOT declaration
539 -- Output whatever needs to be output once per .s file.
540 pprGotDeclaration dflags arch os
541 | osElfTarget os
542 , arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
543 , not (gopt Opt_PIC dflags)
544 = empty
545
546 | osElfTarget os
547 , arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
548 = vcat [
549 -- See Note [.LCTOC1 in PPC PIC code]
550 text ".section \".got2\",\"aw\"",
551 text ".LCTOC1 = .+32768" ]
552
553 pprGotDeclaration _ _ _
554 = panic "pprGotDeclaration: no match"
555
556
557 --------------------------------------------------------------------------------
558 -- On Darwin, we have to generate our own stub code for lazy binding..
559 -- For each processor architecture, there are two versions, one for PIC
560 -- and one for non-PIC.
561 --
562 -- Whenever you change something in this assembler output, make sure
563 -- the splitter in driver/split/ghc-split.lprl recognizes the new output
564
565 pprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc
566 pprImportedSymbol dflags platform@(Platform { platformArch = ArchPPC, platformOS = OSDarwin }) importedLbl
567 | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
568 = case gopt Opt_PIC dflags of
569 False ->
570 vcat [
571 text ".symbol_stub",
572 text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
573 text "\t.indirect_symbol" <+> pprCLabel platform lbl,
574 text "\tlis r11,ha16(L" <> pprCLabel platform lbl
575 <> text "$lazy_ptr)",
576 text "\tlwz r12,lo16(L" <> pprCLabel platform lbl
577 <> text "$lazy_ptr)(r11)",
578 text "\tmtctr r12",
579 text "\taddi r11,r11,lo16(L" <> pprCLabel platform lbl
580 <> text "$lazy_ptr)",
581 text "\tbctr"
582 ]
583 True ->
584 vcat [
585 text ".section __TEXT,__picsymbolstub1,"
586 <> text "symbol_stubs,pure_instructions,32",
587 text "\t.align 2",
588 text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
589 text "\t.indirect_symbol" <+> pprCLabel platform lbl,
590 text "\tmflr r0",
591 text "\tbcl 20,31,L0$" <> pprCLabel platform lbl,
592 text "L0$" <> pprCLabel platform lbl <> char ':',
593 text "\tmflr r11",
594 text "\taddis r11,r11,ha16(L" <> pprCLabel platform lbl
595 <> text "$lazy_ptr-L0$" <> pprCLabel platform lbl <> char ')',
596 text "\tmtlr r0",
597 text "\tlwzu r12,lo16(L" <> pprCLabel platform lbl
598 <> text "$lazy_ptr-L0$" <> pprCLabel platform lbl
599 <> text ")(r11)",
600 text "\tmtctr r12",
601 text "\tbctr"
602 ]
603 $+$ vcat [
604 text ".lazy_symbol_pointer",
605 text "L" <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
606 text "\t.indirect_symbol" <+> pprCLabel platform lbl,
607 text "\t.long dyld_stub_binding_helper"]
608
609 | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
610 = vcat [
611 text ".non_lazy_symbol_pointer",
612 char 'L' <> pprCLabel platform lbl <> text "$non_lazy_ptr:",
613 text "\t.indirect_symbol" <+> pprCLabel platform lbl,
614 text "\t.long\t0"]
615
616 | otherwise
617 = empty
618
619
620 pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl
621 | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
622 = case gopt Opt_PIC dflags of
623 False ->
624 vcat [
625 text ".symbol_stub",
626 text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
627 text "\t.indirect_symbol" <+> pprCLabel platform lbl,
628 text "\tjmp *L" <> pprCLabel platform lbl
629 <> text "$lazy_ptr",
630 text "L" <> pprCLabel platform lbl
631 <> text "$stub_binder:",
632 text "\tpushl $L" <> pprCLabel platform lbl
633 <> text "$lazy_ptr",
634 text "\tjmp dyld_stub_binding_helper"
635 ]
636 True ->
637 vcat [
638 text ".section __TEXT,__picsymbolstub2,"
639 <> text "symbol_stubs,pure_instructions,25",
640 text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
641 text "\t.indirect_symbol" <+> pprCLabel platform lbl,
642 text "\tcall ___i686.get_pc_thunk.ax",
643 text "1:",
644 text "\tmovl L" <> pprCLabel platform lbl
645 <> text "$lazy_ptr-1b(%eax),%edx",
646 text "\tjmp *%edx",
647 text "L" <> pprCLabel platform lbl
648 <> text "$stub_binder:",
649 text "\tlea L" <> pprCLabel platform lbl
650 <> text "$lazy_ptr-1b(%eax),%eax",
651 text "\tpushl %eax",
652 text "\tjmp dyld_stub_binding_helper"
653 ]
654 $+$ vcat [ text ".section __DATA, __la_sym_ptr"
655 <> (if gopt Opt_PIC dflags then int 2 else int 3)
656 <> text ",lazy_symbol_pointers",
657 text "L" <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
658 text "\t.indirect_symbol" <+> pprCLabel platform lbl,
659 text "\t.long L" <> pprCLabel platform lbl
660 <> text "$stub_binder"]
661
662 | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
663 = vcat [
664 text ".non_lazy_symbol_pointer",
665 char 'L' <> pprCLabel platform lbl <> text "$non_lazy_ptr:",
666 text "\t.indirect_symbol" <+> pprCLabel platform lbl,
667 text "\t.long\t0"]
668
669 | otherwise
670 = empty
671
672
673 pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _
674 = empty
675
676 -- XCOFF / AIX
677 --
678 -- Similiar to PPC64 ELF v1, there's dedicated TOC register (r2). To
679 -- workaround the limitation of a global TOC we use an indirect TOC
680 -- with the label `ghc_toc_table`.
681 --
682 -- See also GCC's `-mminimal-toc` compilation mode or
683 -- http://www.ibm.com/developerworks/rational/library/overview-toc-aix/
684 --
685 -- NB: No DSO-support yet
686
687 pprImportedSymbol _ platform@(Platform { platformOS = OSAIX }) importedLbl
688 = case dynamicLinkerLabelInfo importedLbl of
689 Just (SymbolPtr, lbl)
690 -> vcat [
691 text "LC.." <> pprCLabel platform lbl <> char ':',
692 text "\t.long" <+> pprCLabel platform lbl ]
693 _ -> empty
694
695 -- ELF / Linux
696 --
697 -- In theory, we don't need to generate any stubs or symbol pointers
698 -- by hand for Linux.
699 --
700 -- Reality differs from this in two areas.
701 --
702 -- 1) If we just use a dynamically imported symbol directly in a read-only
703 -- section of the main executable (as GCC does), ld generates R_*_COPY
704 -- relocations, which are fundamentally incompatible with reversed info
705 -- tables. Therefore, we need a table of imported addresses in a writable
706 -- section.
707 -- The "official" GOT mechanism (label@got) isn't intended to be used
708 -- in position dependent code, so we have to create our own "fake GOT"
709 -- when not Opt_PIC && WayDyn `elem` ways dflags.
710 --
711 -- 2) PowerPC Linux is just plain broken.
712 -- While it's theoretically possible to use GOT offsets larger
713 -- than 16 bit, the standard crt*.o files don't, which leads to
714 -- linker errors as soon as the GOT size exceeds 16 bit.
715 -- Also, the assembler doesn't support @gotoff labels.
716 -- In order to be able to use a larger GOT, we have to circumvent the
717 -- entire GOT mechanism and do it ourselves (this is also what GCC does).
718
719
720 -- When needImportedSymbols is defined,
721 -- the NCG will keep track of all DynamicLinkerLabels it uses
722 -- and output each of them using pprImportedSymbol.
723
724 pprImportedSymbol _ platform@(Platform { platformArch = ArchPPC_64 _ })
725 importedLbl
726 | osElfTarget (platformOS platform)
727 = case dynamicLinkerLabelInfo importedLbl of
728 Just (SymbolPtr, lbl)
729 -> vcat [
730 text ".section \".toc\", \"aw\"",
731 text ".LC_" <> pprCLabel platform lbl <> char ':',
732 text "\t.quad" <+> pprCLabel platform lbl ]
733 _ -> empty
734
735 pprImportedSymbol dflags platform importedLbl
736 | osElfTarget (platformOS platform)
737 = case dynamicLinkerLabelInfo importedLbl of
738 Just (SymbolPtr, lbl)
739 -> let symbolSize = case wordWidth dflags of
740 W32 -> sLit "\t.long"
741 W64 -> sLit "\t.quad"
742 _ -> panic "Unknown wordRep in pprImportedSymbol"
743
744 in vcat [
745 text ".section \".got2\", \"aw\"",
746 text ".LC_" <> pprCLabel platform lbl <> char ':',
747 ptext symbolSize <+> pprCLabel platform lbl ]
748
749 -- PLT code stubs are generated automatically by the dynamic linker.
750 _ -> empty
751
752 pprImportedSymbol _ _ _
753 = panic "PIC.pprImportedSymbol: no match"
754
755 --------------------------------------------------------------------------------
756 -- Generate code to calculate the address that should be put in the
757 -- PIC base register.
758 -- This is called by MachCodeGen for every CmmProc that accessed the
759 -- PIC base register. It adds the appropriate instructions to the
760 -- top of the CmmProc.
761
762 -- It is assumed that the first NatCmmDecl in the input list is a Proc
763 -- and the rest are CmmDatas.
764
765 -- Darwin is simple: just fetch the address of a local label.
766 -- The FETCHPC pseudo-instruction is expanded to multiple instructions
767 -- during pretty-printing so that we don't have to deal with the
768 -- local label:
769
770 -- PowerPC version:
771 -- bcl 20,31,1f.
772 -- 1: mflr picReg
773
774 -- i386 version:
775 -- call 1f
776 -- 1: popl %picReg
777
778
779
780 -- Get a pointer to our own fake GOT, which is defined on a per-module basis.
781 -- This is exactly how GCC does it in linux.
782
783 initializePicBase_ppc
784 :: Arch -> OS -> Reg
785 -> [NatCmmDecl CmmStatics PPC.Instr]
786 -> NatM [NatCmmDecl CmmStatics PPC.Instr]
787
788 initializePicBase_ppc ArchPPC os picReg
789 (CmmProc info lab live (ListGraph blocks) : statics)
790 | osElfTarget os
791 = do
792 let
793 gotOffset = PPC.ImmConstantDiff
794 (PPC.ImmCLbl gotLabel)
795 (PPC.ImmCLbl mkPicBaseLabel)
796
797 blocks' = case blocks of
798 [] -> []
799 (b:bs) -> fetchPC b : map maybeFetchPC bs
800
801 maybeFetchPC b@(BasicBlock bID _)
802 | bID `mapMember` info = fetchPC b
803 | otherwise = b
804
805 -- GCC does PIC prologs thusly:
806 -- bcl 20,31,.L1
807 -- .L1:
808 -- mflr 30
809 -- addis 30,30,.LCTOC1-.L1@ha
810 -- addi 30,30,.LCTOC1-.L1@l
811 -- TODO: below we use it over temporary register,
812 -- it can and should be optimised by picking
813 -- correct PIC reg.
814 fetchPC (BasicBlock bID insns) =
815 BasicBlock bID (PPC.FETCHPC picReg
816 : PPC.ADDIS picReg picReg (PPC.HA gotOffset)
817 : PPC.ADDI picReg picReg (PPC.LO gotOffset)
818 : PPC.MR PPC.r30 picReg
819 : insns)
820
821 return (CmmProc info lab live (ListGraph blocks') : statics)
822
823
824 initializePicBase_ppc ArchPPC OSDarwin picReg
825 (CmmProc info lab live (ListGraph (entry:blocks)) : statics) -- just one entry because of splitting
826 = return (CmmProc info lab live (ListGraph (b':blocks)) : statics)
827
828 where BasicBlock bID insns = entry
829 b' = BasicBlock bID (PPC.FETCHPC picReg : insns)
830
831 -------------------------------------------------------------------------
832 -- Load TOC into register 2
833 -- PowerPC 64-bit ELF ABI 2.0 requires the address of the callee
834 -- in register 12.
835 -- We pass the label to FETCHTOC and create a .localentry too.
836 -- TODO: Explain this better and refer to ABI spec!
837 {-
838 We would like to do approximately this, but spill slot allocation
839 might be added before the first BasicBlock. That violates the ABI.
840
841 For now we will emit the prologue code in the pretty printer,
842 which is also what we do for ELF v1.
843 initializePicBase_ppc (ArchPPC_64 ELF_V2) OSLinux picReg
844 (CmmProc info lab live (ListGraph (entry:blocks)) : statics)
845 = do
846 bID <-getUniqueM
847 return (CmmProc info lab live (ListGraph (b':entry:blocks))
848 : statics)
849 where BasicBlock entryID _ = entry
850 b' = BasicBlock bID [PPC.FETCHTOC picReg lab,
851 PPC.BCC PPC.ALWAYS entryID]
852 -}
853
854 initializePicBase_ppc _ _ _ _
855 = panic "initializePicBase_ppc: not needed"
856
857
858 -- We cheat a bit here by defining a pseudo-instruction named FETCHGOT
859 -- which pretty-prints as:
860 -- call 1f
861 -- 1: popl %picReg
862 -- addl __GLOBAL_OFFSET_TABLE__+.-1b, %picReg
863 -- (See PprMach.hs)
864
865 initializePicBase_x86
866 :: Arch -> OS -> Reg
867 -> [NatCmmDecl (Alignment, CmmStatics) X86.Instr]
868 -> NatM [NatCmmDecl (Alignment, CmmStatics) X86.Instr]
869
870 initializePicBase_x86 ArchX86 os picReg
871 (CmmProc info lab live (ListGraph blocks) : statics)
872 | osElfTarget os
873 = return (CmmProc info lab live (ListGraph blocks') : statics)
874 where blocks' = case blocks of
875 [] -> []
876 (b:bs) -> fetchGOT b : map maybeFetchGOT bs
877
878 -- we want to add a FETCHGOT instruction to the beginning of
879 -- every block that is an entry point, which corresponds to
880 -- the blocks that have entries in the info-table mapping.
881 maybeFetchGOT b@(BasicBlock bID _)
882 | bID `mapMember` info = fetchGOT b
883 | otherwise = b
884
885 fetchGOT (BasicBlock bID insns) =
886 BasicBlock bID (X86.FETCHGOT picReg : insns)
887
888 initializePicBase_x86 ArchX86 OSDarwin picReg
889 (CmmProc info lab live (ListGraph (entry:blocks)) : statics)
890 = return (CmmProc info lab live (ListGraph (block':blocks)) : statics)
891
892 where BasicBlock bID insns = entry
893 block' = BasicBlock bID (X86.FETCHPC picReg : insns)
894
895 initializePicBase_x86 _ _ _ _
896 = panic "initializePicBase_x86: not needed"
897