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