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 import SysTools ( figureLlvmVersion )
  32
  33 import Data.Maybe ( fromMaybe )
  34 import System.IO
  35
  36 -- -----------------------------------------------------------------------------
  37 -- | Top-level of the LLVM Code generator
  38 --
  39 llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
  40 llvmCodeGen dflags h us cmms
  41   = let cmm = concat $ map (\(Cmm top) -> top) cmms
  42         (cdata,env) = foldr split ([],initLlvmEnv) cmm
  43         split (CmmData s d' ) (d,e) = ((s,d'):d,e)
  44         split (CmmProc i l _) (d,e) =
  45             let lbl = strCLabel_llvm $ if not (null i)
  46                    then entryLblToInfoLbl l
  47                    else l
  48                 env' = funInsert lbl llvmFunTy e
  49             in (d,env')
  50     in do
  51         bufh <- newBufHandle h
  52         Prt.bufLeftRender bufh $ pprLlvmHeader
  53         ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
  54
  55         env' <- cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
  56         cmmProcLlvmGens dflags bufh us env' cmm 1 []
  57
  58         bFlush bufh
  59         return  ()
  60
  61
  62 -- -----------------------------------------------------------------------------
  63 -- | Do LLVM code generation on all these Cmms data sections.
  64 --
  65 cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,[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 False, Just usedArray)
  99     in Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
 100
 101 cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars
 102   = do
 103     (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
 104
 105     let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop env' count) llvm
 106     Prt.bufLeftRender h $ Prt.vcat docs
 107
 108     cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars)
 109
 110
 111 -- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
 112 cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop
 113             -> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] )
 114 cmmLlvmGen dflags us env cmm
 115   = do
 116     -- rewrite assignments to global regs
 117     let fixed_cmm = fixStgRegisters cmm
 118
 119     dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
 120         (pprCmm $ Cmm [fixed_cmm])
 121
 122     -- generate llvm code from cmm
 123     let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
 124
 125     dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
 126         (vcat $ map (docToSDoc . fst . pprLlvmCmmTop env' 0) llvmBC)
 127
 128     return (usGen, env', llvmBC)
 129