quebex

A software analysis framework built around the QBE intermediate language

git clone https://git.8pit.net/quebex.git

  1-- SPDX-FileCopyrightText: 2025-2026 Sören Tempel <soeren+git@soeren-tempel.net>
  2--
  3-- SPDX-License-Identifier: GPL-3.0-only
  4
  5module Language.QBE.Types
  6  ( -- * Identifiers
  7    UserIdent (..),
  8    LocalIdent (..),
  9    BlockIdent (..),
 10    GlobalIdent (..),
 11
 12    -- * Types
 13    BaseType (..),
 14    baseTypeByteSize,
 15    baseTypeBitSize,
 16    ExtType (..),
 17    extTypeBitSize,
 18    extTypeByteSize,
 19    SubWordType (..),
 20    SubType (..),
 21    LoadType (..),
 22    loadByteSize,
 23
 24    -- * Values
 25    Const (..),
 26    DynConst (..),
 27    Value (..),
 28
 29    -- * Definitions
 30    TypeDef (..),
 31    DataDef (..),
 32    Linkage (..),
 33    Field,
 34    AggType (..),
 35    dataSize,
 36    DataObj (..),
 37    objAlign,
 38    objSize,
 39    DataItem (..),
 40    JumpInstr (..),
 41
 42    -- * Functions
 43    FuncDef (..),
 44    FuncParam (..),
 45    FuncArg (..),
 46    Abity (..),
 47    abityToBase,
 48    Block (..),
 49
 50    -- * Instructions
 51    Statement (..),
 52    Instr (..),
 53    VolatileInstr (..),
 54    ExtArg (..),
 55    toExtType,
 56    FloatArg (..),
 57    f2BaseType,
 58    IntArg (..),
 59    i2BaseType,
 60    IntCmpOp (..),
 61    FloatCmpOp (..),
 62    Phi (..),
 63    AllocSize (..),
 64    getSize,
 65  )
 66where
 67
 68import Data.Map (Map)
 69import Data.Word (Word64)
 70
 71-- TODO: Prefix all constructors
 72
 73newtype UserIdent = UserIdent {userIdent :: String}
 74  deriving (Eq, Ord)
 75
 76instance Show UserIdent where
 77  show (UserIdent s) = ':' : s
 78
 79newtype LocalIdent = LocalIdent {localIdent :: String}
 80  deriving (Eq, Ord)
 81
 82instance Show LocalIdent where
 83  show (LocalIdent s) = '%' : s
 84
 85newtype BlockIdent = BlockIdent {blockIdent :: String}
 86  deriving (Eq, Ord)
 87
 88instance Show BlockIdent where
 89  show (BlockIdent s) = '@' : s
 90
 91newtype GlobalIdent = GlobalIdent {globalIdent :: String}
 92  deriving (Eq, Ord)
 93
 94instance Show GlobalIdent where
 95  show (GlobalIdent s) = '$' : s
 96
 97------------------------------------------------------------------------
 98
 99data BaseType
