From: David Terei Date: Mon, 2 May 2011 08:03:13 +0000 (-0700) Subject: LLVM: Support LLVM 2.9 (#5103) X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=50e0db459cb1b1341bbd527a3c450f0930e6ab43 LLVM: Support LLVM 2.9 (#5103) Instead of using the GNU As subsection feature on Linux/Windows for TNTC we now use the LLVM Mangler on all platforms. --- diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs index 911592b..9f25c08 100644 --- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs +++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs @@ -122,34 +122,25 @@ pprInfoTable env count lbl stat then Outputable.panic "LlvmCodeGen.Ppr: invalid info table!" else (pprLlvmData ([ldata'], ltypes), llvmUsed) + -- | We generate labels for info tables by converting them to the same label -- as for the entry code but adding this string as a suffix. iTableSuf :: String iTableSuf = "_itable" --- | Create an appropriate section declaration for subsection of text --- WARNING: This technique could fail as gas documentation says it only --- supports up to 8192 subsections per section. Inspection of the source --- code and some test programs seem to suggest it supports more than this --- so we are hoping it does. +-- | Create a specially crafted section declaration that encodes the order this +-- section should be in the final object code. +-- +-- The LlvmMangler.llvmFixupAsm pass over the assembly produced by LLVM uses +-- this section declaration to do its processing. mkLayoutSection :: Int -> LMSection mkLayoutSection n - -- On OSX we can't use the GNU Assembler, we must use the OSX assembler, which - -- doesn't support subsections. So we post process the assembly code, this - -- section specifier will be replaced with '.text' by the mangler. - = Just (fsLit $ infoSection ++ show n -#if darwin_TARGET_OS - ) -#else - ++ "#") -#endif + = Just (fsLit $ infoSection ++ show n) --- | The section we are putting info tables and their entry code into + +-- | The section we are putting info tables and their entry code into, should +-- be unique since we process the assembly pattern matching this. infoSection :: String -#if darwin_TARGET_OS -infoSection = "__STRIP,__me" -#else -infoSection = ".text; .text " -#endif +infoSection = "X98A__STRIP,__me" diff --git a/compiler/llvmGen/LlvmMangler.hs b/compiler/llvmGen/LlvmMangler.hs index 890f710..591ef81 100644 --- a/compiler/llvmGen/LlvmMangler.hs +++ b/compiler/llvmGen/LlvmMangler.hs @@ -1,19 +1,21 @@ +{-# OPTIONS -fno-warn-unused-binds #-} -- ----------------------------------------------------------------------------- -- | GHC LLVM Mangler -- -- This script processes the assembly produced by LLVM, rearranging the code --- so that an info table appears before its corresponding function. We also --- use it to fix up the stack alignment, which needs to be 16 byte aligned --- but always ends up off by 4 bytes because GHC sets it to the 'wrong' --- starting value in the RTS. +-- so that an info table appears before its corresponding function. -- --- We only need this for Mac OS X, other targets don't use it. +-- On OSX we also use it to fix up the stack alignment, which needs to be 16 +-- byte aligned but always ends up off by word bytes because GHC sets it to +-- the 'wrong' starting value in the RTS. -- module LlvmMangler ( llvmFixupAsm ) where #include "HsVersions.h" +import LlvmCodeGen.Ppr ( infoSection ) + import Control.Exception import qualified Data.ByteString.Char8 as B import Data.Char @@ -21,8 +23,9 @@ import qualified Data.IntMap as I import System.IO -- Magic Strings -infoSec, newInfoSec, newLine, spInst, jmpInst :: B.ByteString -infoSec = B.pack "\t.section\t__STRIP,__me" +secStmt, infoSec, newInfoSec, newLine, spInst, jmpInst :: B.ByteString +secStmt = B.pack "\t.section\t" +infoSec = B.pack infoSection newInfoSec = B.pack "\n\t.text" newLine = B.pack "\n" jmpInst = B.pack "\n\tjmp" @@ -58,25 +61,30 @@ llvmFixupAsm f1 f2 = do {- | Here we process the assembly file one function and data - defenition at a time. When a function is encountered that + definition at a time. When a function is encountered that should have a info table we store it in a map. Otherwise we print it. When an info table is found we retrieve its function from the map and print them both. For all functions we fix up the stack alignment. We also - fix up the section defenition for functions and info tables. + fix up the section definition for functions and info tables. -} fixTables :: Handle -> Handle -> I.IntMap B.ByteString -> IO () fixTables r w m = do f <- getFun r B.empty if B.null f then return () - else let fun = fixupStack f B.empty - (a,b) = B.breakSubstring infoSec fun - (x,c) = B.break eolPred b - fun' = a `B.append` newInfoSec `B.append` c - n = readInt $ B.drop infoLen x - (bs, m') | B.null b = ([fun], m) + else let fun = fixupStack f B.empty + (a,b) = B.breakSubstring infoSec fun + (a',s) = B.breakEnd eolPred a + -- We search for the section header in two parts as it makes + -- us portable across OS types and LLVM version types since + -- section names are wrapped differently. + secHdr = secStmt `B.isPrefixOf` s + (x,c) = B.break eolPred b + fun' = a' `B.append` newInfoSec `B.append` c + n = readInt $ B.takeWhile isDigit $ B.drop infoLen x + (bs, m') | B.null b || not secHdr = ([fun], m) | even n = ([], I.insert n fun' m) | otherwise = case I.lookup (n+1) m of Just xf' -> ([fun',xf'], m) @@ -96,7 +104,7 @@ getFun r f = do Mac OS X requires that the stack be 16 byte aligned when making a function call (only really required though when making a call that will pass through the dynamic linker). The alignment isn't correctly generated by LLVM as - LLVM rightly assumes that the stack wil be aligned to 16n + 12 on entry + LLVM rightly assumes that the stack will be aligned to 16n + 12 on entry (since the function call was 16 byte aligned and the return address should have been pushed, so sub 4). GHC though since it always uses jumps keeps the stack 16 byte aligned on both function calls and function entry. @@ -104,6 +112,11 @@ getFun r f = do We correct the alignment here. -} fixupStack :: B.ByteString -> B.ByteString -> B.ByteString + +#if !darwin_TARGET_OS +fixupStack = const + +#else fixupStack f f' | B.null f' = let -- fixup sub op (a, c) = B.breakSubstring spInst f @@ -132,10 +145,11 @@ fixupStack f f' = then fixupStack b $ f' `B.append` a `B.append` l else fixupStack b $ f' `B.append` a' `B.append` num `B.append` x `B.append` l +#endif --- | read an int or error +-- | Read an int or error readInt :: B.ByteString -> Int readInt str | B.all isDigit str = (read . B.unpack) str - | otherwise = error $ "LLvmMangler Cannot read" ++ show str - ++ "as it's not an Int" + | otherwise = error $ "LLvmMangler Cannot read " ++ show str + ++ " as it's not an Int" diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs index f6a9738..4702682 100644 --- a/compiler/main/DriverPhases.hs +++ b/compiler/main/DriverPhases.hs @@ -143,11 +143,7 @@ nextPhase (Hsc _) = HCc nextPhase SplitMangle = As nextPhase As = SplitAs nextPhase LlvmOpt = LlvmLlc -#if darwin_TARGET_OS nextPhase LlvmLlc = LlvmMangle -#else -nextPhase LlvmLlc = As -#endif nextPhase LlvmMangle = As nextPhase SplitAs = MergeStub nextPhase Ccpp = As diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 03e3cf6..a832034 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1307,22 +1307,18 @@ runPhase LlvmOpt input_fn dflags -- fix up some pretty big deficiencies in the code we generate llvmOpts = ["-mem2reg", "-O1", "-O2"] - ----------------------------------------------------------------------------- -- LlvmLlc phase runPhase LlvmLlc input_fn dflags = do let lc_opts = getOpts dflags opt_lc - let opt_lvl = max 0 (min 2 $ optLevel dflags) - let nphase = if cTargetOS == OSX - then LlvmMangle - else As - let rmodel | opt_PIC = "pic" + opt_lvl = max 0 (min 2 $ optLevel dflags) + rmodel | opt_PIC = "pic" | not opt_Static = "dynamic-no-pic" | otherwise = "static" - output_fn <- phaseOutputFilename nphase + output_fn <- phaseOutputFilename LlvmMangle io $ SysTools.runLlvmLlc dflags ([ SysTools.Option (llvmOpts !! opt_lvl), @@ -1331,13 +1327,13 @@ runPhase LlvmLlc input_fn dflags SysTools.Option "-o", SysTools.FileOption "" output_fn] ++ map SysTools.Option lc_opts) - return (nphase, output_fn) + return (LlvmMangle, output_fn) where + -- Bug in LLVM at O3 on OSX. llvmOpts = if cTargetOS == OSX then ["-O1", "-O2", "-O2"] else ["-O1", "-O2", "-O3"] - ----------------------------------------------------------------------------- -- LlvmMangle phase diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 97a6514..436cfa6 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -238,7 +238,7 @@ initSysTools mbMinusB ld_prog = gcc_prog ld_args = gcc_args - -- figure out llvm location. (TODO: Acutally implement). + -- We just assume on command line ; let lc_prog = "llc" lo_prog = "opt"