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 Pretty
  20 import Unique
  21 import Util
  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 pprCmmStatic env count 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 pprCmmStatic :: LlvmEnv -> Int -> [CmmStatic] -> (Doc, [LlvmVar])
 106 pprCmmStatic env count stat
 107   = let unres = genLlvmData (Text, stat)
 108         (_, (ldata, ltypes)) = resolveLlvmData env unres
 109
 110         setSection (gv@(LMGlobalVar s ty l _ _ c), d)
 111             = let v = if l == Internal then [gv] else []
 112                   sec = mkLayoutSection count
 113               in ((LMGlobalVar s ty l sec llvmInfAlign c, d), v)
 114         setSection v = (v,[])
 115
 116         (ldata', llvmUsed) = mapAndUnzip setSection ldata
 117     in (pprLlvmData (ldata', ltypes), concat llvmUsed)
 118
 119
 120 -- | Create an appropriate section declaration for subsection <n> of text
 121 -- WARNING: This technique could fail as gas documentation says it only
 122 -- supports up to 8192 subsections per section. Inspection of the source
 123 -- code and some test programs seem to suggest it supports more than this
 124 -- so we are hoping it does.
 125 mkLayoutSection :: Int -> LMSection
 126 mkLayoutSection n
 127   = Just (fsLit $ ".text;.text " ++ show n ++ " #")
 128