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 )
28 newSection, oldSection, functionSuf, tableSuf, funDivider, eol :: ByteString
29 newSection = BS.pack "\n.text\n"
30 oldSection = BS.pack infoSection
31 functionSuf = BS.pack $ if ghciTablesNextToCode then "_info:" else "\n_"
32 tableSuf = BS.pack $ "_info" ++ iTableSuf ++ ":"
33 funDivider = BS.pack "\n\n"
37 eolPred, dollarPred, commaPred :: Char -> Bool
39 dollarPred = ((==) '$')
40 commaPred = ((==) ',')
42 -- | Read in assembly file and process
43 llvmFixupAsm :: FilePath -> FilePath -> IO ()
44 llvmFixupAsm f1 f2 = do
46 BS.writeFile f2 BS.empty
50 -- | Run over whole assembly file
51 allTables :: FilePath -> ByteString -> IO ()
59 Look for the next function that needs to have its info table
60 arranged to be before it and process it. This will print out
61 any code before this function, then the info table, then the
62 function. It will return the remainder of the assembly code
65 We rely here on the fact that LLVM prints all global variables
66 at the end of the file, so an info table will always appear
69 To try to help explain the string searches, here is some
70 assembly code that would be processed by this program, with
71 split markers placed in it like so, <split marker>:
78 .globl _Main_main_info
79 _Main_main<bl|al>_info:
91 .global _Main_main_entry
93 <bit|itable>_Main_main_entry:
99 oneTable :: FilePath -> ByteString -> IO ByteString
101 let last' xs = if (null xs) then 0 else last xs
104 (bl, al) = BS.breakSubstring functionSuf str
105 start = last' $ BS.findSubstrings funDivider bl
106 (before, fheader) = BS.splitAt start bl
107 (fun, after) = BS.breakSubstring funDivider al
108 label = snd $ BS.breakEnd eolPred bl
110 -- get the info table
111 ilabel = label `BS.append` tableSuf
112 (bit, itable) = BS.breakSubstring ilabel after
113 (itable', ait) = BS.breakSubstring funDivider itable
114 istart = last' $ BS.findSubstrings funDivider bit
115 (bit', iheader) = BS.splitAt istart bit
117 -- fixup stack alignment
118 fun' = fixupStack fun BS.empty
121 fheader' = replaceSection fheader
122 iheader' = replaceSection iheader
124 function = [before, eol, iheader', itable', eol, fheader', fun', eol]
125 remainder = bit' `BS.append` ait
131 else if ghciTablesNextToCode
132 then if BS.null itable
133 then error $ "Function without matching info table! ("
134 ++ (BS.unpack label) ++ ")"
136 mapM_ (BS.appendFile f) function
140 -- TNTC not turned on so just fix up stack
141 mapM_ (BS.appendFile f) [before, fheader, fun']
144 -- | Replace the current section in a function or table header with the
145 -- text section specifier.
146 replaceSection :: ByteString -> ByteString
148 let (s1, s2) = BS.breakSubstring oldSection sec
149 s1' = fst $ BS.breakEnd eolPred s1
150 s2' = snd $ BS.break eolPred s2
151 in s1' `BS.append` newSection `BS.append` s2'
154 -- | Mac OS X requires that the stack be 16 byte aligned when making a function
155 -- call (only really required though when making a call that will pass through
156 -- the dynamic linker). During code generation we marked any points where we
157 -- make a call that requires this alignment. The alignment isn't correctly
158 -- generated by LLVM as LLVM rightly assumes that the stack wil be aligned to
159 -- 16n + 12 on entry (since the function call was 16 byte aligned and the return
160 -- address should have been pushed, so sub 4). GHC though since it always uses
161 -- jumps keeps the stack 16 byte aligned on both function calls and function
162 -- entry. We correct LLVM's alignment then by putting inline assembly in that
163 -- subtracts and adds 4 to the sp as required.
164 fixupStack :: ByteString -> ByteString -> ByteString
165 fixupStack fun nfun | BS.null nfun =
167 (a, b) = BS.breakSubstring (BS.pack ", %esp\n") fun
168 (a', strNum) = BS.breakEnd dollarPred a
169 Just num = readInt (BS.unpack strNum)
170 num' = BS.pack $ show (num + 4::Int)
171 fix = a' `BS.append` num'
173 then nfun `BS.append` a
174 else fixupStack b (nfun `BS.append` fix)
176 fixupStack fun nfun =
178 (a, b) = BS.breakSubstring (BS.pack "jmp") fun
179 -- We need to avoid processing jumps to labels, they are of the form:
180 -- jmp\tL..., jmp\t_f..., jmpl\t_f..., jmpl\t*%eax...
181 labelJump = BS.index b 4 == 'L'
182 (jmp, b') = BS.break eolPred b
183 (a', numx) = BS.breakEnd dollarPred a
184 (strNum, x) = BS.break commaPred numx
185 Just num = readInt (BS.unpack strNum)
186 num' = BS.pack $ show (num + 4::Int)
187 fix = a' `BS.append` num' `BS.append` x `BS.append` jmp
189 then nfun `BS.append` a
191 then fixupStack b' (nfun `BS.append` a `BS.append` jmp)
192 else fixupStack b' (nfun `BS.append` fix)
195 -- | 'read' is one of my least favourite functions.
196 readInt :: String -> Maybe Int
198 | not $ null $ filter (not . isDigit) str
199 = pprTrace "LLvmMangler"
200 (text "Cannot read" <+> text (show str) <+> text "as it's not an Int")