{-
  This module handles generation of position independent code and
  dynamic-linking related issues for the native code generator.

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

  Things outside this module which are related to this:

  + module CLabel
    - PIC base label (pretty printed as local label 1)
    - DynamicLinkerLabels - several kinds:
        CodeStub, SymbolPtr, GotSymbolPtr, GotSymbolOffset
    - labelDynamic predicate
  + module Cmm
    - The GlobalReg datatype has a PicBaseReg constructor
    - 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).
-}

module PIC (
        cmmMakeDynamicReference,
        CmmMakeDynamicReferenceM(..),
        ReferenceKind(..),
        needImportedSymbols,
        pprImportedSymbol,
        pprGotDeclaration,

        initializePicBase_ppc,
        initializePicBase_x86
)

where

import GhcPrelude

import qualified PPC.Instr      as PPC
import qualified PPC.Regs       as PPC

import qualified X86.Instr      as X86

import GHC.Platform
import Instruction
import Reg
import NCGMonad


import Hoopl.Collections
import Cmm
import CLabel           ( CLabel, ForeignLabelSource(..), pprCLabel,
                          mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
                          dynamicLinkerLabelInfo, mkPicBaseLabel,
                          labelDynamic, externallyVisibleCLabel )

import CLabel           ( mkForeignLabel )


import BasicTypes
import Module

import Outputable

import DynFlags
import FastString



--------------------------------------------------------------------------------
-- 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.

data ReferenceKind
        = DataReference
        | CallReference
        | JumpReference
        deriving(ReferenceKind -> ReferenceKind -> Bool
(ReferenceKind -> ReferenceKind -> Bool)
-> (ReferenceKind -> ReferenceKind -> Bool) -> Eq ReferenceKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferenceKind -> ReferenceKind -> Bool
$c/= :: ReferenceKind -> ReferenceKind -> Bool
== :: ReferenceKind -> ReferenceKind -> Bool
$c== :: ReferenceKind -> ReferenceKind -> Bool
Eq)

class Monad m => CmmMakeDynamicReferenceM m where
    addImport :: CLabel -> m ()
    getThisModule :: m Module

instance CmmMakeDynamicReferenceM NatM where
    addImport :: CLabel -> NatM ()
addImport = CLabel -> NatM ()
addImportNat
    getThisModule :: NatM Module
getThisModule = NatM Module
getThisModuleNat

cmmMakeDynamicReference
  :: CmmMakeDynamicReferenceM m
  => DynFlags
  -> ReferenceKind     -- whether this is the target of a jump
  -> CLabel            -- the label
  -> m CmmExpr

cmmMakeDynamicReference :: DynFlags -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference DynFlags
dflags ReferenceKind
referenceKind CLabel
lbl
  | Just (DynamicLinkerLabelInfo, CLabel)
_ <- CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
lbl
  = CmmExpr -> m CmmExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl   -- already processed it, pass through

  | Bool
otherwise
  = do Module
this_mod <- m Module
forall (m :: * -> *). CmmMakeDynamicReferenceM m => m Module
getThisModule
       case DynFlags
-> Arch
-> OS
-> Module
-> ReferenceKind
-> CLabel
-> LabelAccessStyle
howToAccessLabel
                DynFlags
dflags
                (Platform -> Arch
platformArch (Platform -> Arch) -> Platform -> Arch
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags)
                (Platform -> OS
platformOS   (Platform -> OS) -> Platform -> OS
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags)
                Module
this_mod
                ReferenceKind
referenceKind CLabel
lbl of

        LabelAccessStyle
AccessViaStub -> do
              let stub :: CLabel
stub = DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
CodeStub CLabel
lbl
              CLabel -> m ()
forall (m :: * -> *). CmmMakeDynamicReferenceM m => CLabel -> m ()
addImport CLabel
stub
              CmmExpr -> m CmmExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
stub

        LabelAccessStyle
AccessViaSymbolPtr -> do
              let symbolPtr :: CLabel
symbolPtr = DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
SymbolPtr CLabel
lbl
              CLabel -> m ()
forall (m :: * -> *). CmmMakeDynamicReferenceM m => CLabel -> m ()
addImport CLabel
symbolPtr
              CmmExpr -> m CmmExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmType -> CmmExpr
CmmLoad (DynFlags -> CLabel -> CmmExpr
cmmMakePicReference DynFlags
dflags CLabel
symbolPtr) (DynFlags -> CmmType
bWord DynFlags
dflags)

        LabelAccessStyle
AccessDirectly -> case ReferenceKind
referenceKind of
                -- for data, we might have to make some calculations:
              ReferenceKind
DataReference -> CmmExpr -> m CmmExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CLabel -> CmmExpr
cmmMakePicReference DynFlags
dflags CLabel
lbl
                -- all currently supported processors support
                -- PC-relative branch and call instructions,
                -- so just jump there if it's a call or a jump
              ReferenceKind
_ -> CmmExpr -> m CmmExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl


-- -----------------------------------------------------------------------------
-- 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.

