PIC.hs 30.3 KB
Newer Older
1
2
3
{-
  This module handles generation of position independent code and
  dynamic-linking related issues for the native code generator.
4
5
6

  This depends both the architecture and OS, so we define it here
  instead of in one of the architecture specific modules.
7

8
  Things outside this module which are related to this:
9

10
11
12
13
14
15
  + module CLabel
    - PIC base label (pretty printed as local label 1)
    - DynamicLinkerLabels - several kinds:
        CodeStub, SymbolPtr, GotSymbolPtr, GotSymbolOffset
    - labelDynamic predicate
  + module Cmm
16
    - The GlobalReg datatype has a PicBaseReg constructor
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
    - The CmmLit datatype has a CmmLabelDiffOff constructor
  + codeGen & RTS
    - When tablesNextToCode, no absolute addresses are stored in info tables
      any more. Instead, offsets from the info label are used.
    - For Win32 only, SRTs might contain addresses of __imp_ symbol pointers
      because Win32 doesn't support external references in data sections.
      TODO: make sure this still works, it might be bitrotted
  + NCG
    - The cmmToCmm pass in AsmCodeGen calls cmmMakeDynamicReference for all
      labels.
    - nativeCodeGen calls pprImportedSymbol and pprGotDeclaration to output
      all the necessary stuff for imported symbols.
    - The NCG monad keeps track of a list of imported symbols.
    - MachCodeGen invokes initializePicBase to generate code to initialize
      the PIC base register when needed.
    - MachCodeGen calls cmmMakeDynamicReference whenever it uses a CLabel
      that wasn't in the original Cmm code (e.g. floating point literals).
-}
35

36
37
module PIC (
        cmmMakeDynamicReference,
38
        CmmMakeDynamicReferenceM(..),
39
40
41
42
43
44
45
46
47
48
49
        ReferenceKind(..),
        needImportedSymbols,
        pprImportedSymbol,
        pprGotDeclaration,

        initializePicBase_ppc,
        initializePicBase_x86
)

where

50
51
import qualified PPC.Instr      as PPC
import qualified PPC.Regs       as PPC
52

53
import qualified X86.Instr      as X86
54
55
56
57
58
59
60

import Platform
import Instruction
import Size
import Reg
import NCGMonad

61

62
import Hoopl
63
import Cmm
64
import CLabel           ( CLabel, ForeignLabelSource(..), pprCLabel,
65
66
67
68
                          mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
                          dynamicLinkerLabelInfo, mkPicBaseLabel,
                          labelDynamic, externallyVisibleCLabel )

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
69
import CLabel           ( mkForeignLabel )
70

71

Ian Lynagh's avatar
Ian Lynagh committed
72
import BasicTypes
73
import Module
74

75
import Outputable
76

77
import DynFlags
78
import FastString
79
80


81

82
--------------------------------------------------------------------------------
83
84
85
86
87
88
89
90
91
92
93
94
-- It gets called by the cmmToCmm pass for every CmmLabel in the Cmm
-- code. It does The Right Thing(tm) to convert the CmmLabel into a
-- position-independent, dynamic-linking-aware reference to the thing
-- in question.
-- Note that this also has to be called from MachCodeGen in order to
-- access static data like floating point literals (labels that were
-- created after the cmmToCmm pass).
-- The function must run in a monad that can keep track of imported symbols
-- A function for recording an imported symbol must be passed in:
-- - addImportCmmOpt for the CmmOptM monad
-- - addImportNat for the NatM monad.

95
96
data ReferenceKind
        = DataReference
97
98
99
100
        | CallReference
        | JumpReference
        deriving(Eq)

101
102
class Monad m => CmmMakeDynamicReferenceM m where
    addImport :: CLabel -> m ()
103
    getThisModule :: m Module
104
105
106

instance CmmMakeDynamicReferenceM NatM where
    addImport = addImportNat
107
    getThisModule = getThisModuleNat
108

109
cmmMakeDynamicReference
110
111
112
113
114
115
116
  :: CmmMakeDynamicReferenceM m
  => DynFlags
  -> ReferenceKind     -- whether this is the target of a jump
  -> CLabel            -- the label
  -> m CmmExpr

