LlvmCodeGen.hs 5.46 KB
Newer Older
1 2 3 4
-- -----------------------------------------------------------------------------
-- | This is the top-level module in the LLVM code generator.
--

5
module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where
6 7 8

#include "HsVersions.h"

dterei's avatar
dterei committed
9
import Llvm
10 11 12 13
import LlvmCodeGen.Base
import LlvmCodeGen.CodeGen
import LlvmCodeGen.Data
import LlvmCodeGen.Ppr
14 15
import LlvmMangler

16
import CgUtils ( fixStgRegisters )
17 18
import OldCmm
import OldPprCmm
19 20 21 22

import BufWrite
import DynFlags
import ErrUtils
dterei's avatar
dterei committed
23
import FastString
24 25 26
import Outputable
import qualified Pretty as Prt
import UniqSupply
dterei's avatar
dterei committed
27
import Util
28
import SysTools ( figureLlvmVersion )
29

30
import Data.IORef ( writeIORef )
31
import Data.Maybe ( fromMaybe )
32 33 34
import System.IO

-- -----------------------------------------------------------------------------
dterei's avatar
dterei committed
35
-- | Top-level of the LLVM Code generator
36
--
Simon Peyton Jones's avatar
Simon Peyton Jones committed
37
llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmGroup] -> IO ()
38
llvmCodeGen dflags h us cmms
39
  = let cmm = concat cmms
40
        (cdata,env) = {-# SCC "llvm_split" #-}
41
                      foldr split ([], initLlvmEnv dflags) cmm
42 43
        split (CmmData s d' ) (d,e) = ((s,d'):d,e)
        split (CmmProc i l _) (d,e) =
44
            let lbl = strCLabel_llvm env $ case i of
45 46
                        Nothing                   -> l
                        Just (Statics info_lbl _) -> info_lbl
47 48
                env' = funInsert lbl llvmFunTy e
            in (d,env')
49
    in do
50
        showPass dflags "LlVM CodeGen"
Ian Lynagh's avatar
Ian Lynagh committed
51
        dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" pprLlvmHeader
52
        bufh <- newBufHandle h
Ian Lynagh's avatar
Ian Lynagh committed
53
        Prt.bufLeftRender bufh $ withPprStyleDoc dflags (mkCodeStyle CStyle) pprLlvmHeader
54
        ver  <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
55 56
        -- cache llvm version for later use
        writeIORef (llvmVersion dflags) ver
dterei's avatar
dterei committed
57 58
        env' <- {-# SCC "llvm_datas_gen" #-}
                cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
59
        {-# SCC "llvm_procs_gen" #-}
dterei's avatar
dterei committed
60
             cmmProcLlvmGens dflags bufh us env' cmm 1 []
61 62
        bFlush bufh
        return  ()
63 64 65


-- -----------------------------------------------------------------------------
dterei's avatar
dterei committed
66
-- | Do LLVM code generation on all these Cmms data sections.
67
--
68
cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,CmmStatics)]
69
                -> [LlvmUnresData] -> IO ( LlvmEnv )
70

71
cmmDataLlvmGens dflags h env [] lmdata
dterei's avatar
dterei committed
72
  = let (env', lmdata') = {-# SCC "llvm_resolve" #-}
73
                          resolveLlvmDatas env lmdata
dterei's avatar
dterei committed
74
        lmdoc = {-# SCC "llvm_data_ppr" #-}
Ian Lynagh's avatar
Ian Lynagh committed
75
                vcat $ map pprLlvmData lmdata'
76
    in do
Ian Lynagh's avatar
Ian Lynagh committed
77
        dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" lmdoc
78
        {-# SCC "llvm_data_out" #-}
Ian Lynagh's avatar
Ian Lynagh committed
79
            Prt.bufLeftRender h $ withPprStyleDoc dflags (mkCodeStyle CStyle) lmdoc
80 81
        return env'

82
cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
83 84 85 86 87 88 89
  = let lm@(l, _, ty, _) = {-# SCC "llvm_data_gen" #-}
                           genLlvmData env cmm
        env' = {-# SCC "llvm_data_insert" #-}
               funInsert (strCLabel_llvm env l) ty env
        lmdata' = {-# SCC "llvm_data_append" #-}
                  lm:lmdata
    in cmmDataLlvmGens dflags h env' cmms lmdata'
90 91 92


-- -----------------------------------------------------------------------------
dterei's avatar
dterei committed
93
-- | Do LLVM code generation on all these Cmms procs.
94
--
Simon Peyton Jones's avatar
Simon Peyton Jones committed
95
cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmDecl]
96 97
      -> Int         -- ^ count, used for generating unique subsections
      -> [[LlvmVar]] -- ^ info tables that need to be marked as 'used'
98 99
      -> IO ()

dterei's avatar
dterei committed
100 101
cmmProcLlvmGens _ _ _ _ [] _ []
  = return ()
102

Ian Lynagh's avatar
Ian Lynagh committed
103
cmmProcLlvmGens dflags h _ _ [] _ ivars
104 105 106 107
  = let ivars' = concat ivars
        cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
        ty     = (LMArray (length ivars') i8Ptr)
        usedArray = LMStaticArray (map cast ivars') ty
108
        lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
109
                  (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
110
    in Prt.bufLeftRender h $ {-# SCC "llvm_used_ppr" #-}
Ian Lynagh's avatar
Ian Lynagh committed
111
                             withPprStyleDoc dflags (mkCodeStyle CStyle) $
dterei's avatar
dterei committed
112
                             pprLlvmData ([lmUsed], [])
dterei's avatar
dterei committed
113

114 115
cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars
 = cmmProcLlvmGens dflags h us env cmms count ivars
116

117 118 119 120 121
cmmProcLlvmGens dflags h us env ((CmmProc _ _ (ListGraph [])) : cmms) count ivars
 = cmmProcLlvmGens dflags h us env cmms count ivars

cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars = do
    (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
Simon Peyton Jones's avatar
Simon Peyton Jones committed
122
    let (docs, ivar) = mapAndUnzip (pprLlvmCmmDecl env' count) llvm
Ian Lynagh's avatar
Ian Lynagh committed
123
    Prt.bufLeftRender h $ {-# SCC "llvm_proc_ppr" #-}
Ian Lynagh's avatar
Ian Lynagh committed
124
                          withPprStyleDoc dflags (mkCodeStyle CStyle) $ vcat docs
125
    cmmProcLlvmGens dflags h us' env' cmms (count + 2) (ivar ++ ivars)
126 127


dterei's avatar
dterei committed
128
-- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
129 130
cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmDecl
            -> IO ( UniqSupply, LlvmEnv, [LlvmCmmDecl] )
131
cmmLlvmGen dflags us env cmm = do
132
    -- rewrite assignments to global regs
dterei's avatar
dterei committed
133 134
    let fixed_cmm = {-# SCC "llvm_fix_regs" #-}
                    fixStgRegisters cmm
135 136

    dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
137
        (pprCmmGroup [fixed_cmm])
138 139

    -- generate llvm code from cmm
dterei's avatar
dterei committed
140 141
    let ((env', llvmBC), usGen) = {-# SCC "llvm_proc_gen" #-}
                                  initUs us $ genLlvmProc env fixed_cmm
142 143

    dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
Ian Lynagh's avatar
Ian Lynagh committed
144
        (vcat $ map (fst . pprLlvmCmmDecl env' 0) llvmBC)
145 146 147

    return (usGen, env', llvmBC)