Commit b4d045ae authored by wolfgang's avatar wolfgang

[project @ 2004-10-07 15:54:03 by wolfgang]

Position Independent Code and Dynamic Linking Support, Part 1

This commit allows generation of position independent code (PIC) that fully supports dynamic linking on Mac OS X and PowerPC Linux.
Other platforms are not yet supported, and there is no support for actually linking or using dynamic libraries - so if you use the -fPIC or -dynamic code generation flags, you have to type your (platform-specific) linker command lines yourself.


nativeGen/PositionIndependentCode.hs:
New file. Look here for some more comments on how this works.

cmm/CLabel.hs:
Add support for DynamicLinkerLabels and PIC base labels - for use inside the NCG.
needsCDecl: Case alternative labels now need C decls, see the codeGen/CgInfoTbls.hs below for details

cmm/Cmm.hs:
Add CmmPicBaseReg (used in NCG),
and CmmLabelDiffOff (used in NCG and for offsets in info tables)

cmm/CmmParse.y:
support offsets in info tables

cmm/PprC.hs:
support CmmLabelDiffOff
Case alternative labels now need C decls (see the codeGen/CgInfoTbls.hs for details), so we need to pprDataExterns for info tables.

cmm/PprCmm.hs:
support CmmLabelDiffOff

codeGen/CgInfoTbls.hs:
no longer store absolute addresses in info tables, instead, we store offsets.
Also, for vectored return points, emit the alternatives _after_ the vector table. This is to work around a limitation in Apple's as, which refuses to handle label differences where one label is at the end of a section. Emitting alternatives after vector info tables makes sure this never happens in GHC generated code. Case alternatives now require prototypes in hc code, though (see changes in PprC.hs, CLabel.hs).

main/CmdLineOpts.lhs:
Add a new option, -fPIC.

main/DriverFlags.hs:
Pass the correct options for PIC to gcc, depending on the platform. Only for powerpc for now.

nativeGen/AsmCodeGen.hs:
Many changes...
Mac OS X-specific management of import stubs is no longer, it's now part of a general mechanism to handle such things for all platforms that need it (Darwin [both ppc and x86], Linux on ppc, and some platforms we don't support).
Move cmmToCmm into its own monad which can accumulate a list of imported symbols. Make it call cmmMakeDynamicReference at the right places.

nativeGen/MachCodeGen.hs:
nativeGen/MachInstrs.hs:
nativeGen/MachRegs.lhs:
nativeGen/PprMach.hs:
nativeGen/RegAllocInfo.hs:
Too many changes to enumerate here, PowerPC specific.

nativeGen/NCGMonad.hs:
NatM still tracks imported symbols, as more labels can be created during code generation (float literals, jump tables; on some platforms all data access has to go through the dynamic linking mechanism).

driver/mangler/ghc-asm.lprl:
Mangle absolute addresses in info tables to offsets.
Correctly pass through GCC-generated PIC for Mac OS X and powerpc linux.

includes/Cmm.h:
includes/InfoTables.h:
includes/Storage.h:
includes/mkDerivedConstants.c:
rts/GC.c:
rts/GCCompact.c:
rts/HeapStackCheck.cmm:
rts/Printer.c:
rts/RetainerProfile.c:
rts/Sanity.c:
Adapt to the fact that info tables now contain offsets.

