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\""
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\""
40 $+$ text "target triple = \"i386-linux-gnu\""
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\""
57 -- | Header code for LLVM modules
59 pprLlvmHeader = moduleLayout
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
68 types' = ppLlvmTypes types
69 globals' = vcat $ map tryConst globals
70 in types' $+$ globals'
73 -- | Pretty print LLVM code
74 pprLlvmCmmTop :: LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
75 pprLlvmCmmTop _ _ (CmmData _ lmdata)
76 = (vcat $ map pprLlvmData lmdata, [])
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
84 let sec = mkLayoutSection (count + 1)
85 (lbl',sec') = if not (null info)
86 then (entryLblToInfoLbl lbl, sec)
88 link = if externallyVisibleCLabel lbl'
89 then ExternallyVisible
91 funDec = llvmFunSig lbl' link
92 lmblocks = map (\(BasicBlock id stmts) ->
93 LlvmBlock (getUnique id) stmts) blks
94 fun = LlvmFunction funDec [NoUnwind] sec' lmblocks
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
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,[])
111 (ldata', llvmUsed) = mapAndUnzip setSection ldata
112 in (pprLlvmData (ldata', ltypes), concat llvmUsed)
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
122 = Just (fsLit $ ".text;.text " ++ show n ++ " #")