LlvmCodeGen.hs 3.97 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
10
import Llvm

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

16
17
import LlvmMangler

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

import BufWrite
import DynFlags
import ErrUtils
dterei's avatar
dterei committed
26
import FastString
27
28
29
import Outputable
import qualified Pretty as Prt
import UniqSupply
dterei's avatar
dterei committed
30
import Util
31
32
33
34

import System.IO

-- -----------------------------------------------------------------------------
dterei's avatar
dterei committed
35
-- | Top-level of the LLVM Code generator
36
37
38
39
40
41
42
43
--
llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
llvmCodeGen dflags h us cmms
  = do
      bufh <- newBufHandle h

      Prt.bufLeftRender bufh $ pprLlvmHeader

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

      bFlush bufh

      return  ()
50
51
52
53
54
  where
        cmm = concat $ map (\(Cmm top) -> top) cmms

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

55
        split (CmmData s d'   ) (d,e) = ((s,d'):d,e)
56
57
58
59
60
61
        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')
62
63
64


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

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

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


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

dterei's avatar
dterei committed
92
93
cmmProcLlvmGens _ _ _ _ [] _ []
  = return ()
94

95
96
97
98
99
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
100
                  (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
101
102
    in do
        Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
dterei's avatar
dterei committed
103
104

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

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

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


dterei's avatar
dterei committed
114
-- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
115
116
cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop
            -> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] )
117
118
119
120
121
122
123
124
125
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
126
    let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
127
128

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

    return (usGen, env', llvmBC)