Ppr.hs 4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
-- ----------------------------------------------------------------------------
-- | 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

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

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

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

33
#if darwin_TARGET_OS
dterei's avatar
dterei committed
34 35
    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\""
36 37 38 39
#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
40 41
    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\""
42 43 44 45
#endif

#else

dterei's avatar
dterei committed
46 47 48
#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\""
49 50 51 52 53 54 55 56

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

#endif

dterei's avatar
dterei committed
57

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

dterei's avatar
dterei committed
62

63
-- | Pretty print LLVM code
dterei's avatar
dterei committed
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
pprLlvmCmmTop :: DynFlags -> LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
pprLlvmCmmTop dflags _ _ (CmmData _ lmdata)
  = (vcat $ map (pprLlvmData dflags) lmdata, [])

pprLlvmCmmTop dflags env count (CmmProc info lbl _ (ListGraph blks))
  = let static = CmmDataLabel lbl : info
        (idoc, ivar) = if not (null info)
                          then pprCmmStatic dflags env count static
                          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
85
        in ppLlvmFunction fun
dterei's avatar
dterei committed
86
    ), ivar)
87 88 89 90


-- | Pretty print LLVM data code
pprLlvmData :: DynFlags -> LlvmData -> Doc
dterei's avatar
dterei committed
91
pprLlvmData _ (globals, types) =
92 93 94 95 96 97
    let globals' = ppLlvmGlobals globals
        types'   = ppLlvmTypes types
    in types' $+$ globals'


-- | Pretty print CmmStatic
dterei's avatar
dterei committed
98 99
pprCmmStatic :: DynFlags -> LlvmEnv -> Int -> [CmmStatic] -> (Doc, [LlvmVar])
pprCmmStatic dflags env count stat
100
  = let unres = genLlvmData dflags (Data,stat)
dterei's avatar
dterei committed
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
        (_, (ldata, ltypes)) = resolveLlvmData dflags env unres

        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
    in (pprLlvmData dflags (ldata', ltypes), concat llvmUsed)


-- | 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 ++ " #")
121