module LlvmMangler ( llvmFixupAsm ) where
import Data.ByteString.Char8 ( ByteString )
import qualified Data.ByteString.Char8 as BS
import LlvmCodeGen.Ppr ( infoSection, iTableSuf )
import Util
newSection, oldSection, functionSuf, tableSuf, funDivider, eol :: ByteString
newSection = BS.pack "\n.text\n"
oldSection = BS.pack infoSection
functionSuf = BS.pack $ if ghciTablesNextToCode then "_info:" else "\n_"
tableSuf = BS.pack $ "_info" ++ iTableSuf ++ ":"
funDivider = BS.pack "\n\n"
eol = BS.pack "\n"
eolPred, dollarPred, commaPred :: Char -> Bool
eolPred = ((==) '\n')
dollarPred = ((==) '$')
commaPred = ((==) ',')
llvmFixupAsm :: FilePath -> FilePath -> IO ()
llvmFixupAsm f1 f2 = do
asm <- BS.readFile f1
BS.writeFile f2 BS.empty
allTables f2 asm
return ()
allTables :: FilePath -> ByteString -> IO ()
allTables f str = do
rem <- oneTable f str
if BS.null rem
then return ()
else allTables f rem
oneTable :: FilePath -> ByteString -> IO ByteString
oneTable f str =
let last' xs = if (null xs) then 0 else last xs
(bl, al) = BS.breakSubstring functionSuf str
start = last' $ BS.findSubstrings funDivider bl
(before, fheader) = BS.splitAt start bl
(fun, after) = BS.breakSubstring funDivider al
label = snd $ BS.breakEnd eolPred bl
ilabel = label `BS.append` tableSuf
(bit, itable) = BS.breakSubstring ilabel after
(itable', ait) = BS.breakSubstring funDivider itable
istart = last' $ BS.findSubstrings funDivider bit
(bit', iheader) = BS.splitAt istart bit
fun' = fixupStack fun BS.empty
fheader' = replaceSection fheader
iheader' = replaceSection iheader
function = [before, eol, iheader', itable', eol, fheader', fun', eol]
remainder = bit' `BS.append` ait
in if BS.null al
then do
BS.appendFile f bl
return BS.empty
else if ghciTablesNextToCode
then if BS.null itable
then error $ "Function without matching info table! ("
++ (BS.unpack label) ++ ")"
else do
mapM_ (BS.appendFile f) function
return remainder
else do
mapM_ (BS.appendFile f) [before, fheader, fun']
return after
replaceSection :: ByteString -> ByteString
replaceSection sec =
let (s1, s2) = BS.breakSubstring oldSection sec
s1' = fst $ BS.breakEnd eolPred s1
s2' = snd $ BS.break eolPred s2
in s1' `BS.append` newSection `BS.append` s2'
fixupStack :: ByteString -> ByteString -> ByteString
fixupStack fun nfun | BS.null nfun =
let
(a, b) = BS.breakSubstring (BS.pack ", %esp\n") fun
(a', num) = BS.breakEnd dollarPred a
num' = BS.pack $ show (read (BS.unpack num) + 4::Int)
fix = a' `BS.append` num'
in if BS.null b
then nfun `BS.append` a
else fixupStack b (nfun `BS.append` fix)
fixupStack fun nfun =
let
(a, b) = BS.breakSubstring (BS.pack "jmp") fun
labelJump = BS.index b 4 == 'L'
(jmp, b') = BS.break eolPred b
(a', numx) = BS.breakEnd dollarPred a
(num, x) = BS.break commaPred numx
num' = BS.pack $ show (read (BS.unpack num) + 4::Int)
fix = a' `BS.append` num' `BS.append` x `BS.append` jmp
in if BS.null b
then nfun `BS.append` a
else if labelJump
then fixupStack b' (nfun `BS.append` a `BS.append` jmp)
else fixupStack b' (nfun `BS.append` fix)