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