LlvmCodeGen.hs 4.42 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.Maybe ( fromMaybe )
31
32
33
import System.IO

-- -----------------------------------------------------------------------------
dterei's avatar
dterei committed
34
-- | Top-level of the LLVM Code generator
35
--
Simon Peyton Jones's avatar
Simon Peyton Jones committed
36
llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmGroup] -> IO ()
37
llvmCodeGen dflags h us cmms
38
  = let cmm = concat cmms
39
        (cdata,env) = foldr split ([],initLlvmEnv) cmm
40
41
        split (CmmData s d' ) (d,e) = ((s,d'):d,e)
        split (CmmProc i l _) (d,e) =
42
43
44
            let lbl = strCLabel_llvm $ case i of
                        Nothing                   -> l
                        Just (Statics info_lbl _) -> info_lbl
45
46
                env' = funInsert lbl llvmFunTy e
            in (d,env')
47
48
49
    in do
        bufh <- newBufHandle h
        Prt.bufLeftRender bufh $ pprLlvmHeader
50
        ver  <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
51
        env' <- cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
52
53
54
        cmmProcLlvmGens dflags bufh us env' cmm 1 []
        bFlush bufh
        return  ()
55
56
57


-- -----------------------------------------------------------------------------
dterei's avatar
dterei committed
58
-- | Do LLVM code generation on all these Cmms data sections.
59
--
60
cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,CmmStatics)]
61
                -> [LlvmUnresData] -> IO ( LlvmEnv )
62

63
64
65
66
cmmDataLlvmGens dflags h env [] lmdata
  = let (env', lmdata') = resolveLlvmDatas env lmdata []
        lmdoc = Prt.vcat $ map pprLlvmData lmdata'
    in do
67
68
69
70
        dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc
        Prt.bufLeftRender h lmdoc
        return env'

71
cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
72
  = let lmdata'@(l, _, ty, _) = genLlvmData cmm
73
74
        env' = funInsert (strCLabel_llvm l) ty env
    in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata'])
75
76
77


-- -----------------------------------------------------------------------------
dterei's avatar
dterei committed
78
-- | Do LLVM code generation on all these Cmms procs.
79
--
Simon Peyton Jones's avatar
Simon Peyton Jones committed
80
cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmDecl]
81
82
      -> Int         -- ^ count, used for generating unique subsections
      -> [[LlvmVar]] -- ^ info tables that need to be marked as 'used'
83
84
      -> IO ()

dterei's avatar
dterei committed
85
86
cmmProcLlvmGens _ _ _ _ [] _ []
  = return ()
87

88
cmmProcLlvmGens _ h _ _ [] _ ivars
89
90
91
92
  = let ivars' = concat ivars
        cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
        ty     = (LMArray (length ivars') i8Ptr)
        usedArray = LMStaticArray (map cast ivars') ty
93
        lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
94
                  (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
95
    in Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
dterei's avatar
dterei committed
96

97
98
cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars
 = cmmProcLlvmGens dflags h us env cmms count ivars
99

100
101
102
103
104
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
105
    let (docs, ivar) = mapAndUnzip (pprLlvmCmmDecl env' count) llvm
106
    Prt.bufLeftRender h $ Prt.vcat docs
107
    cmmProcLlvmGens dflags h us' env' cmms (count + 2) (ivar ++ ivars)
108
109


dterei's avatar
dterei committed
110
-- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
111
112
cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmDecl
            -> IO ( UniqSupply, LlvmEnv, [LlvmCmmDecl] )
113
cmmLlvmGen dflags us env cmm = do
114
115
116
117
    -- rewrite assignments to global regs
    let fixed_cmm = fixStgRegisters cmm

    dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
Simon Peyton Jones's avatar
Simon Peyton Jones committed
118
        (pprCmmGroup (targetPlatform dflags) [fixed_cmm])
119
120

    -- generate llvm code from cmm
121
    let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
122
123

    dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
Simon Peyton Jones's avatar
Simon Peyton Jones committed
124
        (vcat $ map (docToSDoc . fst . pprLlvmCmmDecl env' 0) llvmBC)
125
126
127

    return (usGen, env', llvmBC)