projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Merge branch 'master' of http://darcs.haskell.org/ghc into ghc-generics
[ghc-hetmet.git]
/
compiler
/
llvmGen
/
LlvmMangler.hs
diff --git
a/compiler/llvmGen/LlvmMangler.hs
b/compiler/llvmGen/LlvmMangler.hs
index
7f1c786
..
ac187e0
100644
(file)
--- a/
compiler/llvmGen/LlvmMangler.hs
+++ b/
compiler/llvmGen/LlvmMangler.hs
@@
-24,11
+24,12
@@
infoSec = B.pack "\t.section\t__STRIP,__me"
newInfoSec = B.pack "\n\t.text"
newLine = B.pack "\n"
spInst = B.pack ", %esp\n"
newInfoSec = B.pack "\n\t.text"
newLine = B.pack "\n"
spInst = B.pack ", %esp\n"
-jmpInst = B.pack "jmp"
+jmpInst = B.pack "\n\tjmp"
-infoLen, spFix :: Int
+infoLen, spFix, labelStart :: Int
infoLen = B.length infoSec
spFix = 4
infoLen = B.length infoSec
spFix = 4
+labelStart = B.length jmpInst
-- Search Predicates
eolPred, dollarPred, commaPred :: Char -> Bool
-- Search Predicates
eolPred, dollarPred, commaPred :: Char -> Bool
@@
-107,15
+108,19
@@
fixupStack f f' | B.null f' =
fixupStack f f' =
let -- fixup add ops
(a, c) = B.breakSubstring jmpInst f
fixupStack f f' =
let -- fixup add ops
(a, c) = B.breakSubstring jmpInst f
- (l, b) = B.break eolPred c
+ -- we matched on a '\n' so go past it
+ (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
(a', n) = B.breakEnd dollarPred a
(n', x) = B.break commaPred n
num = B.pack $ show $ readInt n' + spFix
+ -- We need to avoid processing jumps to labels, they are of the form:
+ -- jmp\tL..., jmp\t_f..., jmpl\t_f..., jmpl\t*%eax..., jmpl *L...
+ targ = B.dropWhile ((==)'*') $ B.drop 1 $ B.dropWhile ((/=)'\t') $
+ B.drop labelStart c
in if B.null c
then f' `B.append` f
in if B.null c
then f' `B.append` f
- -- We need to avoid processing jumps to labels, they are of the form:
- -- jmp\tL..., jmp\t_f..., jmpl\t_f..., jmpl\t*%eax...
- else if B.index c 4 == 'L'
+ else if B.head targ == '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
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
@@
-123,6
+128,6
@@
fixupStack f f' =
-- | read an int or error
readInt :: B.ByteString -> Int
readInt str | B.all isDigit str = (read . B.unpack) str
-- | read an int or error
readInt :: B.ByteString -> Int
readInt str | B.all isDigit str = (read . B.unpack) str
- | otherwise = error $ "LLvmMangler Cannot read" ++ show str
+ | otherwise = error $ "LLvmMangler Cannot read" ++ show str
++ "as it's not an Int"
++ "as it's not an Int"