Ppr.hs 7.46 KB
Newer Older
1 2
{-# LANGUAGE CPP #-}

3 4 5 6
-- ----------------------------------------------------------------------------
-- | Pretty print helpers for the LLVM Code generator.
--
module LlvmCodeGen.Ppr (
7
        pprLlvmHeader, pprLlvmCmmDecl, pprLlvmData, infoSection
8 9 10 11 12 13 14 15 16
    ) where

#include "HsVersions.h"

import Llvm
import LlvmCodeGen.Base
import LlvmCodeGen.Data

import CLabel
17
import Cmm
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
Peter Wortmann's avatar
Peter Wortmann committed
31
pprLlvmHeader = moduleLayout
32 33


34
-- | LLVM module layout description for the host target
Ian Lynagh's avatar
Ian Lynagh committed
35
moduleLayout :: SDoc
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
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\""
56 57 58
    Platform { platformArch = ArchARM {}, platformOS = OSAndroid } ->
        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-androideabi\""
singpolyma's avatar
singpolyma committed
59 60 61
    Platform { platformArch = ArchARM {}, platformOS = OSQNXNTO } ->
        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-nto-qnx8.0.0eabi\""
62 63 64
    Platform { platformArch = ArchARM {}, platformOS = OSiOS } ->
        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-apple-darwin10\""
65 66 67
    Platform { platformArch = ArchX86, platformOS = OSiOS } ->
        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-darwin11\""
68 69 70
    Platform { platformArch = ArchARM64, platformOS = OSiOS } ->
        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-n32:64-S128\""
        $+$ text "target triple = \"arm64-apple-ios7.0.0\""
71 72 73
    Platform { platformArch = ArchARM64, platformOS = OSLinux } ->
        text "target datalayout = \"e-m:e-i64:64-i128:128-n32:64-S128\""
        $+$ text "target triple = \"aarch64-unknown-linux-gnu\""
74
    _ ->
75 76 77 78 79 80 81 82 83
        if platformIsCrossCompiling platform
            then panic "LlvmCodeGen.Ppr: Cross compiling without valid target info."
            else empty
        -- If you see the above panic, GHC is missing the required target datalayout
        -- and triple information. You can obtain this info by compiling a simple
        -- 'hello world' C program with the clang C compiler eg:
        --     clang hello.c -emit-llvm -o hello.ll
        -- and the first two lines of hello.ll should provide the 'target datalayout'
        -- and 'target triple' lines required.
84

dterei's avatar
dterei committed
85

86
-- | Pretty print LLVM data code
Ian Lynagh's avatar
Ian Lynagh committed
87
pprLlvmData :: LlvmData -> SDoc
88
pprLlvmData (globals, types) =
Peter Wortmann's avatar
Peter Wortmann committed
89
    let ppLlvmTys (LMAlias    a) = ppLlvmAlias a
90 91 92 93
        ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
        ppLlvmTys _other         = empty

        types'   = vcat $ map ppLlvmTys types
Peter Wortmann's avatar
Peter Wortmann committed
94
        globals' = ppLlvmGlobals globals
95 96 97
    in types' $+$ globals'


98
-- | Pretty print LLVM code
99 100
pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
pprLlvmCmmDecl (CmmData _ lmdata)
Peter Wortmann's avatar
Peter Wortmann committed
101
  = return (vcat $ map pprLlvmData lmdata, [])
dterei's avatar
dterei committed
102

103 104 105 106 107
pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
  = do let lbl = case mb_info of
                     Nothing                   -> entry_lbl
                     Just (Statics info_lbl _) -> info_lbl
           link = if externallyVisibleCLabel lbl
dterei's avatar
dterei committed
108 109
                      then ExternallyVisible
                      else Internal
Peter Wortmann's avatar
Peter Wortmann committed
110
           lmblocks = map (\(BasicBlock id stmts) ->
dterei's avatar
dterei committed
111
                                LlvmBlock (getUnique id) stmts) blks
Peter Wortmann's avatar
Peter Wortmann committed
112

113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
       funDec <- llvmFunSig live lbl link
       dflags <- getDynFlags
       let buildArg = fsLit . showSDoc dflags . ppPlainName
           funArgs = map buildArg (llvmFunArgs dflags live)

       -- generate the info table
       prefix <- case mb_info of
                     Nothing -> return Nothing
                     Just (Statics _ statics) -> do
                       infoStatics <- mapM genData statics
                       let infoTy = LMStruct $ map getStatType infoStatics
                       return $ Just $ LMStaticStruc infoStatics infoTy

       let fun = LlvmFunction funDec funArgs llvmStdFunAttrs Nothing
                              prefix lmblocks
           name = decName $ funcDecl fun
129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148
           defName = name `appendFS` fsLit "$def"
           funcDecl' = (funcDecl fun) { decName = defName }
           fun' = fun { funcDecl = funcDecl' }
           funTy = LMFunction funcDecl'
           funVar = LMGlobalVar name
                                (LMPointer funTy)
                                link
                                Nothing
                                Nothing
                                Alias
           defVar = LMGlobalVar defName
                                (LMPointer funTy)
                                (funcLinkage funcDecl')
                                (funcSect fun)
                                (funcAlign funcDecl')
                                Alias
           alias = LMGlobal funVar
                            (Just $ LMBitc (LMStaticPointer defVar)
                                           (LMPointer $ LMInt 8))

149
       return (ppLlvmGlobal alias $+$ ppLlvmFunction fun', [])
150

dterei's avatar
dterei committed
151 152 153

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