1{-# LANGUAGE CPP #-} 2{-# LANGUAGE DeriveFunctor #-} 3 4-- ---------------------------------------------------------------------------- 5-- | Base LLVM Code Generation module 6-- 7-- Contains functions useful through out the code generator. 8-- 9 10module LlvmCodeGen.Base ( 11 12 LlvmCmmDecl, LlvmBasicBlock, 13 LiveGlobalRegs, 14 LlvmUnresData, LlvmData, UnresLabel, UnresStatic, 15 16 LlvmVersion, llvmVersionSupported, parseLlvmVersion, 17 supportedLlvmVersionLowerBound, supportedLlvmVersionUpperBound, 18 llvmVersionStr, llvmVersionList, 19 20 LlvmM, 21 runLlvm, liftStream, withClearVars, varLookup, varInsert, 22 markStackReg, checkStackReg, 23 funLookup, funInsert, getLlvmVer, getDynFlags, getDynFlag, getLlvmPlatform, 24 dumpIfSetLlvm, renderLlvm, markUsedVar, getUsedVars, 25 ghcInternalFunctions, 26 27 getMetaUniqueId, 28 setUniqMeta, getUniqMeta, 29 30 cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy, 31 llvmFunSig, llvmFunArgs, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign, 32 llvmPtrBits, tysToParams, llvmFunSection, 33 34 strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm, 35 getGlobalPtr, generateExternDecls, 36 37 aliasify, llvmDefLabel, 38 39 padLiveArgs, isFPR 40 ) where 41 42#include "HsVersions.h" 43#include "ghcautoconf.h" 44 45import GhcPrelude 46 47import Llvm 48import LlvmCodeGen.Regs 49import Panic 50 51import PprCmm () 52import CLabel 53import GHC.Platform.Regs ( activeStgRegs, globalRegMaybe ) 54import DynFlags 55import FastString 56import Cmm hiding ( succ ) 57import CmmUtils (regsOverlap) 58import Outputable as Outp 59import GHC.Platform 60import UniqFM 61import Unique 62import BufWrite ( BufHandle ) 63import UniqSet 64import UniqSupply 65import ErrUtils 66import qualified Stream 67 68import Data.Maybe (fromJust) 69import Control.Monad (ap) 70import Data.Char (isDigit) 71import Data.List (sortBy, groupBy, intercalate) 72import Data.Ord (comparing) 73import qualified Data.List.NonEmpty as NE 74 75-- ---------------------------------------------------------------------------- 76-- * Some Data Types 77-- 78 79type LlvmCmmDecl = GenCmmDecl [LlvmData] (Maybe CmmStatics) (ListGraph LlvmStatement) 80type LlvmBasicBlock = GenBasicBlock LlvmStatement 81 82-- | Global registers live on proc entry 83type LiveGlobalRegs = [GlobalReg] 84 85-- | Unresolved code. 86-- Of the form: (data label, data type, unresolved data) 87type LlvmUnresData = (CLabel, Section, LlvmType, [UnresStatic]) 88 89-- | Top level LLVM Data (globals and type aliases) 90type LlvmData = ([LMGlobal], [LlvmType]) 91 92-- | An unresolved Label. 93-- 94-- Labels are unresolved when we haven't yet determined if they are defined in 95-- the module we are currently compiling, or an external one. 96type UnresLabel = CmmLit 97type UnresStatic = Either UnresLabel LlvmStatic 98 99-- ---------------------------------------------------------------------------- 100-- * Type translations 101-- 102 103-- | Translate a basic CmmType to an LlvmType. 104cmmToLlvmType :: CmmType -> LlvmType 105cmmToLlvmType ty | isVecType ty = LMVector (vecLength ty) (cmmToLlvmType (vecElemType ty)) 106 | isFloatType ty = widthToLlvmFloat $ typeWidth ty 107 | otherwise = widthToLlvmInt $ typeWidth ty 108 109-- | Translate a Cmm Float Width to a LlvmType. 110widthToLlvmFloat :: Width -> LlvmType 111widthToLlvmFloat W32 = LMFloat 112widthToLlvmFloat W64 = LMDouble 113widthToLlvmFloat W128 = LMFloat128 114widthToLlvmFloat w = panic $ "widthToLlvmFloat: Bad float size: " ++ show w 115 116-- | Translate a Cmm Bit Width to a LlvmType. 117widthToLlvmInt :: Width -> LlvmType 118widthToLlvmInt w = LMInt $ widthInBits w 119 120-- | GHC Call Convention for LLVM 121llvmGhcCC :: DynFlags -> LlvmCallConvention 122llvmGhcCC dflags 123 | platformUnregisterised (targetPlatform dflags) = CC_Ccc 124 | otherwise = CC_Ghc 125 126-- | Llvm Function type for Cmm function 127llvmFunTy :: LiveGlobalRegs -> LlvmM LlvmType 128llvmFunTy live = return . LMFunction =<< llvmFunSig' live (fsLit "a") ExternallyVisible 129 130-- | Llvm Function signature 131llvmFunSig :: LiveGlobalRegs -> CLabel -> LlvmLinkageType -> LlvmM LlvmFunctionDecl 132llvmFunSig live lbl link = do 133 lbl' <- strCLabel_llvm lbl 134 llvmFunSig' live lbl' link 135 136llvmFunSig' :: LiveGlobalRegs -> LMString -> LlvmLinkageType -> LlvmM LlvmFunctionDecl 137llvmFunSig' live lbl link 138 = do let toParams x | isPointer x = (x, [NoAlias, NoCapture]) 139 | otherwise = (x, []) 140 dflags <- getDynFlags 141 return $ LlvmFunctionDecl lbl link (llvmGhcCC dflags) LMVoid FixedArgs 142 (map (toParams . getVarType) (llvmFunArgs dflags live)) 143 (llvmFunAlign dflags) 144 145-- | Alignment to use for functions 146llvmFunAlign :: DynFlags -> LMAlign 147llvmFunAlign dflags = Just (wORD_SIZE dflags) 148 149-- | Alignment to use for into tables 150llvmInfAlign :: DynFlags -> LMAlign 151llvmInfAlign dflags = Just (wORD_SIZE dflags) 152 153-- | Section to use for a function 154llvmFunSection :: DynFlags -> LMString -> LMSection 155llvmFunSection dflags lbl 156 | gopt Opt_SplitSections dflags = Just (concatFS [fsLit ".text.", lbl]) 157 | otherwise = Nothing 158 159-- | A Function's arguments 160llvmFunArgs :: DynFlags -> LiveGlobalRegs -> [LlvmVar] 161llvmFunArgs dflags live = 162 map (lmGlobalRegArg dflags) (filter isPassed allRegs) 163 where allRegs = activeStgRegs (targetPlatform dflags) 164 paddingRegs = padLiveArgs dflags live 165 isLive r = r `elem` alwaysLive 166 || r `elem` live 167 || r `elem` paddingRegs 168 isPassed r = not (isFPR r) || isLive r 169 170 171isFPR :: GlobalReg -> Bool 172isFPR (FloatReg _) = True 173isFPR (DoubleReg _) = True 174isFPR (XmmReg _) = True 175isFPR (YmmReg _) = True 176isFPR (ZmmReg _) = True 177isFPR _ = False 178 179-- | Return a list of "padding" registers for LLVM function calls. 180-- 181-- When we generate LLVM function signatures, we can't just make any register 182-- alive on function entry. Instead, we need to insert fake arguments of the 183-- same register class until we are sure that one of them is mapped to the 184-- register we want alive. E.g. to ensure that F5 is alive, we may need to 185-- insert fake arguments mapped to F1, F2, F3 and F4. 186-- 187-- Invariant: Cmm FPR regs with number "n" maps to real registers with number 188-- "n" If the calling convention uses registers in a different order or if the 189-- invariant doesn't hold, this code probably won't be correct. 190padLiveArgs :: DynFlags -> LiveGlobalRegs -> LiveGlobalRegs 191padLiveArgs dflags live = 192 if platformUnregisterised platform 193 then [] -- not using GHC's register convention for platform. 194 else padded 195 where 196 platform = targetPlatform dflags 197 198 ---------------------------------- 199 -- handle floating-point registers (FPR) 200 201 fprLive = filter isFPR live -- real live FPR registers 202 203 -- we group live registers sharing the same classes, i.e. that use the same 204 -- set of real registers to be passed. E.g. FloatReg, DoubleReg and XmmReg 205 -- all use the same real regs on X86-64 (XMM registers). 206 -- 207 classes = groupBy sharesClass fprLive 208 sharesClass a b = regsOverlap dflags (norm a) (norm b) -- check if mapped to overlapping registers 209 norm x = CmmGlobal ((fpr_ctor x) 1) -- get the first register of the family 210 211 -- For each class, we just have to fill missing registers numbers. We use 212 -- the constructor of the greatest register to build padding registers. 213 -- 214 -- E.g. sortedRs = [ F2, XMM4, D5] 215 -- output = [D1, D3] 216 padded = concatMap padClass classes 217 padClass rs = go sortedRs [1..] 218 where 219 sortedRs = sortBy (comparing fpr_num) rs 220 maxr = last sortedRs 221 ctor = fpr_ctor maxr 222 223 go [] _ = [] 224 go (c1:c2:_) _ -- detect bogus case (see #17920) 225 | fpr_num c1 == fpr_num c2 226 , Just real <- globalRegMaybe platform c1 227 = sorryDoc "LLVM code generator" $ 228 text "Found two different Cmm registers (" <> ppr c1 <> text "," <> ppr c2 <> 229 text ") both alive AND mapped to the same real register: " <> ppr real <> 230 text ". This isn't currently supported by the LLVM backend." 231 go (c:cs) (f:fs) 232 | fpr_num c == f = go cs fs -- already covered by a real register 233 | otherwise = ctor f : go (c:cs) fs -- add padding register 234 go _ _ = undefined -- unreachable 235 236 fpr_ctor :: GlobalReg -> Int -> GlobalReg 237 fpr_ctor (FloatReg _) = FloatReg 238 fpr_ctor (DoubleReg _) = DoubleReg 239 fpr_ctor (XmmReg _) = XmmReg 240 fpr_ctor (YmmReg _) = YmmReg 241 fpr_ctor (ZmmReg _) = ZmmReg 242 fpr_ctor _ = error "fpr_ctor expected only FPR regs" 243 244 fpr_num :: GlobalReg -> Int 245 fpr_num (FloatReg i) = i 246 fpr_num (DoubleReg i) = i 247 fpr_num (XmmReg i) = i 248 fpr_num (YmmReg i) = i 249 fpr_num (ZmmReg i) = i 250 fpr_num _ = error "fpr_num expected only FPR regs" 251 252 253-- | Llvm standard fun attributes 254llvmStdFunAttrs :: [LlvmFuncAttr] 255llvmStdFunAttrs = [NoUnwind] 256 257-- | Convert a list of types to a list of function parameters 258-- (each with no parameter attributes) 259tysToParams :: [LlvmType] -> [LlvmParameter] 260tysToParams = map (\ty -> (ty, [])) 261 262-- | Pointer width 263llvmPtrBits :: DynFlags -> Int 264llvmPtrBits dflags = widthInBits $ typeWidth $ gcWord dflags 265 266-- ---------------------------------------------------------------------------- 267-- * Llvm Version 268-- 269 270newtype LlvmVersion = LlvmVersion { llvmVersionNE :: NE.NonEmpty Int } 271 deriving (Eq, Ord) 272 273parseLlvmVersion :: String -> Maybe LlvmVersion 274parseLlvmVersion = 275 fmap LlvmVersion . NE.nonEmpty . go [] . dropWhile (not . isDigit) 276 where 277 go vs s 278 | null ver_str 279 = reverse vs 280 | '.' : rest' <- rest 281 = go (read ver_str : vs) rest' 282 | otherwise 283 = reverse (read ver_str : vs) 284 where 285 (ver_str, rest) = span isDigit s 286 287-- | The (inclusive) lower bound on the LLVM Version that is currently supported. 288supportedLlvmVersionLowerBound :: LlvmVersion 289supportedLlvmVersionLowerBound = LlvmVersion (sUPPORTED_LLVM_VERSION_MIN NE.:| []) 290 291-- | The (not-inclusive) upper bound bound on the LLVM Version that is currently supported. 292supportedLlvmVersionUpperBound :: LlvmVersion 293supportedLlvmVersionUpperBound = LlvmVersion (sUPPORTED_LLVM_VERSION_MAX NE.:| []) 294 295llvmVersionSupported :: LlvmVersion -> Bool 296llvmVersionSupported v = 297 v >= supportedLlvmVersionLowerBound && v < supportedLlvmVersionUpperBound 298 299llvmVersionStr :: LlvmVersion -> String 300llvmVersionStr = intercalate "." . map show . llvmVersionList 301 302llvmVersionList :: LlvmVersion -> [Int] 303llvmVersionList = NE.toList . llvmVersionNE 304 305-- ---------------------------------------------------------------------------- 306-- * Environment Handling 307-- 308 309data LlvmEnv = LlvmEnv 310 { envVersion :: LlvmVersion -- ^ LLVM version 311 , envDynFlags :: DynFlags -- ^ Dynamic flags 312 , envOutput :: BufHandle -- ^ Output buffer 313 , envMask :: !Char -- ^ Mask for creating unique values 314 , envFreshMeta :: MetaId -- ^ Supply of fresh metadata IDs 315 , envUniqMeta :: UniqFM MetaId -- ^ Global metadata nodes 316 , envFunMap :: LlvmEnvMap -- ^ Global functions so far, with type 317 , envAliases :: UniqSet LMString -- ^ Globals that we had to alias, see [Llvm Forward References] 318 , envUsedVars :: [LlvmVar] -- ^ Pointers to be added to llvm.used (see @cmmUsedLlvmGens@) 319 320 -- the following get cleared for every function (see @withClearVars@) 321 , envVarMap :: LlvmEnvMap -- ^ Local variables so far, with type 322 , envStackRegs :: [GlobalReg] -- ^ Non-constant registers (alloca'd in the function prelude) 323 } 324 325type LlvmEnvMap = UniqFM LlvmType 326 327-- | The Llvm monad. Wraps @LlvmEnv@ state as well as the @IO@ monad 328newtype LlvmM a = LlvmM { runLlvmM :: LlvmEnv -> IO (a, LlvmEnv) } 329 deriving (Functor) 330 331instance Applicative LlvmM where 332 pure x = LlvmM $ \env -> return (x, env) 333 (<*>) = ap 334 335instance Monad LlvmM where 336 m >>= f = LlvmM $ \env -> do (x, env') <- runLlvmM m env 337 runLlvmM (f x) env' 338 339instance HasDynFlags LlvmM where 340 getDynFlags = LlvmM $ \env -> return (envDynFlags env, env) 341 342instance MonadUnique LlvmM where 343 getUniqueSupplyM = do 344 mask <- getEnv envMask 345 liftIO $! mkSplitUniqSupply mask 346 347 getUniqueM = do 348 mask <- getEnv envMask 349 liftIO $! uniqFromMask mask 350 351-- | Lifting of IO actions. Not exported, as we want to encapsulate IO. 352liftIO :: IO a -> LlvmM a 353liftIO m = LlvmM $ \env -> do x <- m 354 return (x, env) 355 356-- | Get initial Llvm environment. 357runLlvm :: DynFlags -> LlvmVersion -> BufHandle -> LlvmM a -> IO a 358runLlvm dflags ver out m = do 359 (a, _) <- runLlvmM m env 360 return a 361 where env = LlvmEnv { envFunMap = emptyUFM 362 , envVarMap = emptyUFM 363 , envStackRegs = [] 364 , envUsedVars = [] 365 , envAliases = emptyUniqSet 366 , envVersion = ver 367 , envDynFlags = dflags 368 , envOutput = out 369 , envMask = 'n' 370 , envFreshMeta = MetaId 0 371 , envUniqMeta = emptyUFM 372 } 373 374-- | Get environment (internal) 375getEnv :: (LlvmEnv -> a) -> LlvmM a 376getEnv f = LlvmM (\env -> return (f env, env)) 377 378-- | Modify environment (internal) 379modifyEnv :: (LlvmEnv -> LlvmEnv) -> LlvmM () 380modifyEnv f = LlvmM (\env -> return ((), f env)) 381 382-- | Lift a stream into the LlvmM monad 383liftStream :: Stream.Stream IO a x -> Stream.Stream LlvmM a x 384liftStream s = Stream.Stream $ do 385 r <- liftIO $ Stream.runStream s 386 case r of 387 Left b -> return (Left b) 388 Right (a, r2) -> return (Right (a, liftStream r2)) 389 390-- | Clear variables from the environment for a subcomputation 391withClearVars :: LlvmM a -> LlvmM a 392withClearVars m = LlvmM $ \env -> do 393 (x, env') <- runLlvmM m env { envVarMap = emptyUFM, envStackRegs = [] } 394 return (x, env' { envVarMap = emptyUFM, envStackRegs = [] }) 395 396-- | Insert variables or functions into the environment. 397varInsert, funInsert :: Uniquable key => key -> LlvmType -> LlvmM () 398varInsert s t = modifyEnv $ \env -> env { envVarMap = addToUFM (envVarMap env) s t } 399funInsert s t = modifyEnv $ \env -> env { envFunMap = addToUFM (envFunMap env) s t } 400 401-- | Lookup variables or functions in the environment. 402varLookup, funLookup :: Uniquable key => key -> LlvmM (Maybe LlvmType) 403varLookup s = getEnv (flip lookupUFM s . envVarMap) 404funLookup s = getEnv (flip lookupUFM s . envFunMap) 405 406-- | Set a register as allocated on the stack 407markStackReg :: GlobalReg -> LlvmM () 408markStackReg r = modifyEnv $ \env -> env { envStackRegs = r : envStackRegs env } 409 410-- | Check whether a register is allocated on the stack 411checkStackReg :: GlobalReg -> LlvmM Bool 412checkStackReg r = getEnv ((elem r) . envStackRegs) 413 414-- | Allocate a new global unnamed metadata identifier 415getMetaUniqueId :: LlvmM MetaId 416getMetaUniqueId = LlvmM $ \env -> 417 return (envFreshMeta env, env { envFreshMeta = succ $ envFreshMeta env }) 418 419-- | Get the LLVM version we are generating code for 420getLlvmVer :: LlvmM LlvmVersion 421getLlvmVer = getEnv envVersion 422 423-- | Get the platform we are generating code for 424getDynFlag :: (DynFlags -> a) -> LlvmM a 425getDynFlag f = getEnv (f . envDynFlags) 426 427-- | Get the platform we are generating code for 428getLlvmPlatform :: LlvmM Platform 429getLlvmPlatform = getDynFlag targetPlatform 430 431-- | Dumps the document if the corresponding flag has been set by the user 432dumpIfSetLlvm :: DumpFlag -> String -> Outp.SDoc -> LlvmM () 433dumpIfSetLlvm flag hdr doc = do 434 dflags <- getDynFlags 435 liftIO $ dumpIfSet_dyn dflags flag hdr doc 436 437-- | Prints the given contents to the output handle 438renderLlvm :: Outp.SDoc -> LlvmM () 439renderLlvm sdoc = do 440 441 -- Write to output 442 dflags <- getDynFlags 443 out <- getEnv envOutput 444 liftIO $ Outp.bufLeftRenderSDoc dflags out 445 (Outp.mkCodeStyle Outp.CStyle) sdoc 446 447 -- Dump, if requested 448 dumpIfSetLlvm Opt_D_dump_llvm "LLVM Code" sdoc 449 return () 450 451-- | Marks a variable as "used" 452markUsedVar :: LlvmVar -> LlvmM () 453markUsedVar v = modifyEnv $ \env -> env { envUsedVars = v : envUsedVars env } 454 455-- | Return all variables marked as "used" so far 456getUsedVars :: LlvmM [LlvmVar] 457getUsedVars = getEnv envUsedVars 458 459-- | Saves that at some point we didn't know the type of the label and 460-- generated a reference to a type variable instead 461saveAlias :: LMString -> LlvmM () 462saveAlias lbl = modifyEnv $ \env -> env { envAliases = addOneToUniqSet (envAliases env) lbl } 463 464-- | Sets metadata node for a given unique 465setUniqMeta :: Unique -> MetaId -> LlvmM () 466setUniqMeta f m = modifyEnv $ \env -> env { envUniqMeta = addToUFM (envUniqMeta env) f m } 467 468-- | Gets metadata node for given unique 469getUniqMeta :: Unique -> LlvmM (Maybe MetaId) 470getUniqMeta s = getEnv (flip lookupUFM s . envUniqMeta) 471 472-- ---------------------------------------------------------------------------- 473-- * Internal functions 474-- 475 476-- | Here we pre-initialise some functions that are used internally by GHC 477-- so as to make sure they have the most general type in the case that 478-- user code also uses these functions but with a different type than GHC 479-- internally. (Main offender is treating return type as 'void' instead of 480-- 'void *'). Fixes trac #5486. 481ghcInternalFunctions :: LlvmM () 482ghcInternalFunctions = do 483 dflags <- getDynFlags 484 let w = llvmWord dflags 485 cint = LMInt $ widthInBits $ cIntWidth dflags 486 mk "memcmp" cint [i8Ptr, i8Ptr, w] 487 mk "memcpy" i8Ptr [i8Ptr, i8Ptr, w] 488 mk "memmove" i8Ptr [i8Ptr, i8Ptr, w] 489 mk "memset" i8Ptr [i8Ptr, w, w] 490 mk "newSpark" w [i8Ptr, i8Ptr] 491 where 492 mk n ret args = do 493 let n' = fsLit n 494 decl = LlvmFunctionDecl n' ExternallyVisible CC_Ccc ret 495 FixedArgs (tysToParams args) Nothing 496 renderLlvm $ ppLlvmFunctionDecl decl 497 funInsert n' (LMFunction decl) 498 499-- ---------------------------------------------------------------------------- 500-- * Label handling 501-- 502 503-- | Pretty print a 'CLabel'. 504strCLabel_llvm :: CLabel -> LlvmM LMString 505strCLabel_llvm lbl = do 506 dflags <- getDynFlags 507 let sdoc = pprCLabel dflags lbl 508 str = Outp.renderWithStyle dflags sdoc (Outp.mkCodeStyle Outp.CStyle) 509 return (fsLit str) 510 511strDisplayName_llvm :: CLabel -> LlvmM LMString 512strDisplayName_llvm lbl = do 513 dflags <- getDynFlags 514 let sdoc = pprCLabel dflags lbl 515 depth = Outp.PartWay 1 516 style = Outp.mkUserStyle dflags Outp.reallyAlwaysQualify depth 517 str = Outp.renderWithStyle dflags sdoc style 518 return (fsLit (dropInfoSuffix str)) 519 520dropInfoSuffix :: String -> String 521dropInfoSuffix = go 522 where go "_info" = [] 523 go "_static_info" = [] 524 go "_con_info" = [] 525 go (x:xs) = x:go xs 526 go [] = [] 527 528strProcedureName_llvm :: CLabel -> LlvmM LMString 529strProcedureName_llvm lbl = do 530 dflags <- getDynFlags 531 let sdoc = pprCLabel dflags lbl 532 depth = Outp.PartWay 1 533 style = Outp.mkUserStyle dflags Outp.neverQualify depth 534 str = Outp.renderWithStyle dflags sdoc style 535 return (fsLit str) 536 537-- ---------------------------------------------------------------------------- 538-- * Global variables / forward references 539-- 540 541-- | Create/get a pointer to a global value. Might return an alias if 542-- the value in question hasn't been defined yet. We especially make 543-- no guarantees on the type of the returned pointer. 544getGlobalPtr :: LMString -> LlvmM LlvmVar 545getGlobalPtr llvmLbl = do 546 m_ty <- funLookup llvmLbl 547 let mkGlbVar lbl ty = LMGlobalVar lbl (LMPointer ty) Private Nothing Nothing 548 case m_ty of 549 -- Directly reference if we have seen it already 550 Just ty -> do 551 if llvmLbl `elem` (map fsLit ["newSpark", "memmove", "memcpy", "memcmp", "memset"]) 552 then return $ mkGlbVar (llvmLbl) ty Global 553 else return $ mkGlbVar (llvmDefLabel llvmLbl) ty Global 554 -- Otherwise use a forward alias of it 555 Nothing -> do 556 saveAlias llvmLbl 557 return $ mkGlbVar llvmLbl i8 Alias 558 559-- | Derive the definition label. It has an identified 560-- structure type. 561llvmDefLabel :: LMString -> LMString 562llvmDefLabel = (`appendFS` fsLit "$def") 563 564-- | Generate definitions for aliases forward-referenced by @getGlobalPtr@. 565-- 566-- Must be called at a point where we are sure that no new global definitions 567-- will be generated anymore! 568generateExternDecls :: LlvmM ([LMGlobal], [LlvmType]) 569generateExternDecls = do 570 delayed <- fmap nonDetEltsUniqSet $ getEnv envAliases 571 -- This is non-deterministic but we do not 572 -- currently support deterministic code-generation. 573 -- See Note [Unique Determinism and code generation] 574 defss <- flip mapM delayed $ \lbl -> do 575 m_ty <- funLookup lbl 576 case m_ty of 577 -- If we have a definition we've already emitted the proper aliases 578 -- when the symbol itself was emitted by @aliasify@ 579 Just _ -> return [] 580 581 -- If we don't have a definition this is an external symbol and we 582 -- need to emit a declaration 583 Nothing -> 584 let var = LMGlobalVar lbl i8Ptr External Nothing Nothing Global 585 in return [LMGlobal var Nothing] 586 587 -- Reset forward list 588 modifyEnv $ \env -> env { envAliases = emptyUniqSet } 589 return (concat defss, []) 590 591-- | Here we take a global variable definition, rename it with a 592-- @$def@ suffix, and generate the appropriate alias. 593aliasify :: LMGlobal -> LlvmM [LMGlobal] 594-- See note [emit-time elimination of static indirections] in CLabel. 595-- Here we obtain the indirectee's precise type and introduce 596-- fresh aliases to both the precise typed label (lbl$def) and the i8* 597-- typed (regular) label of it with the matching new names. 598aliasify (LMGlobal (LMGlobalVar lbl ty@LMAlias{} link sect align Alias) 599 (Just orig)) = do 600 let defLbl = llvmDefLabel lbl 601 LMStaticPointer (LMGlobalVar origLbl _ oLnk Nothing Nothing Alias) = orig 602 defOrigLbl = llvmDefLabel origLbl 603 orig' = LMStaticPointer (LMGlobalVar origLbl i8Ptr oLnk Nothing Nothing Alias) 604 origType <- funLookup origLbl 605 let defOrig = LMBitc (LMStaticPointer (LMGlobalVar defOrigLbl 606 (pLift $ fromJust origType) oLnk 607 Nothing Nothing Alias)) 608 (pLift ty) 609 pure [ LMGlobal (LMGlobalVar defLbl ty link sect align Alias) (Just defOrig) 610 , LMGlobal (LMGlobalVar lbl i8Ptr link sect align Alias) (Just orig') 611 ] 612aliasify (LMGlobal var val) = do 613 let LMGlobalVar lbl ty link sect align const = var 614 615 defLbl = llvmDefLabel lbl 616 defVar = LMGlobalVar defLbl ty Internal sect align const 617 618 defPtrVar = LMGlobalVar defLbl (LMPointer ty) link Nothing Nothing const 619 aliasVar = LMGlobalVar lbl i8Ptr link Nothing Nothing Alias 620 aliasVal = LMBitc (LMStaticPointer defPtrVar) i8Ptr 621 622 -- we need to mark the $def symbols as used so LLVM doesn't forget which 623 -- section they need to go in. This will vanish once we switch away from 624 -- mangling sections for TNTC. 625 markUsedVar defVar 626 627 return [ LMGlobal defVar val 628 , LMGlobal aliasVar (Just aliasVal) 629 ] 630 631-- Note [Llvm Forward References] 632-- 633-- The issue here is that LLVM insists on being strongly typed at 634-- every corner, so the first time we mention something, we have to 635-- settle what type we assign to it. That makes things awkward, as Cmm 636-- will often reference things before their definition, and we have no 637-- idea what (LLVM) type it is going to be before that point. 638-- 639-- Our work-around is to define "aliases" of a standard type (i8 *) in 640-- these kind of situations, which we later tell LLVM to be either 641-- references to their actual local definitions (involving a cast) or 642-- an external reference. This obviously only works for pointers. 643-- 644-- In particular when we encounter a reference to a symbol in a chunk of 645-- C-- there are three possible scenarios, 646-- 647-- 1. We have already seen a definition for the referenced symbol. This 648-- means we already know its type. 649-- 650-- 2. We have not yet seen a definition but we will find one later in this 651-- compilation unit. Since we want to be a good consumer of the 652-- C-- streamed to us from upstream, we don't know the type of the 653-- symbol at the time when we must emit the reference. 654-- 655-- 3. We have not yet seen a definition nor will we find one in this 656-- compilation unit. In this case the reference refers to an 657-- external symbol for which we do not know the type. 658-- 659-- Let's consider case (2) for a moment: say we see a reference to 660-- the symbol @fooBar@ for which we have not seen a definition. As we 661-- do not know the symbol's type, we assume it is of type @i8*@ and emit 662-- the appropriate casts in @getSymbolPtr@. Later on, when we 663-- encounter the definition of @fooBar@ we emit it but with a modified 664-- name, @fooBar$def@ (which we'll call the definition symbol), to 665-- since we have already had to assume that the symbol @fooBar@ 666-- is of type @i8*@. We then emit @fooBar@ itself as an alias 667-- of @fooBar$def@ with appropriate casts. This all happens in 668-- @aliasify@. 669-- 670-- Case (3) is quite similar to (2): References are emitted assuming 671-- the referenced symbol is of type @i8*@. When we arrive at the end of 672-- the compilation unit and realize that the symbol is external, we emit 673-- an LLVM @external global@ declaration for the symbol @fooBar@ 674-- (handled in @generateExternDecls@). This takes advantage of the 675-- fact that the aliases produced by @aliasify@ for exported symbols 676-- have external linkage and can therefore be used as normal symbols. 677-- 678-- Historical note: As of release 3.5 LLVM does not allow aliases to 679-- refer to declarations. This the reason why aliases are produced at the 680-- point of definition instead of the point of usage, as was previously 681-- done. See #9142 for details. 682-- 683-- Finally, case (1) is trival. As we already have a definition for 684-- and therefore know the type of the referenced symbol, we can do 685-- away with casting the alias to the desired type in @getSymbolPtr@ 686-- and instead just emit a reference to the definition symbol directly. 687-- This is the @Just@ case in @getSymbolPtr@. 688