Ppr.hs 3.76 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 32 33
#ifdef i386_TARGET_ARCH

#ifdef 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
#else
dterei's avatar
dterei committed
37 38
    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\""
39 40 41 42
#endif

#else

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

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

#endif

dterei's avatar
dterei committed
54

55 56 57 58
-- | Header code for LLVM modules
pprLlvmHeader :: Doc
pprLlvmHeader = moduleLayout

dterei's avatar
dterei committed
59

60
-- | Pretty print LLVM code
dterei's avatar
dterei committed
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
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
82
        in ppLlvmFunction fun
dterei's avatar
dterei committed
83
    ), ivar)
84 85 86 87


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


-- | Pretty print CmmStatic
dterei's avatar
dterei committed
95 96
pprCmmStatic :: DynFlags -> LlvmEnv -> Int -> [CmmStatic] -> (Doc, [LlvmVar])
pprCmmStatic dflags env count stat
97
  = let unres = genLlvmData dflags (Data,stat)
dterei's avatar
dterei committed
98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117
        (_, (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 ++ " #")
118