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