cmmMakePicReference :: DynFlags -> CLabel -> CmmExpr
cmmMakePicReference :: DynFlags -> CLabel -> CmmExpr
cmmMakePicReference DynFlags
dflags CLabel
lbl

        -- Windows doesn't need PIC,
        -- everything gets relocated at runtime
        | OS
OSMinGW32 <- Platform -> OS
platformOS (Platform -> OS) -> Platform -> OS
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags
        = CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl

        | OS
OSAIX <- Platform -> OS
platformOS (Platform -> OS) -> Platform -> OS
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags
        = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
W32)
                [ CmmReg -> CmmExpr
CmmReg (GlobalReg -> CmmReg
CmmGlobal GlobalReg
PicBaseReg)
                , CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> Arch -> OS -> CLabel -> CmmLit
picRelative DynFlags
dflags
                                (Platform -> Arch
platformArch   (Platform -> Arch) -> Platform -> Arch
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags)
                                (Platform -> OS
platformOS     (Platform -> OS) -> Platform -> OS
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags)
                                CLabel
lbl ]

        -- both ABI versions default to medium code model
        | ArchPPC_64 PPC_64ABI
_ <- Platform -> Arch
platformArch (Platform -> Arch) -> Platform -> Arch
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags
        = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
W32) -- code model medium
                [ CmmReg -> CmmExpr
CmmReg (GlobalReg -> CmmReg
CmmGlobal GlobalReg
PicBaseReg)
                , CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> Arch -> OS -> CLabel -> CmmLit
picRelative DynFlags
dflags
                                (Platform -> Arch
platformArch   (Platform -> Arch) -> Platform -> Arch
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags)
                                (Platform -> OS
platformOS     (Platform -> OS) -> Platform -> OS
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags)
                                CLabel
lbl ]

        | (DynFlags -> Bool
positionIndependent DynFlags
dflags Bool -> Bool -> Bool
|| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags)
            Bool -> Bool -> Bool
&& CLabel -> Bool
absoluteLabel CLabel
lbl
        = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add (DynFlags -> Width
wordWidth DynFlags
dflags))
                [ CmmReg -> CmmExpr
CmmReg (GlobalReg -> CmmReg
CmmGlobal GlobalReg
PicBaseReg)
                , CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> Arch -> OS -> CLabel -> CmmLit
picRelative DynFlags
dflags
                                (Platform -> Arch
platformArch   (Platform -> Arch) -> Platform -> Arch
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags)
                                (Platform -> OS
platformOS     (Platform -> OS) -> Platform -> OS
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags)
                                CLabel
lbl ]

        | Bool
otherwise
        = CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl


absoluteLabel :: CLabel -> Bool
absoluteLabel :: CLabel -> Bool
absoluteLabel CLabel
lbl
 = case CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
lbl of
        Just (DynamicLinkerLabelInfo
GotSymbolPtr, CLabel
_)    -> Bool
False
        Just (DynamicLinkerLabelInfo
GotSymbolOffset, CLabel
_) -> Bool
False
        Maybe (DynamicLinkerLabelInfo, CLabel)
_                         -> Bool
True


--------------------------------------------------------------------------------
-- 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.
data LabelAccessStyle
        = AccessViaStub
        | AccessViaSymbolPtr
        | AccessDirectly

howToAccessLabel
        :: DynFlags -> Arch -> OS -> Module -> ReferenceKind -> CLabel -> LabelAccessStyle


-- Windows
-- 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.
--
-- If not compiling with -dynamic we assume that all our code will be linked
-- into the same .exe file. In this case we always access symbols directly,
-- and never use __imp_SYMBOL.
--
howToAccessLabel :: DynFlags
-> Arch
-> OS
-> Module
-> ReferenceKind
-> CLabel
-> LabelAccessStyle
howToAccessLabel DynFlags
dflags Arch
_ OS
OSMinGW32 Module
this_mod ReferenceKind
_ CLabel
lbl

        -- Assume all symbols will be in the same PE, so just access them directly.
        | Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags)
        = LabelAccessStyle
AccessDirectly

        -- If the target symbol is in another PE we need to access it via the
        --      appropriate __imp_SYMBOL pointer.
        | DynFlags -> Module -> CLabel -> Bool
labelDynamic DynFlags
dflags Module
this_mod CLabel
lbl
        = LabelAccessStyle
AccessViaSymbolPtr

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


-- Mach-O (Darwin, Mac OS X)
--
-- Indirect access is required in the following cases:
--  * things imported from a dynamic library
--  * (not on x86_64) data from a different module, if we're generating PIC code
-- It is always possible to access something indirectly,
-- even when it's not necessary.
--
howToAccessLabel DynFlags
dflags Arch
arch OS
OSDarwin Module
this_mod ReferenceKind
DataReference CLabel
lbl
        -- data access to a dynamic library goes via a symbol pointer
        | DynFlags -> Module -> CLabel -> Bool
labelDynamic DynFlags
dflags Module
this_mod CLabel
lbl
        = LabelAccessStyle
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
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86_64
        , DynFlags -> Bool
positionIndependent DynFlags
dflags Bool -> Bool -> Bool
&& CLabel -> Bool
externallyVisibleCLabel CLabel
lbl
        = LabelAccessStyle
