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