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