compiler/llvmGen/LlvmCodeGen/Ppr.hs

   1 -- ----------------------------------------------------------------------------
   2 -- | Pretty print helpers for the LLVM Code generator.
   3 --
   4
   5 module LlvmCodeGen.Ppr (
   6         pprLlvmHeader, pprLlvmCmmTop, pprLlvmData, infoSection, iTableSuf
   7     ) where
   8
   9 #include "HsVersions.h"
  10
  11 import Llvm
  12 import LlvmCodeGen.Base
  13 import LlvmCodeGen.Data
  14
  15 import CLabel
  16 import OldCmm
  17
  18 import FastString
  19 import qualified Outputable
  20 import Pretty
  21 import Unique
  22
  23
  24 -- ----------------------------------------------------------------------------
  25 -- * Top level
  26 --
  27
  28 -- | LLVM module layout description for the host target
  29 moduleLayout :: Doc
  30 moduleLayout =
  31 #if i386_TARGET_ARCH
  32
  33 #if darwin_TARGET_OS
  34     text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-f32:32:32-f64:32:64-v64:64:64-v128:128:128-a0:0:64-f80:128:128-n8:16:32\""
  35     $+$ text "target triple = \"i386-apple-darwin9.8\""
  36 #elif mingw32_TARGET_OS
  37     text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-f80:128:128-v64:64:64-v128:128:128-a0:0:64-f80:32:32-n8:16:32\""
  38     $+$ text "target triple = \"i686-pc-win32\""
  39 #else /* Linux */
  40     text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-f32:32:32-f64:32:64-v64:64:64-v128:128:128-a0:0:64-f80:32:32-n8:16:32\""
  41     $+$ text "target triple = \"i386-pc-linux-gnu\""
  42 #endif
  43
  44 #elif x86_64_TARGET_ARCH
  45
  46 #if darwin_TARGET_OS
  47     text "target datalayout = \"e-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128-n8:16:32:64\""
  48     $+$ text "target triple = \"x86_64-apple-darwin10.0.0\""
  49 #else /* Linux */
  50     text "target datalayout = \"e-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128-n8:16:32:64\""
  51     $+$ text "target triple = \"x86_64-linux-gnu\""
  52 #endif
  53
  54 #else /* Not x86 */
  55     -- FIX: Other targets
  56     empty
  57 #endif
  58
  59
  60 -- | Header code for LLVM modules
  61 pprLlvmHeader :: Doc
  62 pprLlvmHeader = moduleLayout
  63
  64
  65 -- | Pretty print LLVM data code
  66 pprLlvmData :: LlvmData -> Doc
  67 pprLlvmData (globals, types) =
  68     let tryConst (v, Just s )   = ppLlvmGlobal (v, Just s)
  69         tryConst g@(_, Nothing) = ppLlvmGlobal g
  70
  71         ppLlvmTys (LMAlias    a) = ppLlvmAlias a
  72         ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
  73         ppLlvmTys _other         = empty
  74
  75         types'   = vcat $ map ppLlvmTys types
  76         globals' = vcat $ map tryConst globals
  77     in types' $+$ globals'
  78
  79
  80 -- | Pretty print LLVM code
  81 pprLlvmCmmTop :: LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
  82 pprLlvmCmmTop _ _ (CmmData _ lmdata)
  83   = (vcat $ map pprLlvmData lmdata, [])
  84
  85 pprLlvmCmmTop env count (CmmProc info lbl (ListGraph blks))
  86   = let static = CmmDataLabel lbl : info
  87         (idoc, ivar) = if not (null info)
  88                           then pprInfoTable env count lbl static
  89                           else (empty, [])
  90     in (idoc $+$ (
  91         let sec = mkLayoutSection (count + 1)
  92             (lbl',sec') = if not (null info)
  93                             then (entryLblToInfoLbl lbl, sec)
  94                             else (lbl, Nothing)
  95             link = if externallyVisibleCLabel lbl'
  96                       then ExternallyVisible
  97                       else Internal
  98             lmblocks = map (\(BasicBlock id stmts) ->
  99                                 LlvmBlock (getUnique id) stmts) blks
 100             fun = mkLlvmFunc lbl' link  sec' lmblocks
 101         in ppLlvmFunction fun
 102     ), ivar)
 103
 104
 105 -- | Pretty print CmmStatic
 106 pprInfoTable :: LlvmEnv -> Int -> CLabel -> [CmmStatic] -> (Doc, [LlvmVar])
 107 pprInfoTable env count lbl stat
 108   = let unres = genLlvmData (Text, stat)
 109         (_, (ldata, ltypes)) = resolveLlvmData env unres
 110
 111         setSection ((LMGlobalVar _ ty l _ _ c), d)
 112             = let sec = mkLayoutSection count
 113                   ilabel = strCLabel_llvm (entryLblToInfoLbl lbl)
 114                               `appendFS` fsLit iTableSuf
 115                   gv = LMGlobalVar ilabel ty l sec llvmInfAlign c
 116                   v = if l == Internal then [gv] else []
 117               in ((gv, d), v)
 118         setSection v = (v,[])
 119
 120         (ldata', llvmUsed) = setSection (last ldata)
 121     in if length ldata /= 1
 122           then Outputable.panic "LlvmCodeGen.Ppr: invalid info table!"
 123           else (pprLlvmData ([ldata'], ltypes), llvmUsed)
 124
 125 -- | We generate labels for info tables by converting them to the same label
 126 -- as for the entry code but adding this string as a suffix.
 127 iTableSuf :: String
 128 iTableSuf = "_itable"
 129
 130
 131 -- | Create an appropriate section declaration for subsection <n> of text
 132 -- WARNING: This technique could fail as gas documentation says it only
 133 -- supports up to 8192 subsections per section. Inspection of the source
 134 -- code and some test programs seem to suggest it supports more than this
 135 -- so we are hoping it does.
 136 mkLayoutSection :: Int -> LMSection
 137 mkLayoutSection n
 138   -- On OSX we can't use the GNU Assembler, we must use the OSX assembler, which
 139   -- doesn't support subsections. So we post process the assembly code, this
 140   -- section specifier will be replaced with '.text' by the mangler.
 141   = Just (fsLit $ infoSection ++ show n
 142 #if darwin_TARGET_OS
 143       )
 144 #else
 145       ++ "#")
 146 #endif
 147
 148 -- | The section we are putting info tables and their entry code into
 149 infoSection :: String
 150 #if darwin_TARGET_OS
 151 infoSection = "__STRIP,__me"
 152 #else
 153 infoSection = ".text; .text "
 154 #endif
 155