AccessViaSymbolPtr

        | Bool
otherwise
        = LabelAccessStyle
AccessDirectly

howToAccessLabel DynFlags
dflags Arch
arch OS
OSDarwin Module
this_mod ReferenceKind
JumpReference CLabel
lbl
        -- 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
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchX86 Bool -> Bool -> Bool
|| Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchX86_64
        , DynFlags -> Module -> CLabel -> Bool
labelDynamic DynFlags
dflags Module
this_mod CLabel
lbl
        = LabelAccessStyle
AccessViaSymbolPtr


howToAccessLabel DynFlags
dflags Arch
arch OS
OSDarwin Module
this_mod ReferenceKind
_ CLabel
lbl
        -- 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
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86_64
        , DynFlags -> Module -> CLabel -> Bool
labelDynamic DynFlags
dflags Module
this_mod CLabel
lbl
        = LabelAccessStyle
AccessViaStub

        | Bool
otherwise
        = LabelAccessStyle
AccessDirectly


----------------------------------------------------------------------------
-- AIX

-- quite simple (for now)
howToAccessLabel DynFlags
_dflags Arch
_arch OS
OSAIX Module
_this_mod ReferenceKind
kind CLabel
_lbl
        = case ReferenceKind
kind of
            ReferenceKind
DataReference -> LabelAccessStyle
AccessViaSymbolPtr
            ReferenceKind
CallReference -> LabelAccessStyle
AccessDirectly
            ReferenceKind
JumpReference -> LabelAccessStyle
AccessDirectly

-- ELF (Linux)
--
-- ELF tries to pretend to the main application code that dynamic linking does
-- 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 a non-PIE
-- main program (-dynamic but no -fPIC).
--
-- Indirect access is required for references to imported symbols
-- from position independent code. It is also required from the main program
-- when dynamic libraries containing Haskell code are used.

howToAccessLabel DynFlags
_ (ArchPPC_64 PPC_64ABI
_) OS
os Module
_ ReferenceKind
kind CLabel
_
        | OS -> Bool
osElfTarget OS
os
        = case ReferenceKind
kind of
          -- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC
          ReferenceKind
DataReference -> LabelAccessStyle
AccessViaSymbolPtr
          -- RTLD does not generate stubs for function descriptors
          -- in tail calls. Create a symbol pointer and generate
          -- the code to load the function descriptor at the call site.
          ReferenceKind
JumpReference -> LabelAccessStyle
AccessViaSymbolPtr
          -- regular calls are handled by the runtime linker
          ReferenceKind
_             -> LabelAccessStyle
AccessDirectly

howToAccessLabel DynFlags
dflags Arch
_ OS
os Module
_ ReferenceKind
_ CLabel
_
        -- no PIC -> the dynamic linker does everything for us;
        --           if we don't dynamically link to Haskell code,
        --           it actually manages to do so without messing things up.
        | OS -> Bool
osElfTarget OS
os
        , Bool -> Bool
not (DynFlags -> Bool
positionIndependent DynFlags
dflags) Bool -> Bool -> Bool
&&
          Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags)
        = LabelAccessStyle
AccessDirectly

howToAccessLabel DynFlags
dflags Arch
arch OS
os Module
this_mod ReferenceKind
DataReference CLabel
lbl
        | OS -> Bool
osElfTarget OS
os
        = case () of
            -- A dynamic label needs to be accessed via a symbol pointer.
          ()
_ | DynFlags -> Module -> CLabel -> Bool
labelDynamic DynFlags
dflags Module
this_mod CLabel
lbl
            -> LabelAccessStyle
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
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchPPC
            , DynFlags -> Bool
positionIndependent DynFlags
dflags
            -> LabelAccessStyle
AccessViaSymbolPtr

            | Bool
otherwise
            -> LabelAccessStyle
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)

howToAccessLabel DynFlags
dflags Arch
arch OS
os Module
this_mod ReferenceKind
CallReference CLabel
lbl
        | OS -> Bool
osElfTarget OS
os
        , DynFlags -> Module -> CLabel -> Bool
labelDynamic DynFlags
dflags Module
this_mod CLabel
lbl Bool -> Bool -> Bool
&& Bool -> Bool
not (DynFlags -> Bool
positionIndependent DynFlags
dflags)
        = LabelAccessStyle
AccessDirectly

        | OS -> Bool
osElfTarget OS
os
        , Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86
        , DynFlags -> Module -> CLabel -> Bool
labelDynamic DynFlags
dflags Module
this_mod CLabel
lbl
        , DynFlags -> Bool
positionIndependent DynFlags
dflags
        = LabelAccessStyle
AccessViaStub

howToAccessLabel DynFlags
dflags Arch
_ OS
os Module
this_mod ReferenceKind
_ CLabel
lbl
        | OS -> Bool
osElfTarget OS
os
        = if DynFlags -> Module -> CLabel -> Bool
labelDynamic DynFlags
dflags Module
this_mod CLabel
lbl
            then LabelAccessStyle
AccessViaSymbolPtr
            else LabelAccessStyle
