diff options
| -rw-r--r-- | compiler/llvmGen/Llvm/Types.hs | 3 | ||||
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen.hs | 5 | ||||
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen/Base.hs | 102 | ||||
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen/Data.hs | 10 | ||||
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen/Ppr.hs | 38 |
5 files changed, 127 insertions, 31 deletions
diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs index 89b0e4e141..a9d81a1828 100644 --- a/compiler/llvmGen/Llvm/Types.hs +++ b/compiler/llvmGen/Llvm/Types.hs @@ -271,7 +271,8 @@ pVarLift (LMLitVar _ ) = error $ "Can't lower a literal type!" -- constructors can be lowered. pLower :: LlvmType -> LlvmType pLower (LMPointer x) = x -pLower x = error $ showSDoc undefined (ppr x) ++ " is a unlowerable type, need a pointer" +pLower x = pprPanic "llvmGen(pLower)" + $ ppr x <+> text " is a unlowerable type, need a pointer" -- | Lower a variable of 'LMPointer' type. pVarLower :: LlvmVar -> LlvmVar diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index dd16e52868..6120a72d3a 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -81,7 +81,7 @@ llvmCodeGen' cmm_stream _ <- Stream.collect llvmStream -- Declare aliases for forward references - renderLlvm . pprLlvmData =<< generateAliases + renderLlvm . pprLlvmData =<< generateExternDecls -- Postamble cmmUsedLlvmGens @@ -120,8 +120,9 @@ cmmDataLlvmGens statics = funInsert l ty regGlobal _ = return () mapM_ regGlobal (concat gss) + gss' <- mapM aliasify $ concat gss - renderLlvm $ pprLlvmData (concat gss, concat tss) + renderLlvm $ pprLlvmData (concat gss', concat tss) -- | Complete LLVM code generation phase for a single top-level chunk of Cmm. cmmLlvmGen ::RawCmmDecl -> LlvmM () diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index 0d6e1ac04c..83b06a9a1b 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -31,8 +31,9 @@ module LlvmCodeGen.Base ( llvmPtrBits, mkLlvmFunc, tysToParams, strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm, - getGlobalPtr, generateAliases, + getGlobalPtr, generateExternDecls, + aliasify, ) where #include "HsVersions.h" @@ -191,7 +192,7 @@ minSupportLlvmVersion :: LlvmVersion minSupportLlvmVersion = 28 maxSupportLlvmVersion :: LlvmVersion -maxSupportLlvmVersion = 34 +maxSupportLlvmVersion = 35 -- ---------------------------------------------------------------------------- -- * Environment Handling @@ -383,7 +384,7 @@ ghcInternalFunctions = do mk "newSpark" (llvmWord dflags) [i8Ptr, i8Ptr] where mk n ret args = do - let n' = fsLit n + let n' = fsLit n `appendFS` fsLit "$def" decl = LlvmFunctionDecl n' ExternallyVisible CC_Ccc ret FixedArgs (tysToParams args) Nothing renderLlvm $ ppLlvmFunctionDecl decl @@ -443,34 +444,59 @@ getGlobalPtr llvmLbl = do let mkGlbVar lbl ty = LMGlobalVar lbl (LMPointer ty) Private Nothing Nothing case m_ty of -- Directly reference if we have seen it already - Just ty -> return $ mkGlbVar llvmLbl ty Global + Just ty -> return $ mkGlbVar (llvmLbl `appendFS` fsLit "$def") ty Global -- Otherwise use a forward alias of it Nothing -> do saveAlias llvmLbl - return $ mkGlbVar (llvmLbl `appendFS` fsLit "$alias") i8 Alias + 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! -generateAliases :: LlvmM ([LMGlobal], [LlvmType]) -generateAliases = do +generateExternDecls :: LlvmM ([LMGlobal], [LlvmType]) +generateExternDecls = do delayed <- fmap uniqSetToList $ getEnv envAliases defss <- flip mapM delayed $ \lbl -> do - let var ty = LMGlobalVar lbl (LMPointer ty) External Nothing Nothing Global - aliasLbl = lbl `appendFS` fsLit "$alias" - aliasVar = LMGlobalVar aliasLbl i8Ptr Private Nothing Nothing Alias - -- If we have a definition, set the alias value using a - -- cost. Otherwise, declare it as an undefined external symbol. m_ty <- funLookup lbl case m_ty of - Just ty -> return [LMGlobal aliasVar $ Just $ LMBitc (LMStaticPointer (var ty)) i8Ptr] - Nothing -> return [LMGlobal (var i8) Nothing, - LMGlobal aliasVar $ Just $ LMStaticPointer (var i8) ] + -- 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 declaration + Nothing -> + let var = LMGlobalVar lbl i8Ptr External Nothing Nothing Global + in return [LMGlobal var Nothing] + -- Reset forward list modifyEnv $ \env -> env { envAliases = emptyUniqSet } return (concat defss, []) +-- | 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) = do + let i8Ptr = LMPointer (LMInt 8) + LMGlobalVar 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 Nothing Nothing const + aliasVar = LMGlobalVar lbl (LMPointer i8Ptr) link Nothing Nothing Alias + 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 (Just aliasVal) + ] + -- Note [Llvm Forward References] -- -- The issue here is that LLVM insists on being strongly typed at @@ -483,6 +509,51 @@ generateAliases = do -- 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@. -- ---------------------------------------------------------------------------- -- * Misc @@ -491,4 +562,3 @@ generateAliases = do -- | Error function panic :: String -> a panic s = Outp.panic $ "LlvmCodeGen.Base." ++ s - diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs index 1dbfb4b527..90ce44367a 100644 --- a/compiler/llvmGen/LlvmCodeGen/Data.hs +++ b/compiler/llvmGen/LlvmCodeGen/Data.hs @@ -39,15 +39,16 @@ genLlvmData (sec, Statics lbl xs) = do let types = map getStatType static strucTy = LMStruct types - alias = LMAlias ((label `appendFS` structStr), strucTy) + tyAlias = LMAlias ((label `appendFS` structStr), strucTy) - struct = Just $ LMStaticStruc static alias + struct = Just $ LMStaticStruc static tyAlias link = if (externallyVisibleCLabel lbl) then ExternallyVisible else Internal const = if isSecConstant sec then Constant else Global - glob = LMGlobalVar label alias link Nothing Nothing const + varDef = LMGlobalVar label tyAlias link Nothing Nothing const + globDef = LMGlobal varDef struct - return ([LMGlobal glob struct], [alias]) + return ([globDef], [tyAlias]) -- | Should a data in this section be considered constant isSecConstant :: Section -> Bool @@ -134,4 +135,3 @@ genStaticLit (CmmHighStackMark) -- | Error Function panic :: String -> a panic s = Outputable.panic $ "LlvmCodeGen.Data." ++ s - diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs index 3b5cbbf632..ed21685b55 100644 --- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs +++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs @@ -107,8 +107,28 @@ pprLlvmCmmDecl count (CmmProc mb_info entry_lbl live (ListGraph blks)) LlvmBlock (getUnique id) stmts) blks fun <- mkLlvmFunc live lbl' link sec' lmblocks - - return (idoc $+$ ppLlvmFunction fun, ivar) + let name = decName $ funcDecl fun + defName = name `appendFS` fsLit "$def" + funcDecl' = (funcDecl fun) { decName = defName } + fun' = fun { funcDecl = funcDecl' } + funTy = LMFunction funcDecl' + funVar = LMGlobalVar name + (LMPointer funTy) + link + Nothing + Nothing + Alias + defVar = LMGlobalVar defName + (LMPointer funTy) + (funcLinkage funcDecl') + (funcSect fun) + (funcAlign funcDecl') + Alias + alias = LMGlobal funVar + (Just $ LMBitc (LMStaticPointer defVar) + (LMPointer $ LMInt 8)) + + return (ppLlvmGlobal alias $+$ idoc $+$ ppLlvmFunction fun', ivar) -- | Pretty print CmmStatic @@ -118,7 +138,8 @@ pprInfoTable count info_lbl stat dflags <- getDynFlags platform <- getLlvmPlatform - let setSection (LMGlobal (LMGlobalVar _ ty l _ _ c) d) = do + let setSection :: LMGlobal -> LlvmM (LMGlobal, [LlvmVar]) + setSection (LMGlobal (LMGlobalVar _ ty l _ _ c) d) = do lbl <- strCLabel_llvm info_lbl let sec = mkLayoutSection count ilabel = lbl `appendFS` fsLit iTableSuf @@ -133,10 +154,13 @@ pprInfoTable count info_lbl stat return (LMGlobal gv d, v) setSection v = return (v,[]) - (ldata', llvmUsed) <- setSection (last ldata) - if length ldata /= 1 - then Outputable.panic "LlvmCodeGen.Ppr: invalid info table!" - else return (pprLlvmData ([ldata'], ltypes), llvmUsed) + (ldata', llvmUsed) <- unzip `fmap` mapM setSection ldata + ldata'' <- mapM aliasify ldata' + let modUsedLabel (LMGlobalVar name ty link sect align const) = + LMGlobalVar (name `appendFS` fsLit "$def") ty link sect align const + modUsedLabel v = v + llvmUsed' = map modUsedLabel $ concat llvmUsed + return (pprLlvmData (concat ldata'', ltypes), llvmUsed') -- | We generate labels for info tables by converting them to the same label |