compiler/llvmGen/LlvmMangler.hs

   1 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
   2
   3 -- -----------------------------------------------------------------------------
   4 -- | GHC LLVM Mangler
   5 --
   6 -- This script processes the assembly produced by LLVM, rearranging the code
   7 -- so that an info table appears before its corresponding function.
   8 module LlvmMangler ( llvmFixupAsm ) where
   9
  10 import Data.ByteString.Char8 ( ByteString )
  11 import qualified Data.ByteString.Char8 as BS
  12
  13 {-
  14   Configuration.
  15 -}
  16 newSection, oldSection, functionSuf, tableSuf, funDivider, eol :: ByteString
  17 newSection  = BS.pack "\n.text\n"
  18 oldSection  = BS.pack "__STRIP,__me"
  19 functionSuf = BS.pack "_info:"
  20 tableSuf    = BS.pack "_info_itable:"
  21 funDivider  = BS.pack "\n\n"
  22 eol         = BS.pack "\n"
  23
  24 eolPred :: Char -> Bool
  25 eolPred = ((==) '\n')
  26
  27 -- | Read in assembly file and process
  28 llvmFixupAsm :: FilePath -> FilePath -> IO ()
  29 llvmFixupAsm f1 f2 = do
  30     asm <- BS.readFile f1
  31     BS.writeFile f2 BS.empty
  32     allTables f2 asm
  33     return ()
  34
  35 -- | Run over whole assembly file
  36 allTables :: FilePath -> ByteString -> IO ()
  37 allTables f str = do
  38     rem <- oneTable f str
  39     if BS.null rem
  40        then return ()
  41        else allTables f rem
  42
  43 {- |
  44   Look for the next function that needs to have its info table
  45   arranged to be before it and process it. This will print out
  46   any code before this function, then the info table, then the
  47   function. It will return the remainder of the assembly code
  48   to process.
  49
  50   We rely here on the fact that LLVM prints all global variables
  51   at the end of the file, so an info table will always appear
  52   after its function.
  53
  54   To try to help explain the string searches, here is some
  55   assembly code that would be processed by this program, with
  56   split markers placed in it like so, <split marker>:
  57
  58     [ ...asm code... ]
  59     jmp *%eax
  60     <before|fheader>
  61     .def Main_main_info
  62     .section TEXT
  63     .globl _Main_main_info
  64     _Main_main<bl|al>_info:
  65         sub $12, %esp
  66         [ ...asm code... ]
  67         jmp *%eax
  68     <fun|after>
  69     .def .....
  70
  71     [ ...asm code... ]
  72
  73         .long 231231
  74     <bit'|itable_h>
  75     .section TEXT
  76     .global _Main_main_entry
  77     .align 4
  78     <bit|itable>_Main_main_entry:
  79         .long 0
  80         [ ...asm code... ]
  81     <itable'|ait>
  82     .section TEXT
  83 -}
  84 oneTable :: FilePath -> ByteString -> IO ByteString
  85 oneTable f str =
  86     let last' xs = if (null xs) then 0 else last xs
  87
  88         -- get the function
  89         (bl, al) = BS.breakSubstring functionSuf str
  90         start = last' $ BS.findSubstrings funDivider bl
  91         (before, fheader) = BS.splitAt start bl
  92         (fun, after) = BS.breakSubstring funDivider al
  93         label = snd $ BS.breakEnd eolPred bl
  94
  95         -- get the info table
  96         ilabel = label `BS.append` tableSuf
  97         (bit, itable) = BS.breakSubstring ilabel after
  98         (itable', ait) = BS.breakSubstring funDivider itable
  99         istart = last' $ BS.findSubstrings funDivider bit
 100         (bit', iheader) = BS.splitAt istart bit
 101
 102         -- fix up sections
 103         fheader' = replaceSection fheader
 104         iheader' = replaceSection iheader
 105
 106         function = [before, eol, iheader', itable', eol, fheader', fun, eol]
 107         remainder = bit' `BS.append` ait
 108     in if BS.null al
 109           then do
 110               BS.appendFile f bl
 111               return BS.empty
 112
 113           else if BS.null itable
 114                   then error $ "Function without matching info table! ("
 115                               ++ (BS.unpack label) ++ ")"
 116
 117                   else do
 118                       mapM_ (BS.appendFile f) function
 119                       return remainder
 120
 121 -- | Replace the current section in a function or table header with the
 122 -- text section specifier.
 123 replaceSection :: ByteString -> ByteString
 124 replaceSection sec =
 125     let (s1, s2) = BS.breakSubstring oldSection sec
 126         s1' = fst $ BS.breakEnd eolPred s1
 127         s2' = snd $ BS.break eolPred s2
 128     in s1' `BS.append` newSection `BS.append` s2'
 129