Ppr.hs 3.89 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
-- ----------------------------------------------------------------------------
-- | Pretty print helpers for the LLVM Code generator.
--

module LlvmCodeGen.Ppr (
        pprLlvmHeader, pprLlvmCmmTop, pprLlvmData
    ) where

#include "HsVersions.h"

import Llvm
import LlvmCodeGen.Base
import LlvmCodeGen.Data

import CLabel
import Cmm

dterei's avatar
dterei committed
18
import FastString
19 20
import Pretty
import Unique
dterei's avatar
dterei committed
21
import Util
22 23 24 25 26 27 28

-- ----------------------------------------------------------------------------
-- * Top level
--

-- | LLVM module layout description for the host target
moduleLayout :: Doc
dterei's avatar
dterei committed
29
moduleLayout =
30
#if i386_TARGET_ARCH
31

32
#if darwin_TARGET_OS
dterei's avatar
dterei committed
33 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\""
    $+$ text "target triple = \"i386-apple-darwin9.8\""
35 36 37 38
#elif mingw32_TARGET_OS
    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\""
    $+$ text "target triple = \"i686-pc-win32\""
#else /* Linux */
dterei's avatar
dterei committed
39 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\""
    $+$ text "target triple = \"i386-linux-gnu\""
41 42 43 44
#endif

#else

dterei's avatar
dterei committed
45 46 47
#ifdef x86_64_TARGET_ARCH
    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\""
    $+$ text "target triple = \"x86_64-linux-gnu\""
48 49 50 51 52 53 54 55

#else /* Not i386 */
    -- FIX: Other targets
    empty
#endif

#endif

dterei's avatar
dterei committed
56

57 58 59 60
-- | Header code for LLVM modules
pprLlvmHeader :: Doc
pprLlvmHeader = moduleLayout

dterei's avatar
dterei committed
61

62
-- | Pretty print LLVM code
63 64 65
pprLlvmCmmTop :: LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
pprLlvmCmmTop _ _ (CmmData _ lmdata)
  = (vcat $ map pprLlvmData lmdata, [])
dterei's avatar
dterei committed
66

67
pprLlvmCmmTop env count (CmmProc info lbl _ (ListGraph blks))
dterei's avatar
dterei committed
68 69
  = let static = CmmDataLabel lbl : info
        (idoc, ivar) = if not (null info)
70
                          then pprCmmStatic env count static
dterei's avatar
dterei committed
71 72 73 74 75 76 77 78 79 80 81 82 83
                          else (empty, [])
    in (idoc $+$ (
        let sec = mkLayoutSection (count + 1)
            (lbl',sec') = if not (null info)
                            then (entryLblToInfoLbl lbl, sec)
                            else (lbl, Nothing)
            link = if externallyVisibleCLabel lbl'
                      then ExternallyVisible
                      else Internal
            funDec = llvmFunSig lbl' link
            lmblocks = map (\(BasicBlock id stmts) ->
                                LlvmBlock (getUnique id) stmts) blks
            fun = LlvmFunction funDec [NoUnwind] sec' lmblocks
84
        in ppLlvmFunction fun
dterei's avatar
dterei committed
85
    ), ivar)
86 87 88


-- | Pretty print LLVM data code
89 90
pprLlvmData :: LlvmData -> Doc
pprLlvmData (globals, types) =
91 92 93 94 95 96
    let globals' = ppLlvmGlobals globals
        types'   = ppLlvmTypes types
    in types' $+$ globals'


-- | Pretty print CmmStatic
97 98 99 100
pprCmmStatic :: LlvmEnv -> Int -> [CmmStatic] -> (Doc, [LlvmVar])
pprCmmStatic env count stat
  = let unres = genLlvmData stat
        (_, (ldata, ltypes)) = resolveLlvmData env unres
dterei's avatar
dterei committed
101 102 103 104 105 106 107 108

        setSection (gv@(LMGlobalVar s ty l _ _), d)
            = let v = if l == Internal then [gv] else []
                  sec = mkLayoutSection count
              in ((LMGlobalVar s ty l sec llvmInfAlign, d), v)
        setSection v = (v,[])

        (ldata', llvmUsed) = mapAndUnzip setSection ldata
109
    in (pprLlvmData (ldata', ltypes), concat llvmUsed)
dterei's avatar
dterei committed
110 111 112 113 114 115 116 117 118 119


-- | Create an appropriate section declaration for subsection <n> of text
-- WARNING: This technique could fail as gas documentation says it only
-- supports up to 8192 subsections per section. Inspection of the source
-- code and some test programs seem to suggest it supports more than this
-- so we are hoping it does.
mkLayoutSection :: Int -> LMSection
mkLayoutSection n
  = Just (fsLit $ ".text;.text " ++ show n ++ " #")
120