AccessDirectly

-- all other platforms
howToAccessLabel DynFlags
dflags Arch
_ OS
_ Module
_ ReferenceKind
_ CLabel
_
        | Bool -> Bool
not (DynFlags -> Bool
positionIndependent DynFlags
dflags)
        = LabelAccessStyle
AccessDirectly

        | Bool
otherwise
        = String -> LabelAccessStyle
forall a. String -> a
panic String
"howToAccessLabel: PIC not defined for this platform"



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

picRelative :: DynFlags -> Arch -> OS -> CLabel -> CmmLit

-- Darwin, but not x86_64:
-- The PIC base register points to the PIC base label at the beginning
-- of the current CmmDecl. We just have to use a label difference to
-- 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).
picRelative :: DynFlags -> Arch -> OS -> CLabel -> CmmLit
picRelative DynFlags
dflags Arch
arch OS
OSDarwin CLabel
lbl
        | Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86_64
        = CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff CLabel
lbl CLabel
mkPicBaseLabel Int
0 (DynFlags -> Width
wordWidth DynFlags
dflags)

-- On AIX we use an indirect local TOC anchored by 'gotLabel'.
-- This way we use up only one global TOC entry per compilation-unit
-- (this is quite similiar to GCC's @-mminimal-toc@ compilation mode)
picRelative DynFlags
dflags Arch
_ OS
OSAIX CLabel
lbl
        = CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff CLabel
lbl CLabel
gotLabel Int
0 (DynFlags -> Width
wordWidth DynFlags
dflags)

-- 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.
picRelative DynFlags
dflags Arch
ArchPPC OS
os CLabel
lbl
        | OS -> Bool
osElfTarget OS
os
        = CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff CLabel
lbl CLabel
gotLabel Int
0 (DynFlags -> Width
wordWidth DynFlags
dflags)


-- Most Linux versions:
-- The PIC base register points to the GOT. Use foo@got for symbol
-- pointers, and foo@gotoff for everything else.
-- 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.
picRelative DynFlags
_ Arch
arch OS
os CLabel
lbl
        | OS -> Bool
osElfTarget OS
os Bool -> Bool -> Bool
|| (OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin Bool -> Bool -> Bool
&& Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchX86_64)
        = let   result :: CmmLit
result
                        | Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl') <- CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
lbl
                        = CLabel -> CmmLit
CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
forall a b. (a -> b) -> a -> b
$ DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
GotSymbolPtr CLabel
lbl'

                        | Bool
otherwise
                        = CLabel -> CmmLit
CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
forall a b. (a -> b) -> a -> b
$ DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
GotSymbolOffset CLabel
lbl

          in    CmmLit
result

picRelative DynFlags
_ Arch
_ OS
_ CLabel
_
        = String -> CmmLit
forall a. String -> a
panic String
"PositionIndependentCode.picRelative undefined for this platform"



--------------------------------------------------------------------------------

needImportedSymbols :: DynFlags -> Arch -> OS -> Bool
needImportedSymbols :: DynFlags -> Arch -> OS -> Bool
needImportedSymbols DynFlags
dflags Arch
arch OS
os
        | OS
os    OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
        , Arch
arch  Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86_64
        = Bool
True

        | OS
os    OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSAIX
        = Bool
True

        -- PowerPC Linux: -fPIC or -dynamic
        | OS -> Bool
osElfTarget OS
os
        , Arch
arch  Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchPPC
        = DynFlags -> Bool
positionIndependent DynFlags
dflags Bool -> Bool -> Bool
|| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags

        -- PowerPC 64 Linux: always
        | OS -> Bool
osElfTarget OS
os
        , Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
|| Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
        = Bool
True

        -- i386 (and others?): -dynamic but not -fPIC
        | OS -> Bool
osElfTarget OS
os
        , Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
&& Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
        = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags Bool -> Bool -> Bool
&&
          Bool -> Bool
not (DynFlags -> Bool
positionIndependent DynFlags
dflags)

        | Bool
otherwise
        = Bool
False

-- gotLabel
-- The label used to refer to our "fake GOT" from
-- position-independent code.
gotLabel :: CLabel
gotLabel :: CLabel
gotLabel
        -- HACK: this label isn't really foreign
        = FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel
                (String -> FastString
fsLit String
".LCTOC1")
                Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInThisPackage FunctionOrData
IsData



--------------------------------------------------------------------------------
-- We don't need to declare any offset tables.
-- However, for PIC on x86, we need a small helper function.
pprGotDeclaration :: DynFlags -> Arch -> OS -> SDoc
pprGotDeclaration :: DynFlags -> Arch -> OS -> SDoc
pprGotDeclaration DynFlags
dflags Arch
ArchX86 OS
OSDarwin
        | DynFlags -> Bool
positionIndependent DynFlags
dflags
        = [SDoc] -> SDoc
vcat [
                String -> SDoc
text String
".section __TEXT,__textcoal_nt,coalesced,no_toc",
                String -> SDoc
text String
".weak_definition ___i686.get_pc_thunk.ax",
                String -> SDoc
text String
".private_extern ___i686.get_pc_thunk.ax",
                String -> SDoc
text String
"___i686.get_pc_thunk.ax:",
                String -> SDoc
text String
"\tmovl (%esp), %eax",
                String -> SDoc
text String
"\tret" ]

pprGotDeclaration DynFlags
_ Arch
_ OS
OSDarwin
        = SDoc
empty

-- Emit XCOFF TOC section
pprGotDeclaration DynFlags
_ Arch
_ OS
OSAIX
        = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ [ String -> SDoc
text String
".toc"
                 , String -> SDoc
text String
".tc ghc_toc_table[TC],.LCTOC1"
                 , String -> SDoc
text String
".csect ghc_toc_table[RW]"
                   -- See Note [.LCTOC1 in PPC PIC code]
                 , String -> SDoc
text String
".set .LCTOC1,$+0x8000"
                 ]


-- PPC 64 ELF v1 needs a Table Of Contents (TOC)
pprGotDeclaration DynFlags
_ (ArchPPC_64 PPC_64ABI
ELF_V1) OS
_
        = String -> SDoc
text String
".section \".toc\",\"aw\""
-- In ELF v2 we also need to tell the assembler that we want ABI
-- version 2. This would normally be done at the top of the file
-- right after a file directive, but I could not figure out how
-- to do that.
pprGotDeclaration DynFlags
_ (ArchPPC_64 PPC_64ABI
ELF_V2) OS
_
        = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
".abiversion 2",
                 String -> SDoc
text String
".section \".toc\",\"aw\""
               ]

