-oneTable :: FilePath -> ByteString -> IO ByteString
-oneTable f str =
- let last' xs = if (null xs) then 0 else last xs
-
- -- get the function
- (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
-
- -- get the info table
- 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
-
- -- fixup stack alignment
- fun' = fixupStack fun BS.empty
-
- -- fix up sections
- 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 BS.null itable
- then error $ "Function without matching info table! ("
- ++ (BS.unpack label) ++ ")"
-
- else do
- mapM_ (BS.appendFile f) function
- return remainder
-
--- | Replace the current section in a function or table header with the
--- text section specifier.
-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'
-
-
--- | Mac OS X requires that the stack be 16 byte aligned when making a function
--- call (only really required though when making a call that will pass through
--- the dynamic linker). During code generation we marked any points where we
--- make a call that requires this alignment. The alignment isn't correctly
--- generated by LLVM as LLVM rightly assumes that the stack wil be aligned to
--- 16n + 12 on entry (since the function call was 16 byte aligned and the return
--- address should have been pushed, so sub 4). GHC though since it always uses
--- jumps keeps the stack 16 byte aligned on both function calls and function
--- entry. We correct LLVM's alignment then by putting inline assembly in that
--- subtracts and adds 4 to the sp as required.
-fixupStack :: ByteString -> ByteString -> ByteString
-fixupStack fun nfun | BS.null nfun =