Add {-# OPTIONS_GHC -w #-} and some blurb to all compiler modules
[ghc-hetmet.git] / compiler / nativeGen / PositionIndependentCode.hs
index ffd6577..cb94a86 100644 (file)
@@ -1,5 +1,13 @@
+{-# OPTIONS_GHC -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+-- for details
+
 module PositionIndependentCode (
         cmmMakeDynamicReference,
+        ReferenceKind(..),
         needImportedSymbols,
         pprImportedSymbol,
         pprGotDeclaration,
@@ -47,7 +55,7 @@ module PositionIndependentCode (
 #include "nativeGen/NCG.h"
 
 import Cmm
-import MachOp           ( MachOp(MO_Add), wordRep )
+import MachOp           ( MachOp(MO_Add), wordRep, MachRep(..) )
 import CLabel           ( CLabel, pprCLabel,
                           mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
                           dynamicLinkerLabelInfo, mkPicBaseLabel,
@@ -67,6 +75,7 @@ import Pretty
 import qualified Outputable
 
 import Panic            ( panic )
+import DynFlags
 
 
 -- The most important function here is cmmMakeDynamicReference.
@@ -83,17 +92,23 @@ import Panic            ( panic )
 -- - addImportCmmOpt for the CmmOptM monad
 -- - addImportNat for the NatM monad.
 
+data ReferenceKind = DataReference
+                   | CallReference
+                   | JumpReference
+                   deriving(Eq)
+
 cmmMakeDynamicReference
-  :: Monad m => (CLabel -> m ())  -- a monad & a function
+  :: Monad m => DynFlags
+             -> (CLabel -> m ())  -- a monad & a function
                                   -- used for recording imported symbols
-             -> Bool              -- whether this is the target of a jump
+             -> ReferenceKind     -- whether this is the target of a jump
              -> CLabel            -- the label
              -> m CmmExpr
   
-cmmMakeDynamicReference addImport isJumpTarget lbl
+cmmMakeDynamicReference dflags addImport referenceKind lbl
   | Just _ <- dynamicLinkerLabelInfo lbl
   = return $ CmmLit $ CmmLabel lbl   -- already processed it, pass through
-  | otherwise = case howToAccessLabel isJumpTarget lbl of
+  | otherwise = case howToAccessLabel dflags referenceKind lbl of
         AccessViaStub -> do
               let stub = mkDynamicLinkerLabel CodeStub lbl
               addImport stub
@@ -102,12 +117,13 @@ cmmMakeDynamicReference addImport isJumpTarget lbl
               let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
               addImport symbolPtr
               return $ CmmLoad (cmmMakePicReference symbolPtr) wordRep
-        AccessDirectly
-                -- all currently supported processors support
-                -- a PC-relative branch instruction, so just jump there
-          | isJumpTarget -> return $ CmmLit $ CmmLabel lbl
+        AccessDirectly -> case referenceKind of
                 -- for data, we might have to make some calculations:
-          | otherwise    -> return $ cmmMakePicReference lbl  
+              DataReference -> return $ cmmMakePicReference lbl  
+                -- 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
   
 -- -------------------------------------------------------------------
   
@@ -124,7 +140,7 @@ cmmMakePicReference :: CLabel -> CmmExpr
         -- everything gets relocated at runtime
 
 cmmMakePicReference lbl
-    | opt_PIC && absoluteLabel lbl = CmmMachOp (MO_Add wordRep) [
+    | (opt_PIC || not opt_Static) && absoluteLabel lbl = CmmMachOp (MO_Add wordRep) [
             CmmReg (CmmGlobal PicBaseReg),
             CmmLit $ picRelative lbl
         ]
@@ -154,7 +170,7 @@ data LabelAccessStyle = AccessViaStub
                       | AccessViaSymbolPtr
                       | AccessDirectly
 
-howToAccessLabel :: Bool -> CLabel -> LabelAccessStyle
+howToAccessLabel :: DynFlags -> ReferenceKind -> CLabel -> LabelAccessStyle
 
 #if mingw32_TARGET_OS
 -- Windows
@@ -163,47 +179,62 @@ howToAccessLabel :: Bool -> CLabel -> LabelAccessStyle
 -- are imported from a DLL via an __imp_* label.
 -- There are no stubs for imported code.
 
-howToAccessLabel _ lbl | labelDynamic lbl = AccessViaSymbolPtr
-                       | otherwise        = AccessDirectly
-
+howToAccessLabel dflags _ lbl | labelDynamic (thisPackage dflags) lbl = AccessViaSymbolPtr
+                             | otherwise        = AccessDirectly
 #elif darwin_TARGET_OS
 -- Mach-O (Darwin, Mac OS X)
 --
 -- Indirect access is required in the following cases:
 --  * things imported from a dynamic library
---  * things from a different module, if we're generating PIC code
+--  * (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.
 
-#if powerpc_TARGET_ARCH || powerpc64_TARGET_ARCH
-    -- on i386 and probably also on x86_64, dyld code stubs don't
-    -- work for tailcalls because the stack alignment is only right
-    -- for regular calls.
-
-howToAccessLabel True lbl
-      -- jumps to a dynamic library go via a symbol stub
-    | labelDynamic lbl = AccessViaStub
-      -- when generating PIC code, all cross-module references must
-      -- must go via a symbol pointer, too.
+howToAccessLabel dflags DataReference lbl
+      -- data access to a dynamic library goes via a symbol pointer
+    | labelDynamic (thisPackage dflags) lbl = AccessViaSymbolPtr
+    
+#if !x86_64_TARGET_ARCH
+      -- 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.
-    | opt_PIC && externallyVisibleCLabel lbl = AccessViaStub
-#endif
-howToAccessLabel _ lbl
-      -- data access to a dynamic library goes via a symbol pointer
-    | labelDynamic lbl = AccessViaSymbolPtr
-      -- cross-module PIC references: same as above
     | opt_PIC && externallyVisibleCLabel lbl = AccessViaSymbolPtr
-howToAccessLabel _ _ = AccessDirectly
+#endif
+    | otherwise = AccessDirectly
+
+
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
+    -- 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:
+howToAccessLabel dflags JumpReference lbl
+    | labelDynamic (thisPackage dflags) lbl
+    = AccessViaSymbolPtr
+#endif
+
+howToAccessLabel dflags _ lbl
+#if !x86_64_TARGET_ARCH
+    -- 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.
+    | labelDynamic (thisPackage dflags) lbl
+    = AccessViaStub
+#endif
+    | otherwise
+    = AccessDirectly
+
 
 #elif linux_TARGET_OS && powerpc64_TARGET_ARCH
 -- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC
 
-howToAccessLabel True lbl = AccessDirectly -- actually, .label instead of label
-howToAccessLabel _ lbl = AccessViaSymbolPtr
+howToAccessLabel _ DataReference lbl = AccessViaSymbolPtr
+howToAccessLabel _ _ lbl = AccessDirectly -- actually, .label instead of label
 
 #elif linux_TARGET_OS
 -- ELF (Linux)
@@ -217,54 +248,52 @@ howToAccessLabel _ lbl = AccessViaSymbolPtr
 -- from position independent code. It is also required from the main program
 -- when dynamic libraries containing Haskell code are used.
 
-howToAccessLabel isJump lbl
+howToAccessLabel _ _ lbl
        -- 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 thins up.
     | not opt_PIC && opt_Static = AccessDirectly
    
-#if !i386_TARGET_ARCH
--- for Intel, we temporarily disable the use of the
--- Procedure Linkage Table, because PLTs on intel require the
--- address of the GOT to be loaded into register %ebx before
--- a jump through the PLT is made.
--- TODO: make the i386 NCG ensure this before jumping to a
---       CodeStub label, so we can remove this special case.
-
-       -- As long as we're in a shared library ourselves,
-       -- we can use the plt.
-       -- NOTE: We might want to disable this, because this
-       --       prevents -fPIC code from being linked statically.
-    | isJump && labelDynamic lbl && opt_PIC = AccessViaStub
-
-       -- TODO: it would be OK to access non-Haskell code via a stub
---  | isJump && labelDynamic lbl && not isHaskellCode lbl = AccessViaStub
-
-       -- Using code stubs for jumps from the main program to an entry
-       -- label in a dynamic library is deadly; this will cause the dynamic
-       -- linker to replace all references (even data references) to that
-       -- label by references to the stub, so we won't find our info tables
-       -- any more.
-#endif
-
+howToAccessLabel dflags DataReference lbl
        -- A dynamic label needs to be accessed via a symbol pointer.
-       -- NOTE: It would be OK to jump to foreign code via a PLT stub.
-    | labelDynamic lbl = AccessViaSymbolPtr
-    
+    | labelDynamic (thisPackage dflags) lbl = AccessViaSymbolPtr
 #if powerpc_TARGET_ARCH
        -- 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).
-    | opt_PIC && not isJump = AccessViaSymbolPtr
+    | opt_PIC = AccessViaSymbolPtr
 #endif
-
     | 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) 
+
+howToAccessLabel dflags CallReference lbl
+    | labelDynamic (thisPackage dflags) lbl && not opt_PIC
+    = AccessDirectly
+#if !i386_TARGET_ARCH
+    | labelDynamic (thisPackage dflags) lbl && opt_PIC
+    = AccessViaStub
+#endif
+
+howToAccessLabel dflags _ lbl
+    | labelDynamic (thisPackage dflags) lbl = AccessViaSymbolPtr
+    | otherwise = AccessDirectly
 #else
 --
 -- all other platforms
 --
-howToAccessLabel _ _
+howToAccessLabel _ _ _
         | not opt_PIC = AccessDirectly
         | otherwise   = panic "howToAccessLabel: PIC not defined for this platform"
 #endif
@@ -275,8 +304,8 @@ howToAccessLabel _ _
 -- get the address of a label?
 
 picRelative :: CLabel -> CmmLit
-#if darwin_TARGET_OS
--- Darwin:
+#if darwin_TARGET_OS && !x86_64_TARGET_ARCH
+-- Darwin, but not x86_64:
 -- The PIC base register points to the PIC base label at the beginning
 -- of the current CmmTop. We just have to use a label difference to
 -- get the offset.
@@ -297,10 +326,14 @@ picRelative lbl
 picRelative lbl
   = CmmLabelDiffOff lbl gotLabel 0
 
-#elif linux_TARGET_OS
--- Other Linux versions:
+#elif linux_TARGET_OS || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
+-- 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 lbl
   | Just (SymbolPtr, lbl') <- dynamicLinkerLabelInfo lbl
@@ -323,7 +356,7 @@ asmSDoc d = Outputable.withPprStyleDoc (
 pprCLabel_asm l = asmSDoc (pprCLabel l)
 
 
-#if darwin_TARGET_OS
+#if darwin_TARGET_OS && !x86_64_TARGET_ARCH
 
 needImportedSymbols = True
 
@@ -348,6 +381,9 @@ pprGotDeclaration = Pretty.empty
 -- 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.
+--
+-- Whenever you change something in this assembler output, make sure
+-- the splitter in driver/split/ghc-split.lprl recognizes the new output
 pprImportedSymbol importedLbl
 #if powerpc_TARGET_ARCH
     | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
@@ -418,7 +454,7 @@ pprImportedSymbol importedLbl
                 ptext SLIT("1:"),
                     ptext SLIT("\tmovl L") <> pprCLabel_asm lbl
                         <> ptext SLIT("$lazy_ptr-1b(%eax),%edx"),
-                    ptext SLIT("\tjmp %edx"),
+                    ptext SLIT("\tjmp *%edx"),
                 ptext SLIT("L") <> pprCLabel_asm lbl
                     <> ptext SLIT("$stub_binder:"),
                     ptext SLIT("\tlea L") <> pprCLabel_asm lbl
@@ -503,7 +539,7 @@ pprGotDeclaration
         ptext SLIT(".LCTOC1 = .+32768")
     ]
 
--- We generate one .long literal for every symbol we import;
+-- We generate one .long/.quad literal for every symbol we import;
 -- the dynamic linker will relocate those addresses.
 
 pprImportedSymbol importedLbl
@@ -511,11 +547,16 @@ pprImportedSymbol importedLbl
     = vcat [
         ptext SLIT(".section \".got2\", \"aw\""),
         ptext SLIT(".LC_") <> pprCLabel_asm lbl <> char ':',
-        ptext SLIT("\t.long") <+> pprCLabel_asm lbl
+        ptext symbolSize <+> pprCLabel_asm lbl
     ]
 
 -- PLT code stubs are generated automatically be the dynamic linker.
     | otherwise = empty
+    where
+      symbolSize = case wordRep of
+                    I32 -> SLIT("\t.long")
+                    I64 -> SLIT("\t.quad")
+                    _ -> panic "Unknown wordRep in pprImportedSymbol"
 
 #else