{-# LANGUAGE CPP #-}-- ------------------------------------------------------------------------------ | Base LLVM Code Generation module---- Contains functions useful through out the code generator.--moduleLlvmCodeGen.Base(LlvmCmmDecl ,LlvmBasicBlock ,LiveGlobalRegs ,LlvmUnresData ,LlvmData ,UnresLabel ,UnresStatic ,LlvmVersion ,supportedLlvmVersion ,llvmVersionStr ,LlvmM ,runLlvm ,liftStream ,withClearVars ,varLookup ,varInsert ,markStackReg ,checkStackReg ,funLookup ,funInsert ,getLlvmVer ,getDynFlags ,getDynFlag ,getLlvmPlatform ,dumpIfSetLlvm ,renderLlvm ,markUsedVar ,getUsedVars ,ghcInternalFunctions ,getMetaUniqueId ,setUniqMeta ,getUniqMeta ,cmmToLlvmType ,widthToLlvmFloat ,widthToLlvmInt ,llvmFunTy ,llvmFunSig ,llvmFunArgs ,llvmStdFunAttrs ,llvmFunAlign ,llvmInfAlign ,llvmPtrBits ,tysToParams ,llvmFunSection ,strCLabel_llvm ,strDisplayName_llvm ,strProcedureName_llvm ,getGlobalPtr ,generateExternDecls ,aliasify ,)where#include "HsVersions.h"
#include "ghcautoconf.h"
importGhcPrelude importLlvm importLlvmCodeGen.Regs importCLabel importCodeGen.Platform (activeStgRegs )importDynFlags importFastString importCmm hiding(succ )importOutputable asOutpimportPlatform importUniqFM importUnique importBufWrite (BufHandle )importUniqSet importUniqSupply importErrUtils importqualifiedStream importControl.Monad(ap)-- ------------------------------------------------------------------------------ * Some Data Types--typeLlvmCmmDecl =GenCmmDecl [LlvmData ](MaybeCmmStatics )(ListGraph LlvmStatement )typeLlvmBasicBlock =GenBasicBlock LlvmStatement -- | Global registers live on proc entrytypeLiveGlobalRegs =[GlobalReg ]-- | Unresolved code.-- Of the form: (data label, data type, unresolved data)typeLlvmUnresData =(CLabel ,Section ,LlvmType ,[UnresStatic ])-- | Top level LLVM Data (globals and type aliases)typeLlvmData =([LMGlobal ],[LlvmType ])-- | An unresolved Label.---- Labels are unresolved when we haven't yet determined if they are defined in-- the module we are currently compiling, or an external one.typeUnresLabel =CmmLit typeUnresStatic =EitherUnresLabel LlvmStatic -- ------------------------------------------------------------------------------ * Type translations---- | Translate a basic CmmType to an LlvmType.cmmToLlvmType::CmmType ->LlvmType cmmToLlvmType ty |isVecType ty =LMVector (vecLength ty )(cmmToLlvmType (vecElemType ty ))|isFloatType ty =widthToLlvmFloat $typeWidth ty |otherwise=widthToLlvmInt $typeWidth ty -- | Translate a Cmm Float Width to a LlvmType.widthToLlvmFloat::Width ->LlvmType widthToLlvmFloat W32 =LMFloat widthToLlvmFloatW64 =LMDouble widthToLlvmFloatW80 =LMFloat80 widthToLlvmFloatW128 =LMFloat128 widthToLlvmFloatw =panic $"widthToLlvmFloat: Bad float size: "++showw -- | Translate a Cmm Bit Width to a LlvmType.widthToLlvmInt::Width ->LlvmType widthToLlvmInt w =LMInt $widthInBits w -- | GHC Call Convention for LLVMllvmGhcCC::DynFlags ->LlvmCallConvention llvmGhcCC dflags |platformUnregisterised(targetPlatform dflags )=CC_Ccc |otherwise=CC_Ghc -- | Llvm Function type for Cmm functionllvmFunTy::LiveGlobalRegs ->LlvmM LlvmType llvmFunTy live =return.LMFunction =<<llvmFunSig' live (fsLit "a")ExternallyVisible -- | Llvm Function signaturellvmFunSig::LiveGlobalRegs ->CLabel ->LlvmLinkageType ->LlvmM LlvmFunctionDecl llvmFunSig live lbl link =dolbl' <-strCLabel_llvm lbl llvmFunSig' live lbl' link llvmFunSig'::LiveGlobalRegs ->LMString ->LlvmLinkageType ->LlvmM LlvmFunctionDecl llvmFunSig' live lbl link =dolettoParams x |isPointer x =(x ,[NoAlias ,NoCapture ])|otherwise=(x ,[])dflags <-getDynFlags return$LlvmFunctionDecl lbl link (llvmGhcCC dflags )LMVoid FixedArgs (map(toParams .getVarType )(llvmFunArgs dflags live ))(llvmFunAlign dflags )-- | Alignment to use for functionsllvmFunAlign::DynFlags ->LMAlign llvmFunAlign dflags =Just(wORD_SIZE dflags )-- | Alignment to use for into tablesllvmInfAlign::DynFlags ->LMAlign llvmInfAlign dflags =Just(wORD_SIZE dflags )-- | Section to use for a functionllvmFunSection::DynFlags ->LMString ->LMSection llvmFunSection dflags lbl |gopt Opt_SplitSections dflags =Just(concatFS [fsLit ".text.",lbl ])|otherwise=Nothing-- | A Function's argumentsllvmFunArgs::DynFlags ->LiveGlobalRegs ->[LlvmVar ]llvmFunArgs dflags live =map(lmGlobalRegArg dflags )(filterisPassed (activeStgRegs platform ))whereplatform =targetPlatform dflags isLive r =not(isSSE r )||r `elem`alwaysLive ||r `elem`live isPassed r =not(isSSE r )||isLive r isSSE (FloatReg _)=TrueisSSE(DoubleReg _)=TrueisSSE(XmmReg _)=TrueisSSE(YmmReg _)=TrueisSSE(ZmmReg _)=TrueisSSE_=False-- | Llvm standard fun attributesllvmStdFunAttrs::[LlvmFuncAttr ]llvmStdFunAttrs =[NoUnwind ]-- | Convert a list of types to a list of function parameters-- (each with no parameter attributes)tysToParams::[LlvmType ]->[LlvmParameter ]tysToParams =map(\ty ->(ty ,[]))-- | Pointer widthllvmPtrBits::DynFlags ->IntllvmPtrBits dflags =widthInBits $typeWidth $gcWord dflags -- ------------------------------------------------------------------------------ * Llvm Version---- | LLVM Version NumbertypeLlvmVersion =(Int,Int)-- | The LLVM Version that is currently supported.supportedLlvmVersion::LlvmVersion supportedLlvmVersion =sUPPORTED_LLVM_VERSIONllvmVersionStr::LlvmVersion ->StringllvmVersionStr (major ,minor )=showmajor ++"."++showminor -- ------------------------------------------------------------------------------ * Environment Handling--dataLlvmEnv =LlvmEnv {envVersion ::LlvmVersion -- ^ LLVM version,envDynFlags ::DynFlags -- ^ Dynamic flags,envOutput ::BufHandle -- ^ Output buffer,envUniq ::UniqSupply -- ^ Supply of unique values,envFreshMeta ::MetaId -- ^ Supply of fresh metadata IDs,envUniqMeta ::UniqFM MetaId -- ^ Global metadata nodes,envFunMap ::LlvmEnvMap -- ^ Global functions so far, with type,envAliases ::UniqSet LMString -- ^ Globals that we had to alias, see [Llvm Forward References],envUsedVars ::[LlvmVar ]-- ^ Pointers to be added to llvm.used (see @cmmUsedLlvmGens@)-- the following get cleared for every function (see @withClearVars@),envVarMap ::LlvmEnvMap -- ^ Local variables so far, with type,envStackRegs ::[GlobalReg ]-- ^ Non-constant registers (alloca'd in the function prelude)}typeLlvmEnvMap =UniqFM LlvmType -- | The Llvm monad. Wraps @LlvmEnv@ state as well as the @IO@ monadnewtypeLlvmM a =LlvmM {runLlvmM ::LlvmEnv ->IO(a ,LlvmEnv )}instanceFunctorLlvmM wherefmap f m =LlvmM $\env ->do(x ,env' )<-runLlvmMm env return(f x ,env' )instanceApplicativeLlvmM wherepure x =LlvmM $\env ->return(x ,env )(<*> )=apinstanceMonadLlvmM wherem >>= f =LlvmM $\env ->do(x ,env' )<-runLlvmMm env runLlvmM(f x )env' instanceHasDynFlags LlvmM wheregetDynFlags =LlvmM $\env ->return(envDynFlagsenv ,env )instanceMonadUnique LlvmM wheregetUniqueSupplyM =dous <-getEnv envUniqlet(us1 ,us2 )=splitUniqSupply us modifyEnv (\s ->s {envUniq=us2 })returnus1 getUniqueM =dous <-getEnv envUniqlet(u ,us' )=takeUniqFromSupply us modifyEnv (\s ->s {envUniq=us' })returnu -- | Lifting of IO actions. Not exported, as we want to encapsulate IO.liftIO::IOa ->LlvmM a liftIO m =LlvmM $\env ->dox <-m return(x ,env )-- | Get initial Llvm environment.runLlvm::DynFlags ->LlvmVersion ->BufHandle ->UniqSupply ->LlvmM ()->IO()runLlvm dflags ver out us m =do_<-runLlvmMm env return()whereenv =LlvmEnv {envFunMap=emptyUFM ,envVarMap=emptyUFM ,envStackRegs=[],envUsedVars=[],envAliases=emptyUniqSet ,envVersion=ver ,envDynFlags=dflags ,envOutput=out ,envUniq=us ,envFreshMeta=MetaId 0,envUniqMeta=emptyUFM }-- | Get environment (internal)getEnv::(LlvmEnv ->a )->LlvmM a getEnv f =LlvmM (\env ->return(f env ,env ))-- | Modify environment (internal)modifyEnv::(LlvmEnv ->LlvmEnv )->LlvmM ()modifyEnv f =LlvmM (\env ->return((),f env ))-- | Lift a stream into the LlvmM monadliftStream::Stream.Stream IOa x ->Stream.Stream LlvmM a x liftStream s =Stream.Stream $dor <-liftIO $Stream.runStreams caser ofLeftb ->return(Leftb )Right(a ,r2 )->return(Right(a ,liftStream r2 ))-- | Clear variables from the environment for a subcomputationwithClearVars::LlvmM a ->LlvmM a withClearVars m =LlvmM $\env ->do(x ,env' )<-runLlvmMm env {envVarMap=emptyUFM ,envStackRegs=[]}return(x ,env' {envVarMap=emptyUFM ,envStackRegs=[]})-- | Insert variables or functions into the environment.varInsert,funInsert::Uniquable key =>key ->LlvmType ->LlvmM ()varInsert s t =modifyEnv $\env ->env {envVarMap=addToUFM (envVarMapenv )s t }funInsert s t =modifyEnv $\env ->env {envFunMap=addToUFM (envFunMapenv )s t }-- | Lookup variables or functions in the environment.varLookup,funLookup::Uniquable key =>key ->LlvmM (MaybeLlvmType )varLookup s =getEnv (fliplookupUFM s .envVarMap)funLookup s =getEnv (fliplookupUFM s .envFunMap)-- | Set a register as allocated on the stackmarkStackReg::GlobalReg ->LlvmM ()markStackReg r =modifyEnv $\env ->env {envStackRegs=r :envStackRegsenv }-- | Check whether a register is allocated on the stackcheckStackReg::GlobalReg ->LlvmM BoolcheckStackReg r =getEnv ((elemr ).envStackRegs)-- | Allocate a new global unnamed metadata identifiergetMetaUniqueId::LlvmM MetaId getMetaUniqueId =LlvmM $\env ->return(envFreshMetaenv ,env {envFreshMeta=succ$envFreshMetaenv })-- | Get the LLVM version we are generating code forgetLlvmVer::LlvmM LlvmVersion getLlvmVer =getEnv envVersion-- | Get the platform we are generating code forgetDynFlag::(DynFlags ->a )->LlvmM a getDynFlag f =getEnv (f .envDynFlags)-- | Get the platform we are generating code forgetLlvmPlatform::LlvmM Platform getLlvmPlatform =getDynFlag targetPlatform -- | Dumps the document if the corresponding flag has been set by the userdumpIfSetLlvm::DumpFlag ->String->Outp.SDoc ->LlvmM ()dumpIfSetLlvm flag hdr doc =dodflags <-getDynFlags liftIO $dumpIfSet_dyn dflags flag hdr doc -- | Prints the given contents to the output handlerenderLlvm::Outp.SDoc ->LlvmM ()renderLlvm sdoc =do-- Write to outputdflags <-getDynFlags out <-getEnv envOutputliftIO $Outp.bufLeftRenderSDoc dflags out (Outp.mkCodeStyle Outp.CStyle )sdoc -- Dump, if requesteddumpIfSetLlvm Opt_D_dump_llvm "LLVM Code"sdoc return()-- | Marks a variable as "used"markUsedVar::LlvmVar ->LlvmM ()markUsedVar v =modifyEnv $\env ->env {envUsedVars=v :envUsedVarsenv }-- | Return all variables marked as "used" so fargetUsedVars::LlvmM [LlvmVar ]getUsedVars =getEnv envUsedVars-- | Saves that at some point we didn't know the type of the label and-- generated a reference to a type variable insteadsaveAlias::LMString ->LlvmM ()saveAlias lbl =modifyEnv $\env ->env {envAliases=addOneToUniqSet (envAliasesenv )lbl }-- | Sets metadata node for a given uniquesetUniqMeta::Unique ->MetaId ->LlvmM ()setUniqMeta f m =modifyEnv $\env ->env {envUniqMeta=addToUFM (envUniqMetaenv )f m }-- | Gets metadata node for given uniquegetUniqMeta::Unique ->LlvmM (MaybeMetaId )getUniqMeta s =getEnv (fliplookupUFM s .envUniqMeta)-- ------------------------------------------------------------------------------ * Internal functions---- | Here we pre-initialise some functions that are used internally by GHC-- so as to make sure they have the most general type in the case that-- user code also uses these functions but with a different type than GHC-- internally. (Main offender is treating return type as 'void' instead of-- 'void *'). Fixes trac #5486.ghcInternalFunctions::LlvmM ()ghcInternalFunctions =dodflags <-getDynFlags mk "memcpy"i8Ptr [i8Ptr ,i8Ptr ,llvmWord dflags ]mk "memmove"i8Ptr [i8Ptr ,i8Ptr ,llvmWord dflags ]mk "memset"i8Ptr [i8Ptr ,llvmWord dflags ,llvmWord dflags ]mk "newSpark"(llvmWord dflags )[i8Ptr ,i8Ptr ]wheremk n ret args =doletn' =fsLit n `appendFS `fsLit "$def"decl =LlvmFunctionDecl n' ExternallyVisible CC_Ccc ret FixedArgs (tysToParams args )NothingrenderLlvm $ppLlvmFunctionDecl decl funInsert n' (LMFunction decl )-- ------------------------------------------------------------------------------ * Label handling---- | Pretty print a 'CLabel'.strCLabel_llvm::CLabel ->LlvmM LMString strCLabel_llvm lbl =doplatform <-getLlvmPlatform dflags <-getDynFlags letsdoc =pprCLabel platform lbl str =Outp.renderWithStyle dflags sdoc (Outp.mkCodeStyle Outp.CStyle )return(fsLit str )strDisplayName_llvm::CLabel ->LlvmM LMString strDisplayName_llvm lbl =doplatform <-getLlvmPlatform dflags <-getDynFlags letsdoc =pprCLabel platform lbl depth =Outp.PartWay 1style =Outp.mkUserStyle dflags Outp.reallyAlwaysQualify depth str =Outp.renderWithStyle dflags sdoc style return(fsLit (dropInfoSuffix str ))dropInfoSuffix::String->StringdropInfoSuffix =go wherego "_info"=[]go"_static_info"=[]go"_con_info"=[]go(x :xs )=x :go xs go[]=[]strProcedureName_llvm::CLabel ->LlvmM LMString strProcedureName_llvm lbl =doplatform <-getLlvmPlatform dflags <-getDynFlags letsdoc =pprCLabel platform lbl depth =Outp.PartWay 1style =Outp.mkUserStyle dflags Outp.neverQualify depth str =Outp.renderWithStyle dflags sdoc style return(fsLit str )-- ------------------------------------------------------------------------------ * Global variables / forward references---- | Create/get a pointer to a global value. Might return an alias if-- the value in question hasn't been defined yet. We especially make-- no guarantees on the type of the returned pointer.getGlobalPtr::LMString ->LlvmM LlvmVar getGlobalPtr llvmLbl =dom_ty <-funLookup llvmLbl letmkGlbVar lbl ty =LMGlobalVar lbl (LMPointer ty )Private NothingNothingcasem_ty of-- Directly reference if we have seen it alreadyJustty ->return$mkGlbVar (llvmLbl `appendFS `fsLit "$def")ty Global -- Otherwise use a forward alias of itNothing->dosaveAlias llvmLbl return$mkGlbVar llvmLbl i8 Alias -- | Generate definitions for aliases forward-referenced by @getGlobalPtr@.---- Must be called at a point where we are sure that no new global definitions-- will be generated anymore!generateExternDecls::LlvmM ([LMGlobal ],[LlvmType ])generateExternDecls =dodelayed <-fmapnonDetEltsUniqSet $getEnv envAliases-- This is non-deterministic but we do not-- currently support deterministic code-generation.-- See Note [Unique Determinism and code generation]defss <-flipmapMdelayed $\lbl ->dom_ty <-funLookup lbl casem_ty of-- If we have a definition we've already emitted the proper aliases-- when the symbol itself was emitted by @aliasify@Just_->return[]-- If we don't have a definition this is an external symbol and we-- need to emit a declarationNothing->letvar =LMGlobalVar lbl i8Ptr External NothingNothingGlobal inreturn[LMGlobal var Nothing]-- Reset forward listmodifyEnv $\env ->env {envAliases=emptyUniqSet }return(concatdefss ,[])-- | Here we take a global variable definition, rename it with a-- @$def@ suffix, and generate the appropriate alias.aliasify::LMGlobal ->LlvmM [LMGlobal ]aliasify (LMGlobal var val )=doletLMGlobalVar lbl ty link sect align const =var defLbl =lbl `appendFS `fsLit "$def"defVar =LMGlobalVar defLbl ty Internal sect align const defPtrVar =LMGlobalVar defLbl (LMPointer ty )link NothingNothingconst aliasVar =LMGlobalVar lbl i8Ptr link NothingNothingAlias aliasVal =LMBitc (LMStaticPointer defPtrVar )i8Ptr -- we need to mark the $def symbols as used so LLVM doesn't forget which-- section they need to go in. This will vanish once we switch away from-- mangling sections for TNTC.markUsedVar defVar return[LMGlobal defVar val ,LMGlobal aliasVar (JustaliasVal )]-- Note [Llvm Forward References]---- The issue here is that LLVM insists on being strongly typed at-- every corner, so the first time we mention something, we have to-- settle what type we assign to it. That makes things awkward, as Cmm-- will often reference things before their definition, and we have no-- idea what (LLVM) type it is going to be before that point.---- Our work-around is to define "aliases" of a standard type (i8 *) in-- these kind of situations, which we later tell LLVM to be either-- references to their actual local definitions (involving a cast) or-- an external reference. This obviously only works for pointers.---- In particular when we encounter a reference to a symbol in a chunk of-- C-- there are three possible scenarios,---- 1. We have already seen a definition for the referenced symbol. This-- means we already know its type.---- 2. We have not yet seen a definition but we will find one later in this-- compilation unit. Since we want to be a good consumer of the-- C-- streamed to us from upstream, we don't know the type of the-- symbol at the time when we must emit the reference.---- 3. We have not yet seen a definition nor will we find one in this-- compilation unit. In this case the reference refers to an-- external symbol for which we do not know the type.---- Let's consider case (2) for a moment: say we see a reference to-- the symbol @fooBar@ for which we have not seen a definition. As we-- do not know the symbol's type, we assume it is of type @i8*@ and emit-- the appropriate casts in @getSymbolPtr@. Later on, when we-- encounter the definition of @fooBar@ we emit it but with a modified-- name, @fooBar$def@ (which we'll call the definition symbol), to-- since we have already had to assume that the symbol @fooBar@-- is of type @i8*@. We then emit @fooBar@ itself as an alias-- of @fooBar$def@ with appropriate casts. This all happens in-- @aliasify@.---- Case (3) is quite similar to (2): References are emitted assuming-- the referenced symbol is of type @i8*@. When we arrive at the end of-- the compilation unit and realize that the symbol is external, we emit-- an LLVM @external global@ declaration for the symbol @fooBar@-- (handled in @generateExternDecls@). This takes advantage of the-- fact that the aliases produced by @aliasify@ for exported symbols-- have external linkage and can therefore be used as normal symbols.---- Historical note: As of release 3.5 LLVM does not allow aliases to-- refer to declarations. This the reason why aliases are produced at the-- point of definition instead of the point of usage, as was previously-- done. See #9142 for details.---- Finally, case (1) is trival. As we already have a definition for-- and therefore know the type of the referenced symbol, we can do-- away with casting the alias to the desired type in @getSymbolPtr@-- and instead just emit a reference to the definition symbol directly.-- This is the @Just@ case in @getSymbolPtr@.