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 DynFlags
  19 import FastString
  20 import Pretty
  21 import Unique
  22 import Util
  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\""
  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\""
  41     $+$ text "target triple = \"i386-linux-gnu\""
  42 #endif
  43
  44 #else
  45
  46 #ifdef x86_64_TARGET_ARCH
  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\""
  48     $+$ text "target triple = \"x86_64-linux-gnu\""
  49
  50 #else /* Not i386 */
  51     -- FIX: Other targets
  52     empty
  53 #endif
  54
  55 #endif
  56
  57
  58 -- | Header code for LLVM modules
  59 pprLlvmHeader :: Doc
  60 pprLlvmHeader = moduleLayout
  61
  62
  63 -- | Pretty print LLVM code
  64 pprLlvmCmmTop :: DynFlags -> LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
  65 pprLlvmCmmTop dflags _ _ (CmmData _ lmdata)
  66   = (vcat $ map (pprLlvmData dflags) lmdata, [])
  67
  68 pprLlvmCmmTop dflags env count (CmmProc info lbl _ (ListGraph blks))
  69   = let static = CmmDataLabel lbl : info
  70         (idoc, ivar) = if not (null info)
  71                           then pprCmmStatic dflags env count static
  72                           else (empty, [])
  73     in (idoc $+$ (
  74         let sec = mkLayoutSection (count + 1)
  75             (lbl',sec') = if not (null info)
  76                             then (entryLblToInfoLbl lbl, sec)
  77                             else (lbl, Nothing)
  78             link = if externallyVisibleCLabel lbl'
  79                       then ExternallyVisible
  80                       else Internal
  81             funDec = llvmFunSig lbl' link
  82             lmblocks = map (\(BasicBlock id stmts) ->
  83                                 LlvmBlock (getUnique id) stmts) blks
  84             fun = LlvmFunction funDec [NoUnwind] sec' lmblocks
  85         in ppLlvmFunction fun
  86     ), ivar)
  87
  88
  89 -- | Pretty print LLVM data code
  90 pprLlvmData :: DynFlags -> LlvmData -> Doc
  91 pprLlvmData _ (globals, types) =
  92     let globals' = ppLlvmGlobals globals
  93         types'   = ppLlvmTypes types
  94     in types' $+$ globals'
  95
  96
  97 -- | Pretty print CmmStatic
  98 pprCmmStatic :: DynFlags -> LlvmEnv -> Int -> [CmmStatic] -> (Doc, [LlvmVar])
  99 pprCmmStatic dflags env count stat
 100   = let unres = genLlvmData dflags (Data,stat)
 101         (_, (ldata, ltypes)) = resolveLlvmData dflags env unres
 102
 103         setSection (gv@(LMGlobalVar s ty l _ _), d)
 104             = let v = if l == Internal then [gv] else []
 105                   sec = mkLayoutSection count
 106               in ((LMGlobalVar s ty l sec llvmInfAlign, d), v)
 107         setSection v = (v,[])
 108
 109         (ldata', llvmUsed) = mapAndUnzip setSection ldata
 110     in (pprLlvmData dflags (ldata', ltypes), concat llvmUsed)
 111
 112
 113 -- | Create an appropriate section declaration for subsection <n> of text
 114 -- WARNING: This technique could fail as gas documentation says it only
 115 -- supports up to 8192 subsections per section. Inspection of the source
 116 -- code and some test programs seem to suggest it supports more than this
 117 -- so we are hoping it does.
 118 mkLayoutSection :: Int -> LMSection
 119 mkLayoutSection n
 120   = Just (fsLit $ ".text;.text " ++ show n ++ " #")
 121