-- Emit GOT declaration
-- Output whatever needs to be output once per .s file.
pprGotDeclaration DynFlags
dflags Arch
arch OS
os
        | OS -> Bool
osElfTarget OS
os
        , Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
&& Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
        , Bool -> Bool
not (DynFlags -> Bool
positionIndependent DynFlags
dflags)
        = SDoc
empty

        | OS -> Bool
osElfTarget OS
os
        , Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
&& Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
        = [SDoc] -> SDoc
vcat [
                -- See Note [.LCTOC1 in PPC PIC code]
                String -> SDoc
text String
".section \".got2\",\"aw\"",
                String -> SDoc
text String
".LCTOC1 = .+32768" ]

pprGotDeclaration DynFlags
_ Arch
_ OS
_
        = String -> SDoc
forall a. String -> a
panic String
"pprGotDeclaration: no match"


--------------------------------------------------------------------------------
-- On Darwin, we have to generate our own stub code for lazy binding..
-- For each processor architecture, there are two versions, one for PIC
-- and one for non-PIC.
--

pprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc
pprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc
pprImportedSymbol DynFlags
dflags (Platform { platformMini :: Platform -> PlatformMini
platformMini = PlatformMini { platformMini_arch :: PlatformMini -> Arch
platformMini_arch = Arch
ArchX86, platformMini_os :: PlatformMini -> OS
platformMini_os = OS
OSDarwin } }) CLabel
importedLbl
        | Just (DynamicLinkerLabelInfo
CodeStub, CLabel
lbl) <- CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl
        = case DynFlags -> Bool
positionIndependent DynFlags
dflags of
           Bool
False ->
            [SDoc] -> SDoc
vcat [
                String -> SDoc
text String
".symbol_stub",
                String -> SDoc
text String
"L" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"$stub:"),
                    String -> SDoc
text String
"\t.indirect_symbol" SDoc -> SDoc -> SDoc
<+> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl,
                    String -> SDoc
text String
"\tjmp *L" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl
                        SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$lazy_ptr",
                String -> SDoc
text String
"L" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl
                    SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$stub_binder:",
                    String -> SDoc
text String
"\tpushl $L" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl
                        SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$lazy_ptr",
                    String -> SDoc
text String
"\tjmp dyld_stub_binding_helper"
            ]
           Bool
True ->
            [SDoc] -> SDoc
vcat [
                String -> SDoc
text String
".section __TEXT,__picsymbolstub2,"
                    SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"symbol_stubs,pure_instructions,25",
                String -> SDoc
text String
"L" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"$stub:"),
                    String -> SDoc
text String
"\t.indirect_symbol" SDoc -> SDoc -> SDoc
<+> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl,
                    String -> SDoc
text String
"\tcall ___i686.get_pc_thunk.ax",
                String -> SDoc
text String
"1:",
                    String -> SDoc
text String
"\tmovl L" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl
                        SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$lazy_ptr-1b(%eax),%edx",
                    String -> SDoc
text String
"\tjmp *%edx",
                String -> SDoc
text String
"L" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl
                    SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$stub_binder:",
                    String -> SDoc
text String
"\tlea L" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl
                        SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$lazy_ptr-1b(%eax),%eax",
                    String -> SDoc
text String
"\tpushl %eax",
                    String -> SDoc
text String
"\tjmp dyld_stub_binding_helper"
            ]
          SDoc -> SDoc -> SDoc
