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