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