cmmMakeDynamicReference dflags referenceKind lbl
117
118
  | Just _ <- dynamicLinkerLabelInfo lbl
  = return $ CmmLit $ CmmLabel lbl   -- already processed it, pass through
119

120
  | otherwise
121
122
  = do this_mod <- getThisModule
       case howToAccessLabel
123
124
125
                dflags
                (platformArch $ targetPlatform dflags)
                (platformOS   $ targetPlatform dflags)
126
                this_mod
127
                referenceKind lbl of
128

129
130
131
132
        AccessViaStub -> do
              let stub = mkDynamicLinkerLabel CodeStub lbl
              addImport stub
              return $ CmmLit $ CmmLabel stub
133

134
135
136
        AccessViaSymbolPtr -> do
              let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
              addImport symbolPtr
137
              return $ CmmLoad (cmmMakePicReference dflags symbolPtr) (bWord dflags)
138

139
        AccessDirectly -> case referenceKind of
140
                -- for data, we might have to make some calculations:
141
              DataReference -> return $ cmmMakePicReference dflags lbl
142
143
144
145
                -- all currently supported processors support
                -- PC-relative branch and call instructions,
                -- so just jump there if it's a call or a jump
              _ -> return $ CmmLit $ CmmLabel lbl
146
147
148


-- -----------------------------------------------------------------------------
149
150
151
152
153
154
-- Create a position independent reference to a label.
-- (but do not bother with dynamic linking).
-- We calculate the label's address by adding some (platform-dependent)
-- offset to our base register; this offset is calculated by
-- the function picRelative in the platform-dependent part below.

155
156
157
cmmMakePicReference :: DynFlags -> CLabel -> CmmExpr
cmmMakePicReference dflags lbl

158
159
        -- Windows doesn't need PIC,
        -- everything gets relocated at runtime
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
        | OSMinGW32 <- platformOS $ targetPlatform dflags
        = CmmLit $ CmmLabel lbl


        | (gopt Opt_PIC dflags || not (gopt Opt_Static dflags)) && absoluteLabel lbl
        = CmmMachOp (MO_Add (wordWidth dflags))
                [ CmmReg (CmmGlobal PicBaseReg)
                , CmmLit $ picRelative
                                (platformArch   $ targetPlatform dflags)
                                (platformOS     $ targetPlatform dflags)
                                lbl ]

        | otherwise
        = CmmLit $ CmmLabel lbl


176
absoluteLabel :: CLabel -> Bool
177
absoluteLabel lbl
178
 = case dynamicLinkerLabelInfo lbl of
179
180
181
        Just (GotSymbolPtr, _)    -> False
        Just (GotSymbolOffset, _) -> False
        _                         -> True
182

183
184

--------------------------------------------------------------------------------
185
186
187
188
189
190
-- Knowledge about how special dynamic linker labels like symbol
-- pointers, code stubs and GOT offsets look like is located in the
-- module CLabel.

-- We have to decide which labels need to be accessed
-- indirectly or via a piece of stub code.
191
192
193
194
data LabelAccessStyle
        = AccessViaStub
        | AccessViaSymbolPtr
        | AccessDirectly
195

196
howToAccessLabel
197
        :: DynFlags -> Arch -> OS -> Module -> ReferenceKind -> CLabel -> LabelAccessStyle
198

199

200
-- Windows
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
-- In Windows speak, a "module" is a set of objects linked into the
-- same Portable Exectuable (PE) file. (both .exe and .dll files are PEs).
--
-- If we're compiling a multi-module program then symbols from other modules
-- are accessed by a symbol pointer named __imp_SYMBOL. At runtime we have the
-- following.
--
--   (in the local module)
--     __imp_SYMBOL: addr of SYMBOL
--
--   (in the other module)
--     SYMBOL: the real function / data.
--
-- To access the function at SYMBOL from our local module, we just need to
-- dereference the local __imp_SYMBOL.
--
ian@well-typed.com's avatar
ian@well-typed.com committed
217
-- If Opt_Static is set then we assume that all our code will be linked
218
-- into the same .exe file. In this case we always access symbols directly,
219
-- and never use __imp_SYMBOL.
220
--
221
howToAccessLabel dflags _ OSMinGW32 this_mod _ lbl
222

