compiler/llvmGen/LlvmCodeGen.hs

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