$+$ [SDoc] -> SDoc
vcat [        String -> SDoc
text String
".section __DATA, __la_sym_ptr"
                    SDoc -> SDoc -> SDoc
<> (if DynFlags -> Bool
positionIndependent DynFlags
dflags then Int -> SDoc
int Int
2 else Int -> SDoc
int Int
3)
                    SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
",lazy_symbol_pointers",
                String -> SDoc
text String
"L" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"$lazy_ptr:"),
                    String -> SDoc
text String
"\t.indirect_symbol" SDoc -> SDoc -> SDoc
<+> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl,
                    String -> SDoc
text String
"\t.long L" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl
                    SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$stub_binder"]

        | Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl) <- CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl
        = [SDoc] -> SDoc
vcat [
                String -> SDoc
text String
".non_lazy_symbol_pointer",
                Char -> SDoc
char Char
'L' SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$non_lazy_ptr:",
                String -> SDoc
text String
"\t.indirect_symbol" SDoc -> SDoc -> SDoc
<+> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl,
                String -> SDoc
text String
"\t.long\t0"]

        | Bool
otherwise
        = SDoc
empty


pprImportedSymbol DynFlags
_ (Platform { platformMini :: Platform -> PlatformMini
platformMini = PlatformMini { platformMini_os :: PlatformMini -> OS
platformMini_os = OS
OSDarwin } }) CLabel
_
        = SDoc
empty

-- XCOFF / AIX
--
-- Similiar to PPC64 ELF v1, there's dedicated TOC register (r2). To
-- workaround the limitation of a global TOC we use an indirect TOC
-- with the label `ghc_toc_table`.
--
-- See also GCC's `-mminimal-toc` compilation mode or
-- http://www.ibm.com/developerworks/rational/library/overview-toc-aix/
--
-- NB: No DSO-support yet

pprImportedSymbol DynFlags
dflags (Platform { platformMini :: Platform -> PlatformMini
platformMini = PlatformMini { platformMini_os :: PlatformMini -> OS
platformMini_os = OS
OSAIX } }) CLabel
importedLbl
        = case CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl of
            Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl)
              -> [SDoc] -> SDoc
vcat [
                   String -> SDoc
text String
"LC.." SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':',
                   String -> SDoc
text String
"\t.long" SDoc -> SDoc -> SDoc
<+> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl ]
            Maybe (DynamicLinkerLabelInfo, CLabel)
_ -> SDoc
empty

-- 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.
--
-- 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"
--    when not Opt_PIC && WayDyn `elem` ways dflags.
--
-- 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.

pprImportedSymbol DynFlags
dflags platform :: Platform
platform@(Platform { platformMini :: Platform -> PlatformMini
platformMini = PlatformMini { platformMini_arch :: PlatformMini -> Arch
platformMini_arch = ArchPPC_64 PPC_64ABI
_ } })
                  CLabel
importedLbl
        | OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform)
        = case CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl of
            Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl)
              -> [SDoc] -> SDoc
vcat [
                   String -> SDoc
text String
".section \".toc\", \"aw\"",
                   String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':',
                   String -> SDoc
text String
"\t.quad" SDoc -> SDoc -> SDoc
<+> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl ]
            Maybe (DynamicLinkerLabelInfo, CLabel)
_ -> SDoc
empty

pprImportedSymbol DynFlags
dflags Platform
platform CLabel
importedLbl
        | OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform)
        = case CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl of
            Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl)
              -> let symbolSize :: PtrString
symbolSize = case DynFlags -> Width
wordWidth DynFlags
dflags of
                         Width
W32 -> String -> PtrString
sLit String
"\t.long"
                         Width
W64 -> String -> PtrString
sLit String
"\t.quad"
                         Width
_ -> String -> PtrString
forall a. String -> a
panic String
"Unknown wordRep in pprImportedSymbol"

                 in [SDoc] -> SDoc
vcat [
                      String -> SDoc
text String
".section \".got2\", \"aw\"",
                      String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':',
                      PtrString -> SDoc
ptext PtrString
symbolSize SDoc -> SDoc -> SDoc
<+> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dflags CLabel
lbl ]

            -- PLT code stubs are generated automatically by the dynamic linker.
            Maybe (DynamicLinkerLabelInfo, CLabel)
_ -> SDoc
empty

pprImportedSymbol DynFlags
_ Platform
_ CLabel
_
        = String -> SDoc
forall a. String -> a
panic String
"PIC.pprImportedSymbol: no match"

--------------------------------------------------------------------------------
-- 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.

-- It is assumed that the first NatCmmDecl in the input list is a Proc
-- and the rest are CmmDatas.

-- Darwin is simple: just fetch the address of a local label.
-- 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



-- Get a pointer to our own fake GOT, which is defined on a per-module basis.
-- This is exactly how GCC does it in linux.

initializePicBase_ppc
        :: Arch -> OS -> Reg
        -> [NatCmmDecl CmmStatics PPC.Instr]
        -> NatM [NatCmmDecl CmmStatics PPC.Instr]

initializePicBase_ppc :: Arch
-> OS
-> Reg
-> [NatCmmDecl CmmStatics Instr]
-> NatM [NatCmmDecl CmmStatics Instr]
initializePicBase_ppc Arch
ArchPPC OS
os Reg
picReg
    (CmmProc LabelMap CmmStatics
info CLabel
lab [GlobalReg]
live (ListGraph [GenBasicBlock Instr]
blocks) : [NatCmmDecl CmmStatics Instr]
statics)
    | OS -> Bool
