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 )
24 newSection, oldSection, functionSuf, tableSuf, funDivider, eol :: ByteString
25 newSection = BS.pack "\n.text\n"
26 oldSection = BS.pack infoSection
27 functionSuf = BS.pack "_info:"
28 tableSuf = BS.pack $ "_info" ++ iTableSuf ++ ":"
29 funDivider = BS.pack "\n\n"
33 eolPred, dollarPred, commaPred :: Char -> Bool
35 dollarPred = ((==) '$')
36 commaPred = ((==) ',')
38 -- | Read in assembly file and process
39 llvmFixupAsm :: FilePath -> FilePath -> IO ()
40 llvmFixupAsm f1 f2 = do
42 BS.writeFile f2 BS.empty
46 -- | Run over whole assembly file
47 allTables :: FilePath -> ByteString -> IO ()
55 Look for the next function that needs to have its info table
56 arranged to be before it and process it. This will print out
57 any code before this function, then the info table, then the
58 function. It will return the remainder of the assembly code
61 We rely here on the fact that LLVM prints all global variables
62 at the end of the file, so an info table will always appear
65 To try to help explain the string searches, here is some
66 assembly code that would be processed by this program, with
67 split markers placed in it like so, <split marker>:
74 .globl _Main_main_info
75 _Main_main<bl|al>_info:
87 .global _Main_main_entry
89 <bit|itable>_Main_main_entry:
95 oneTable :: FilePath -> ByteString -> IO ByteString
97 let last' xs = if (null xs) then 0 else last xs
100 (bl, al) = BS.breakSubstring functionSuf str
101 start = last' $ BS.findSubstrings funDivider bl
102 (before, fheader) = BS.splitAt start bl
103 (fun, after) = BS.breakSubstring funDivider al
104 label = snd $ BS.breakEnd eolPred bl
106 -- get the info table
107 ilabel = label `BS.append` tableSuf
108 (bit, itable) = BS.breakSubstring ilabel after
109 (itable', ait) = BS.breakSubstring funDivider itable
110 istart = last' $ BS.findSubstrings funDivider bit
111 (bit', iheader) = BS.splitAt istart bit
113 -- fixup stack alignment
114 fun' = fixupStack fun BS.empty
117 fheader' = replaceSection fheader
118 iheader' = replaceSection iheader
120 function = [before, eol, iheader', itable', eol, fheader', fun', eol]
121 remainder = bit' `BS.append` ait
127 else if BS.null itable
128 then error $ "Function without matching info table! ("
129 ++ (BS.unpack label) ++ ")"
132 mapM_ (BS.appendFile f) function
135 -- | Replace the current section in a function or table header with the
136 -- text section specifier.
137 replaceSection :: ByteString -> ByteString
139 let (s1, s2) = BS.breakSubstring oldSection sec
140 s1' = fst $ BS.breakEnd eolPred s1
141 s2' = snd $ BS.break eolPred s2
142 in s1' `BS.append` newSection `BS.append` s2'
145 -- | Mac OS X requires that the stack be 16 byte aligned when making a function
146 -- call (only really required though when making a call that will pass through
147 -- the dynamic linker). During code generation we marked any points where we
148 -- make a call that requires this alignment. The alignment isn't correctly
149 -- generated by LLVM as LLVM rightly assumes that the stack wil be aligned to
150 -- 16n + 12 on entry (since the function call was 16 byte aligned and the return
151 -- address should have been pushed, so sub 4). GHC though since it always uses
152 -- jumps keeps the stack 16 byte aligned on both function calls and function
153 -- entry. We correct LLVM's alignment then by putting inline assembly in that
154 -- subtracts and adds 4 to the sp as required.
155 fixupStack :: ByteString -> ByteString -> ByteString
156 fixupStack fun nfun | BS.null nfun =
158 (a, b) = BS.breakSubstring (BS.pack ", %esp\n") fun
159 (a', num) = BS.breakEnd dollarPred a
160 num' = BS.pack $ show (read (BS.unpack num) + 4::Int)
161 fix = a' `BS.append` num'
163 then nfun `BS.append` a
164 else fixupStack b (nfun `BS.append` fix)
166 fixupStack fun nfun =
168 (a, b) = BS.breakSubstring (BS.pack "jmp") fun
169 -- We need to avoid processing jumps to labels, they are of the form:
170 -- jmp\tL..., jmp\t_f..., jmpl\t_f..., jmpl\t*%eax...
171 labelJump = BS.index b 4 == 'L'
172 (jmp, b') = BS.break eolPred b
173 (a', numx) = BS.breakEnd dollarPred a
174 (num, x) = BS.break commaPred numx
175 num' = BS.pack $ show (read (BS.unpack num) + 4::Int)
176 fix = a' `BS.append` num' `BS.append` x `BS.append` jmp
178 then nfun `BS.append` a
180 then fixupStack b' (nfun `BS.append` a `BS.append` jmp)
181 else fixupStack b' (nfun `BS.append` fix)