223
224
225
        -- Assume all symbols will be in the same PE, so just access them directly.
        | gopt Opt_Static dflags
        = AccessDirectly
226

227
228
        -- If the target symbol is in another PE we need to access it via the
        --      appropriate __imp_SYMBOL pointer.
229
        | labelDynamic dflags (thisPackage dflags) this_mod lbl
230
231
232
233
234
        = AccessViaSymbolPtr

        -- Target symbol is in the same PE as the caller, so just access it directly.
        | otherwise
        = AccessDirectly
235

236
237
238
239

-- Mach-O (Darwin, Mac OS X)
--
-- Indirect access is required in the following cases:
240
--  * things imported from a dynamic library
241
--  * (not on x86_64) data from a different module, if we're generating PIC code
242
243
-- It is always possible to access something indirectly,
-- even when it's not necessary.
244
--
245
howToAccessLabel dflags arch OSDarwin this_mod DataReference lbl
246
        -- data access to a dynamic library goes via a symbol pointer
247
        | labelDynamic dflags (thisPackage dflags) this_mod lbl
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
        = AccessViaSymbolPtr

        -- when generating PIC code, all cross-module data references must
        -- must go via a symbol pointer, too, because the assembler
        -- cannot generate code for a label difference where one
        -- label is undefined. Doesn't apply t x86_64.
        -- Unfortunately, we don't know whether it's cross-module,
        -- so we do it for all externally visible labels.
        -- This is a slight waste of time and space, but otherwise
        -- we'd need to pass the current Module all the way in to
        -- this function.
        | arch /= ArchX86_64
        , gopt Opt_PIC dflags && externallyVisibleCLabel lbl
        = AccessViaSymbolPtr

        | otherwise
        = AccessDirectly
265

266
howToAccessLabel dflags arch OSDarwin this_mod JumpReference lbl
267
268
269
270
        -- dyld code stubs don't work for tailcalls because the
        -- stack alignment is only right for regular calls.
        -- Therefore, we have to go via a symbol pointer:
        | arch == ArchX86 || arch == ArchX86_64
271
        , labelDynamic dflags (thisPackage dflags) this_mod lbl
272
273
        = AccessViaSymbolPtr

274

275
howToAccessLabel dflags arch OSDarwin this_mod _ lbl
276
277
278
279
        -- Code stubs are the usual method of choice for imported code;
        -- not needed on x86_64 because Apple's new linker, ld64, generates
        -- them automatically.
        | arch /= ArchX86_64
280
        , labelDynamic dflags (thisPackage dflags) this_mod lbl
281
        = AccessViaStub
282

283
284
        | otherwise
        = AccessDirectly
285
286
287

-- ELF (Linux)
--
288
-- ELF tries to pretend to the main application code that dynamic linking does
289
290
291
292
-- not exist. While this may sound convenient, it tends to mess things up in
-- very bad ways, so we have to be careful when we generate code for the main
-- program (-dynamic but no -fPIC).
--
293
-- Indirect access is required for references to imported symbols
294
295
-- from position independent code. It is also required from the main program
-- when dynamic libraries containing Haskell code are used.
296

297
howToAccessLabel _ ArchPPC_64 os _ kind _
298
299
300
        | osElfTarget os
        = if kind == DataReference
            -- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC
301
            then AccessViaSymbolPtr
302
            -- actually, .label instead of label
303
304
            else AccessDirectly

305
howToAccessLabel dflags _ os _ _ _
306
307
        -- no PIC -> the dynamic linker does everything for us;
        --           if we don't dynamically link to Haskell code,
308
        --           it actually manages to do so without messing things up.
309
310
311
        | osElfTarget os
        , not (gopt Opt_PIC dflags) && gopt Opt_Static dflags
        = AccessDirectly
312

313
howToAccessLabel dflags arch os this_mod DataReference lbl
314
315
316
        | osElfTarget os
        = case () of
            -- A dynamic label needs to be accessed via a symbol pointer.
