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"