Ppr.hs 5.79 KB
Newer Older
1 2 3 4 5
-- ----------------------------------------------------------------------------
-- | Pretty print helpers for the LLVM Code generator.
--

module LlvmCodeGen.Ppr (
Simon Peyton Jones's avatar
Simon Peyton Jones committed
6
        pprLlvmHeader, pprLlvmCmmDecl, pprLlvmData, infoSection, iTableSuf
7 8 9 10 11 12 13
    ) where

#include "HsVersions.h"

import Llvm
import LlvmCodeGen.Base
import LlvmCodeGen.Data
14
import LlvmCodeGen.Regs
15 16

import CLabel
17
import OldCmm
18
import Platform
19

dterei's avatar
dterei committed
20
import FastString
Ian Lynagh's avatar
Ian Lynagh committed
21
import Outputable
22 23
import Unique

24

25 26 27 28
-- ----------------------------------------------------------------------------
-- * Top level
--

29
-- | Header code for LLVM modules
Ian Lynagh's avatar
Ian Lynagh committed
30
pprLlvmHeader :: SDoc
31
pprLlvmHeader = sdocWithDynFlags $ \dflags ->
32 33
    moduleLayout
    $+$ text ""
34
    $+$ ppLlvmFunctionDecls (map snd (ghcInternalFunctions dflags))
35 36 37 38
    $+$ ppLlvmMetas stgTBAA
    $+$ text ""


39
-- | LLVM module layout description for the host target
Ian Lynagh's avatar
Ian Lynagh committed
40
moduleLayout :: SDoc
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
moduleLayout = sdocWithPlatform $ \platform ->
    case platform of
    Platform { platformArch = ArchX86, platformOS = OSDarwin } ->
        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\""
        $+$ text "target triple = \"i386-apple-darwin9.8\""
    Platform { platformArch = ArchX86, platformOS = OSMinGW32 } ->
        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\""
    Platform { platformArch = ArchX86, platformOS = OSLinux } ->
        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\""
        $+$ text "target triple = \"i386-pc-linux-gnu\""
    Platform { platformArch = ArchX86_64, platformOS = OSDarwin } ->
        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\""
        $+$ text "target triple = \"x86_64-apple-darwin10.0.0\""
    Platform { platformArch = ArchX86_64, platformOS = OSLinux } ->
        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\""
        $+$ text "target triple = \"x86_64-linux-gnu\""
    Platform { platformArch = ArchARM {}, platformOS = OSLinux } ->
        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-v64:64:64-v128:64:128-a0:0:64-n32\""
        $+$ text "target triple = \"arm-unknown-linux-gnueabi\""
    _ ->
        -- FIX: Other targets
        empty
64

dterei's avatar
dterei committed
65

66
-- | Pretty print LLVM data code
Ian Lynagh's avatar
Ian Lynagh committed
67
pprLlvmData :: LlvmData -> SDoc
68 69 70 71
pprLlvmData (globals, types) =
    let tryConst (v, Just s )   = ppLlvmGlobal (v, Just s)
        tryConst g@(_, Nothing) = ppLlvmGlobal g

72 73 74 75 76
        ppLlvmTys (LMAlias    a) = ppLlvmAlias a
        ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
        ppLlvmTys _other         = empty

        types'   = vcat $ map ppLlvmTys types
77 78 79 80
        globals' = vcat $ map tryConst globals
    in types' $+$ globals'


81
-- | Pretty print LLVM code
Ian Lynagh's avatar
Ian Lynagh committed
82
pprLlvmCmmDecl :: LlvmEnv -> Int -> LlvmCmmDecl -> (SDoc, [LlvmVar])
Simon Peyton Jones's avatar
Simon Peyton Jones committed
83
pprLlvmCmmDecl _ _ (CmmData _ lmdata)
84
  = (vcat $ map pprLlvmData lmdata, [])
dterei's avatar
dterei committed
85

Simon Peyton Jones's avatar
Simon Peyton Jones committed
86
pprLlvmCmmDecl env count (CmmProc mb_info entry_lbl (ListGraph blks))
87 88 89 90
  = let (idoc, ivar) = case mb_info of
                        Nothing -> (empty, [])
                        Just (Statics info_lbl dat)
                         -> pprInfoTable env count info_lbl (Statics entry_lbl dat)
dterei's avatar
dterei committed
91 92
    in (idoc $+$ (
        let sec = mkLayoutSection (count + 1)
93 94 95
            (lbl',sec') = case mb_info of
                           Nothing                   -> (entry_lbl, Nothing)
                           Just (Statics info_lbl _) -> (info_lbl,  sec)
dterei's avatar
dterei committed
96 97 98 99 100
            link = if externallyVisibleCLabel lbl'
                      then ExternallyVisible
                      else Internal
            lmblocks = map (\(BasicBlock id stmts) ->
                                LlvmBlock (getUnique id) stmts) blks
101
            fun = mkLlvmFunc env lbl' link  sec' lmblocks
102
        in ppLlvmFunction fun
dterei's avatar
dterei committed
103
    ), ivar)
104 105 106


-- | Pretty print CmmStatic
Ian Lynagh's avatar
Ian Lynagh committed
107
pprInfoTable :: LlvmEnv -> Int -> CLabel -> CmmStatics -> (SDoc, [LlvmVar])
108
pprInfoTable env count info_lbl stat
109
  = let unres = genLlvmData env (Text, stat)
110
        (_, (ldata, ltypes)) = resolveLlvmData env unres
dterei's avatar
dterei committed
111

112 113
        setSection ((LMGlobalVar _ ty l _ _ c), d)
            = let sec = mkLayoutSection count
114
                  ilabel = strCLabel_llvm env info_lbl
115
                              `appendFS` fsLit iTableSuf
116 117 118
                  gv = LMGlobalVar ilabel ty l sec llvmInfAlign c
                  v = if l == Internal then [gv] else []
              in ((gv, d), v)
dterei's avatar
dterei committed
119 120
        setSection v = (v,[])

121 122 123 124
        (ldata', llvmUsed) = setSection (last ldata)
    in if length ldata /= 1
          then Outputable.panic "LlvmCodeGen.Ppr: invalid info table!"
          else (pprLlvmData ([ldata'], ltypes), llvmUsed)
dterei's avatar
dterei committed
125

dterei's avatar
dterei committed
126

127 128 129 130 131
-- | We generate labels for info tables by converting them to the same label
-- as for the entry code but adding this string as a suffix.
iTableSuf :: String
iTableSuf = "_itable"

dterei's avatar
dterei committed
132

dterei's avatar
dterei committed
133 134 135 136 137
-- | Create a specially crafted section declaration that encodes the order this
-- section should be in the final object code.
-- 
-- The LlvmMangler.llvmFixupAsm pass over the assembly produced by LLVM uses
-- this section declaration to do its processing.
dterei's avatar
dterei committed
138 139
mkLayoutSection :: Int -> LMSection
mkLayoutSection n
dterei's avatar
dterei committed
140
  = Just (fsLit $ infoSection ++ show n)
141

dterei's avatar
dterei committed
142 143 144

-- | The section we are putting info tables and their entry code into, should
-- be unique since we process the assembly pattern matching this.
145
infoSection :: String
dterei's avatar
dterei committed
146
infoSection = "X98A__STRIP,__me"
147