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
23 -- ----------------------------------------------------------------------------
27 -- | LLVM module layout description for the host target
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-n8:16:32\""
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\""
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\""
43 #elif 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-n8:16:32:64\""
47 $+$ text "target triple = \"x86_64-apple-darwin10.0.0\""
49 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-n8:16:32:64\""
50 $+$ text "target triple = \"x86_64-linux-gnu\""
59 -- | Header code for LLVM modules
61 pprLlvmHeader = moduleLayout
64 -- | Pretty print LLVM data code
65 pprLlvmData :: LlvmData -> Doc
66 pprLlvmData (globals, types) =
67 let tryConst (v, Just s ) = ppLlvmGlobal (v, Just s)
68 tryConst g@(_, Nothing) = ppLlvmGlobal g
70 ppLlvmTys (LMAlias a) = ppLlvmAlias a
71 ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
72 ppLlvmTys _other = empty
74 types' = vcat $ map ppLlvmTys types
75 globals' = vcat $ map tryConst globals
76 in types' $+$ globals'
79 -- | Pretty print LLVM code
80 pprLlvmCmmTop :: LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
81 pprLlvmCmmTop _ _ (CmmData _ lmdata)
82 = (vcat $ map pprLlvmData lmdata, [])
84 pprLlvmCmmTop env count (CmmProc info lbl _ (ListGraph blks))
85 = let static = CmmDataLabel lbl : info
86 (idoc, ivar) = if not (null info)
87 then pprCmmStatic env count static
90 let sec = mkLayoutSection (count + 1)
91 (lbl',sec') = if not (null info)
92 then (entryLblToInfoLbl lbl, sec)
94 link = if externallyVisibleCLabel lbl'
95 then ExternallyVisible
97 lmblocks = map (\(BasicBlock id stmts) ->
98 LlvmBlock (getUnique id) stmts) blks
99 fun = mkLlvmFunc lbl' link sec' lmblocks
100 in ppLlvmFunction fun
104 -- | Pretty print CmmStatic
105 pprCmmStatic :: LlvmEnv -> Int -> [CmmStatic] -> (Doc, [LlvmVar])
106 pprCmmStatic env count stat
107 = let unres = genLlvmData (Text, stat)
108 (_, (ldata, ltypes)) = resolveLlvmData env unres
110 setSection (gv@(LMGlobalVar s ty l _ _ c), d)
111 = let v = if l == Internal then [gv] else []
112 sec = mkLayoutSection count
113 in ((LMGlobalVar s ty l sec llvmInfAlign c, d), v)
114 setSection v = (v,[])
116 (ldata', llvmUsed) = mapAndUnzip setSection ldata
117 in (pprLlvmData (ldata', ltypes), concat llvmUsed)
120 -- | Create an appropriate section declaration for subsection <n> of text
121 -- WARNING: This technique could fail as gas documentation says it only
122 -- supports up to 8192 subsections per section. Inspection of the source
123 -- code and some test programs seem to suggest it supports more than this
124 -- so we are hoping it does.
125 mkLayoutSection :: Int -> LMSection
127 = Just (fsLit $ ".text;.text " ++ show n ++ " #")