1 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
3 -- -----------------------------------------------------------------------------
6 -- This script processes the assembly produced by LLVM, rearranging the code
7 -- so that an info table appears before its corresponding function. We also
8 -- use it to fix up the stack alignment, which needs to be 16 byte aligned
9 -- but always ends up off by 4 bytes because GHC sets it to the wrong starting
12 -- We only need this for Mac OS X, other targets don't use it.
15 module LlvmMangler ( llvmFixupAsm ) where
17 import Data.ByteString.Char8 ( ByteString )
18 import qualified Data.ByteString.Char8 as BS
20 import LlvmCodeGen.Ppr ( infoSection, iTableSuf )
25 newSection, oldSection, functionSuf, tableSuf, funDivider, eol :: ByteString
26 newSection = BS.pack "\n.text\n"
27 oldSection = BS.pack infoSection
28 functionSuf = BS.pack $ if ghciTablesNextToCode then "_info:" else "\n_"
29 tableSuf = BS.pack $ "_info" ++ iTableSuf ++ ":"
30 funDivider = BS.pack "\n\n"
34 eolPred, dollarPred, commaPred :: Char -> Bool
36 dollarPred = ((==) '$')
37 commaPred = ((==) ',')
39 -- | Read in assembly file and process
40 llvmFixupAsm :: FilePath -> FilePath -> IO ()
41 llvmFixupAsm f1 f2 = do
43 BS.writeFile f2 BS.empty
47 -- | Run over whole assembly file
48 allTables :: FilePath -> ByteString -> IO ()
56 Look for the next function that needs to have its info table
57 arranged to be before it and process it. This will print out
58 any code before this function, then the info table, then the
59 function. It will return the remainder of the assembly code
62 We rely here on the fact that LLVM prints all global variables
63 at the end of the file, so an info table will always appear
66 To try to help explain the string searches, here is some
67 assembly code that would be processed by this program, with
68 split markers placed in it like so, <split marker>:
75 .globl _Main_main_info
76 _Main_main<bl|al>_info:
88 .global _Main_main_entry
90 <bit|itable>_Main_main_entry:
96 oneTable :: FilePath -> ByteString -> IO ByteString
98 let last' xs = if (null xs) then 0 else last xs
101 (bl, al) = BS.breakSubstring functionSuf str
102 start = last' $ BS.findSubstrings funDivider bl
103 (before, fheader) = BS.splitAt start bl
104 (fun, after) = BS.breakSubstring funDivider al
105 label = snd $ BS.breakEnd eolPred bl
107 -- get the info table
108 ilabel = label `BS.append` tableSuf
109 (bit, itable) = BS.breakSubstring ilabel after
110 (itable', ait) = BS.breakSubstring funDivider itable
111 istart = last' $ BS.findSubstrings funDivider bit
112 (bit', iheader) = BS.splitAt istart bit
114 -- fixup stack alignment
115 fun' = fixupStack fun BS.empty
118 fheader' = replaceSection fheader
119 iheader' = replaceSection iheader
121 function = [before, eol, iheader', itable', eol, fheader', fun', eol]
122 remainder = bit' `BS.append` ait
128 else if ghciTablesNextToCode
129 then if BS.null itable
130 then error $ "Function without matching info table! ("
131 ++ (BS.unpack label) ++ ")"
133 mapM_ (BS.appendFile f) function
137 -- TNTC not turned on so just fix up stack
138 mapM_ (BS.appendFile f) [before, fheader, fun']
141 -- | Replace the current section in a function or table header with the
142 -- text section specifier.
143 replaceSection :: ByteString -> ByteString
145 let (s1, s2) = BS.breakSubstring oldSection sec
146 s1' = fst $ BS.breakEnd eolPred s1
147 s2' = snd $ BS.break eolPred s2
148 in s1' `BS.append` newSection `BS.append` s2'
151 -- | Mac OS X requires that the stack be 16 byte aligned when making a function
152 -- call (only really required though when making a call that will pass through
153 -- the dynamic linker). During code generation we marked any points where we
154 -- make a call that requires this alignment. The alignment isn't correctly
155 -- generated by LLVM as LLVM rightly assumes that the stack wil be aligned to
156 -- 16n + 12 on entry (since the function call was 16 byte aligned and the return
157 -- address should have been pushed, so sub 4). GHC though since it always uses
158 -- jumps keeps the stack 16 byte aligned on both function calls and function
159 -- entry. We correct LLVM's alignment then by putting inline assembly in that
160 -- subtracts and adds 4 to the sp as required.
161 fixupStack :: ByteString -> ByteString -> ByteString
162 fixupStack fun nfun | BS.null nfun =
164 (a, b) = BS.breakSubstring (BS.pack ", %esp\n") fun
165 (a', num) = BS.breakEnd dollarPred a
166 num' = BS.pack $ show (read (BS.unpack num) + 4::Int)
167 fix = a' `BS.append` num'
169 then nfun `BS.append` a
170 else fixupStack b (nfun `BS.append` fix)
172 fixupStack fun nfun =
174 (a, b) = BS.breakSubstring (BS.pack "jmp") fun
175 -- We need to avoid processing jumps to labels, they are of the form:
176 -- jmp\tL..., jmp\t_f..., jmpl\t_f..., jmpl\t*%eax...
177 labelJump = BS.index b 4 == 'L'
178 (jmp, b') = BS.break eolPred b
179 (a', numx) = BS.breakEnd dollarPred a
180 (num, x) = BS.break commaPred numx
181 num' = BS.pack $ show (read (BS.unpack num) + 4::Int)
182 fix = a' `BS.append` num' `BS.append` x `BS.append` jmp
184 then nfun `BS.append` a
186 then fixupStack b' (nfun `BS.append` a `BS.append` jmp)
187 else fixupStack b' (nfun `BS.append` fix)