LlvmCodeGen.hs 4.3 KB
Newer Older
1
2
3
4
5
6
7
8
-- -----------------------------------------------------------------------------
-- | This is the top-level module in the LLVM code generator.
--

module LlvmCodeGen ( llvmCodeGen ) where

#include "HsVersions.h"

dterei's avatar
dterei committed
9
10
import Llvm

11
12
13
14
15
import LlvmCodeGen.Base
import LlvmCodeGen.CodeGen
import LlvmCodeGen.Data
import LlvmCodeGen.Ppr

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

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
30
31
32
33
34
35
36
37
38
39
40
41

import System.IO

-- -----------------------------------------------------------------------------
-- | Top-level of the llvm codegen
--
llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
llvmCodeGen dflags h us cmms
  = do
      bufh <- newBufHandle h

      Prt.bufLeftRender bufh $ pprLlvmHeader

42
43
      env' <- cmmDataLlvmGens dflags bufh env cdata []
      cmmProcLlvmGens dflags bufh us env' cmm 1 []
44
45
46
47

      bFlush bufh

      return  ()
48
49
50
51
52
53
54
55
56
57
58
59
  where
        cmm = concat $ map (\(Cmm top) -> top) cmms

        (cdata,env) = foldr split ([],initLlvmEnv) cmm

        split (CmmData _ d'   ) (d,e) = (d':d,e)
        split (CmmProc i l _ _) (d,e) =
            let lbl = strCLabel_llvm $ if not (null i)
                   then entryLblToInfoLbl l
                   else l
                env' = funInsert lbl llvmFunTy e
            in (d,env')
60
61
62
63
64


-- -----------------------------------------------------------------------------
-- | Do llvm code generation on all these cmms data sections.
--
65
66
cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [[CmmStatic]]
                -> [LlvmUnresData] -> IO ( LlvmEnv )
67

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

76
77
78
79
cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
  = let lmdata'@(l, ty, _) = genLlvmData cmm
        env' = funInsert (strCLabel_llvm l) ty env
    in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata'])
80
81
82
83
84


-- -----------------------------------------------------------------------------
-- | Do llvm code generation on all these cmms procs.
--
85
cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmTop]
dterei's avatar
dterei committed
86
87
      -> Int          -- ^ count, used for generating unique subsections
      -> [LlvmVar]    -- ^ info tables that need to be marked as 'used'
88
89
      -> IO ()

dterei's avatar
dterei committed
90
91
cmmProcLlvmGens _ _ _ _ [] _ []
  = return ()
92

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

cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars
103
  = do
104
    (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
105

106
107
    let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop env' count) llvm
    Prt.bufLeftRender h $ Prt.vcat docs
108

109
    cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars)
110
111
112


-- | Complete llvm code generation phase for a single top-level chunk of Cmm.
113
114
cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop
            -> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] )
115
116
117
118
119
120
121
122
123
124

cmmLlvmGen dflags us env cmm
  = do
    -- 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
125
    let ((env', llvmBC), usGen) = initUs us $ genLlvmCode env fixed_cmm
126
127

    dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
128
        (vcat $ map (docToSDoc . fst . pprLlvmCmmTop env' 0) llvmBC)
129
130
131
132
133
134
135

    return (usGen, env', llvmBC)


-- -----------------------------------------------------------------------------
-- | Instruction selection
--
136
137
138
139
140
genLlvmCode :: LlvmEnv -> RawCmmTop
            -> UniqSM (LlvmEnv, [LlvmCmmTop])
genLlvmCode env (CmmData _ _                 ) = return (env, [])
genLlvmCode env (CmmProc _ _ _ (ListGraph [])) = return (env, [])
genLlvmCode env cp@(CmmProc _ _ _ _          ) = genLlvmProc env cp
141