module LlvmMangler ( llvmFixupAsm ) where
import Control.Exception
import qualified Data.ByteString.Char8 as B
import Data.Char
import qualified Data.IntMap as I
import System.IO
infoSec, newInfoSec, newLine, spInst, jmpInst :: B.ByteString
infoSec = B.pack "\t.section\t__STRIP,__me"
newInfoSec = B.pack "\n\t.text"
newLine = B.pack "\n"
spInst = B.pack ", %esp\n"
jmpInst = B.pack "\n\tjmp"
infoLen, spFix, labelStart :: Int
infoLen = B.length infoSec
spFix = 4
labelStart = B.length jmpInst + 1
eolPred, dollarPred, commaPred :: Char -> Bool
eolPred = ((==) '\n')
dollarPred = ((==) '$')
commaPred = ((==) ',')
llvmFixupAsm :: FilePath -> FilePath -> IO ()
llvmFixupAsm f1 f2 = do
r <- openBinaryFile f1 ReadMode
w <- openBinaryFile f2 WriteMode
fixTables r w I.empty
B.hPut w (B.pack "\n\n")
hClose r
hClose w
return ()
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)
| even n = ([], I.insert n fun' m)
| otherwise = case I.lookup (n+1) m of
Just xf' -> ([fun',xf'], m)
Nothing -> ([fun'], m)
in mapM_ (B.hPut w) bs >> fixTables r w m'
getFun :: Handle -> B.ByteString -> IO B.ByteString
getFun r f = do
l <- (try (B.hGetLine r))::IO (Either IOError B.ByteString)
case l of
Right l' | B.null l' -> return f
| otherwise -> getFun r (f `B.append` newLine `B.append` l')
Left _ -> return B.empty
fixupStack :: B.ByteString -> B.ByteString -> B.ByteString
fixupStack f f' | B.null f' =
let
(a, c) = B.breakSubstring spInst f
(b, n) = B.breakEnd dollarPred a
num = B.pack $ show $ readInt n + spFix
in if B.null c
then f' `B.append` f
else fixupStack c $ f' `B.append` b `B.append` num
fixupStack f f' =
let
(a, c) = B.breakSubstring jmpInst f
(l', b) = B.break eolPred $ B.tail c
l = (B.head c) `B.cons` l'
(a', n) = B.breakEnd dollarPred a
(n', x) = B.break commaPred n
num = B.pack $ show $ readInt n' + spFix
in if B.null c
then f' `B.append` f
else if B.index c labelStart == 'L'
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
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"