osElfTarget OS
os
    = do
        let
            gotOffset :: Imm
gotOffset = Imm -> Imm -> Imm
PPC.ImmConstantDiff
                                (CLabel -> Imm
PPC.ImmCLbl CLabel
gotLabel)
                                (CLabel -> Imm
PPC.ImmCLbl CLabel
mkPicBaseLabel)

            blocks' :: [GenBasicBlock Instr]
blocks' = case [GenBasicBlock Instr]
blocks of
                       [] -> []
                       (GenBasicBlock Instr
b:[GenBasicBlock Instr]
bs) -> GenBasicBlock Instr -> GenBasicBlock Instr
fetchPC GenBasicBlock Instr
b GenBasicBlock Instr
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
forall a. a -> [a] -> [a]
: (GenBasicBlock Instr -> GenBasicBlock Instr)
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
forall a b. (a -> b) -> [a] -> [b]
map GenBasicBlock Instr -> GenBasicBlock Instr
maybeFetchPC [GenBasicBlock Instr]
bs

            maybeFetchPC :: GenBasicBlock Instr -> GenBasicBlock Instr
maybeFetchPC b :: GenBasicBlock Instr
b@(BasicBlock BlockId
bID [Instr]
_)
              | KeyOf LabelMap
BlockId
bID KeyOf LabelMap -> LabelMap CmmStatics -> Bool
forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> Bool
`mapMember` LabelMap CmmStatics
info = GenBasicBlock Instr -> GenBasicBlock Instr
fetchPC GenBasicBlock Instr
b
              | Bool
otherwise            = GenBasicBlock Instr
b

            -- GCC does PIC prologs thusly:
            --     bcl 20,31,.L1
            -- .L1:
            --     mflr 30
            --     addis 30,30,.LCTOC1-.L1@ha
            --     addi 30,30,.LCTOC1-.L1@l
            -- TODO: below we use it over temporary register,
            -- it can and should be optimised by picking
            -- correct PIC reg.
            fetchPC :: GenBasicBlock Instr -> GenBasicBlock Instr
fetchPC (BasicBlock BlockId
bID [Instr]
insns) =
              BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
bID (Reg -> Instr
PPC.FETCHPC Reg
picReg
                              Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: Reg -> Reg -> Imm -> Instr
PPC.ADDIS Reg
picReg Reg
picReg (Imm -> Imm
PPC.HA Imm
gotOffset)
                              Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: Reg -> Reg -> RI -> Instr
PPC.ADD Reg
picReg Reg
picReg
                                        (Imm -> RI
PPC.RIImm (Imm -> Imm
PPC.LO Imm
gotOffset))
                              Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: Reg -> Reg -> Instr
PPC.MR Reg
PPC.r30 Reg
picReg
                              Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
insns)

        [NatCmmDecl CmmStatics Instr] -> NatM [NatCmmDecl CmmStatics Instr]