317
          _ | labelDynamic dflags (thisPackage dflags) this_mod lbl
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
            -> AccessViaSymbolPtr

            -- For PowerPC32 -fPIC, we have to access even static data
            -- via a symbol pointer (see below for an explanation why
            -- PowerPC32 Linux is especially broken).
            | arch == ArchPPC
            , gopt Opt_PIC dflags
            -> AccessViaSymbolPtr

            | otherwise
            -> AccessDirectly


        -- In most cases, we have to avoid symbol stubs on ELF, for the following reasons:
        --   on i386, the position-independent symbol stubs in the Procedure Linkage Table
        --   require the address of the GOT to be loaded into register %ebx on entry.
        --   The linker will take any reference to the symbol stub as a hint that
        --   the label in question is a code label. When linking executables, this
        --   will cause the linker to replace even data references to the label with
        --   references to the symbol stub.

        -- This leaves calling a (foreign) function from non-PIC code
        -- (AccessDirectly, because we get an implicit symbol stub)
        -- and calling functions from PIC code on non-i386 platforms (via a symbol stub)
342

343
howToAccessLabel dflags arch os this_mod CallReference lbl
344
        | osElfTarget os
345
        , labelDynamic dflags (thisPackage dflags) this_mod lbl && not (gopt Opt_PIC dflags)
346
        = AccessDirectly
347

348
349
        | osElfTarget os
        , arch /= ArchX86
350
        , labelDynamic dflags (thisPackage dflags) this_mod lbl && gopt Opt_PIC dflags
351
        = AccessViaStub
352

353
howToAccessLabel dflags _ os this_mod _ lbl
354
        | osElfTarget os
355
        = if labelDynamic dflags (thisPackage dflags) this_mod lbl
356
357
            then AccessViaSymbolPtr
            else AccessDirectly
358

dons's avatar
dons committed
359
-- all other platforms
360
howToAccessLabel dflags _ _ _ _ _
361
362
363
364
365
        | not (gopt Opt_PIC dflags)
        = AccessDirectly

        | otherwise
        = panic "howToAccessLabel: PIC not defined for this platform"
366
367


368
369

-- -------------------------------------------------------------------
370
-- | Says what we we have to add to our 'PIC base register' in order to
371
--      get the address of a label.
372

373
picRelative :: Arch -> OS -> CLabel -> CmmLit
374

375
-- Darwin, but not x86_64:
376
-- The PIC base register points to the PIC base label at the beginning
Simon Peyton Jones's avatar
Simon Peyton Jones committed
377
-- of the current CmmDecl. We just have to use a label difference to
378
379
380
381
-- get the offset.
-- We have already made sure that all labels that are not from the current
-- module are accessed indirectly ('as' can't calculate differences between
-- undefined labels).
382
picRelative arch OSDarwin lbl
383
384
385
        | arch /= ArchX86_64
        = CmmLabelDiffOff lbl mkPicBaseLabel 0

386
387
388
389
390
391
392

-- PowerPC Linux:
-- The PIC base register points to our fake GOT. Use a label difference
-- to get the offset.
-- We have made sure that *everything* is accessed indirectly, so this
-- is only used for offsets from the GOT to symbol pointers inside the
-- GOT.
393
picRelative ArchPPC os lbl
394
395
        | osElfTarget os
        = CmmLabelDiffOff lbl gotLabel 0
396

397

