LlvmCodeGen.hs 4.13 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
import CgUtils ( fixStgRegisters )
20
21
import OldCmm
import OldPprCmm
22
23
24
25

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
import SysTools ( figureLlvmVersion )
32

33
import Data.Maybe ( fromMaybe )
34
35
36
import System.IO

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

        bFlush bufh
        return  ()
60
61
62


-- -----------------------------------------------------------------------------
dterei's avatar
dterei committed
63
-- | Do LLVM code generation on all these Cmms data sections.
64
--
65
cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,CmmStatics)]
66
                -> [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
cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
77
  = let lmdata'@(l, _, ty, _) = genLlvmData cmm
78
79
        env' = funInsert (strCLabel_llvm l) ty env
    in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata'])
80
81
82


-- -----------------------------------------------------------------------------
dterei's avatar
dterei committed
83
-- | Do LLVM code generation on all these Cmms procs.
84
--
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
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
98
                  (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
99
    in Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
dterei's avatar
dterei committed
100
101

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

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

108
    cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat 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
115
116
117
118
119
120
121
122
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
123
    let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
124
125

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

    return (usGen, env', llvmBC)