llvmGen: Compatibility with LLVM 3.5 (re #9142)
authorBen Gamari <bgamari.foss@gmail.com>
Fri, 21 Nov 2014 20:05:25 +0000 (21:05 +0100)
committerHerbert Valerio Riedel <hvr@gnu.org>
Fri, 21 Nov 2014 21:32:16 +0000 (22:32 +0100)
Due to changes in LLVM 3.5 aliases now may only refer to definitions.
Previously to handle symbols defined outside of the current commpilation
unit GHC would emit both an `external` declaration, as well as an alias
pointing to it, e.g.,

    @stg_BCO_info = external global i8
    @stg_BCO_info$alias = alias private i8* @stg_BCO_info

Where references to `stg_BCO_info` will use the alias
`stg_BCO_info$alias`. This is not permitted under the new alias
behavior, resulting in errors resembling,

    Alias must point to a definition
    i8* @"stg_BCO_info$alias"

To fix this, we invert the naming relationship between aliases and
definitions. That is, now the symbol definition takes the name
`@stg_BCO_info$def` and references use the actual name, `@stg_BCO_info`.
This means the external symbols can be handled by simply emitting an
`external` declaration,

    @stg_BCO_info = external global i8

Whereas in the case of a forward declaration we emit,

    @stg_BCO_info = alias private i8* @stg_BCO_info$def

Reviewed By: austin

Differential Revision: https://phabricator.haskell.org/D155

compiler/llvmGen/Llvm/Types.hs
compiler/llvmGen/LlvmCodeGen.hs
compiler/llvmGen/LlvmCodeGen/Base.hs
compiler/llvmGen/LlvmCodeGen/Data.hs
compiler/llvmGen/LlvmCodeGen/Ppr.hs

index 89b0e4e..a9d81a1 100644 (file)
@@ -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
index dd16e52..6120a72 100644 (file)
@@ -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 ()
index 0d6e1ac..83b06a9 100644 (file)
@@ -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
-
index 1dbfb4b..90ce443 100644 (file)
@@ -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
-
index 3b5cbbf..ed21685 100644 (file)
@@ -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