398
-- Most Linux versions:
399
400
-- The PIC base register points to the GOT. Use foo@got for symbol
-- pointers, and foo@gotoff for everything else.
401
402
403
404
-- Linux and Darwin on x86_64:
-- The PIC base register is %rip, we use foo@gotpcrel for symbol pointers,
-- and a GotSymbolOffset label for other things.
-- For reasons of tradition, the symbol offset label is written as a plain label.
405
picRelative arch os lbl
406
407
408
409
410
411
412
        | osElfTarget os || (os == OSDarwin && arch == ArchX86_64)
        = let   result
                        | Just (SymbolPtr, lbl') <- dynamicLinkerLabelInfo lbl
                        = CmmLabel $ mkDynamicLinkerLabel GotSymbolPtr lbl'

                        | otherwise
                        = CmmLabel $ mkDynamicLinkerLabel GotSymbolOffset lbl
413

414
          in    result
415
416

picRelative _ _ _
417
        = panic "PositionIndependentCode.picRelative undefined for this platform"
418
419
420



421
--------------------------------------------------------------------------------
422

Ian Lynagh's avatar
Ian Lynagh committed
423
424
needImportedSymbols :: DynFlags -> Arch -> OS -> Bool
needImportedSymbols dflags arch os
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
        | os    == OSDarwin
        , arch  /= ArchX86_64
        = True

        -- PowerPC Linux: -fPIC or -dynamic
        | osElfTarget os
        , arch  == ArchPPC
        = gopt Opt_PIC dflags || not (gopt Opt_Static dflags)

        -- i386 (and others?): -dynamic but not -fPIC
        | osElfTarget os
        , arch  /= ArchPPC_64
        = not (gopt Opt_Static dflags) && not (gopt Opt_PIC dflags)

        | otherwise
        = False
441

442
443
444
445
-- gotLabel
-- The label used to refer to our "fake GOT" from
-- position-independent code.
gotLabel :: CLabel
446
447
448
449
450
gotLabel
        -- HACK: this label isn't really foreign
        = mkForeignLabel
                (fsLit ".LCTOC1")
                Nothing ForeignLabelInThisPackage IsData
451
452
453



454
--------------------------------------------------------------------------------
455
456
-- We don't need to declare any offset tables.
-- However, for PIC on x86, we need a small helper function.
Ian Lynagh's avatar
Ian Lynagh committed
457
458
pprGotDeclaration :: DynFlags -> Arch -> OS -> SDoc
pprGotDeclaration dflags ArchX86 OSDarwin
459
460
461
462
463
464
465
466
        | gopt Opt_PIC dflags
        = vcat [
                ptext (sLit ".section __TEXT,__textcoal_nt,coalesced,no_toc"),
                ptext (sLit ".weak_definition ___i686.get_pc_thunk.ax"),
                ptext (sLit ".private_extern ___i686.get_pc_thunk.ax"),
                ptext (sLit "___i686.get_pc_thunk.ax:"),
                ptext (sLit "\tmovl (%esp), %eax"),
                ptext (sLit "\tret") ]
467

Ian Lynagh's avatar
Ian Lynagh committed
468
pprGotDeclaration _ _ OSDarwin
469
470
        = empty

471
472
473
474
475
-- pprGotDeclaration
-- Output whatever needs to be output once per .s file.
-- The .LCTOC1 label is defined to point 32768 bytes into the table,
-- to make the most of the PPC's 16-bit displacements.
-- Only needed for PIC.
Ian Lynagh's avatar
Ian Lynagh committed
476
pprGotDeclaration dflags arch os
477
478
479
480
        | osElfTarget os
        , arch  /= ArchPPC_64
        , not (gopt Opt_PIC dflags)
        = empty
481

482
483
484
485
486
        | osElfTarget os
        , arch  /= ArchPPC_64
        = vcat [
                ptext (sLit ".section \".got2\",\"aw\""),
                ptext (sLit ".LCTOC1 = .+32768") ]
487

Ian Lynagh's avatar
Ian Lynagh committed
488
pprGotDeclaration _ _ _
489
        = panic "pprGotDeclaration: no match"
490

491
492

--------------------------------------------------------------------------------
493
-- On Darwin, we have to generate our own stub code for lazy binding..
494
495
-- For each processor architecture, there are two versions, one for PIC
-- and one for non-PIC.
496
497
498
--
-- Whenever you change something in this assembler output, make sure
-- the splitter in driver/split/ghc-split.lprl recognizes the new output
499

Ian Lynagh's avatar
Ian Lynagh committed
500
501
pprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc
pprImportedSymbol dflags platform@(Platform { platformArch = ArchPPC, platformOS = OSDarwin }) importedLbl
502
503
        | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
        = case gopt Opt_PIC dflags of
504
           False ->
505
            vcat [
506
                ptext (sLit ".symbol_stub"),
507
508
509
                ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
                    ptext (sLit "\tlis r11,ha16(L") <> pprCLabel platform lbl
510
                        <> ptext (sLit "$lazy_ptr)"),
511
                    ptext (sLit "\tlwz r12,lo16(L") <> pprCLabel platform lbl
512
513
                        <> ptext (sLit "$lazy_ptr)(r11)"),
                    ptext (sLit "\tmtctr r12"),
514
                    ptext (sLit "\taddi r11,r11,lo16(L") <> pprCLabel platform lbl
515
516
                        <> ptext (sLit "$lazy_ptr)"),
                    ptext (sLit "\tbctr")
517
            ]
518
           True ->
519
            vcat [
520
521
522
                ptext (sLit ".section __TEXT,__picsymbolstub1,")
                  <> ptext (sLit "symbol_stubs,pure_instructions,32"),
                ptext (sLit "\t.align 2"),
523
524
                ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
525
                    ptext (sLit "\tmflr r0"),
526
527
                    ptext (sLit "\tbcl 20,31,L0$") <> pprCLabel platform lbl,
                ptext (sLit "L0$") <> pprCLabel platform lbl <> char ':',
528
                    ptext (sLit "\tmflr r11"),
529
530
                    ptext (sLit "\taddis r11,r11,ha16(L") <> pprCLabel platform lbl
                        <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel platform lbl <> char ')',
531
                    ptext (sLit "\tmtlr r0"),
532
533
                    ptext (sLit "\tlwzu r12,lo16(L") <> pprCLabel platform lbl
                        <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel platform lbl
534
535
536
                        <> ptext (sLit ")(r11)"),
                    ptext (sLit "\tmtctr r12"),
                    ptext (sLit "\tbctr")
537
            ]
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
          $+$ vcat [
                ptext (sLit ".lazy_symbol_pointer"),
                ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
                ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
                ptext (sLit "\t.long dyld_stub_binding_helper")]

        | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
        = vcat [
                ptext (sLit ".non_lazy_symbol_pointer"),
                char 'L' <> pprCLabel platform lbl <> ptext (sLit "$non_lazy_ptr:"),
                ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
                ptext (sLit "\t.long\t0")]

        | otherwise
        = empty


Ian Lynagh's avatar
Ian Lynagh committed
555
pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl
556
557
        | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
        = case gopt Opt_PIC dflags of
558
           False ->
559
            vcat [
560
                ptext (sLit ".symbol_stub"),
561
562
563
                ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
                    ptext (sLit "\tjmp *L") <> pprCLabel platform lbl
564
                        <> ptext (sLit "$lazy_ptr"),
565
                ptext (sLit "L") <> pprCLabel platform lbl
566
                    <> ptext (sLit "$stub_binder:"),
567
                    ptext (sLit "\tpushl $L") <> pprCLabel platform lbl
568
569
                        <> ptext (sLit "$lazy_ptr"),
                    ptext (sLit "\tjmp dyld_stub_binding_helper")
570
            ]
571
           True ->
572
            vcat [
573
574
                ptext (sLit ".section __TEXT,__picsymbolstub2,")
                    <> ptext (sLit "symbol_stubs,pure_instructions,25"),
575
576
                ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
577
578
                    ptext (sLit "\tcall ___i686.get_pc_thunk.ax"),
                ptext (sLit "1:"),
579
                    ptext (sLit "\tmovl L") <> pprCLabel platform lbl
580
581
                        <> ptext (sLit "$lazy_ptr-1b(%eax),%edx"),
                    ptext (sLit "\tjmp *%edx"),
582
                ptext (sLit "L") <> pprCLabel platform lbl
583
                    <> ptext (sLit "$stub_binder:"),
584
                    ptext (sLit "\tlea L") <> pprCLabel platform lbl
585
586
587
                        <> ptext (sLit "$lazy_ptr-1b(%eax),%eax"),
                    ptext (sLit "\tpushl %eax"),
                    ptext (sLit "\tjmp dyld_stub_binding_helper")
588
            ]
589
          $+$ vcat [        ptext (sLit ".section __DATA, __la_sym_ptr")
ian@well-typed.com's avatar
ian@well-typed.com committed
590
                    <> (if gopt Opt_PIC dflags then int 2 else int 3)
591
                    <> ptext (sLit ",lazy_symbol_pointers"),
592
593
594
                ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
                    ptext (sLit "\t.long L") <> pprCLabel platform lbl
595
596
                    <> ptext (sLit "$stub_binder")]

597
598
599
600
601
602
        | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
        = vcat [
                ptext (sLit ".non_lazy_symbol_pointer"),
                char 'L' <> pprCLabel platform lbl <> ptext (sLit "$non_lazy_ptr:"),
                ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
                ptext (sLit "\t.long\t0")]
603

604
605
        | otherwise
        = empty
606
607


Ian Lynagh's avatar
Ian Lynagh committed
608
pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _
609
610
        = empty

611

612
613
614
615
616
617
-- ELF / Linux
--
-- In theory, we don't need to generate any stubs or symbol pointers
-- by hand for Linux.
--
-- Reality differs from this in two areas.
618
--
619
620
621
622
623
624
625
-- 1) If we just use a dynamically imported symbol directly in a read-only
--    section of the main executable (as GCC does), ld generates R_*_COPY
--    relocations, which are fundamentally incompatible with reversed info
--    tables. Therefore, we need a table of imported addresses in a writable
--    section.
--    The "official" GOT mechanism (label@got) isn't intended to be used
--    in position dependent code, so we have to create our own "fake GOT"
ian@well-typed.com's avatar
ian@well-typed.com committed
626
--    when not Opt_PIC && not (gopt Opt_Static dflags).
627
628
629
630
631
632
633
634
635
636
637
638
639
--
-- 2) PowerPC Linux is just plain broken.
--    While it's theoretically possible to use GOT offsets larger
--    than 16 bit, the standard crt*.o files don't, which leads to
--    linker errors as soon as the GOT size exceeds 16 bit.
--    Also, the assembler doesn't support @gotoff labels.
--    In order to be able to use a larger GOT, we have to circumvent the
--    entire GOT mechanism and do it ourselves (this is also what GCC does).


