1 -- ----------------------------------------------------------------------------
2 -- | Pretty print helpers for the LLVM Code generator.
5 module LlvmCodeGen.Ppr (
6 pprLlvmHeader, pprLlvmCmmTop, pprLlvmData
9 #include "HsVersions.h"
12 import LlvmCodeGen.Base
13 import LlvmCodeGen.Data
24 -- ----------------------------------------------------------------------------
28 -- | LLVM module layout description for the host target
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\""
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\""
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\""
58 -- | Header code for LLVM modules
60 pprLlvmHeader = moduleLayout
63 -- | Pretty print LLVM code
64 pprLlvmCmmTop :: DynFlags -> LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
65 pprLlvmCmmTop dflags _ _ (CmmData _ lmdata)
66 = (vcat $ map (pprLlvmData dflags) lmdata, [])
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
74 let sec = mkLayoutSection (count + 1)
75 (lbl',sec') = if not (null info)
76 then (entryLblToInfoLbl lbl, sec)
78 link = if externallyVisibleCLabel lbl'
79 then ExternallyVisible
81 funDec = llvmFunSig lbl' link
82 lmblocks = map (\(BasicBlock id stmts) ->
83 LlvmBlock (getUnique id) stmts) blks
84 fun = LlvmFunction funDec [NoUnwind] sec' lmblocks
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'
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
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,[])
109 (ldata', llvmUsed) = mapAndUnzip setSection ldata
110 in (pprLlvmData dflags (ldata', ltypes), concat llvmUsed)
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
120 = Just (fsLit $ ".text;.text " ++ show n ++ " #")