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 ( [], [] )
......
This diff is collapsed.
This diff is collapsed.
......@@ -661,6 +661,10 @@ fPair other = pprPanic "fPair(sparc NCG)" (ppr other)
| CRNOR Int Int Int -- condition register nor
| MFCR Reg -- move from condition register
| MFLR Reg -- move from link register
| FETCHPC Reg -- pseudo-instruction:
-- bcl to next insn, mflr reg
condUnsigned GU = True
condUnsigned LU = True
condUnsigned GEU = True
......
......@@ -107,6 +107,8 @@ data Imm
| ImmIndex CLabel Int
| ImmFloat Rational
| ImmDouble Rational
| ImmConstantSum Imm Imm
| ImmConstantDiff Imm Imm
#if sparc_TARGET_ARCH
| LO Imm {- Possible restrictions... -}
| HI Imm
......@@ -115,10 +117,6 @@ data Imm
| LO Imm
| HI Imm
| HA Imm {- high halfword adjusted -}
#if darwin_TARGET_OS
-- special dyld (dynamic linker) things
| ImmDyldNonLazyPtr CLabel -- Llabel$non_lazy_ptr
#endif
#endif
strImmLit s = ImmLit (text s)
......@@ -128,6 +126,10 @@ litToImm (CmmFloat f F32) = ImmFloat f
litToImm (CmmFloat f F64) = ImmDouble f
litToImm (CmmLabel l) = ImmCLbl l
litToImm (CmmLabelOff l off) = ImmIndex l off
litToImm (CmmLabelDiffOff l1 l2 off)
= ImmConstantSum
(ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
(ImmInt off)
-- -----------------------------------------------------------------------------
-- Addressing modes
......
......@@ -13,6 +13,7 @@ module NCGMonad (
initNat, addImportNat, getUniqueNat,
mapAccumLNat, setDeltaNat, getDeltaNat,
getBlockIdNat, getNewLabelNat, getNewRegNat, getNewRegPairNat,
getPicBaseMaybeNat, getPicBaseNat
) where
#include "HsVersions.h"
......@@ -28,7 +29,8 @@ import Unique ( Unique )
data NatM_State = NatM_State {
natm_us :: UniqSupply,
natm_delta :: Int,
natm_imports :: [(Bool,CLabel)]
natm_imports :: [(CLabel)],
natm_pic :: Maybe Reg
}
newtype NatM result = NatM (NatM_State -> (result, NatM_State))
......@@ -36,7 +38,7 @@ newtype NatM result = NatM (NatM_State -> (result, NatM_State))
unNat (NatM a) = a
mkNatM_State :: UniqSupply -> Int -> NatM_State
mkNatM_State us delta = NatM_State us delta []
mkNatM_State us delta = NatM_State us delta [] Nothing
initNat :: NatM_State -> NatM a -> (a, NatM_State)
initNat init_st m = case unNat m init_st of { (r,st) -> (r,st) }
......@@ -66,20 +68,20 @@ mapAccumLNat f b (x:xs)
return (b__3, x__2:xs__2)
getUniqueNat :: NatM Unique
getUniqueNat = NatM $ \ (NatM_State us delta imports) ->
getUniqueNat = NatM $ \ (NatM_State us delta imports pic) ->
case splitUniqSupply us of
(us1,us2) -> (uniqFromSupply us1, (NatM_State us2 delta imports))
(us1,us2) -> (uniqFromSupply us1, (NatM_State us2 delta imports pic))
getDeltaNat :: NatM Int
getDeltaNat = NatM $ \ st -> (natm_delta st, st)
setDeltaNat :: Int -> NatM ()
setDeltaNat delta = NatM $ \ (NatM_State us _ imports) ->
((), NatM_State us delta imports)
setDeltaNat delta = NatM $ \ (NatM_State us _ imports pic) ->
((), NatM_State us delta imports pic)
addImportNat :: Bool -> CLabel -> NatM ()
addImportNat is_code imp = NatM $ \ (NatM_State us delta imports) ->
((), NatM_State us delta ((is_code,imp):imports))
addImportNat :: CLabel -> NatM ()
addImportNat imp = NatM $ \ (NatM_State us delta imports pic) ->
((), NatM_State us delta (imp:imports) pic)
getBlockIdNat :: NatM BlockId
getBlockIdNat = do u <- getUniqueNat; return (BlockId u)
......@@ -96,3 +98,14 @@ getNewRegPairNat rep = do
let lo = mkVReg u rep; hi = getHiVRegFromLo lo
return (lo,hi)
getPicBaseMaybeNat :: NatM (Maybe Reg)
getPicBaseMaybeNat = NatM (\state -> (natm_pic state, state))
getPicBaseNat :: MachRep -> NatM Reg
getPicBaseNat rep = do
mbPicBase <- getPicBaseMaybeNat
case mbPicBase of
Just picBase -> return picBase
Nothing -> do
reg <- getNewRegNat rep
NatM (\state -> (reg, state { natm_pic = Just reg }))
This diff is collapsed.
......@@ -15,9 +15,6 @@
module PprMach (
pprNatCmmTop, pprBasicBlock,
pprInstr, pprSize, pprUserReg,
#if darwin_TARGET_OS
pprDyldSymbolStub,
#endif
) where
......@@ -37,6 +34,8 @@ import Pretty
import FastString
import qualified Outputable
import CmdLineOpts ( opt_PIC )
#if __GLASGOW_HASKELL__ >= 504
import Data.Array.ST
import Data.Word ( Word8 )
......@@ -378,15 +377,17 @@ pprImm :: Imm -> Doc
pprImm (ImmInt i) = int i
pprImm (ImmInteger i) = integer i
pprImm (ImmCLbl l) = (if labelDynamic l then text "__imp_" else empty)
<> pprCLabel_asm l
pprImm (ImmIndex l i) = (if labelDynamic l then text "__imp_" else empty)
<> pprCLabel_asm l <> char '+' <> int i
pprImm (ImmCLbl l) = pprCLabel_asm l
pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
pprImm (ImmLit s) = s
pprImm (ImmFloat _) = panic "pprImm:ImmFloat"
pprImm (ImmDouble _) = panic "pprImm:ImmDouble"
pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
<> lparen <> pprImm b <> rparen
#if sparc_TARGET_ARCH
pprImm (LO i)
= hcat [ pp_lo, pprImm i, rparen ]
......@@ -415,9 +416,6 @@ pprImm (HA i)
where
pp_ha = text "ha16("
pprImm (ImmDyldNonLazyPtr lbl)
= ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$non_lazy_ptr")
#else
pprImm (LO i)
= pprImm i <> text "@l"
......@@ -643,7 +641,9 @@ pprInstr (COMMENT s)
= IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
,IF_ARCH_powerpc( ((<>) (ptext SLIT("; ")) (ftext s))
,IF_ARCH_powerpc( IF_OS_linux(
((<>) (ptext SLIT("# ")) (ftext s)),
((<>) (ptext SLIT("; ")) (ftext s)))
,))))
pprInstr (DELTA d)
......@@ -1958,9 +1958,8 @@ pprInstr (BCTR _) = hcat [
ptext SLIT("bctr")
]
pprInstr (BL lbl _) = hcat [
ptext SLIT("\tbl\tL"),
pprCLabel_asm lbl,
ptext SLIT("$stub")
ptext SLIT("\tbl\t"),
pprCLabel_asm lbl
]
pprInstr (BCTRL _) = hcat [
char '\t',
......@@ -2089,6 +2088,18 @@ pprInstr (MFCR reg) = hcat [
pprReg reg
]
pprInstr (MFLR reg) = hcat [
char '\t',
ptext SLIT("mflr"),
char '\t',
pprReg reg