-- When needImportedSymbols is defined,
-- the NCG will keep track of all DynamicLinkerLabels it uses
-- and output each of them using pprImportedSymbol.
640

Ian Lynagh's avatar
Ian Lynagh committed
641
pprImportedSymbol _ platform@(Platform { platformArch = ArchPPC_64 }) _
642
643
        | osElfTarget (platformOS platform)
        = empty
644

645
pprImportedSymbol dflags platform importedLbl
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
        | osElfTarget (platformOS platform)
        = case dynamicLinkerLabelInfo importedLbl of
            Just (SymbolPtr, lbl)
              -> let symbolSize = case wordWidth dflags of
                         W32 -> sLit "\t.long"
                         W64 -> sLit "\t.quad"
                         _ -> panic "Unknown wordRep in pprImportedSymbol"

                 in vcat [
                      ptext (sLit ".section \".got2\", \"aw\""),
                      ptext (sLit ".LC_") <> pprCLabel platform lbl <> char ':',
                      ptext symbolSize <+> pprCLabel platform lbl ]

            -- PLT code stubs are generated automatically by the dynamic linker.
            _ -> empty
661

Ian Lynagh's avatar
Ian Lynagh committed
662
pprImportedSymbol _ _ _
663
        = panic "PIC.pprImportedSymbol: no match"
