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 Llvm
  10
  11 import LlvmCodeGen.Base
  12 import LlvmCodeGen.CodeGen
  13 import LlvmCodeGen.Data
  14 import LlvmCodeGen.Ppr
  15
  16 import CLabel
  17 import Cmm
  18 import CgUtils ( fixStgRegisters )
  19 import PprCmm
  20
  21 import BufWrite
  22 import DynFlags
  23 import ErrUtils
  24 import FastString
  25 import Outputable
  26 import qualified Pretty as Prt
  27 import UniqSupply
  28 import Util
  29
  30 import System.IO
  31
  32 -- -----------------------------------------------------------------------------
  33 -- | Top-level of the llvm codegen
  34 --
  35 llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
  36 llvmCodeGen dflags h us cmms
  37   = do
  38       bufh <- newBufHandle h
  39
  40       Prt.bufLeftRender bufh $ pprLlvmHeader
  41
  42       env' <- cmmDataLlvmGens dflags bufh env cdata []
  43       cmmProcLlvmGens dflags bufh us env' cmm 1 []
  44
  45       bFlush bufh
  46
  47       return  ()
  48   where
  49         cmm = concat $ map (\(Cmm top) -> top) cmms
  50
  51         (cdata,env) = foldr split ([],initLlvmEnv) cmm
  52
  53         split (CmmData _ d'   ) (d,e) = (d':d,e)
  54         split (CmmProc i l _ _) (d,e) =
  55             let lbl = strCLabel_llvm $ if not (null i)
  56                    then entryLblToInfoLbl l
  57                    else l
  58                 env' = funInsert lbl llvmFunTy e
  59             in (d,env')
  60
  61
  62 -- -----------------------------------------------------------------------------
  63 -- | Do llvm code generation on all these cmms data sections.
  64 --
  65 cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [[CmmStatic]]
  66                 -> [LlvmUnresData] -> IO ( LlvmEnv )
  67
  68 cmmDataLlvmGens dflags h env [] lmdata
  69   = let (env', lmdata') = resolveLlvmDatas env lmdata []
  70         lmdoc = Prt.vcat $ map pprLlvmData lmdata'
  71     in do
  72         dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc
  73         Prt.bufLeftRender h lmdoc
  74         return env'
  75
  76 cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
  77   = let lmdata'@(l, ty, _) = genLlvmData cmm
  78         env' = funInsert (strCLabel_llvm l) ty env
  79     in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata'])
  80
  81
  82 -- -----------------------------------------------------------------------------
  83 -- | Do llvm code generation on all these cmms procs.
  84 --
  85 cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmTop]
  86       -> Int          -- ^ count, used for generating unique subsections
  87       -> [LlvmVar]    -- ^ info tables that need to be marked as 'used'
  88       -> IO ()
  89
  90 cmmProcLlvmGens _ _ _ _ [] _ []
  91   = return ()
  92
  93 cmmProcLlvmGens _ h _ _ [] _ ivars
  94   = let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
  95         ty     = (LMArray (length ivars) i8Ptr)
  96         usedArray = LMStaticArray (map cast ivars) ty
  97         lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
  98                   (Just $ fsLit "llvm.metadata") Nothing, Just usedArray)
  99     in do
 100         Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
 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     let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop env' count) llvm
 107     Prt.bufLeftRender h $ Prt.vcat docs
 108
 109     cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars)
 110
 111
 112 -- | Complete llvm code generation phase for a single top-level chunk of Cmm.
 113 cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop
 114             -> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] )
 115
 116 cmmLlvmGen dflags us env cmm
 117   = do
 118     -- rewrite assignments to global regs
 119     let fixed_cmm = fixStgRegisters cmm
 120
 121     dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
 122         (pprCmm $ Cmm [fixed_cmm])
 123
 124     -- generate llvm code from cmm
 125     let ((env', llvmBC), usGen) = initUs us $ genLlvmCode env fixed_cmm
 126
 127     dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
 128         (vcat $ map (docToSDoc . fst . pprLlvmCmmTop env' 0) llvmBC)
 129
 130     return (usGen, env', llvmBC)
 131
 132
 133 -- -----------------------------------------------------------------------------
 134 -- | Instruction selection
 135 --
 136 genLlvmCode :: LlvmEnv -> RawCmmTop
 137             -> UniqSM (LlvmEnv, [LlvmCmmTop])
 138 genLlvmCode env (CmmData _ _                 ) = return (env, [])
 139 genLlvmCode env (CmmProc _ _ _ (ListGraph [])) = return (env, [])
 140 genLlvmCode env cp@(CmmProc _ _ _ _          ) = genLlvmProc env cp
 141