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