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