664

665
--------------------------------------------------------------------------------
666
667
668
669
670
671
-- Generate code to calculate the address that should be put in the
-- PIC base register.
-- This is called by MachCodeGen for every CmmProc that accessed the
-- PIC base register. It adds the appropriate instructions to the
-- top of the CmmProc.

Simon Peyton Jones's avatar
Simon Peyton Jones committed
672
-- It is assumed that the first NatCmmDecl in the input list is a Proc
673
674
675
-- and the rest are CmmDatas.

-- Darwin is simple: just fetch the address of a local label.
676
677
678
679
680
681
682
683
684
685
686
687
-- The FETCHPC pseudo-instruction is expanded to multiple instructions
-- during pretty-printing so that we don't have to deal with the
-- local label:

-- PowerPC version:
--          bcl 20,31,1f.
--      1:  mflr picReg

-- i386 version:
--          call 1f
--      1:  popl %picReg

688
689
690
691
692
693
694
695
696


-- Get a pointer to our own fake GOT, which is defined on a per-module basis.
-- This is exactly how GCC does it, and it's quite horrible:
-- We first fetch the address of a local label (mkPicBaseLabel).
-- Then we add a 16-bit offset to that to get the address of a .long that we
-- define in .text space right next to the proc. This .long literal contains
-- the (32-bit) offset from our local label to our global offset table
-- (.LCTOC1 aka gotOffLabel).
697

698
699
700
701
initializePicBase_ppc
        :: Arch -> OS -> Reg
        -> [NatCmmDecl CmmStatics PPC.Instr]
        -> NatM [NatCmmDecl CmmStatics PPC.Instr]
