-- 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/CodingStyle#Warnings
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module PositionIndependentCode (
initializePicBase
) where
+#include "HsVersions.h"
+
{-
This module handles generation of position independent code and
dynamic-linking related issues for the native code generator.
by GCC are left intact by the mangler (so far only on ppc-darwin
and ppc-linux).
-}
-
-#include "HsVersions.h"
+
#include "nativeGen/NCG.h"
import Cmm
-import MachOp ( MachOp(MO_Add), wordRep, MachRep(..) )
import CLabel ( CLabel, pprCLabel,
mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
dynamicLinkerLabelInfo, mkPicBaseLabel,
import CLabel ( mkForeignLabel )
#endif
-import MachRegs
-import MachInstrs
+import Regs
+import Instrs
import NCGMonad ( NatM, getNewRegNat, getNewLabelNat )
import StaticFlags ( opt_PIC, opt_Static )
+import BasicTypes
import Pretty
import qualified Outputable
import Panic ( panic )
import DynFlags
+import FastString
-- The most important function here is cmmMakeDynamicReference.
AccessViaSymbolPtr -> do
let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
addImport symbolPtr
- return $ CmmLoad (cmmMakePicReference symbolPtr) wordRep
+ return $ CmmLoad (cmmMakePicReference symbolPtr) bWord
AccessDirectly -> case referenceKind of
-- for data, we might have to make some calculations:
DataReference -> return $ cmmMakePicReference lbl
-- everything gets relocated at runtime
cmmMakePicReference lbl
- | (opt_PIC || not opt_Static) && absoluteLabel lbl = CmmMachOp (MO_Add wordRep) [
+ | (opt_PIC || not opt_Static) && absoluteLabel lbl = CmmMachOp (MO_Add wordWidth) [
CmmReg (CmmGlobal PicBaseReg),
CmmLit $ picRelative lbl
]
pprGotDeclaration
| opt_PIC
= vcat [
- ptext SLIT(".section __TEXT,__textcoal_nt,coalesced,no_toc"),
- ptext SLIT(".weak_definition ___i686.get_pc_thunk.ax"),
- ptext SLIT(".private_extern ___i686.get_pc_thunk.ax"),
- ptext SLIT("___i686.get_pc_thunk.ax:"),
- ptext SLIT("\tmovl (%esp), %eax"),
- ptext SLIT("\tret")
+ ptext (sLit ".section __TEXT,__textcoal_nt,coalesced,no_toc"),
+ ptext (sLit ".weak_definition ___i686.get_pc_thunk.ax"),
+ ptext (sLit ".private_extern ___i686.get_pc_thunk.ax"),
+ ptext (sLit "___i686.get_pc_thunk.ax:"),
+ ptext (sLit "\tmovl (%esp), %eax"),
+ ptext (sLit "\tret")
]
| otherwise = Pretty.empty
#else
= case opt_PIC of
False ->
vcat [
- ptext SLIT(".symbol_stub"),
- ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
- ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
- ptext SLIT("\tlis r11,ha16(L") <> pprCLabel_asm lbl
- <> ptext SLIT("$lazy_ptr)"),
- ptext SLIT("\tlwz r12,lo16(L") <> pprCLabel_asm lbl
- <> ptext SLIT("$lazy_ptr)(r11)"),
- ptext SLIT("\tmtctr r12"),
- ptext SLIT("\taddi r11,r11,lo16(L") <> pprCLabel_asm lbl
- <> ptext SLIT("$lazy_ptr)"),
- ptext SLIT("\tbctr")
+ ptext (sLit ".symbol_stub"),
+ ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$stub:"),
+ ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+ ptext (sLit "\tlis r11,ha16(L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$lazy_ptr)"),
+ ptext (sLit "\tlwz r12,lo16(L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$lazy_ptr)(r11)"),
+ ptext (sLit "\tmtctr r12"),
+ ptext (sLit "\taddi r11,r11,lo16(L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$lazy_ptr)"),
+ ptext (sLit "\tbctr")
]
True ->
vcat [
- ptext SLIT(".section __TEXT,__picsymbolstub1,")
- <> ptext SLIT("symbol_stubs,pure_instructions,32"),
- ptext SLIT("\t.align 2"),
- ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
- ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
- ptext SLIT("\tmflr r0"),
- ptext SLIT("\tbcl 20,31,L0$") <> pprCLabel_asm lbl,
- ptext SLIT("L0$") <> pprCLabel_asm lbl <> char ':',
- ptext SLIT("\tmflr r11"),
- ptext SLIT("\taddis r11,r11,ha16(L") <> pprCLabel_asm lbl
- <> ptext SLIT("$lazy_ptr-L0$") <> pprCLabel_asm lbl <> char ')',
- ptext SLIT("\tmtlr r0"),
- ptext SLIT("\tlwzu r12,lo16(L") <> pprCLabel_asm lbl
- <> ptext SLIT("$lazy_ptr-L0$") <> pprCLabel_asm lbl
- <> ptext SLIT(")(r11)"),
- ptext SLIT("\tmtctr r12"),
- ptext SLIT("\tbctr")
+ ptext (sLit ".section __TEXT,__picsymbolstub1,")
+ <> ptext (sLit "symbol_stubs,pure_instructions,32"),
+ ptext (sLit "\t.align 2"),
+ ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$stub:"),
+ ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+ ptext (sLit "\tmflr r0"),
+ ptext (sLit "\tbcl 20,31,L0$") <> pprCLabel_asm lbl,
+ ptext (sLit "L0$") <> pprCLabel_asm lbl <> char ':',
+ ptext (sLit "\tmflr r11"),
+ ptext (sLit "\taddis r11,r11,ha16(L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm lbl <> char ')',
+ ptext (sLit "\tmtlr r0"),
+ ptext (sLit "\tlwzu r12,lo16(L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm lbl
+ <> ptext (sLit ")(r11)"),
+ ptext (sLit "\tmtctr r12"),
+ ptext (sLit "\tbctr")
]
$+$ vcat [
- ptext SLIT(".lazy_symbol_pointer"),
- ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$lazy_ptr:"),
- ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
- ptext SLIT("\t.long dyld_stub_binding_helper")
+ ptext (sLit ".lazy_symbol_pointer"),
+ ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$lazy_ptr:"),
+ ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+ ptext (sLit "\t.long dyld_stub_binding_helper")
]
#elif i386_TARGET_ARCH
| Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
= case opt_PIC of
False ->
vcat [
- ptext SLIT(".symbol_stub"),
- ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
- ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
- ptext SLIT("\tjmp *L") <> pprCLabel_asm lbl
- <> ptext SLIT("$lazy_ptr"),
- ptext SLIT("L") <> pprCLabel_asm lbl
- <> ptext SLIT("$stub_binder:"),
- ptext SLIT("\tpushl $L") <> pprCLabel_asm lbl
- <> ptext SLIT("$lazy_ptr"),
- ptext SLIT("\tjmp dyld_stub_binding_helper")
+ ptext (sLit ".symbol_stub"),
+ ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$stub:"),
+ ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+ ptext (sLit "\tjmp *L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$lazy_ptr"),
+ ptext (sLit "L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$stub_binder:"),
+ ptext (sLit "\tpushl $L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$lazy_ptr"),
+ ptext (sLit "\tjmp dyld_stub_binding_helper")
]
True ->
vcat [
- ptext SLIT(".section __TEXT,__picsymbolstub2,")
- <> ptext SLIT("symbol_stubs,pure_instructions,25"),
- ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
- ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
- ptext SLIT("\tcall ___i686.get_pc_thunk.ax"),
- ptext SLIT("1:"),
- ptext SLIT("\tmovl L") <> pprCLabel_asm lbl
- <> ptext SLIT("$lazy_ptr-1b(%eax),%edx"),
- ptext SLIT("\tjmp *%edx"),
- ptext SLIT("L") <> pprCLabel_asm lbl
- <> ptext SLIT("$stub_binder:"),
- ptext SLIT("\tlea L") <> pprCLabel_asm lbl
- <> ptext SLIT("$lazy_ptr-1b(%eax),%eax"),
- ptext SLIT("\tpushl %eax"),
- ptext SLIT("\tjmp dyld_stub_binding_helper")
+ ptext (sLit ".section __TEXT,__picsymbolstub2,")
+ <> ptext (sLit "symbol_stubs,pure_instructions,25"),
+ ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$stub:"),
+ ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+ ptext (sLit "\tcall ___i686.get_pc_thunk.ax"),
+ ptext (sLit "1:"),
+ ptext (sLit "\tmovl L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$lazy_ptr-1b(%eax),%edx"),
+ ptext (sLit "\tjmp *%edx"),
+ ptext (sLit "L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$stub_binder:"),
+ ptext (sLit "\tlea L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$lazy_ptr-1b(%eax),%eax"),
+ ptext (sLit "\tpushl %eax"),
+ ptext (sLit "\tjmp dyld_stub_binding_helper")
]
- $+$ vcat [ ptext SLIT(".section __DATA, __la_sym_ptr")
+ $+$ vcat [ ptext (sLit ".section __DATA, __la_sym_ptr")
<> (if opt_PIC then int 2 else int 3)
- <> ptext SLIT(",lazy_symbol_pointers"),
- ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$lazy_ptr:"),
- ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
- ptext SLIT("\t.long L") <> pprCLabel_asm lbl
- <> ptext SLIT("$stub_binder")
+ <> ptext (sLit ",lazy_symbol_pointers"),
+ ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$lazy_ptr:"),
+ ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+ ptext (sLit "\t.long L") <> pprCLabel_asm lbl
+ <> ptext (sLit "$stub_binder")
]
#endif
-- We also have to declare our symbol pointers ourselves:
| Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
= vcat [
- ptext SLIT(".non_lazy_symbol_pointer"),
- char 'L' <> pprCLabel_asm lbl <> ptext SLIT("$non_lazy_ptr:"),
- ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
- ptext SLIT("\t.long\t0")
+ ptext (sLit ".non_lazy_symbol_pointer"),
+ char 'L' <> pprCLabel_asm lbl <> ptext (sLit "$non_lazy_ptr:"),
+ ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+ ptext (sLit "\t.long\t0")
]
| otherwise = empty
-- The label used to refer to our "fake GOT" from
-- position-independent code.
gotLabel = mkForeignLabel -- HACK: it's not really foreign
- FSLIT(".LCTOC1") Nothing False
+ (fsLit ".LCTOC1") Nothing False IsData
-- pprGotDeclaration
-- Output whatever needs to be output once per .s file.
pprGotDeclaration
| not opt_PIC = Pretty.empty
| otherwise = vcat [
- ptext SLIT(".section \".got2\",\"aw\""),
- ptext SLIT(".LCTOC1 = .+32768")
+ ptext (sLit ".section \".got2\",\"aw\""),
+ ptext (sLit ".LCTOC1 = .+32768")
]
-- We generate one .long/.quad literal for every symbol we import;
pprImportedSymbol importedLbl
| Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
= vcat [
- ptext SLIT(".section \".got2\", \"aw\""),
- ptext SLIT(".LC_") <> pprCLabel_asm lbl <> char ':',
+ ptext (sLit ".section \".got2\", \"aw\""),
+ ptext (sLit ".LC_") <> pprCLabel_asm lbl <> char ':',
ptext symbolSize <+> pprCLabel_asm lbl
]
--- PLT code stubs are generated automatically be the dynamic linker.
+-- PLT code stubs are generated automatically by the dynamic linker.
| otherwise = empty
where
- symbolSize = case wordRep of
- I32 -> SLIT("\t.long")
- I64 -> SLIT("\t.quad")
+ symbolSize = case wordWidth of
+ W32 -> sLit "\t.long"
+ W64 -> sLit "\t.quad"
_ -> panic "Unknown wordRep in pprImportedSymbol"
#else
-- call 1f
-- 1: popl %picReg
-initializePicBase picReg (CmmProc info lab params blocks : statics)
- = return (CmmProc info lab params (b':tail blocks) : statics)
+initializePicBase picReg (CmmProc info lab params (ListGraph blocks) : statics)
+ = return (CmmProc info lab params (ListGraph (b':tail blocks)) : statics)
where BasicBlock bID insns = head blocks
b' = BasicBlock bID (FETCHPC picReg : insns)
-- the (32-bit) offset from our local label to our global offset table
-- (.LCTOC1 aka gotOffLabel).
initializePicBase picReg
- (CmmProc info lab params blocks : statics)
+ (CmmProc info lab params (ListGraph blocks) : statics)
= do
gotOffLabel <- getNewLabelNat
- tmp <- getNewRegNat wordRep
+ tmp <- getNewRegNat $ intSize wordWidth
let
gotOffset = CmmData Text [
CmmDataLabel gotOffLabel,
(ImmCLbl mkPicBaseLabel)
BasicBlock bID insns = head blocks
b' = BasicBlock bID (FETCHPC picReg
- : LD wordRep tmp
+ : LD wordSize tmp
(AddrRegImm picReg offsetToOffset)
: ADD picReg picReg (RIReg tmp)
: insns)
- return (CmmProc info lab params (b' : tail blocks) : gotOffset : statics)
+ return (CmmProc info lab params (ListGraph (b' : tail blocks)) : gotOffset : statics)
#elif i386_TARGET_ARCH && linux_TARGET_OS
-- We cheat a bit here by defining a pseudo-instruction named FETCHGOT
-- addl __GLOBAL_OFFSET_TABLE__+.-1b, %picReg
-- (See PprMach.lhs)
-initializePicBase picReg (CmmProc info lab params blocks : statics)
- = return (CmmProc info lab params (b':tail blocks) : statics)
+initializePicBase picReg (CmmProc info lab params (ListGraph blocks) : statics)
+ = return (CmmProc info lab params (ListGraph (b':tail blocks)) : statics)
where BasicBlock bID insns = head blocks
b' = BasicBlock bID (FETCHGOT picReg : insns)
projects / ghc-hetmet.git / blobdiff