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

import System.IO

-- -----------------------------------------------------------------------------
dterei's avatar
dterei committed
33
-- | Top-level of the LLVM Code generator
34 35 36 37 38 39 40 41
--
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
  where
        cmm = concat $ map (\(Cmm top) -> top) cmms

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

53
        split (CmmData s d'   ) (d,e) = ((s,d'):d,e)
54 55 56 57 58 59
        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


-- -----------------------------------------------------------------------------
dterei's avatar
dterei committed
63
-- | Do LLVM code generation on all these Cmms data sections.
64
--
65
cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,[CmmStatic])]
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 100
    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


dterei's avatar
dterei committed
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
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
124
    let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
125 126

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

    return (usGen, env', llvmBC)