100  = Word
101  | Long
102  | Single
103  | Double
104  deriving (Show, Eq)
105
106baseTypeByteSize :: BaseType -> Int
107baseTypeByteSize Word = 4
108baseTypeByteSize Long = 8
109baseTypeByteSize Single = 4
110baseTypeByteSize Double = 8
111
112baseTypeBitSize :: BaseType -> Int
113baseTypeBitSize ty = baseTypeByteSize ty * 8
114
115data ExtType
116  = Base BaseType
117  | Byte
118  | HalfWord
119  deriving (Show, Eq)
120
121extTypeByteSize :: ExtType -> Int
122extTypeByteSize (Base b) = baseTypeByteSize b
123extTypeByteSize Byte = 1
124extTypeByteSize HalfWord = 2
125
126extTypeBitSize :: ExtType -> Int
127extTypeBitSize ty = extTypeByteSize ty * 8
128
129data SubWordType
130  = SignedByte
131  | UnsignedByte
132  | SignedHalf
133  | UnsignedHalf
134  deriving (Show, Eq)
135
136data Abity
137  = ABase BaseType
138  | ASubWordType SubWordType
139  | AUserDef UserIdent
140  deriving (Show, Eq)
141
142abityToBase :: Abity -> BaseType
143-- Calls with a sub-word return type define a temporary of base type
144-- w with its most significant bits unspecified.
145abityToBase (ASubWordType _) = Word
146-- When an aggregate type is used as argument type or return type, the
147-- value respectively passed or returned needs to be a pointer to a
148-- memory location holding the value.
149abityToBase (AUserDef _) = Long
150abityToBase (ABase ty) = ty
151
152data Const
153  = Number Word64
154  | SFP Float
155  | DFP Double
156  | Global GlobalIdent
157  deriving (Show, Eq)
158
159data DynConst
160  = Const Const
161  | Thread GlobalIdent
162  | Extern GlobalIdent
163  | ExternThread GlobalIdent
164  deriving (Show, Eq)
165
166data Value
167  = VConst DynConst
168  | VLocal LocalIdent
169  deriving (Show, Eq)
170
171data Linkage
172  = LExport
173  | LThread
174  | LSection String (Maybe String)
175  deriving (Show, Eq)
176
177data AllocSize
178  = AllocWord
179  | AllocLong
180  | AllocLongLong
181  deriving (Show, Eq)
182
183getSize :: AllocSize -> Int
184getSize AllocWord = 4
185getSize AllocLong = 8
186getSize AllocLongLong = 16
187
188data TypeDef
189  = TypeDef
190  { aggName :: UserIdent,
191    aggAlign :: Maybe Word64,
192    aggType :: AggType
193  }
194  deriving (Show, Eq)
195
196data SubType
197  = SExtType ExtType
198  | SUserDef UserIdent
199  deriving (Show, Eq)
200
201type Field = (SubType, Maybe Word64)
202
203-- TODO: Type for tuple
204data AggType
205  = ARegular [Field]
206  | AUnion [[Field]]
207  | AOpaque Word64
208  deriving (Show, Eq)
209
210data DataDef
211  = DataDef
212  { linkage :: [Linkage],
213    name :: GlobalIdent,
214    align :: Maybe Word64,
215    objs :: [DataObj]
216  }
217  deriving (Show, Eq)
218
219dataSize :: DataDef -> Int
220dataSize dataDef =
221  sum $ map objSize (objs dataDef)
222
223data DataObj
224  = OItem ExtType [DataItem]
225  | OZeroFill Word64
226  deriving (Show, Eq)
227
228objAlign :: DataObj -> Word64
229objAlign (OZeroFill _) = 1 :: Word64
230objAlign (OItem ty _) = fromIntegral $ extTypeByteSize ty
231
232objSize :: DataObj -> Int
233objSize (OZeroFill n) = fromIntegral n
234objSize (OItem ty items) = extTypeByteSize ty * cnt items
235  where
236    cnt :: [DataItem] -> Int
237    cnt [] = 0
238    cnt ((DString s) : xs) = length s + cnt xs
239    cnt (_ : xs) = 1 + cnt xs
240
241data DataItem
242  = DSymOff GlobalIdent Word64
243  | DString String
244  | DConst Const
245  deriving (Show, Eq)
246
247data FuncDef
248  = FuncDef
249  { fLinkage :: [Linkage],
250    fName :: GlobalIdent,
251    fAbity :: Maybe Abity,
252    fParams :: [FuncParam],
253    fBlock :: [Block] -- TODO: Use a Map here
254  }
255  deriving (Show, Eq)
256
257data FuncParam
258  = Regular Abity LocalIdent
259  | Env LocalIdent
260  | Variadic
261  deriving (Show, Eq)
262
263data FuncArg
264  = ArgReg Abity Value
265  | ArgEnv Value
266  | ArgVar
267  deriving (Show, Eq)
268
269data JumpInstr
270  = Jump BlockIdent
271  | Jnz Value BlockIdent BlockIdent
272  | Return (Maybe Value)
273  | Halt
274  deriving (Show, Eq)
275
276data LoadType
277  = LSubWord SubWordType
278  | LBase BaseType
279  deriving (Show, Eq)
280
281-- TODO: Could/Should define this on ExtType instead.
282loadByteSize :: LoadType -> Word64
283loadByteSize (LSubWord UnsignedByte) = 1
284loadByteSize (LSubWord SignedByte) = 1
285loadByteSize (LSubWord SignedHalf) = 2
286loadByteSize (LSubWord UnsignedHalf) = 2
287loadByteSize (LBase Word) = 4
288loadByteSize (LBase Long) = 8
289loadByteSize (LBase Single) = 4
290loadByteSize (LBase Double) = 8
291
292data ExtArg
293  = ExtSingle
294  | ExtSubWord SubWordType
295  | ExtSignedWord
296  | ExtUnsignedWord
297  deriving (Show, Eq)
298
299toExtType :: ExtArg -> (Bool, ExtType)
300toExtType (ExtSubWord SignedByte) = (True, Byte)
301toExtType (ExtSubWord UnsignedByte) = (False, Byte)
302toExtType (ExtSubWord SignedHalf) = (True, HalfWord)
303toExtType (ExtSubWord UnsignedHalf) = (False, HalfWord)
304toExtType ExtSignedWord = (True, Base Word)
305toExtType ExtUnsignedWord = (False, Base Word)
306toExtType ExtSingle = (True, Base Single)
307
308data FloatArg = FDouble | FSingle
309  deriving (Show, Eq)
310
311f2BaseType :: FloatArg -> BaseType
312f2BaseType FSingle = Single
313f2BaseType FDouble = Double
314
315data IntArg = IWord | ILong
316  deriving (Show, Eq)
317
318i2BaseType :: IntArg -> BaseType
319i2BaseType IWord = Word
320i2BaseType ILong = Long
321
322-- TODO: Distinict types for floating point comparison?
323data IntCmpOp
324  = IEq
325  | INe
326  | ISle
327  | ISlt
328  | ISge
329  | ISgt
330  | IUle
331  | IUlt
332  | IUge
333  | IUgt
334  deriving (Show, Eq)
335
336data FloatCmpOp
337  = FEq
338  | FNe
339  | FLe
340  | FLt
341  | FGe
342  | FGt
343  | FOrd
344  | FUnord
345  deriving (Show, Eq)
346
347data Instr
348  = Add Value Value
349  | Sub Value Value
350  | Div Value Value
351  | Mul Value Value
352  | Neg Value
353  | URem Value Value
354  | Rem Value Value
355  | UDiv Value Value
356  | Or Value Value
357  | Xor Value Value
358  | And Value Value
359  | Sar Value Value
360  | Shr Value Value
361  | Shl Value Value
362  | Alloc AllocSize Value
363  | Load LoadType Value
364  | CompareInt IntArg IntCmpOp Value Value
365  | CompareFloat FloatArg FloatCmpOp Value Value
366  | Ext ExtArg Value
367  | FloatToInt FloatArg Bool Value
368  | IntToFloat IntArg Bool Value
369  | TruncDouble Value
370  | Cast Value
371  | Copy Value
372  | VAArg Value
373  deriving (Show, Eq)
374
375data VolatileInstr
376  = Store ExtType Value Value
377  | VAStart Value
378  | Blit Value Value Word64
379  | DBGLoc Word64 Word64 (Maybe Word64)
380  deriving (Show, Eq)
381
382data Statement
383  = Assign LocalIdent BaseType Instr
384  | Call (Maybe (LocalIdent, Abity)) Value [FuncArg]
385  | Volatile VolatileInstr
386  deriving (Show, Eq)
387
388data Phi
389  = Phi
390  { pName :: LocalIdent,
391    pType :: BaseType,
392    pLabels :: Map BlockIdent Value
393  }
394  deriving (Show, Eq)
395
396data Block
397  = Block
398  { label :: BlockIdent,
399    phi :: [Phi],
400    stmt :: [Statement],
401    term :: JumpInstr
402  }
403  deriving (Show, Eq)