forall (m :: * -> *) a. Monad m => a -> m a
return (LabelMap CmmStatics
-> CLabel
-> [GlobalReg]
-> ListGraph Instr
-> NatCmmDecl CmmStatics Instr
forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap CmmStatics
info CLabel
lab [GlobalReg]
live ([GenBasicBlock Instr] -> ListGraph Instr
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph [GenBasicBlock Instr]
blocks') NatCmmDecl CmmStatics Instr
-> [NatCmmDecl CmmStatics Instr] -> [NatCmmDecl CmmStatics Instr]
forall a. a -> [a] -> [a]
: [NatCmmDecl CmmStatics Instr]
statics)

-------------------------------------------------------------------------
-- Load TOC into register 2
-- PowerPC 64-bit ELF ABI 2.0 requires the address of the callee
-- in register 12.
-- We pass the label to FETCHTOC and create a .localentry too.
-- TODO: Explain this better and refer to ABI spec!
{-
We would like to do approximately this, but spill slot allocation
might be added before the first BasicBlock. That violates the ABI.

For now we will emit the prologue code in the pretty printer,
which is also what we do for ELF v1.
initializePicBase_ppc (ArchPPC_64 ELF_V2) OSLinux picReg
        (CmmProc info lab live (ListGraph (entry:blocks)) : statics)
        = do
           bID <-getUniqueM
           return (CmmProc info lab live (ListGraph (b':entry:blocks))
                                         : statics)
        where   BasicBlock entryID _ = entry
                b' = BasicBlock bID [PPC.FETCHTOC picReg lab,
                                     PPC.BCC PPC.ALWAYS entryID]
-}

initializePicBase_ppc Arch
_ OS
_ Reg
_ [NatCmmDecl CmmStatics Instr]
_
        = String -> NatM [NatCmmDecl CmmStatics Instr]
forall a. String -> a
panic String
"initializePicBase_ppc: not needed"


-- We cheat a bit here by defining a pseudo-instruction named FETCHGOT
-- which pretty-prints as:
--              call 1f
-- 1:           popl %picReg
--              addl __GLOBAL_OFFSET_TABLE__+.-1b, %picReg
-- (See PprMach.hs)

initializePicBase_x86
        :: Arch -> OS -> Reg
        -> [NatCmmDecl (Alignment, CmmStatics) X86.Instr]
        -> NatM [NatCmmDecl (Alignment, CmmStatics) X86.Instr]

initializePicBase_x86 :: Arch
-> OS
-> Reg
-> [NatCmmDecl (Alignment, CmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, CmmStatics) Instr]
initializePicBase_x86 Arch
ArchX86 OS
os Reg
picReg
        (CmmProc LabelMap CmmStatics
info CLabel
lab [GlobalReg]
live (ListGraph [GenBasicBlock Instr]
blocks) : [NatCmmDecl (Alignment, CmmStatics) Instr]
statics)
    | OS -> Bool
osElfTarget OS
os
    = [NatCmmDecl (Alignment, CmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, CmmStatics) Instr]
forall (m :: * -> *) a. Monad m => a -> m a
return (LabelMap CmmStatics
-> CLabel
-> [GlobalReg]
-> ListGraph Instr
-> NatCmmDecl (Alignment, CmmStatics) Instr
forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap CmmStatics
info CLabel
lab [GlobalReg]
live ([GenBasicBlock Instr] -> ListGraph Instr
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph [GenBasicBlock Instr]
blocks') NatCmmDecl (Alignment, CmmStatics) Instr
-> [NatCmmDecl (Alignment, CmmStatics) Instr]
-> [NatCmmDecl (Alignment, CmmStatics) Instr]
forall a. a -> [a] -> [a]
: [NatCmmDecl (Alignment, CmmStatics) Instr]
statics)
    where blocks' :: [GenBasicBlock Instr]
blocks' = case [GenBasicBlock Instr]
blocks of
                     [] -> []
                     (GenBasicBlock Instr
b:[GenBasicBlock Instr]
bs) -> GenBasicBlock Instr -> GenBasicBlock Instr
fetchGOT GenBasicBlock Instr
b GenBasicBlock Instr
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
forall a. a -> [a] -> [a]
: (GenBasicBlock Instr -> GenBasicBlock Instr)
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
forall a b. (a -> b) -> [a] -> [b]
map GenBasicBlock Instr -> GenBasicBlock Instr
maybeFetchGOT [GenBasicBlock Instr]
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 :: GenBasicBlock Instr -> GenBasicBlock Instr
maybeFetchGOT b :: GenBasicBlock Instr
b@(BasicBlock BlockId
bID [Instr]
_)
            | KeyOf LabelMap
BlockId
bID KeyOf LabelMap -> LabelMap CmmStatics -> Bool
forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> Bool
`mapMember` LabelMap CmmStatics
info = GenBasicBlock Instr -> GenBasicBlock Instr
fetchGOT GenBasicBlock Instr
b
            | Bool
otherwise            = GenBasicBlock Instr
b

          fetchGOT :: GenBasicBlock Instr -> GenBasicBlock Instr
fetchGOT (BasicBlock BlockId
bID [Instr]
insns) =
             BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
bID (Reg -> Instr
X86.FETCHGOT Reg
picReg Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
insns)

initializePicBase_x86 Arch
ArchX86 OS
OSDarwin Reg
picReg
        (CmmProc LabelMap CmmStatics
info CLabel
lab [GlobalReg]
live (ListGraph (GenBasicBlock Instr
entry:[GenBasicBlock Instr]
blocks)) : [NatCmmDecl (Alignment, CmmStatics) Instr]
statics)
        = [NatCmmDecl (Alignment, CmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, CmmStatics) Instr]
forall (m :: * -> *) a. Monad m => a -> m a
return (LabelMap CmmStatics
-> CLabel
-> [GlobalReg]
-> ListGraph Instr
-> NatCmmDecl (Alignment, CmmStatics) Instr
forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap CmmStatics
info CLabel
lab [GlobalReg]
live ([GenBasicBlock Instr] -> ListGraph Instr
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph (GenBasicBlock Instr
block'GenBasicBlock Instr
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
forall a. a -> [a] -> [a]
:[GenBasicBlock Instr]
blocks)) NatCmmDecl (Alignment, CmmStatics) Instr
-> [NatCmmDecl (Alignment, CmmStatics) Instr]
-> [NatCmmDecl (Alignment, CmmStatics) Instr]
forall a. a -> [a] -> [a]
: [NatCmmDecl (Alignment, CmmStatics) Instr]
statics)

    where BasicBlock BlockId
bID [Instr]
insns = GenBasicBlock Instr
entry
          block' :: GenBasicBlock Instr
block' = BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
bID (Reg -> Instr
X86.FETCHPC Reg
picReg Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
insns)

initializePicBase_x86 Arch
_ OS
_ Reg
_ [NatCmmDecl (Alignment, CmmStatics) Instr]
_
        = String -> NatM [NatCmmDecl (Alignment, CmmStatics) Instr]
forall a. String -> a
panic String
"initializePicBase_x86: not needed"