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

import System.IO

-- -----------------------------------------------------------------------------
-- | Top-level of the llvm codegen
--
llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
llvmCodeGen dflags h us cmms
  = do
dterei's avatar
dterei committed
38
      let cmm = concat $ map (\(Cmm top) -> top) cmms
39
40
41
42
43
44

      bufh <- newBufHandle h

      Prt.bufLeftRender bufh $ pprLlvmHeader

      env <- cmmDataLlvmGens dflags bufh cmm
dterei's avatar
dterei committed
45
      cmmProcLlvmGens dflags bufh us env cmm 1 []
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

      bFlush bufh

      return  ()


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

cmmDataLlvmGens _ _ []
  = return ( initLlvmEnv )

cmmDataLlvmGens dflags h cmm =
    let exData (CmmData s d) = [(s,d)]
        exData  _            = []

dterei's avatar
dterei committed
68
69
70
71
        exProclbl (CmmProc i l _ _)
                | not (null i) = [strCLabel_llvm $ entryLblToInfoLbl l]
        exProclbl (CmmProc _ l _ _) | otherwise = [strCLabel_llvm l]
        exProclbl _                             = []
72
73

        cproc = concat $ map exProclbl cmm
dterei's avatar
dterei committed
74
        cdata = concat $ map exData cmm
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
        env = foldl (\e l -> funInsert l llvmFunTy e) initLlvmEnv cproc
    in cmmDataLlvmGens' dflags h env cdata []

cmmDataLlvmGens'
      :: DynFlags
      -> BufHandle
      -> LlvmEnv
      -> [(Section, [CmmStatic])]
      -> [LlvmUnresData]
      -> IO ( LlvmEnv )

cmmDataLlvmGens' dflags h env [] lmdata
    = do
        let (env', lmdata') = resolveLlvmDatas dflags env lmdata []
        let lmdoc = Prt.vcat $ map (pprLlvmData dflags) lmdata'

        dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc

        Prt.bufLeftRender h lmdoc
        return env'

cmmDataLlvmGens' dflags h env (cmm:cmms) lmdata
    = do
        let lmdata'@(l, ty, _) = genLlvmData dflags cmm
        let env' = funInsert (strCLabel_llvm l) ty env
        cmmDataLlvmGens' dflags h env' cmms (lmdata ++ [lmdata'])


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

dterei's avatar
dterei committed
116
117
cmmProcLlvmGens _ _ _ _ [] _ []
  = return ()
118

dterei's avatar
dterei committed
119
120
121
122
123
124
125
126
127
128
cmmProcLlvmGens dflags h _ _ [] _ ivars
  = do
      let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
      let ty = (LMArray (length ivars) i8Ptr)
      let usedArray = LMStaticArray (map cast ivars) ty
      let lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
                      (Just $ fsLit "llvm.metadata") Nothing, Just usedArray)
      Prt.bufLeftRender h $ pprLlvmData dflags ([lmUsed], [])

cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars
129
130
131
  = do
      (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm

dterei's avatar
dterei committed
132
133
      let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop dflags env' count) llvm
      Prt.bufLeftRender h $ Prt.vcat docs
134

dterei's avatar
dterei committed
135
      cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars)
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159


-- | Complete llvm code generation phase for a single top-level chunk of Cmm.
cmmLlvmGen
      :: DynFlags
      -> UniqSupply
      -> LlvmEnv
      -> RawCmmTop              -- ^ the cmm to generate code for
      -> IO ( UniqSupply,
              LlvmEnv,
              [LlvmCmmTop] )   -- llvm code

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
    let ((env', llvmBC), usGen) = initUs us $ genLlvmCode dflags env fixed_cmm

    dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
dterei's avatar
dterei committed
160
        (vcat $ map (docToSDoc . fst . pprLlvmCmmTop dflags env' 0) llvmBC)
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182

    return (usGen, env', llvmBC)


-- -----------------------------------------------------------------------------
-- | Instruction selection
--
genLlvmCode
    :: DynFlags
    -> LlvmEnv
    -> RawCmmTop
    -> UniqSM (LlvmEnv, [LlvmCmmTop])

genLlvmCode _ env (CmmData _ _)
    = return (env, [])

genLlvmCode _ env (CmmProc _ _ _ (ListGraph []))
    = return (env, [])

genLlvmCode _ env cp@(CmmProc _ _ _ _)
    = genLlvmProc env cp