never executed always true always false
1
2 {-# LANGUAGE LambdaCase #-}
3
4 --------------------------------------------------------------------------------
5 -- | The LLVM Type System.
6 --
7
8 module GHC.Llvm.Types where
9
10 import GHC.Prelude
11
12 import Data.Char
13 import Numeric
14
15 import GHC.Platform
16 import GHC.Driver.Session
17 import GHC.Data.FastString
18 import GHC.Utils.Outputable
19 import GHC.Utils.Panic
20 import GHC.Types.Unique
21
22 -- from NCG
23 import GHC.CmmToAsm.Ppr
24
25 import GHC.Float
26
27 -- -----------------------------------------------------------------------------
28 -- * LLVM Basic Types and Variables
29 --
30
31 -- | A global mutable variable. Maybe defined or external
32 data LMGlobal = LMGlobal {
33 getGlobalVar :: LlvmVar, -- ^ Returns the variable of the 'LMGlobal'
34 getGlobalValue :: Maybe LlvmStatic -- ^ Return the value of the 'LMGlobal'
35 }
36
37 -- | A String in LLVM
38 type LMString = FastString
39
40 -- | A type alias
41 type LlvmAlias = (LMString, LlvmType)
42
43 -- | Llvm Types
44 data LlvmType
45 = LMInt Int -- ^ An integer with a given width in bits.
46 | LMFloat -- ^ 32 bit floating point
47 | LMDouble -- ^ 64 bit floating point
48 | LMFloat80 -- ^ 80 bit (x86 only) floating point
49 | LMFloat128 -- ^ 128 bit floating point
50 | LMPointer LlvmType -- ^ A pointer to a 'LlvmType'
51 | LMArray Int LlvmType -- ^ An array of 'LlvmType'
52 | LMVector Int LlvmType -- ^ A vector of 'LlvmType'
53 | LMLabel -- ^ A 'LlvmVar' can represent a label (address)
54 | LMVoid -- ^ Void type
55 | LMStruct [LlvmType] -- ^ Packed structure type
56 | LMStructU [LlvmType] -- ^ Unpacked structure type
57 | LMAlias LlvmAlias -- ^ A type alias
58 | LMMetadata -- ^ LLVM Metadata
59
60 -- | Function type, used to create pointers to functions
61 | LMFunction LlvmFunctionDecl
62 deriving (Eq)
63
64 instance Outputable LlvmType where
65 ppr = ppType
66
67 ppType :: LlvmType -> SDoc
68 ppType t = case t of
69 LMInt size -> char 'i' <> ppr size
70 LMFloat -> text "float"
71 LMDouble -> text "double"
72 LMFloat80 -> text "x86_fp80"
73 LMFloat128 -> text "fp128"
74 LMPointer x -> ppr x <> char '*'
75 LMArray nr tp -> char '[' <> ppr nr <> text " x " <> ppr tp <> char ']'
76 LMVector nr tp -> char '<' <> ppr nr <> text " x " <> ppr tp <> char '>'
77 LMLabel -> text "label"
78 LMVoid -> text "void"
79 LMStruct tys -> text "<{" <> ppCommaJoin tys <> text "}>"
80 LMStructU tys -> text "{" <> ppCommaJoin tys <> text "}"
81 LMMetadata -> text "metadata"
82 LMAlias (s,_) -> char '%' <> ftext s
83 LMFunction (LlvmFunctionDecl _ _ _ r varg p _)
84 -> ppr r <+> lparen <> ppParams varg p <> rparen
85
86 ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc
87 ppParams varg p
88 = let varg' = case varg of
89 VarArgs | null args -> text "..."
90 | otherwise -> text ", ..."
91 _otherwise -> text ""
92 -- by default we don't print param attributes
93 args = map fst p
94 in ppCommaJoin args <> varg'
95
96 -- | An LLVM section definition. If Nothing then let LLVM decide the section
97 type LMSection = Maybe LMString
98 type LMAlign = Maybe Int
99
100 data LMConst = Global -- ^ Mutable global variable
101 | Constant -- ^ Constant global variable
102 | Alias -- ^ Alias of another variable
103 deriving (Eq)
104
105 -- | LLVM Variables
106 data LlvmVar
107 -- | Variables with a global scope.
108 = LMGlobalVar LMString LlvmType LlvmLinkageType LMSection LMAlign LMConst
109 -- | Variables local to a function or parameters.
110 | LMLocalVar Unique LlvmType
111 -- | Named local variables. Sometimes we need to be able to explicitly name
112 -- variables (e.g for function arguments).
113 | LMNLocalVar LMString LlvmType
114 -- | A constant variable
115 | LMLitVar LlvmLit
116 deriving (Eq)
117
118 -- | Llvm Literal Data.
119 --
120 -- These can be used inline in expressions.
121 data LlvmLit
122 -- | Refers to an integer constant (i64 42).
123 = LMIntLit Integer LlvmType
124 -- | Floating point literal
125 | LMFloatLit Double LlvmType
126 -- | Literal NULL, only applicable to pointer types
127 | LMNullLit LlvmType
128 -- | Vector literal
129 | LMVectorLit [LlvmLit]
130 -- | Undefined value, random bit pattern. Useful for optimisations.
131 | LMUndefLit LlvmType
132 deriving (Eq)
133
134 -- | Llvm Static Data.
135 --
136 -- These represent the possible global level variables and constants.
137 data LlvmStatic
138 = LMComment LMString -- ^ A comment in a static section
139 | LMStaticLit LlvmLit -- ^ A static variant of a literal value
140 | LMUninitType LlvmType -- ^ For uninitialised data
141 | LMStaticStr LMString LlvmType -- ^ Defines a static 'LMString'
142 | LMStaticArray [LlvmStatic] LlvmType -- ^ A static array
143 | LMStaticStruc [LlvmStatic] LlvmType -- ^ A static structure type
144 | LMStaticPointer LlvmVar -- ^ A pointer to other data
145
146 -- static expressions, could split out but leave
147 -- for moment for ease of use. Not many of them.
148
149 | LMTrunc LlvmStatic LlvmType -- ^ Truncate
150 | LMBitc LlvmStatic LlvmType -- ^ Pointer to Pointer conversion
151 | LMPtoI LlvmStatic LlvmType -- ^ Pointer to Integer conversion
152 | LMAdd LlvmStatic LlvmStatic -- ^ Constant addition operation
153 | LMSub LlvmStatic LlvmStatic -- ^ Constant subtraction operation
154
155 -- -----------------------------------------------------------------------------
156 -- ** Operations on LLVM Basic Types and Variables
157 --
158
159 -- | LLVM code generator options
160 data LlvmOpts = LlvmOpts
161 { llvmOptsPlatform :: !Platform -- ^ Target platform
162 , llvmOptsFillUndefWithGarbage :: !Bool -- ^ Fill undefined literals with garbage values
163 , llvmOptsSplitSections :: !Bool -- ^ Split sections
164 }
165
166 -- | Get LlvmOptions from DynFlags
167 initLlvmOpts :: DynFlags -> LlvmOpts
168 initLlvmOpts dflags = LlvmOpts
169 { llvmOptsPlatform = targetPlatform dflags
170 , llvmOptsFillUndefWithGarbage = gopt Opt_LlvmFillUndefWithGarbage dflags
171 , llvmOptsSplitSections = gopt Opt_SplitSections dflags
172 }
173
174 garbageLit :: LlvmType -> Maybe LlvmLit
175 garbageLit t@(LMInt w) = Just (LMIntLit (0xbbbbbbbbbbbbbbb0 `mod` (2^w)) t)
176 -- Use a value that looks like an untagged pointer, so we are more
177 -- likely to try to enter it
178 garbageLit t
179 | isFloat t = Just (LMFloatLit 12345678.9 t)
180 garbageLit t@(LMPointer _) = Just (LMNullLit t)
181 -- Using null isn't totally ideal, since some functions may check for null.
182 -- But producing another value is inconvenient since it needs a cast,
183 -- and the knowledge for how to format casts is in PpLlvm.
184 garbageLit _ = Nothing
185 -- More cases could be added, but this should do for now.
186
187 -- | Return the 'LlvmType' of the 'LlvmVar'
188 getVarType :: LlvmVar -> LlvmType
189 getVarType (LMGlobalVar _ y _ _ _ _) = y
190 getVarType (LMLocalVar _ y ) = y
191 getVarType (LMNLocalVar _ y ) = y
192 getVarType (LMLitVar l ) = getLitType l
193
194 -- | Return the 'LlvmType' of a 'LlvmLit'
195 getLitType :: LlvmLit -> LlvmType
196 getLitType (LMIntLit _ t) = t
197 getLitType (LMFloatLit _ t) = t
198 getLitType (LMVectorLit []) = panic "getLitType"
199 getLitType (LMVectorLit ls) = LMVector (length ls) (getLitType (head ls))
200 getLitType (LMNullLit t) = t
201 getLitType (LMUndefLit t) = t
202
203 -- | Return the 'LlvmType' of the 'LlvmStatic'
204 getStatType :: LlvmStatic -> LlvmType
205 getStatType (LMStaticLit l ) = getLitType l
206 getStatType (LMUninitType t) = t
207 getStatType (LMStaticStr _ t) = t
208 getStatType (LMStaticArray _ t) = t
209 getStatType (LMStaticStruc _ t) = t
210 getStatType (LMStaticPointer v) = getVarType v
211 getStatType (LMTrunc _ t) = t
212 getStatType (LMBitc _ t) = t
213 getStatType (LMPtoI _ t) = t
214 getStatType (LMAdd t _) = getStatType t
215 getStatType (LMSub t _) = getStatType t
216 getStatType (LMComment _) = error "Can't call getStatType on LMComment!"
217
218 -- | Return the 'LlvmLinkageType' for a 'LlvmVar'
219 getLink :: LlvmVar -> LlvmLinkageType
220 getLink (LMGlobalVar _ _ l _ _ _) = l
221 getLink _ = Internal
222
223 -- | Add a pointer indirection to the supplied type. 'LMLabel' and 'LMVoid'
224 -- cannot be lifted.
225 pLift :: LlvmType -> LlvmType
226 pLift LMLabel = error "Labels are unliftable"
227 pLift LMVoid = error "Voids are unliftable"
228 pLift LMMetadata = error "Metadatas are unliftable"
229 pLift x = LMPointer x
230
231 -- | Lift a variable to 'LMPointer' type.
232 pVarLift :: LlvmVar -> LlvmVar
233 pVarLift (LMGlobalVar s t l x a c) = LMGlobalVar s (pLift t) l x a c
234 pVarLift (LMLocalVar s t ) = LMLocalVar s (pLift t)
235 pVarLift (LMNLocalVar s t ) = LMNLocalVar s (pLift t)
236 pVarLift (LMLitVar _ ) = error $ "Can't lower a literal type!"
237
238 -- | Remove the pointer indirection of the supplied type. Only 'LMPointer'
239 -- constructors can be lowered.
240 pLower :: LlvmType -> LlvmType
241 pLower (LMPointer x) = x
242 pLower x = pprPanic "llvmGen(pLower)"
243 $ ppr x <+> text " is a unlowerable type, need a pointer"
244
245 -- | Lower a variable of 'LMPointer' type.
246 pVarLower :: LlvmVar -> LlvmVar
247 pVarLower (LMGlobalVar s t l x a c) = LMGlobalVar s (pLower t) l x a c
248 pVarLower (LMLocalVar s t ) = LMLocalVar s (pLower t)
249 pVarLower (LMNLocalVar s t ) = LMNLocalVar s (pLower t)
250 pVarLower (LMLitVar _ ) = error $ "Can't lower a literal type!"
251
252 -- | Test if the given 'LlvmType' is an integer
253 isInt :: LlvmType -> Bool
254 isInt (LMInt _) = True
255 isInt _ = False
256
257 -- | Test if the given 'LlvmType' is a floating point type
258 isFloat :: LlvmType -> Bool
259 isFloat LMFloat = True
260 isFloat LMDouble = True
261 isFloat LMFloat80 = True
262 isFloat LMFloat128 = True
263 isFloat _ = False
264
265 -- | Test if the given 'LlvmType' is an 'LMPointer' construct
266 isPointer :: LlvmType -> Bool
267 isPointer (LMPointer _) = True
268 isPointer _ = False
269
270 -- | Test if the given 'LlvmType' is an 'LMVector' construct
271 isVector :: LlvmType -> Bool
272 isVector (LMVector {}) = True
273 isVector _ = False
274
275 -- | Test if a 'LlvmVar' is global.
276 isGlobal :: LlvmVar -> Bool
277 isGlobal (LMGlobalVar _ _ _ _ _ _) = True
278 isGlobal _ = False
279
280 -- | Width in bits of an 'LlvmType', returns 0 if not applicable
281 llvmWidthInBits :: Platform -> LlvmType -> Int
282 llvmWidthInBits platform = \case
283 (LMInt n) -> n
284 (LMFloat) -> 32
285 (LMDouble) -> 64
286 (LMFloat80) -> 80
287 (LMFloat128) -> 128
288 -- Could return either a pointer width here or the width of what
289 -- it points to. We will go with the former for now.
290 -- PMW: At least judging by the way LLVM outputs constants, pointers
291 -- should use the former, but arrays the latter.
292 (LMPointer _) -> llvmWidthInBits platform (llvmWord platform)
293 (LMArray n t) -> n * llvmWidthInBits platform t
294 (LMVector n ty) -> n * llvmWidthInBits platform ty
295 LMLabel -> 0
296 LMVoid -> 0
297 (LMStruct tys) -> sum $ map (llvmWidthInBits platform) tys
298 (LMStructU _) ->
299 -- It's not trivial to calculate the bit width of the unpacked structs,
300 -- since they will be aligned depending on the specified datalayout (
301 -- http://llvm.org/docs/LangRef.html#data-layout ). One way we could support
302 -- this could be to make the GHC.CmmToLlvm.Ppr.moduleLayout be a data type
303 -- that exposes the alignment information. However, currently the only place
304 -- we use unpacked structs is LLVM intrinsics that return them (e.g.,
305 -- llvm.sadd.with.overflow.*), so we don't actually need to compute their
306 -- bit width.
307 panic "llvmWidthInBits: not implemented for LMStructU"
308 (LMFunction _) -> 0
309 (LMAlias (_,t)) -> llvmWidthInBits platform t
310 LMMetadata -> panic "llvmWidthInBits: Meta-data has no runtime representation!"
311
312
313 -- -----------------------------------------------------------------------------
314 -- ** Shortcut for Common Types
315 --
316
317 i128, i64, i32, i16, i8, i1, i8Ptr :: LlvmType
318 i128 = LMInt 128
319 i64 = LMInt 64
320 i32 = LMInt 32
321 i16 = LMInt 16
322 i8 = LMInt 8
323 i1 = LMInt 1
324 i8Ptr = pLift i8
325
326 -- | The target architectures word size
327 llvmWord, llvmWordPtr :: Platform -> LlvmType
328 llvmWord platform = LMInt (platformWordSizeInBytes platform * 8)
329 llvmWordPtr platform = pLift (llvmWord platform)
330
331 -- -----------------------------------------------------------------------------
332 -- * LLVM Function Types
333 --
334
335 -- | An LLVM Function
336 data LlvmFunctionDecl = LlvmFunctionDecl {
337 -- | Unique identifier of the function
338 decName :: LMString,
339 -- | LinkageType of the function
340 funcLinkage :: LlvmLinkageType,
341 -- | The calling convention of the function
342 funcCc :: LlvmCallConvention,
343 -- | Type of the returned value
344 decReturnType :: LlvmType,
345 -- | Indicates if this function uses varargs
346 decVarargs :: LlvmParameterListType,
347 -- | Parameter types and attributes
348 decParams :: [LlvmParameter],
349 -- | Function align value, must be power of 2
350 funcAlign :: LMAlign
351 }
352 deriving (Eq)
353
354 instance Outputable LlvmFunctionDecl where
355 ppr (LlvmFunctionDecl n l c r varg p a)
356 = let align = case a of
357 Just a' -> text " align " <> ppr a'
358 Nothing -> empty
359 in ppr l <+> ppr c <+> ppr r <+> char '@' <> ftext n <>
360 lparen <> ppParams varg p <> rparen <> align
361
362 type LlvmFunctionDecls = [LlvmFunctionDecl]
363
364 type LlvmParameter = (LlvmType, [LlvmParamAttr])
365
366 -- | LLVM Parameter Attributes.
367 --
368 -- Parameter attributes are used to communicate additional information about
369 -- the result or parameters of a function
370 data LlvmParamAttr
371 -- | This indicates to the code generator that the parameter or return value
372 -- should be zero-extended to a 32-bit value by the caller (for a parameter)
373 -- or the callee (for a return value).
374 = ZeroExt
375 -- | This indicates to the code generator that the parameter or return value
376 -- should be sign-extended to a 32-bit value by the caller (for a parameter)
377 -- or the callee (for a return value).
378 | SignExt
379 -- | This indicates that this parameter or return value should be treated in
380 -- a special target-dependent fashion during while emitting code for a
381 -- function call or return (usually, by putting it in a register as opposed
382 -- to memory).
383 | InReg
384 -- | This indicates that the pointer parameter should really be passed by
385 -- value to the function.
386 | ByVal
387 -- | This indicates that the pointer parameter specifies the address of a
388 -- structure that is the return value of the function in the source program.
389 | SRet
390 -- | This indicates that the pointer does not alias any global or any other
391 -- parameter.
392 | NoAlias
393 -- | This indicates that the callee does not make any copies of the pointer
394 -- that outlive the callee itself
395 | NoCapture
396 -- | This indicates that the pointer parameter can be excised using the
397 -- trampoline intrinsics.
398 | Nest
399 deriving (Eq)
400
401 instance Outputable LlvmParamAttr where
402 ppr ZeroExt = text "zeroext"
403 ppr SignExt = text "signext"
404 ppr InReg = text "inreg"
405 ppr ByVal = text "byval"
406 ppr SRet = text "sret"
407 ppr NoAlias = text "noalias"
408 ppr NoCapture = text "nocapture"
409 ppr Nest = text "nest"
410
411 -- | Llvm Function Attributes.
412 --
413 -- Function attributes are set to communicate additional information about a
414 -- function. Function attributes are considered to be part of the function,
415 -- not of the function type, so functions with different parameter attributes
416 -- can have the same function type. Functions can have multiple attributes.
417 --
418 -- Descriptions taken from <http://llvm.org/docs/LangRef.html#fnattrs>
419 data LlvmFuncAttr
420 -- | This attribute indicates that the inliner should attempt to inline this
421 -- function into callers whenever possible, ignoring any active inlining
422 -- size threshold for this caller.
423 = AlwaysInline
424 -- | This attribute indicates that the source code contained a hint that
425 -- inlining this function is desirable (such as the \"inline\" keyword in
426 -- C/C++). It is just a hint; it imposes no requirements on the inliner.
427 | InlineHint
428 -- | This attribute indicates that the inliner should never inline this
429 -- function in any situation. This attribute may not be used together
430 -- with the alwaysinline attribute.
431 | NoInline
432 -- | This attribute suggests that optimization passes and code generator
433 -- passes make choices that keep the code size of this function low, and
434 -- otherwise do optimizations specifically to reduce code size.
435 | OptSize
436 -- | This function attribute indicates that the function never returns
437 -- normally. This produces undefined behavior at runtime if the function
438 -- ever does dynamically return.
439 | NoReturn
440 -- | This function attribute indicates that the function never returns with
441 -- an unwind or exceptional control flow. If the function does unwind, its
442 -- runtime behavior is undefined.
443 | NoUnwind
444 -- | This attribute indicates that the function computes its result (or
445 -- decides to unwind an exception) based strictly on its arguments, without
446 -- dereferencing any pointer arguments or otherwise accessing any mutable
447 -- state (e.g. memory, control registers, etc) visible to caller functions.
448 -- It does not write through any pointer arguments (including byval
449 -- arguments) and never changes any state visible to callers. This means
450 -- that it cannot unwind exceptions by calling the C++ exception throwing
451 -- methods, but could use the unwind instruction.
452 | ReadNone
453 -- | This attribute indicates that the function does not write through any
454 -- pointer arguments (including byval arguments) or otherwise modify any
455 -- state (e.g. memory, control registers, etc) visible to caller functions.
456 -- It may dereference pointer arguments and read state that may be set in
457 -- the caller. A readonly function always returns the same value (or unwinds
458 -- an exception identically) when called with the same set of arguments and
459 -- global state. It cannot unwind an exception by calling the C++ exception
460 -- throwing methods, but may use the unwind instruction.
461 | ReadOnly
462 -- | This attribute indicates that the function should emit a stack smashing
463 -- protector. It is in the form of a \"canary\"—a random value placed on the
464 -- stack before the local variables that's checked upon return from the
465 -- function to see if it has been overwritten. A heuristic is used to
466 -- determine if a function needs stack protectors or not.
467 --
468 -- If a function that has an ssp attribute is inlined into a function that
469 -- doesn't have an ssp attribute, then the resulting function will have an
470 -- ssp attribute.
471 | Ssp
472 -- | This attribute indicates that the function should always emit a stack
473 -- smashing protector. This overrides the ssp function attribute.
474 --
475 -- If a function that has an sspreq attribute is inlined into a function
476 -- that doesn't have an sspreq attribute or which has an ssp attribute,
477 -- then the resulting function will have an sspreq attribute.
478 | SspReq
479 -- | This attribute indicates that the code generator should not use a red
480 -- zone, even if the target-specific ABI normally permits it.
481 | NoRedZone
482 -- | This attributes disables implicit floating point instructions.
483 | NoImplicitFloat
484 -- | This attribute disables prologue / epilogue emission for the function.
485 -- This can have very system-specific consequences.
486 | Naked
487 deriving (Eq)
488
489 instance Outputable LlvmFuncAttr where
490 ppr AlwaysInline = text "alwaysinline"
491 ppr InlineHint = text "inlinehint"
492 ppr NoInline = text "noinline"
493 ppr OptSize = text "optsize"
494 ppr NoReturn = text "noreturn"
495 ppr NoUnwind = text "nounwind"
496 ppr ReadNone = text "readnone"
497 ppr ReadOnly = text "readonly"
498 ppr Ssp = text "ssp"
499 ppr SspReq = text "ssqreq"
500 ppr NoRedZone = text "noredzone"
501 ppr NoImplicitFloat = text "noimplicitfloat"
502 ppr Naked = text "naked"
503
504
505 -- | Different types to call a function.
506 data LlvmCallType
507 -- | Normal call, allocate a new stack frame.
508 = StdCall
509 -- | Tail call, perform the call in the current stack frame.
510 | TailCall
511 deriving (Eq,Show)
512
513 -- | Different calling conventions a function can use.
514 data LlvmCallConvention
515 -- | The C calling convention.
516 -- This calling convention (the default if no other calling convention is
517 -- specified) matches the target C calling conventions. This calling
518 -- convention supports varargs function calls and tolerates some mismatch in
519 -- the declared prototype and implemented declaration of the function (as
520 -- does normal C).
521 = CC_Ccc
522 -- | This calling convention attempts to make calls as fast as possible
523 -- (e.g. by passing things in registers). This calling convention allows
524 -- the target to use whatever tricks it wants to produce fast code for the
525 -- target, without having to conform to an externally specified ABI
526 -- (Application Binary Interface). Implementations of this convention should
527 -- allow arbitrary tail call optimization to be supported. This calling
528 -- convention does not support varargs and requires the prototype of al
529 -- callees to exactly match the prototype of the function definition.
530 | CC_Fastcc
531 -- | This calling convention attempts to make code in the caller as efficient
532 -- as possible under the assumption that the call is not commonly executed.
533 -- As such, these calls often preserve all registers so that the call does
534 -- not break any live ranges in the caller side. This calling convention
535 -- does not support varargs and requires the prototype of all callees to
536 -- exactly match the prototype of the function definition.
537 | CC_Coldcc
538 -- | The GHC-specific 'registerised' calling convention.
539 | CC_Ghc
540 -- | Any calling convention may be specified by number, allowing
541 -- target-specific calling conventions to be used. Target specific calling
542 -- conventions start at 64.
543 | CC_Ncc Int
544 -- | X86 Specific 'StdCall' convention. LLVM includes a specific alias for it
545 -- rather than just using CC_Ncc.
546 | CC_X86_Stdcc
547 deriving (Eq)
548
549 instance Outputable LlvmCallConvention where
550 ppr CC_Ccc = text "ccc"
551 ppr CC_Fastcc = text "fastcc"
552 ppr CC_Coldcc = text "coldcc"
553 ppr CC_Ghc = text "ghccc"
554 ppr (CC_Ncc i) = text "cc " <> ppr i
555 ppr CC_X86_Stdcc = text "x86_stdcallcc"
556
557
558 -- | Functions can have a fixed amount of parameters, or a variable amount.
559 data LlvmParameterListType
560 -- Fixed amount of arguments.
561 = FixedArgs
562 -- Variable amount of arguments.
563 | VarArgs
564 deriving (Eq,Show)
565
566
567 -- | Linkage type of a symbol.
568 --
569 -- The description of the constructors is copied from the Llvm Assembly Language
570 -- Reference Manual <http://www.llvm.org/docs/LangRef.html#linkage>, because
571 -- they correspond to the Llvm linkage types.
572 data LlvmLinkageType
573 -- | Global values with internal linkage are only directly accessible by
574 -- objects in the current module. In particular, linking code into a module
575 -- with an internal global value may cause the internal to be renamed as
576 -- necessary to avoid collisions. Because the symbol is internal to the
577 -- module, all references can be updated. This corresponds to the notion
578 -- of the @static@ keyword in C.
579 = Internal
580 -- | Globals with @linkonce@ linkage are merged with other globals of the
581 -- same name when linkage occurs. This is typically used to implement
582 -- inline functions, templates, or other code which must be generated
583 -- in each translation unit that uses it. Unreferenced linkonce globals are
584 -- allowed to be discarded.
585 | LinkOnce
586 -- | @weak@ linkage is exactly the same as linkonce linkage, except that
587 -- unreferenced weak globals may not be discarded. This is used for globals
588 -- that may be emitted in multiple translation units, but that are not
589 -- guaranteed to be emitted into every translation unit that uses them. One
590 -- example of this are common globals in C, such as @int X;@ at global
591 -- scope.
592 | Weak
593 -- | @appending@ linkage may only be applied to global variables of pointer
594 -- to array type. When two global variables with appending linkage are
595 -- linked together, the two global arrays are appended together. This is
596 -- the Llvm, typesafe, equivalent of having the system linker append
597 -- together @sections@ with identical names when .o files are linked.
598 | Appending
599 -- | The semantics of this linkage follow the ELF model: the symbol is weak
600 -- until linked, if not linked, the symbol becomes null instead of being an
601 -- undefined reference.
602 | ExternWeak
603 -- | The symbol participates in linkage and can be used to resolve external
604 -- symbol references.
605 | ExternallyVisible
606 -- | Alias for 'ExternallyVisible' but with explicit textual form in LLVM
607 -- assembly.
608 | External
609 -- | Symbol is private to the module and should not appear in the symbol table
610 | Private
611 deriving (Eq)
612
613 instance Outputable LlvmLinkageType where
614 ppr Internal = text "internal"
615 ppr LinkOnce = text "linkonce"
616 ppr Weak = text "weak"
617 ppr Appending = text "appending"
618 ppr ExternWeak = text "extern_weak"
619 -- ExternallyVisible does not have a textual representation, it is
620 -- the linkage type a function resolves to if no other is specified
621 -- in Llvm.
622 ppr ExternallyVisible = empty
623 ppr External = text "external"
624 ppr Private = text "private"
625
626 -- -----------------------------------------------------------------------------
627 -- * LLVM Operations
628 --
629
630 -- | Llvm binary operators machine operations.
631 data LlvmMachOp
632 = LM_MO_Add -- ^ add two integer, floating point or vector values.
633 | LM_MO_Sub -- ^ subtract two ...
634 | LM_MO_Mul -- ^ multiply ..
635 | LM_MO_UDiv -- ^ unsigned integer or vector division.
636 | LM_MO_SDiv -- ^ signed integer ..
637 | LM_MO_URem -- ^ unsigned integer or vector remainder (mod)
638 | LM_MO_SRem -- ^ signed ...
639
640 | LM_MO_FAdd -- ^ add two floating point or vector values.
641 | LM_MO_FSub -- ^ subtract two ...
642 | LM_MO_FMul -- ^ multiply ...
643 | LM_MO_FDiv -- ^ divide ...
644 | LM_MO_FRem -- ^ remainder ...
645
646 -- | Left shift
647 | LM_MO_Shl
648 -- | Logical shift right
649 -- Shift right, filling with zero
650 | LM_MO_LShr
651 -- | Arithmetic shift right
652 -- The most significant bits of the result will be equal to the sign bit of
653 -- the left operand.
654 | LM_MO_AShr
655
656 | LM_MO_And -- ^ AND bitwise logical operation.
657 | LM_MO_Or -- ^ OR bitwise logical operation.
658 | LM_MO_Xor -- ^ XOR bitwise logical operation.
659 deriving (Eq)
660
661 instance Outputable LlvmMachOp where
662 ppr LM_MO_Add = text "add"
663 ppr LM_MO_Sub = text "sub"
664 ppr LM_MO_Mul = text "mul"
665 ppr LM_MO_UDiv = text "udiv"
666 ppr LM_MO_SDiv = text "sdiv"
667 ppr LM_MO_URem = text "urem"
668 ppr LM_MO_SRem = text "srem"
669 ppr LM_MO_FAdd = text "fadd"
670 ppr LM_MO_FSub = text "fsub"
671 ppr LM_MO_FMul = text "fmul"
672 ppr LM_MO_FDiv = text "fdiv"
673 ppr LM_MO_FRem = text "frem"
674 ppr LM_MO_Shl = text "shl"
675 ppr LM_MO_LShr = text "lshr"
676 ppr LM_MO_AShr = text "ashr"
677 ppr LM_MO_And = text "and"
678 ppr LM_MO_Or = text "or"
679 ppr LM_MO_Xor = text "xor"
680
681
682 -- | Llvm compare operations.
683 data LlvmCmpOp
684 = LM_CMP_Eq -- ^ Equal (Signed and Unsigned)
685 | LM_CMP_Ne -- ^ Not equal (Signed and Unsigned)
686 | LM_CMP_Ugt -- ^ Unsigned greater than
687 | LM_CMP_Uge -- ^ Unsigned greater than or equal
688 | LM_CMP_Ult -- ^ Unsigned less than
689 | LM_CMP_Ule -- ^ Unsigned less than or equal
690 | LM_CMP_Sgt -- ^ Signed greater than
691 | LM_CMP_Sge -- ^ Signed greater than or equal
692 | LM_CMP_Slt -- ^ Signed less than
693 | LM_CMP_Sle -- ^ Signed less than or equal
694
695 -- Float comparisons. GHC uses a mix of ordered and unordered float
696 -- comparisons.
697 | LM_CMP_Feq -- ^ Float equal
698 | LM_CMP_Fne -- ^ Float not equal
699 | LM_CMP_Fgt -- ^ Float greater than
700 | LM_CMP_Fge -- ^ Float greater than or equal
701 | LM_CMP_Flt -- ^ Float less than
702 | LM_CMP_Fle -- ^ Float less than or equal
703 deriving (Eq)
704
705 instance Outputable LlvmCmpOp where
706 ppr LM_CMP_Eq = text "eq"
707 ppr LM_CMP_Ne = text "ne"
708 ppr LM_CMP_Ugt = text "ugt"
709 ppr LM_CMP_Uge = text "uge"
710 ppr LM_CMP_Ult = text "ult"
711 ppr LM_CMP_Ule = text "ule"
712 ppr LM_CMP_Sgt = text "sgt"
713 ppr LM_CMP_Sge = text "sge"
714 ppr LM_CMP_Slt = text "slt"
715 ppr LM_CMP_Sle = text "sle"
716 ppr LM_CMP_Feq = text "oeq"
717 ppr LM_CMP_Fne = text "une"
718 ppr LM_CMP_Fgt = text "ogt"
719 ppr LM_CMP_Fge = text "oge"
720 ppr LM_CMP_Flt = text "olt"
721 ppr LM_CMP_Fle = text "ole"
722
723
724 -- | Llvm cast operations.
725 data LlvmCastOp
726 = LM_Trunc -- ^ Integer truncate
727 | LM_Zext -- ^ Integer extend (zero fill)
728 | LM_Sext -- ^ Integer extend (sign fill)
729 | LM_Fptrunc -- ^ Float truncate
730 | LM_Fpext -- ^ Float extend
731 | LM_Fptoui -- ^ Float to unsigned Integer
732 | LM_Fptosi -- ^ Float to signed Integer
733 | LM_Uitofp -- ^ Unsigned Integer to Float
734 | LM_Sitofp -- ^ Signed Int to Float
735 | LM_Ptrtoint -- ^ Pointer to Integer
736 | LM_Inttoptr -- ^ Integer to Pointer
737 | LM_Bitcast -- ^ Cast between types where no bit manipulation is needed
738 deriving (Eq)
739
740 instance Outputable LlvmCastOp where
741 ppr LM_Trunc = text "trunc"
742 ppr LM_Zext = text "zext"
743 ppr LM_Sext = text "sext"
744 ppr LM_Fptrunc = text "fptrunc"
745 ppr LM_Fpext = text "fpext"
746 ppr LM_Fptoui = text "fptoui"
747 ppr LM_Fptosi = text "fptosi"
748 ppr LM_Uitofp = text "uitofp"
749 ppr LM_Sitofp = text "sitofp"
750 ppr LM_Ptrtoint = text "ptrtoint"
751 ppr LM_Inttoptr = text "inttoptr"
752 ppr LM_Bitcast = text "bitcast"
753
754
755 -- -----------------------------------------------------------------------------
756 -- * Floating point conversion
757 --
758
759 -- | Convert a Haskell Double to an LLVM hex encoded floating point form. In
760 -- Llvm float literals can be printed in a big-endian hexadecimal format,
761 -- regardless of underlying architecture.
762 --
763 -- See Note [LLVM Float Types].
764 ppDouble :: Platform -> Double -> SDoc
765 ppDouble platform d
766 = let bs = doubleToBytes d
767 hex d' = case showHex d' "" of
768 [] -> error "ppDouble: too few hex digits for float"
769 [x] -> ['0',x]
770 [x,y] -> [x,y]
771 _ -> error "ppDouble: too many hex digits for float"
772
773 fixEndian = case platformByteOrder platform of
774 BigEndian -> id
775 LittleEndian -> reverse
776 str = map toUpper $ concat $ fixEndian $ map hex bs
777 in text "0x" <> text str
778
779 -- Note [LLVM Float Types]
780 -- ~~~~~~~~~~~~~~~~~~~~~~~
781 -- We use 'ppDouble' for both printing Float and Double floating point types. This is
782 -- as LLVM expects all floating point constants (single & double) to be in IEEE
783 -- 754 Double precision format. However, for single precision numbers (Float)
784 -- they should be *representable* in IEEE 754 Single precision format. So the
785 -- easiest way to do this is to narrow and widen again.
786 -- (i.e., Double -> Float -> Double). We must be careful doing this that GHC
787 -- doesn't optimize that away.
788
789 -- Note [narrowFp & widenFp]
790 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
791 -- NOTE: we use float2Double & co directly as GHC likes to optimize away
792 -- successive calls of 'realToFrac', defeating the narrowing. (Bug #7600).
793 -- 'realToFrac' has inconsistent behaviour with optimisation as well that can
794 -- also cause issues, these methods don't.
795
796 narrowFp :: Double -> Float
797 {-# NOINLINE narrowFp #-}
798 narrowFp = double2Float
799
800 widenFp :: Float -> Double
801 {-# NOINLINE widenFp #-}
802 widenFp = float2Double
803
804 ppFloat :: Platform -> Float -> SDoc
805 ppFloat platform = ppDouble platform . widenFp
806
807
808 --------------------------------------------------------------------------------
809 -- * Misc functions
810 --------------------------------------------------------------------------------
811
812 ppCommaJoin :: (Outputable a) => [a] -> SDoc
813 ppCommaJoin strs = hsep $ punctuate comma (map ppr strs)
814
815 ppSpaceJoin :: (Outputable a) => [a] -> SDoc
816 ppSpaceJoin strs = hsep (map ppr strs)