702

703
initializePicBase_ppc ArchPPC os picReg
704
    (CmmProc info lab live (ListGraph blocks) : statics)
705
    | osElfTarget os
706
    = do
707
        dflags <- getDynFlags
708
        gotOffLabel <- getNewLabelNat
709
        tmp <- getNewRegNat $ intSize (wordWidth dflags)
710
        let
711
            gotOffset = CmmData Text $ Statics gotOffLabel [
712
713
714
                            CmmStaticLit (CmmLabelDiffOff gotLabel
                                                          mkPicBaseLabel
                                                          0)
715
                        ]
716
            offsetToOffset
717
718
719
                        = PPC.ImmConstantDiff
                                (PPC.ImmCLbl gotOffLabel)
                                (PPC.ImmCLbl mkPicBaseLabel)
720

721
722
723
            blocks' = case blocks of
                       [] -> []
                       (b:bs) -> fetchPC b : map maybeFetchPC bs
724

725
726
727
728
729
730
            maybeFetchPC b@(BasicBlock bID _)
              | bID `mapMember` info = fetchPC b
              | otherwise            = b

            fetchPC (BasicBlock bID insns) =
              BasicBlock bID (PPC.FETCHPC picReg
731
                              : PPC.ADDIS tmp picReg (PPC.HI offsetToOffset)
732
                              : PPC.LD PPC.archWordSize tmp
733
734
                                   (PPC.AddrRegImm tmp (PPC.LO offsetToOffset))
                              : PPC.ADD picReg picReg (PPC.RIReg picReg)
735
736
737
                              : insns)

        return (CmmProc info lab live (ListGraph blocks') : gotOffset : statics)
738
739
740


initializePicBase_ppc ArchPPC OSDarwin picReg
741
742
        (CmmProc info lab live (ListGraph (entry:blocks)) : statics) -- just one entry because of splitting
        = return (CmmProc info lab live (ListGraph (b':blocks)) : statics)
743

744
        where   BasicBlock bID insns = entry
745
                b' = BasicBlock bID (PPC.FETCHPC picReg : insns)
746
747
748


initializePicBase_ppc _ _ _ _
749
        = panic "initializePicBase_ppc: not needed"
750

751

752
753
-- We cheat a bit here by defining a pseudo-instruction named FETCHGOT
-- which pretty-prints as:
754
755
756
--              call 1f
-- 1:           popl %picReg
--              addl __GLOBAL_OFFSET_TABLE__+.-1b, %picReg
757
758
-- (See PprMach.lhs)

759
initializePicBase_x86
760
761
762
        :: Arch -> OS -> Reg
        -> [NatCmmDecl (Alignment, CmmStatics) X86.Instr]
        -> NatM [NatCmmDecl (Alignment, CmmStatics) X86.Instr]
763

764
initializePicBase_x86 ArchX86 os picReg
765
        (CmmProc info lab live (ListGraph blocks) : statics)
766
    | osElfTarget os
767
    = return (CmmProc info lab live (ListGraph blocks') : statics)
768
769
770
771
772
773
774
775
776
777
778
779
780
    where blocks' = case blocks of
                     [] -> []
                     (b:bs) -> fetchGOT b : map maybeFetchGOT bs

          -- we want to add a FETCHGOT instruction to the beginning of
          -- every block that is an entry point, which corresponds to
          -- the blocks that have entries in the info-table mapping.
          maybeFetchGOT b@(BasicBlock bID _)
            | bID `mapMember` info = fetchGOT b
            | otherwise            = b

          fetchGOT (BasicBlock bID insns) =
             BasicBlock bID (X86.FETCHGOT picReg : insns)
781
782

initializePicBase_x86 ArchX86 OSDarwin picReg
783
784
        (CmmProc info lab live (ListGraph (entry:blocks)) : statics)
        = return (CmmProc info lab live (ListGraph (block':blocks)) : statics)
785

786
787
    where BasicBlock bID insns = entry
          block' = BasicBlock bID (X86.FETCHPC picReg : insns)
788

789
initializePicBase_x86 _ _ _ _
790
        = panic "initializePicBase_x86: not needed"
791