rts/Linker.c:
Mac-specific: change machoInitSymbolsWithoutUnderscore to support PIC.
parent a558bffd
......@@ -74,9 +74,15 @@ module CLabel (
mkCCLabel, mkCCSLabel,
DynamicLinkerLabelInfo(..),
mkDynamicLinkerLabel,
dynamicLinkerLabelInfo,
mkPicBaseLabel,
infoLblToEntryLbl, entryLblToInfoLbl,
needsCDecl, isAsmTemp, externallyVisibleCLabel,
CLabelType(..), labelType, labelDynamic, labelCouldBeDynamic,
CLabelType(..), labelType, labelDynamic,
pprCLabel
) where
......@@ -97,7 +103,6 @@ import CostCentre ( CostCentre, CostCentreStack )
import Outputable
import FastString
-- -----------------------------------------------------------------------------
-- The CLabel type
......@@ -163,9 +168,21 @@ data CLabel
| CC_Label CostCentre
| CCS_Label CostCentreStack
-- Dynamic Linking in the NCG:
-- generated and used inside the NCG only,
-- see module PositionIndependentCode for details.
| DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
-- special variants of a label used for dynamic linking
| PicBaseLabel -- a label used as a base for PIC calculations
-- on some platforms.
-- It takes the form of a local numeric
-- assembler label '1'; it is pretty-printed
-- as 1b, referring to the previous definition
-- of 1: in the assembler source file.
deriving (Eq, Ord)
data IdLabelInfo
= Closure -- Label for closure
| SRT -- Static reference table
......@@ -226,6 +243,14 @@ data RtsLabelInfo
-- NOTE: Eq on LitString compares the pointer only, so this isn't
-- a real equality.
data DynamicLinkerLabelInfo
= CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
| SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
| GotSymbolPtr -- ELF: foo@got
| GotSymbolOffset -- ELF: foo@gotoff
deriving (Eq, Ord)
-- -----------------------------------------------------------------------------
-- Constructing CLabels
......@@ -309,6 +334,20 @@ mkRtsDataLabelFS str = RtsLabel (RtsDataFS str)
mkRtsSlowTickyCtrLabel :: String -> CLabel
mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
-- Dynamic linking
mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel = DynamicLinkerLabel
dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
dynamicLinkerLabelInfo _ = Nothing
-- Position independent code
mkPicBaseLabel :: CLabel
mkPicBaseLabel = PicBaseLabel
-- -----------------------------------------------------------------------------
-- Converting info labels to entry labels.
......@@ -345,8 +384,7 @@ needsCDecl (IdLabel _ SRT) = False
needsCDecl (IdLabel _ SRTDesc) = False
needsCDecl (IdLabel _ Bitmap) = False
needsCDecl (IdLabel _ _) = True
needsCDecl (CaseLabel _ CaseReturnPt) = True
needsCDecl (CaseLabel _ CaseReturnInfo) = True
needsCDecl (CaseLabel _ _) = True
needsCDecl (ModuleInitLabel _ _) = True
needsCDecl (PlainModuleInitLabel _) = True
needsCDecl ModuleRegdLabel = False
......@@ -384,7 +422,7 @@ externallyVisibleCLabel (ForeignLabel _ _ _) = True
externallyVisibleCLabel (IdLabel id _) = isExternalName id
externallyVisibleCLabel (CC_Label _) = True
externallyVisibleCLabel (CCS_Label _) = True
externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
-- -----------------------------------------------------------------------------
-- Finding the "type" of a CLabel
......@@ -411,7 +449,7 @@ labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
labelType (RtsLabel (RtsRetFS _)) = CodeLabel
labelType (CaseLabel _ CaseReturnInfo) = DataLabel
labelType (CaseLabel _ CaseReturnPt) = CodeLabel
labelType (CaseLabel _ _) = CodeLabel
labelType (ModuleInitLabel _ _) = CodeLabel
labelType (PlainModuleInitLabel _) = CodeLabel
......@@ -441,23 +479,19 @@ labelDynamic lbl =
case lbl of
RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not?
IdLabel n k -> isDllName n
#if mingw32_TARGET_OS
ForeignLabel _ _ d -> d
#else
-- On Mac OS X and on ELF platforms, false positives are OK,
-- so we claim that all foreign imports come from dynamic libraries
ForeignLabel _ _ _ -> True
#endif
ModuleInitLabel m _ -> (not opt_Static) && (not (isHomeModule m))
PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False
-- Basically the same as above, but this time for Darwin only.
-- The things that GHC does when labelDynamic returns true are not quite right
-- for Darwin. Also, every ForeignLabel might possibly be from a dynamic library,
-- and a 'false positive' doesn't really hurt on Darwin, so this just returns
-- True for every ForeignLabel.
--
-- ToDo: Clean up DLL-related code so we can do away with the distinction
-- between this and labelDynamic above.
labelCouldBeDynamic (ForeignLabel _ _ _) = True
labelCouldBeDynamic lbl = labelDynamic lbl
{-
OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
right places. It is used to detect when the abstractC statement of an
......@@ -514,6 +548,12 @@ pprCLabel (AsmTempLabel u)
ptext asmTempLabelPrefix <> pprUnique u
else
char '_' <> pprUnique u
pprCLabel (DynamicLinkerLabel info lbl)
= pprDynamicLinkerAsmLabel info lbl
pprCLabel PicBaseLabel
= ptext SLIT("1b")
#endif
pprCLabel lbl =
......@@ -668,3 +708,29 @@ asmTempLabelPrefix =
#else
SLIT(".L")
#endif
pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
#if darwin_TARGET_OS
pprDynamicLinkerAsmLabel SymbolPtr lbl
= char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
pprDynamicLinkerAsmLabel CodeStub lbl
= char 'L' <> pprCLabel lbl <> text "$stub"
#elif powerpc_TARGET_ARCH && linux_TARGET_OS
pprDynamicLinkerAsmLabel CodeStub lbl
= pprCLabel lbl <> text "@plt"
pprDynamicLinkerAsmLabel SymbolPtr lbl
= text ".LC_" <> pprCLabel lbl
#elif linux_TARGET_OS
pprDynamicLinkerAsmLabel CodeStub lbl
= pprCLabel lbl <> text "@plt"
pprDynamicLinkerAsmLabel GotSymbolPtr lbl
= pprCLabel lbl <> text "@got"
pprDynamicLinkerAsmLabel GotSymbolOffset lbl
= pprCLabel lbl <> text "@gotoff"
#elif mingw32_TARGET_OS
pprDynamicLinkerAsmLabel SymbolPtr lbl
= text "__imp_" <> pprCLabel lbl
#endif
pprDynamicLinkerAsmLabel _ _
= panic "pprDynamicLinkerAsmLabel"
......@@ -162,6 +162,7 @@ data CmmExpr
-- ** is shorthand only, meaning **
-- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep)))
-- where rep = cmmRegRep reg
| CmmPicBaseReg -- Base Register for PIC calculations
cmmExprRep :: CmmExpr -> MachRep
cmmExprRep (CmmLit lit) = cmmLitRep lit
......@@ -169,6 +170,7 @@ cmmExprRep (CmmLoad _ rep) = rep
cmmExprRep (CmmReg reg) = cmmRegRep reg
cmmExprRep (CmmMachOp op _) = resultRepOfMachOp op
cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
cmmExprRep CmmPicBaseReg = wordRep
data CmmReg
= CmmLocal LocalReg
......@@ -201,12 +203,22 @@ data CmmLit
| CmmFloat Rational MachRep
| CmmLabel CLabel -- Address of label
| CmmLabelOff CLabel Int -- Address of label + byte offset
-- Due to limitations in the C backend, the following
-- MUST ONLY be used inside the info table indicated by label2
-- (label2 must be the info label), and label1 must be an
-- SRT, a slow entrypoint or a large bitmap (see the Mangler)
-- Don't use it at all unless tablesNextToCode.
-- It is also used inside the NCG during when generating
-- position-independent code.
| CmmLabelDiffOff CLabel CLabel Int -- label1 - label2 + offset
cmmLitRep :: CmmLit -> MachRep
cmmLitRep (CmmInt _ rep) = rep
cmmLitRep (CmmFloat _ rep) = rep
cmmLitRep (CmmLabel _) = wordRep
cmmLitRep (CmmLabelOff _ _) = wordRep
cmmLitRep (CmmLabelDiffOff _ _ _) = wordRep
-----------------------------------------------------------------------------
-- A local label.
......
......@@ -464,7 +464,7 @@ exprMacros = listToUFM [
( FSLIT("INFO_TYPE"), \ [x] -> infoTableClosureType x ),
( FSLIT("INFO_PTRS"), \ [x] -> infoTablePtrs x ),
( FSLIT("INFO_NPTRS"), \ [x] -> infoTableNonPtrs x ),
( FSLIT("RET_VEC"), \ [info, conZ] -> CmmLoad (vectorSlot info conZ) wordRep )
( FSLIT("RET_VEC"), \ [info, conZ] -> retVec info conZ )
]
-- we understand a subset of C-- primitives:
......@@ -677,9 +677,10 @@ forkLabelledCodeEC ec = do
retInfo name size live_bits cl_type vector = do
let liveness = smallLiveness (fromIntegral size) (fromIntegral live_bits)
(info1,info2) = mkRetInfoTable liveness NoC_SRT
info_lbl = mkRtsRetInfoLabelFS name
(info1,info2) = mkRetInfoTable info_lbl liveness NoC_SRT
(fromIntegral cl_type) vector
return (mkRtsRetInfoLabelFS name, info1, info2)
return (info_lbl, info1, info2)
stdInfo name ptrs nptrs srt_bitmap cl_type desc_str ty_str =
basicInfo name (packHalfWordsCLit ptrs nptrs)
......@@ -854,7 +855,9 @@ doSwitch mb_range scrut arms deflt
initEnv :: Env
initEnv = listToUFM [
( FSLIT("SIZEOF_StgHeader"),
CmmLit (CmmInt (fromIntegral (fixedHdrSize * wORD_SIZE)) wordRep) )
CmmLit (CmmInt (fromIntegral (fixedHdrSize * wORD_SIZE)) wordRep) ),
( FSLIT("SIZEOF_StgInfoTable"),
CmmLit (CmmInt (fromIntegral stdInfoTableSizeB) wordRep) )
]
parseCmmFile :: DynFlags -> FilePath -> IO (Maybe Cmm)
......
......@@ -85,7 +85,8 @@ pprC (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
pprTop :: CmmTop -> SDoc
pprTop (CmmProc info clbl _params blocks) =
(if not (null info)
then pprWordArray (entryLblToInfoLbl clbl) info
then pprDataExterns info $$
pprWordArray (entryLblToInfoLbl clbl) info
else empty) $$
(case blocks of
[] -> empty
......@@ -367,9 +368,18 @@ pprLit lit = case lit of
CmmFloat f rep -> parens (machRepCType rep) <> (rational f)
CmmLabel clbl -> mkW_ <> pprCLabel clbl
CmmLabelOff clbl i -> mkW_ <> pprCLabel clbl <> char '+' <> int i
CmmLabelDiffOff clbl1 clbl2 i
-- WARNING:
-- * the lit must occur in the info table clbl2
-- * clbl1 must be an SRT, a slow entry point or a large bitmap
-- The Mangler is expected to convert any reference to an SRT,
-- a slow entry point or a large bitmap
-- from an info table to an offset.
-> mkW_ <> pprCLabel clbl1 <> char '+' <> int i
pprLit1 :: CmmLit -> SDoc
pprLit1 lit@(CmmLabelOff _ _) = parens (pprLit lit)
pprLit1 lit@(CmmLabelDiffOff _ _ _) = parens (pprLit lit)
pprLit1 lit@(CmmFloat _ _) = parens (pprLit lit)
pprLit1 other = pprLit other
......@@ -786,6 +796,8 @@ te_BB (BasicBlock _ ss) = mapM_ te_Stmt ss
te_Lit :: CmmLit -> TE ()
te_Lit (CmmLabel l) = te_lbl l
te_Lit (CmmLabelOff l _) = te_lbl l
te_Lit (CmmLabelDiffOff l1 l2 _) = te_lbl l1
te_Lit _ = return ()
te_Stmt :: CmmStmt -> TE ()
......
......@@ -369,6 +369,8 @@ pprLit lit = case lit of
CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ]
CmmLabel clbl -> pprCLabel clbl
CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
<> pprCLabel clbl2 <> ppr_offset i
pprLit1 lit@(CmmLabelOff clbl i) = parens (pprLit lit)
pprLit1 lit = pprLit lit
......
......@@ -15,13 +15,14 @@ module CgInfoTbls (
emitDirectReturnInstr, emitVectoredReturnInstr,
mkRetInfoTable,
mkStdInfoTable,
stdInfoTableSizeB,
mkFunGenInfoExtraBits,
entryCode, closureInfoPtr,
getConstrTag,
infoTable, infoTableClosureType,
infoTablePtrs, infoTableNonPtrs,
funInfoTable,
vectorSlot,
retVec
) where
......@@ -120,7 +121,7 @@ emitClosureCodeAndInfoTable cl_info args body
(mkIntCLit 0, fromIntegral (dataConTagZ con))
Nothing -> -- Not a constructor
srtLabelAndLength srt
srtLabelAndLength srt info_lbl
ptrs = closurePtrsSize cl_info
nptrs = size - ptrs
......@@ -141,11 +142,14 @@ emitClosureCodeAndInfoTable cl_info args body
| ArgGen liveness <- arg_descr
= [ fun_amode,
srt_label,
mkLivenessCLit liveness,
CmmLabel (mkSlowEntryLabel (closureName cl_info)) ]
makeRelativeRefTo info_lbl $ mkLivenessCLit liveness,
slow_entry ]
| needs_srt = [fun_amode, srt_label]
| otherwise = [fun_amode]
slow_entry = makeRelativeRefTo info_lbl (CmmLabel slow_entry_label)
slow_entry_label = mkSlowEntryLabel (closureName cl_info)
fun_amode = packHalfWordsCLit fun_type arity
fun_type = argDescrType arg_descr
......@@ -207,7 +211,15 @@ vectorSlot info_amode zero_indexed_tag
zero_indexed_tag
-- The "2" is one for the entry-code slot and one for the SRT slot
retVec :: CmmExpr -> CmmExpr -> CmmExpr
-- Get a return vector from the info pointer
retVec info_amode zero_indexed_tag
= let slot = vectorSlot info_amode zero_indexed_tag
tableEntry = CmmLoad slot wordRep
in if tablesNextToCode
then CmmMachOp (MO_Add wordRep) [tableEntry, info_amode]
else tableEntry
emitReturnTarget
:: Name
-> CgStmts -- The direct-return code (if any)
......@@ -229,7 +241,7 @@ emitReturnTarget name stmts vector srt
(False, False) -> rET_VEC_SMALL
(std_info, extra_bits) =
mkRetInfoTable liveness srt_info cl_type vector
mkRetInfoTable info_lbl liveness srt_info cl_type vector
; blks <- cgStmtsToBlocks stmts
; emitInfoTableAndCode info_lbl std_info extra_bits args blks
......@@ -241,15 +253,16 @@ emitReturnTarget name stmts vector srt
mkRetInfoTable
:: Liveness -- liveness
:: CLabel -- info label
-> Liveness -- liveness
-> C_SRT -- SRT Info
-> Int -- type (eg. rET_SMALL)
-> [CmmLit] -- vector
-> ([CmmLit],[CmmLit])
mkRetInfoTable liveness srt_info cl_type vector
mkRetInfoTable info_lbl liveness srt_info cl_type vector
= (std_info, extra_bits)
where
(srt_label, srt_len) = srtLabelAndLength srt_info
(srt_label, srt_len) = srtLabelAndLength srt_info info_lbl
srt_slot | need_srt = [srt_label]
| otherwise = []
......@@ -259,9 +272,9 @@ mkRetInfoTable liveness srt_info cl_type vector
-- an SRT slot, so that the vector table is at a
-- known offset from the info pointer
liveness_lit = mkLivenessCLit liveness
liveness_lit = makeRelativeRefTo info_lbl $ mkLivenessCLit liveness
std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit
extra_bits = srt_slot ++ vector
extra_bits = srt_slot ++ map (makeRelativeRefTo info_lbl) vector
emitDirectReturnTarget
......@@ -292,11 +305,15 @@ emitAlgReturnTarget name branches mb_deflt srt ret_conv
-- global labels, so we can't use them at the 'call site'
VectoredReturn fam_sz -> do
{ tagged_lbls <- mapFCs emit_alt branches
; deflt_lbl <- emit_deflt mb_deflt
{ let tagged_lbls = zip (map fst branches) $
map (CmmLabel . mkAltLabel uniq . fst) branches
deflt_lbl | isJust mb_deflt = CmmLabel $ mkDefaultLabel uniq
| otherwise = mkIntCLit 0
; let vector = [ assocDefault deflt_lbl tagged_lbls i
| i <- [0..fam_sz-1]]
; lbl <- emitReturnTarget name noCgStmts vector srt
; mapFCs emit_alt branches
; emit_deflt mb_deflt
; return (lbl, Just (tagged_lbls, deflt_lbl)) }
where
uniq = getUnique name
......@@ -331,9 +348,8 @@ emitVectoredReturnInstr :: CmmExpr -- *Zero-indexed* constructor tag
-> Code
emitVectoredReturnInstr zero_indexed_tag
= do { info_amode <- getSequelAmode
; let slot = vectorSlot info_amode zero_indexed_tag
; stmtC (CmmJump (CmmLoad slot wordRep) []) }
; let target = retVec info_amode zero_indexed_tag
; stmtC (CmmJump target []) }
-------------------------------------------------------------------------
......@@ -532,7 +548,31 @@ getSRTInfo id (SRT off len bmp)
srt_escape = (-1) :: StgHalfWord
srtLabelAndLength :: C_SRT -> (CmmLit, StgHalfWord)
srtLabelAndLength NoC_SRT = (zeroCLit, 0)
srtLabelAndLength (C_SRT lbl off bitmap) = (cmmLabelOffW lbl off, bitmap)
srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
srtLabelAndLength NoC_SRT _
= (zeroCLit, 0)
srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
= (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
-------------------------------------------------------------------------
--
-- Position independent code
--
-------------------------------------------------------------------------
-- In order to support position independent code, we mustn't put absolute
-- references into read-only space. Info tables in the tablesNextToCode
-- case must be in .text, which is read-only, so we doctor the CmmLits
-- to use relative offsets instead.
-- Note that this is done even when the -fPIC flag is not specified,
-- as we want to keep binary compatibility between PIC and non-PIC.
makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
makeRelativeRefTo info_lbl (CmmLabel lbl)
| tablesNextToCode
= CmmLabelDiffOff lbl info_lbl 0
makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
| tablesNextToCode
= CmmLabelDiffOff lbl info_lbl off
makeRelativeRefTo _ lit = lit
......@@ -93,7 +93,8 @@ module CmdLineOpts (
opt_OmitBlackHoling,
opt_Static,
opt_Unregisterised,
opt_EmitExternalCore
opt_EmitExternalCore,
opt_PIC
) where
#include "HsVersions.h"
......@@ -832,6 +833,8 @@ opt_EmitExternalCore = lookUp FSLIT("-fext-core")
-- Include full span info in error messages, instead of just the start position.
opt_ErrorSpans = lookUp FSLIT("-ferror-spans")
opt_PIC = lookUp FSLIT("-fPIC")
\end{code}
%************************************************************************
......@@ -874,7 +877,8 @@ isStaticHscFlag f =
"frule-check",
"frules-off",
"fcpr-off",
"ferror-spans"
"ferror-spans",
"fPIC"
]
|| any (flip prefixMatch f) [
"fcontext-stack",
......
......@@ -621,11 +621,20 @@ machdepCCOpts
-- for "normal" programs, but it doesn't support register variable
-- declarations.
-- -mdynamic-no-pic:
-- As we don't support haskell code in shared libraries anyway,
-- we might as well turn of PIC code generation and save space and time.
-- This is completely optional.
= return ( ["-no-cpp-precomp","-mdynamic-no-pic"], [] )
-- Turn off PIC code generation to save space and time.
-- -fno-common:
-- Don't generate "common" symbols - these are unwanted
-- in dynamic libraries.
= if opt_PIC
then return ( ["-no-cpp-precomp", "-fno-common"],
["-fno-common"] )
else return ( ["-no-cpp-precomp", "-mdynamic-no-pic"],
["-mdynamic-no-pic"] )
| prefixMatch "powerpc" cTARGETPLATFORM && opt_PIC
= return ( ["-fPIC"], ["-fPIC"] )
| otherwise
= return ( [], [] )
......
......@@ -19,11 +19,12 @@ import PprMach
import RegisterAlloc
import RegAllocInfo ( jumpDests )
import NCGMonad
import PositionIndependentCode
import Cmm
import PprCmm ( pprStmt, pprCmms )
import MachOp
import CLabel ( CLabel, mkSplitMarkerLabel )
import CLabel ( CLabel, mkSplitMarkerLabel, mkAsmTempLabel )
#if powerpc_TARGET_ARCH
import CLabel ( mkRtsCodeLabel )
#endif
......@@ -32,13 +33,13 @@ import UniqFM
import Unique ( Unique, getUnique )
import UniqSupply
import FastTypes
#if darwin_TARGET_OS
import PprMach ( pprDyldSymbolStub )
import List ( group, sort )
#if darwin_TARGET_OS || (powerpc_TARGET_ARCH && linux_TARGET_OS)
import List ( groupBy, sortBy )
import CLabel ( pprCLabel )
#endif
import ErrUtils ( dumpIfSet_dyn )
import CmdLineOpts ( DynFlags, DynFlag(..), dopt, opt_Static,
opt_EnsureSplittableC )
opt_EnsureSplittableC, opt_PIC )
import Digraph
import qualified Pretty
......@@ -112,21 +113,10 @@ The machine-dependent bits break down as follows:
nativeCodeGen :: DynFlags -> [Cmm] -> UniqSupply -> IO Pretty.Doc
nativeCodeGen dflags cmms us
| not opt_Static
= panic "NCG does not handle dynamic libraries right now"
-- ToDo: MachCodeGen used to have derefDLL function which expanded
-- dynamic CLabels (labelDynamic lbl == True) into the appropriate
-- dereferences. This should be done in the pre-NCG cmmToCmm pass instead.
-- It doesn't apply to static data, of course. There are hacks so that
-- the RTS knows what to do for references to closures in a DLL in SRTs,
-- and we never generate a reference to a closure in another DLL in a
-- static constructor.
| otherwise
= let ((ppr_cmms, insn_sdoc, imports), _) = initUs us $
cgCmm (concat (map add_split cmms))
cgCmm :: [CmmTop] -> UniqSM (Cmm, Pretty.Doc, [(Bool, CLabel)])
cgCmm :: [CmmTop] -> UniqSM (Cmm, Pretty.Doc, [CLabel])
cgCmm tops =
lazyMapUs (cmmNativeGen dflags) tops `thenUs` \ results ->
let (cmms,docs,imps) = unzip3 results in
......@@ -143,11 +133,28 @@ nativeCodeGen dflags cmms us
split_marker = CmmProc [] mkSplitMarkerLabel [] []
#if darwin_TARGET_OS
#if darwin_TARGET_OS || (powerpc_TARGET_ARCH && linux_TARGET_OS)
-- Generate "symbol stubs" for all external symbols that might
-- come from a dynamic library.
dyld_stubs imps = Pretty.vcat $ map pprDyldSymbolStub $
map head $ group $ sort imps
{- dyld_stubs imps = Pretty.vcat $ map pprDyldSymbolStub $
map head $ group $ sort imps-}
-- (Hack) sometimes two Labels pretty-print the same, but have
-- different uniques; so we compare their text versions...
dyld_stubs imps
| needImportedSymbols
= Pretty.vcat $
(pprGotDeclaration :) $
map (pprImportedSymbol . fst . head) $
groupBy (\(_,a) (_,b) -> a == b) $
sortBy (\(_,a) (_,b) -> compare a b) $
map doPpr $
imps
| otherwise
= Pretty.empty
where doPpr lbl = (lbl, Pretty.render $ pprCLabel lbl astyle)
astyle = mkCodeStyle AsmStyle
#else
dyld_stubs imps = Pretty.empty
#endif
......@@ -169,17 +176,17 @@ nativeCodeGen dflags cmms us
-- Complete native code generation phase for a single top-level chunk
-- of Cmm.
cmmNativeGen :: DynFlags -> CmmTop -> UniqSM (CmmTop, Pretty.Doc, [(Bool,CLabel)])
cmmNativeGen :: DynFlags -> CmmTop -> UniqSM (CmmTop, Pretty.Doc, [CLabel])
cmmNativeGen dflags cmm
= {-# SCC "fixAssigns" #-}
fixAssignsTop cmm `thenUs` \ fixed_cmm ->
{-# SCC "genericOpt" #-}
cmmToCmm fixed_cmm `bind` \ cmm ->
cmmToCmm fixed_cmm `bind` \ (cmm, imports) ->
(if dopt Opt_D_dump_opt_cmm dflags -- space leak avoidance
then cmm
else CmmData Text []) `bind` \ ppr_cmm ->
{-# SCC "genMachCode" #-}
genMachCode cmm `thenUs` \ (pre_regalloc, imports) ->
genMachCode cmm `thenUs` \ (pre_regalloc, lastMinuteImports) ->
{-# SCC "regAlloc" #-}
map regAlloc pre_regalloc `bind` \ with_regs ->
{-# SCC "sequenceBlocks" #-}
......@@ -189,7 +196,7 @@ cmmNativeGen dflags cmm
{-# SCC "vcat" #-}
Pretty.vcat (map pprNatCmmTop final_mach_code) `bind` \ final_sdoc ->
returnUs (ppr_cmm, final_sdoc Pretty.$$ Pretty.text "", imports)
returnUs (ppr_cmm, final_sdoc Pretty.$$ Pretty.text "", lastMinuteImports ++ imports)
where
x86fp_kludge :: NatCmmTop -> NatCmmTop
x86fp_kludge top@(CmmData _ _) = top
......@@ -279,7 +286,7 @@ reorder id accum (b@(block,id',out) : rest)
-- Switching between the two monads whilst carrying along the same
-- Unique supply breaks abstraction. Is that bad?
genMachCode :: CmmTop -> UniqSM ([NatCmmTop], [(Bool,CLabel)])
genMachCode :: CmmTop -> UniqSM ([NatCmmTop], [CLabel])
genMachCode cmm_top initial_us
= let initial_st = mkNatM_State initial_us 0
......@@ -323,7 +330,7 @@ fixAssign (CmmAssign (CmmGlobal BaseReg) src)
fixAssign (CmmAssign (CmmGlobal reg) src)
| Left realreg <- reg_or_addr
= returnUs [CmmAssign (CmmGlobal reg) (cmmExprConFold src)]
= returnUs [CmmAssign (CmmGlobal reg) src]
| Right baseRegAddr <- reg_or_addr