LlvmCodeGen.hs 4.39 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

dterei's avatar
dterei committed
16
import CLabel
17
import CgUtils ( fixStgRegisters )
18
19
import OldCmm
import OldPprCmm
20
21
22
23

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

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
37
38
--
llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
llvmCodeGen dflags h us cmms
39
  = let cmm = concat $ map (\(Cmm top) -> top) cmms
40
        (cdata,env) = foldr split ([],initLlvmEnv) cmm
41
42
        split (CmmData s d' ) (d,e) = ((s,d'):d,e)
        split (CmmProc i l _) (d,e) =
43
44
45
46
47
            let lbl = strCLabel_llvm $ if not (null i)
                   then entryLblToInfoLbl l
                   else l
                env' = funInsert lbl llvmFunTy e
            in (d,env')
48
49
50
    in do
        bufh <- newBufHandle h
        Prt.bufLeftRender bufh $ pprLlvmHeader
51
        ver  <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
52
        env' <- cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
53
54
55
        cmmProcLlvmGens dflags bufh us env' cmm 1 []
        bFlush bufh
        return  ()
56
57
58


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

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

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


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

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

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

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

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


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

    dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
        (pprCmm $ Cmm [fixed_cmm])

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

    dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
125
        (vcat $ map (docToSDoc . fst . pprLlvmCmmTop env' 0) llvmBC)
126
127
128

    return (usGen, env', llvmBC)