compiler/llvmGen/LlvmCodeGen.hs

   1 -- -----------------------------------------------------------------------------
   2 -- | This is the top-level module in the LLVM code generator.
   3 --
   4
   5 module LlvmCodeGen ( llvmCodeGen ) where
   6
   7 #include "HsVersions.h"
   8
   9 import LlvmCodeGen.Base
  10 import LlvmCodeGen.CodeGen
  11 import LlvmCodeGen.Data
  12 import LlvmCodeGen.Ppr
  13
  14 import Cmm
  15 import CgUtils ( fixStgRegisters )
  16 import PprCmm
  17
  18 import BufWrite
  19 import DynFlags
  20 import ErrUtils
  21 import Outputable
  22 import qualified Pretty as Prt
  23 import UniqSupply
  24
  25 import System.IO
  26
  27 -- -----------------------------------------------------------------------------
  28 -- | Top-level of the llvm codegen
  29 --
  30 llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
  31 llvmCodeGen dflags h us cmms
  32   = do
  33       let cmm = concat $ map extractRawCmm cmms
  34
  35       bufh <- newBufHandle h
  36
  37       Prt.bufLeftRender bufh $ pprLlvmHeader
  38
  39       env <- cmmDataLlvmGens dflags bufh cmm
  40       cmmProcLlvmGens dflags bufh us env cmm
  41
  42       bFlush bufh
  43
  44       return  ()
  45
  46   where extractRawCmm (Cmm tops) = tops
  47
  48
  49 -- -----------------------------------------------------------------------------
  50 -- | Do llvm code generation on all these cmms data sections.
  51 --
  52 cmmDataLlvmGens
  53       :: DynFlags
  54       -> BufHandle
  55       -> [RawCmmTop]
  56       -> IO ( LlvmEnv )
  57
  58 cmmDataLlvmGens _ _ []
  59   = return ( initLlvmEnv )
  60
  61 cmmDataLlvmGens dflags h cmm =
  62     let exData (CmmData s d) = [(s,d)]
  63         exData  _            = []
  64
  65         exProclbl (CmmProc _ l _ _) = [(strCLabel_llvm l)]
  66         exProclbl  _                = []
  67
  68         cdata = concat $ map exData cmm
  69         -- put the functions into the enviornment
  70         cproc = concat $ map exProclbl cmm
  71         env = foldl (\e l -> funInsert l llvmFunTy e) initLlvmEnv cproc
  72     in cmmDataLlvmGens' dflags h env cdata []
  73
  74 cmmDataLlvmGens'
  75       :: DynFlags
  76       -> BufHandle
  77       -> LlvmEnv
  78       -> [(Section, [CmmStatic])]
  79       -> [LlvmUnresData]
  80       -> IO ( LlvmEnv )
  81
  82 cmmDataLlvmGens' dflags h env [] lmdata
  83     = do
  84         let (env', lmdata') = resolveLlvmDatas dflags env lmdata []
  85         let lmdoc = Prt.vcat $ map (pprLlvmData dflags) lmdata'
  86
  87         dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc
  88
  89         Prt.bufLeftRender h lmdoc
  90         return env'
  91
  92 cmmDataLlvmGens' dflags h env (cmm:cmms) lmdata
  93     = do
  94         let lmdata'@(l, ty, _) = genLlvmData dflags cmm
  95         let env' = funInsert (strCLabel_llvm l) ty env
  96         cmmDataLlvmGens' dflags h env' cmms (lmdata ++ [lmdata'])
  97
  98
  99 -- -----------------------------------------------------------------------------
 100 -- | Do llvm code generation on all these cmms procs.
 101 --
 102 cmmProcLlvmGens
 103       :: DynFlags
 104       -> BufHandle
 105       -> UniqSupply
 106       -> LlvmEnv
 107       -> [RawCmmTop]
 108       -> IO ()
 109
 110 cmmProcLlvmGens _ _ _ _ []
 111     = return ()
 112
 113 cmmProcLlvmGens dflags h us env (cmm : cmms)
 114   = do
 115       (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
 116
 117       Prt.bufLeftRender h $ Prt.vcat $ map (pprLlvmCmmTop dflags) llvm
 118
 119       cmmProcLlvmGens dflags h us' env' cmms
 120
 121
 122 -- | Complete llvm code generation phase for a single top-level chunk of Cmm.
 123 cmmLlvmGen
 124       :: DynFlags
 125       -> UniqSupply
 126       -> LlvmEnv
 127       -> RawCmmTop              -- ^ the cmm to generate code for
 128       -> IO ( UniqSupply,
 129               LlvmEnv,
 130               [LlvmCmmTop] )   -- llvm code
 131
 132 cmmLlvmGen dflags us env cmm
 133   = do
 134     -- rewrite assignments to global regs
 135     let fixed_cmm = fixStgRegisters cmm
 136
 137     dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
 138         (pprCmm $ Cmm [fixed_cmm])
 139
 140     -- generate llvm code from cmm
 141     let ((env', llvmBC), usGen) = initUs us $ genLlvmCode dflags env fixed_cmm
 142
 143     dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
 144         (vcat $ map (docToSDoc . pprLlvmCmmTop dflags) llvmBC)
 145
 146     return (usGen, env', llvmBC)
 147
 148
 149 -- -----------------------------------------------------------------------------
 150 -- | Instruction selection
 151 --
 152 genLlvmCode
 153     :: DynFlags
 154     -> LlvmEnv
 155     -> RawCmmTop
 156     -> UniqSM (LlvmEnv, [LlvmCmmTop])
 157
 158 genLlvmCode _ env (CmmData _ _)
 159     = return (env, [])
 160
 161 genLlvmCode _ env (CmmProc _ _ _ (ListGraph []))
 162     = return (env, [])
 163
 164 genLlvmCode _ env cp@(CmmProc _ _ _ _)
 165     = genLlvmProc env cp
 166