qute-syntax (empty) → 0.1.0
raw patch · 10 files changed
+2672/−0 lines, 10 filesdep +basedep +containersdep +exceptions
Dependencies added: base, containers, exceptions, filepath, parsec, process, qute-syntax, tasty, tasty-golden, tasty-hunit
Files
- qute-syntax.cabal +68/−0
- src/Language/QBE.hs +109/−0
- src/Language/QBE/Numbers.hs +145/−0
- src/Language/QBE/Parser.lhs +1464/−0
- src/Language/QBE/Types.hs +410/−0
- src/Language/QBE/Util.hs +47/−0
- test/Golden.hs +82/−0
- test/Main.hs +16/−0
- test/Parser.hs +310/−0
- test/Types.hs +21/−0
+ qute-syntax.cabal view
@@ -0,0 +1,68 @@+cabal-version: 3.4+name: qute-syntax+version: 0.1.0+synopsis: This package provides a parser for the QBE intermediate language.+description:+ This library provides a parser for the [QBE intermediate language](https://c9x.me/compile/)+ and algebraic data types to represent various QBE constructs. This package is the foundation+ of the [Qute](https://hackage.haskell.org/package/qute) software analysis framework.+license: GPL-3.0-only AND BSD-2-Clause AND MIT+-- license-file:+author: Sören Tempel+maintainer: soeren+hackage@soeren-tempel.net+-- copyright:+category: Language+build-type: Simple+homepage: https://git.8pit.net/qute+bug-reports: https://github.com/nmeum/qute/issues++source-repository head+ type: git+ location: https://git.8pit.net/qute.git++common warnings+ ghc-options: -Wall++library+ import: warnings+ -- other-extensions:+ hs-source-dirs: src+ default-language: GHC2021++ other-modules:+ Language.QBE.Util,+ Language.QBE.Numbers++ exposed-modules:+ Language.QBE,+ Language.QBE.Types,+ Language.QBE.Parser++ build-depends:+ base >= 4.16.4.0 && < 4.23,+ parsec >= 3.1.15 && < 3.19,+ containers >= 0.6.5.1 && < 0.9,+ exceptions >= 0.10.4 && < 0.11++test-suite qute-syntax-test+ import: warnings+ default-language: GHC2021+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs++ other-modules:+ Parser,+ Golden,+ Types++ build-depends:+ base,+ qute-syntax,+ parsec,+ process,+ filepath,+ containers,+ tasty >=1.4.3,+ tasty-hunit >=0.10,+ tasty-golden >=2.3.5,
+ src/Language/QBE.hs view
@@ -0,0 +1,109 @@+-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>+--+-- SPDX-License-Identifier: GPL-3.0-only++-- | This module provides top-level definitions for representing programs+-- written in the [QBE](https://c9x.me/compile/) intermediate representation.+module Language.QBE+ ( Program,+ Definition (..),+ globalFuncs,+ Language.QBE.parse,+ ExecError (..),+ parseAndFind,+ )+where++import Control.Monad.Catch (Exception, MonadThrow, throwM)+import Data.List (find)+import Data.Maybe (mapMaybe)+import Language.QBE.Parser (dataDef, fileDef, funcDef, skipInitComments, typeDef)+import Language.QBE.Types (DataDef, FuncDef, GlobalIdent, TypeDef, fName)+import Text.ParserCombinators.Parsec+ ( ParseError,+ Parser,+ SourceName,+ choice,+ eof,+ many,+ parse,+ try,+ )++-- | A QBE program consists of a sequence of definitions. Four types of objects+-- can be defined: aggregate types, data, functions, and debugging information.+--+-- See also: The corresponding section of the [QBE specification](https://c9x.me/compile/doc/il-v1.2.html#Definitions).+data Definition+ = -- | Definition of data (e.g. a string).+ DefData DataDef+ | -- | Definition of an aggregate data type.+ DefType TypeDef+ | -- | Definition of a function.+ DefFunc FuncDef+ | -- | Definition of a debug file.+ DefFile String+ deriving (Eq, Show)++parseDef :: Parser Definition+parseDef =+ choice+ [ DefType <$> typeDef,+ -- Need to try funcDef as both funcDef and+ -- dataDef start with a linkage definition.+ --+ -- TODO: Try parsing linkage then funcDef <|> dataDef.+ DefData <$> try dataDef,+ DefFunc <$> funcDef,+ DefFile <$> fileDef+ ]++-- | A parsed QBE program, represented as a list of 'Definition' values.+type Program = [Definition]++-- | Wrapper to parse a QBE program using 'Text.ParserCombinators.Parsec.parse'.+parse :: SourceName -> String -> Either ParseError Program+parse =+ Text.ParserCombinators.Parsec.parse+ (skipInitComments *> many parseDef <* eof)++-- | Utility function to obtain all functions defined in a QBE 'Program'.+globalFuncs :: Program -> [FuncDef]+globalFuncs = mapMaybe globalFuncs'+ where+ globalFuncs' :: Definition -> Maybe FuncDef+ globalFuncs' (DefFunc f) = Just f+ globalFuncs' _ = Nothing++------------------------------------------------------------------------++-- | Custom 'Exception' used for error handling in 'parseAndFind'.+data ExecError+ = -- | The input is not a valid QBE program.+ ESyntaxError ParseError+ | -- | The given entry function is not defined in the QBE program.+ EUnknownEntry GlobalIdent+ deriving (Show)++instance Exception ExecError++-- | Utility function for the common task of parsing an input as a QBE+-- 'Program' and, within that program, finding the entry function. If the+-- function doesn't exist or a the input is invalid a 'ExecError' exception+-- is thrown.+parseAndFind ::+ (MonadThrow m) =>+ GlobalIdent ->+ String ->+ m (Program, FuncDef)+parseAndFind entryIdent input = do+ prog <- case Language.QBE.parse "" input of -- TODO: file name+ Right rt -> pure rt+ Left err -> throwM $ ESyntaxError err++ let funcs = globalFuncs prog+ func <- case find (\f -> fName f == entryIdent) funcs of+ Just x -> pure x+ Nothing -> throwM $ EUnknownEntry entryIdent++ pure (prog, func)
+ src/Language/QBE/Numbers.hs view
@@ -0,0 +1,145 @@+-- SPDX-FileCopyrightText: 1999-2001 Daan Leijen+-- SPDX-FileCopyrightText: 2007 Paolo Martini+-- SPDX-FileCopyrightText: 2013-2014 Christian Maeder <chr.maeder@web.de>+-- SPDX-FileCopyrightText: 2025-2026 Sören Tempel <soeren+git@soeren-tempel.net>+--+-- SPDX-License-Identifier: BSD-2-Clause AND GPL-3.0-only++module Language.QBE.Numbers where++import Control.Monad (ap)+import Data.Char (digitToInt)+import Text.Parsec++-- ** float parts++-- | parse a floating point number given the number before a dot, e or E+fractExponent :: (Floating f, Stream s m Char) => Integer -> ParsecT s u m f+fractExponent i = fractExp i False++-- | parse a floating point number given the number before a dot, e or E+fractExp ::+ (Floating f, Stream s m Char) =>+ Integer ->+ Bool ->+ ParsecT s u m f+fractExp i b = genFractExp i (fraction b) exponentFactor++-- | parse a floating point number given the number before the fraction and+-- exponent+genFractExp ::+ (Floating f, Stream s m Char) =>+ Integer ->+ ParsecT s u m f ->+ ParsecT s u m (f -> f) ->+ ParsecT s u m f+genFractExp i frac expo = case fromInteger i of+ f -> genFractAndExp f frac expo <|> fmap ($ f) expo++-- | parse a floating point number given the number before the fraction and+-- exponent that must follow the fraction+genFractAndExp ::+ (Floating f, Stream s m Char) =>+ f ->+ ParsecT s u m f ->+ ParsecT s u m (f -> f) ->+ ParsecT s u m f+genFractAndExp f frac = ap (fmap (flip id . (f +)) frac) . option id++-- | parse a floating point exponent starting with e or E+exponentFactor :: (Floating f, Stream s m Char) => ParsecT s u m (f -> f)+exponentFactor = oneOf "eE" >> extExponentFactor 10 <?> "exponent"++-- | parse a signed decimal and compute the exponent factor given a base.+-- For hexadecimal exponential notation (IEEE 754) the base is 2 and the+-- leading character a p.+extExponentFactor ::+ (Floating f, Stream s m Char) =>+ Int -> ParsecT s u m (f -> f)+extExponentFactor base =+ fmap (flip (*) . exponentValue base) (ap sign (decimal <?> "exponent"))++-- | compute the factor given by the number following e or E. This+-- implementation uses @**@ rather than @^@ for more efficiency for large+-- integers.+exponentValue :: (Floating f) => Int -> Integer -> f+exponentValue base = (fromIntegral base **) . fromInteger++-- ** fractional parts++-- | optionally parse a dot followed by decimal digits as fractional part.+-- if there is no dot, and the fractional part is not required (as indicated+-- by the predicate argument), then 0.0 is returned.+fraction :: (Fractional f, Stream s m Char) => Bool -> ParsecT s u m f+fraction reqDigit = do+ hasDot <- (char '.' >> pure True) <|> pure False+ if hasDot+ then baseFraction reqDigit 10 digit+ else if reqDigit then parserFail "no dot in fraction" else pure 0.0++-- | parse base dependent digits (usually after dot) as fractional part+baseFraction ::+ (Fractional f, Stream s m Char) =>+ Bool ->+ Int ->+ ParsecT s u m Char ->+ ParsecT s u m f+baseFraction requireDigit base baseDigit =+ fmap+ (fractionValue base)+ ((if requireDigit then many1 else many) baseDigit <?> "fraction")+ <?> "fraction"++-- | compute the fraction given by a sequence of digits following the dot.+-- Only one division is performed and trailing zeros are ignored.+fractionValue :: (Fractional f) => Int -> String -> f+fractionValue base =+ uncurry (/)+ . foldl+ ( \(s, p) d ->+ (p * fromIntegral (digitToInt d) + s, p * fromIntegral base)+ )+ (0, 1)+ . dropWhile (== '0')+ . reverse++-- * integers and naturals++-- | parse a negative or a positive number (returning 'negate' or 'id').+-- positive numbers are NOT allowed to be prefixed by a plus sign.+signMinus :: (Num a, Stream s m Char) => ParsecT s u m (a -> a)+signMinus = (char '-' >> return negate) <|> return id++-- | parse an optional plus or minus sign, returning 'negate' or 'id'+sign :: (Num a, Stream s m Char) => ParsecT s u m (a -> a)+sign = (char '-' >> return negate) <|> (optional (char '+') >> return id)++-- | parse plain non-negative decimal numbers given by a non-empty sequence+-- of digits+decimal :: (Integral i, Stream s m Char) => ParsecT s u m i+decimal = number 10 digit++-- ** natural parts++-- | parse a hexadecimal number+hexnum :: (Integral i, Stream s m Char) => ParsecT s u m i+hexnum = number 16 hexDigit++-- | parse an octal number+octnum :: (Integral i, Stream s m Char) => ParsecT s u m i+octnum = number 8 octDigit++-- | parse a non-negative number given a base and a parser for the digits+number ::+ (Integral i, Stream s m t) =>+ Int ->+ ParsecT s u m Char ->+ ParsecT s u m i+number base baseDigit = do+ n <- fmap (numberValue base) (many1 baseDigit)+ seq n (return n)++-- | compute the value from a string of digits using a base+numberValue :: (Integral i) => Int -> String -> i+numberValue base =+ foldl (\x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0
+ src/Language/QBE/Parser.lhs view
@@ -0,0 +1,1464 @@+% SPDX-FileCopyrightText: 2015-2024 Quentin Carbonneaux <quentin@c9x.me>+% SPDX-FileCopyrightText: 2025-2026 Sören Tempel <soeren+git@soeren-tempel.net>+%+% SPDX-License-Identifier: MIT AND GPL-3.0-only++\documentclass{article}+%include polycode.fmt++%subst blankline = "\\[5mm]"++% See https://github.com/kosmikus/lhs2tex/issues/58+%format <$> = "\mathbin{\langle\$\rangle}"+%format <&> = "\mathbin{\langle\&\rangle}"+%format <|> = "\mathbin{\langle\:\vline\:\rangle}"+%format <?> = "\mathbin{\langle?\rangle}"+%format <*> = "\mathbin{\langle*\rangle}"+%format <* = "\mathbin{\langle*}"+%format *> = "\mathbin{*\rangle}"++\long\def\ignore#1{}++\usepackage{hyperref}+\hypersetup{+ colorlinks = true,+}++\begin{document}++\title{QBE Intermediate Language\vspace{-2em}}+\date{}+\maketitle+\frenchspacing++\ignore{+\begin{code}+module Language.QBE.Parser+ ( skipInitComments,+ dataDef,+ typeDef,+ funcDef,+ fileDef+ )+where++import Control.Monad (foldM)+import Data.Char (chr)+import Data.Word (Word64)+import Data.Functor ((<&>))+import Data.List (singleton)+import Data.Map (Map)+import Data.Map qualified as Map+import qualified Language.QBE.Types as Q+import Language.QBE.Util (bind, decNumber, octNumber, float)+import Text.ParserCombinators.Parsec+ ( Parser,+ alphaNum,+ anyChar,+ between,+ char,+ choice,+ letter,+ many,+ many1,+ manyTill,+ newline,+ noneOf,+ oneOf,+ optional,+ optionMaybe,+ sepBy,+ sepBy1,+ skipMany,+ skipMany1,+ string,+ try,+ (<?>),+ (<|>),+ )+\end{code}+}++This an executable description of the+\href{https://c9x.me/compile/doc/il-v1.2.html}{QBE intermediate language},+specified through \href{https://hackage.haskell.org/package/parsec}{Parsec}+parser combinators and generated from a literate Haskell file. The description+is derived from the original QBE IL documentation, licensed under MIT.+Presently, this implementation targets version 1.2 of the QBE intermediate+language and aims to be equivalent with the original specification.++\section{Basic Concepts}++The intermediate language (IL) is a higher-level language than the+machine's assembly language. It smoothes most of the+irregularities of the underlying hardware and allows an infinite number+of temporaries to be used. This higher abstraction level lets frontend+programmers focus on language design issues.++\subsection{Input Files}++The intermediate language is provided to QBE as text. Usually, one file+is generated per each compilation unit from the frontend input language.+An IL file is a sequence of \nameref{sec:definitions} for+data, functions, and types. Once processed by QBE, the resulting file+can be assembled and linked using a standard toolchain (e.g., GNU+binutils).++\begin{code}+comment :: Parser ()+comment = skipMany blankNL >> comment' >> skipMany blankNL+ where+ comment' = char '#' >> manyTill anyChar newline+\end{code}++\ignore{+\begin{code}+skipNoCode :: Parser () -> Parser ()+skipNoCode blankP = try (skipMany1 comment <?> "comments") <|> blankP+\end{code}+}++Here is a complete "Hello World" IL file which defines a function that+prints to the screen. Since the string is not a first class object (only+the pointer is) it is defined outside the function\textquotesingle s+body. Comments start with a \# character and finish with the end of the+line.++\begin{verbatim}+data $str = { b "hello world", b 0 }++export function w $main() {+@start+ # Call the puts function with $str as argument.+ %r =w call $puts(l $str)+ ret 0+}+\end{verbatim}++If you have read the LLVM language reference, you might recognize the+example above. In comparison, QBE makes a much lighter use of types and+the syntax is terser.++\subsection{Parser Combinators}++\ignore{+\begin{code}+bracesNL :: Parser a -> Parser a+bracesNL = between (wsNL $ char '{') (wsNL $ char '}')++quoted :: Parser a -> Parser a+quoted = let q = char '"' in between q q++sepByTrail1 :: Parser a -> Parser sep -> Parser [a]+sepByTrail1 p sep = do+ x <- p+ xs <- many (try $ sep >> p)+ _ <- optional sep+ return (x:xs)++sepByTrail :: Parser a -> Parser sep -> Parser [a]+sepByTrail p sep = sepByTrail1 p sep <|> return []++parenLst :: Parser a -> Parser [a]+parenLst p = between (ws $ char '(') (char ')') inner+ where+ inner = sepBy (ws p) (ws $ char ',')++unaryInstr :: (Q.Value -> Q.Instr) -> String -> Parser Q.Instr+unaryInstr conc keyword = do+ _ <- ws (string keyword)+ conc <$> ws val++binaryInstr :: (Q.Value -> Q.Value -> Q.Instr) -> String -> Parser Q.Instr+binaryInstr conc keyword = do+ _ <- ws (string keyword)+ vfst <- ws val <* ws (char ',')+ conc vfst <$> ws val++-- Can only appear in data and type definitions and hence allows newlines.+alignAny :: Parser Word64+alignAny = (ws1 (string "align")) >> wsNL decNumber++-- Returns true if it is signed.+signageChar :: Parser Bool+signageChar = (char 's' <|> char 'u') <&> (== 's')+\end{code}+}++The original QBE specification defines the syntax using a BNF grammar. In+contrast, this document defines it using Parsec parser combinators. As such,+this specification is less formal but more accurate as the parsing code is+actually executable. Consequently, this specification also captures constructs+omitted in the original specification (e.g., \nameref{sec:identifiers}, or+\nameref{sec:strlit}). Nonetheless, the formal language recognized by these+combinators aims to be equivalent to the one of the BNF grammar.++\subsection{Identifiers}+\label{sec:identifiers}++% Ident is not documented in the original QBE specification.+% See https://c9x.me/git/qbe.git/tree/parse.c?h=v1.2#n304++\begin{code}+ident :: Parser String+ident = do+ start <- letter <|> oneOf "._"+ rest <- many (alphaNum <|> oneOf "$._")+ return $ start : rest+\end{code}++Identifiers for data, types, and functions can start with any ASCII letter or+the special characters \texttt{.} and \texttt{\_}. This initial character can+be followed by a sequence of zero or more alphanumeric characters and the+special characters \texttt{\$}, \texttt{.}, and \texttt{\_}.++\subsection{Sigils}++\begin{code}+userDef :: Parser Q.UserIdent+userDef = Q.UserIdent <$> (char ':' >> ident)++global :: Parser Q.GlobalIdent+global = Q.GlobalIdent <$> (char '$' >> ident)++local :: Parser Q.LocalIdent+local = Q.LocalIdent <$> (char '%' >> ident)++label :: Parser Q.BlockIdent+label = Q.BlockIdent <$> (char '@' >> ident)+\end{code}++The intermediate language makes heavy use of sigils, all user-defined+names are prefixed with a sigil. This is to avoid keyword conflicts, and+also to quickly spot the scope and nature of identifiers.++\begin{itemize}+ \item \texttt{:} is for user-defined \nameref{sec:aggregate-types}+ \item \texttt{\$} is for globals (represented by a pointer)+ \item \texttt{\%} is for function-scope temporaries+ \item \texttt{@@} is for block labels+\end{itemize}++\subsection{Spacing}++\begin{code}+blank :: Parser Char+blank = oneOf "\t " <?> "blank"++blankNL :: Parser Char+blankNL = oneOf "\n\t " <?> "blank or newline"+\end{code}++Individual tokens in IL files must be separated by one or more spacing+characters. Both spaces and tabs are recognized as spacing characters.+In data and type definitions, newlines may also be used as spaces to+prevent overly long lines. When exactly one of two consecutive tokens is+a symbol (for example \texttt{,} or \texttt{=} or \texttt{\{}), spacing may be omitted.++\ignore{+\begin{code}+ws :: Parser a -> Parser a+ws p = p <* skipMany blank++ws1 :: Parser a -> Parser a+ws1 p = p <* skipMany1 blank++wsNL :: Parser a -> Parser a+wsNL p = p <* skipNoCode (skipMany blankNL)++wsNL1 :: Parser a -> Parser a+wsNL1 p = p <* skipNoCode (skipMany1 blankNL)++-- Only intended to be used to skip comments at the start of a file.+skipInitComments :: Parser ()+skipInitComments = skipNoCode (skipMany blankNL)+\end{code}+}++\subsection{String Literals}+\label{sec:strlit}++% The string literal is not documented in the original QBE specification.+% See https://c9x.me/git/qbe.git/tree/parse.c?h=v1.2#n287++\begin{code}+strLit :: Parser String+strLit = concat <$> quoted (many strChr)+ where+ strChr :: Parser [Char]+ strChr = (singleton <$> noneOf "\"\\") <|> escSeq++ -- TODO: not documnted in the QBE BNF.+ octEsc :: Parser Char+ octEsc = do+ n <- octNumber+ pure $ chr (fromIntegral n)++ escSeq :: Parser [Char]+ escSeq = try $ do+ esc <- char '\\'+ (singleton <$> octEsc) <|> (anyChar <&> (\c -> [esc, c]))+\end{code}++Strings are enclosed by double quotes and are, for example, used to specify a+section name as part of the \nameref{sec:linkage} information. Within a string,+a double quote can be escaped using a \texttt{\textbackslash} character. All+escape sequences, including double quote escaping, are passed through as-is to+the generated assembly file.++\section{Types}++\subsection{Simple Types}++The IL makes minimal use of types. By design, the types used are+restricted to what is necessary for unambiguous compilation to machine+code and C interfacing. Unlike LLVM, QBE is not using types as a means+to safety; they are only here for semantic purposes.++\begin{code}+baseType :: Parser Q.BaseType+baseType = choice+ [ bind "w" Q.Word+ , bind "l" Q.Long+ , bind "s" Q.Single+ , bind "d" Q.Double ]+\end{code}++The four base types are \texttt{w} (word), \texttt{l} (long), \texttt{s} (single), and \texttt{d}+(double), they stand respectively for 32-bit and 64-bit integers, and+32-bit and 64-bit floating-point numbers. There are no pointer types+available; pointers are typed by an integer type sufficiently wide to+represent all memory addresses (e.g., \texttt{l} on 64-bit architectures).+Temporaries in the IL can only have a base type.++\begin{code}+extType :: Parser Q.ExtType+extType = (Q.Base <$> baseType)+ <|> bind "b" Q.Byte+ <|> bind "h" Q.HalfWord+\end{code}++Extended types contain base types plus \texttt{b} (byte) and \texttt{h} (half word),+respectively for 8-bit and 16-bit integers. They are used in \nameref{sec:aggregate-types}+and \nameref{sec:data} definitions.++For C interfacing, the IL also provides user-defined aggregate types as+well as signed and unsigned variants of the sub-word extended types.+Read more about these types in the \nameref{sec:aggregate-types}+and \nameref{sec:functions} sections.++\subsection{Subtyping}+\label{sec:subtyping}++The IL has a minimal subtyping feature, for integer types only. Any+value of type \texttt{l} can be used in a \texttt{w} context. In that case, only the+32 least significant bits of the word value are used.++Make note that it is the opposite of the usual subtyping on integers (in+C, we can safely use an \texttt{int} where a \texttt{long} is expected). A long value+cannot be used in word context. The rationale is that a word can be+signed or unsigned, so extending it to a long could be done in two ways,+either by zero-extension, or by sign-extension.++\subsection{Constants and Vals}+\label{sec:constants-and-vals}++\begin{code}+dynConst :: Parser Q.DynConst+dynConst =+ (Q.Const <$> constant)+ <|> (Q.Thread <$> (key "thread" >> global))+ <|> (Q.Extern <$> try (key "extern" >> global))+ <|> (Q.ExternThread <$> (key "extern" >> key "thread" >> global))+ <?> "dynconst"+ where+ key s = ws1 $ string s+\end{code}++Constants come in two kinds: compile-time constants and dynamic+constants. Dynamic constants include compile-time constants and other+symbol variants that are only known at program-load time or execution+time. Consequently, dynamic constants can only occur in function bodies.++When the \texttt{extern} keyword prefixes a symbol name, the symbol is+accessed indirectly through a table edited by the dynamic linker (e.g.,+GOT/PLT). This enables PIE/PIC code generation. When \texttt{extern} is+combined with \texttt{thread}, the symbol is accessed using the+initial-exec TLS model, suitable for thread-local variables defined in+shared objects available at startup time (i.e., not loaded through+dlopen).++The representation of integers is two's complement.+Floating-point numbers are represented using the single-precision and+double-precision formats of the IEEE 754 standard.++\begin{code}+constant :: Parser Q.Const+constant =+ (Q.Number <$> decNumber)+ <|> (Q.SFP <$> sfp)+ <|> (Q.DFP <$> dfp)+ <|> (Q.Global <$> global)+ <?> "const"+ where+ sfp = string "s_" >> float+ dfp = string "d_" >> float+\end{code}++Constants specify a sequence of bits and are untyped. They are always+parsed as 64-bit blobs. Depending on the context surrounding a constant,+only some of its bits are used. For example, in the program below, the+two variables defined have the same value since the first operand of the+subtraction is a word (32-bit) context.++\begin{verbatim}+%x =w sub -1, 0 %y =w sub 4294967295, 0+\end{verbatim}++Because specifying floating-point constants by their bits makes the code+less readable, syntactic sugar is provided to express them. Standard+scientific notation is prefixed with \texttt{s\_} and \texttt{d\_} for single and+double precision numbers respectively. Once again, the following example+defines twice the same double-precision constant.++\begin{verbatim}+%x =d add d_0, d_-1+%y =d add d_0, -4616189618054758400+\end{verbatim}++Global symbols can also be used directly as constants; they will be+resolved and turned into actual numeric constants by the linker.++When the \texttt{thread} keyword prefixes a symbol name, the+symbol\textquotesingle s numeric value is resolved at runtime in the+thread-local storage.++\begin{code}+val :: Parser Q.Value+val =+ (Q.VConst <$> dynConst)+ <|> (Q.VLocal <$> local)+ <?> "val"+\end{code}++Vals are used as arguments in regular, phi, and jump instructions within+function definitions. They are either constants or function-scope+temporaries.++\subsection{Linkage}+\label{sec:linkage}++\begin{code}+linkage :: Parser Q.Linkage+linkage =+ wsNL (bind "export" Q.LExport)+ <|> wsNL (bind "thread" Q.LThread)+ <|> do+ _ <- ws1 $ string "section"+ (try secWithFlags) <|> sec+ where+ sec :: Parser Q.Linkage+ sec = wsNL strLit <&> (`Q.LSection` Nothing)++ secWithFlags :: Parser Q.Linkage+ secWithFlags = do+ n <- ws1 strLit+ wsNL strLit <&> Q.LSection n . Just+\end{code}++Function and data definitions (see below) can specify linkage+information to be passed to the assembler and eventually to the linker.++The \texttt{export} linkage flag marks the defined item as visible outside the+current file\textquotesingle s scope. If absent, the symbol can only be+referred to locally. Functions compiled by QBE and called from C need to+be exported.++The \texttt{thread} linkage flag can only qualify data definitions. It mandates+that the object defined is stored in thread-local storage. Each time a+runtime thread starts, the supporting platform runtime is in charge of+making a new copy of the object for the fresh thread. Objects in+thread-local storage must be accessed using the \texttt{thread \$IDENT} syntax,+as specified in the \nameref{sec:constants-and-vals} section.++A \texttt{section} flag can be specified to tell the linker to put the defined+item in a certain section. The use of the section flag is platform+dependent and we refer the user to the documentation of their assembler+and linker for relevant information.++\begin{verbatim}+section ".init_array" data $.init.f = { l $f }+\end{verbatim}++The section flag can be used to add function pointers to a global+initialization list, as depicted above. Note that some platforms provide+a BSS section that can be used to minimize the footprint of uniformly+zeroed data. When this section is available, QBE will automatically make+use of it and no section flag is required.++The section and export linkage flags should each appear at most once in+a definition. If multiple occurrences are present, QBE is free to use+any.++\subsection{Definitions}+\label{sec:definitions}++Definitions are the essential components of an IL file. They can define+three types of objects: aggregate types, data, and functions. Aggregate+types are never exported and do not compile to any code. Data and+function definitions have file scope and are mutually recursive (even+across IL files). Their visibility can be controlled using linkage+flags.++\subsubsection{Aggregate Types}+\label{sec:aggregate-types}++\begin{code}+typeDef :: Parser Q.TypeDef+typeDef = do+ _ <- wsNL1 (string "type")+ i <- wsNL1 userDef+ _ <- wsNL1 (char '=')+ a <- optionMaybe alignAny+ bracesNL (opaqueType <|> unionType <|> regularType) <&> Q.TypeDef i a+\end{code}++Aggregate type definitions start with the \texttt{type} keyword. They have file+scope, but types must be defined before being referenced. The inner+structure of a type is expressed by a comma-separated list of fields.++\begin{code}+subType :: Parser Q.SubType+subType =+ (Q.SExtType <$> extType)+ <|> (Q.SUserDef <$> userDef)++field :: Parser Q.Field+field = do+ -- TODO: newline is required if there is a number argument+ f <- wsNL subType+ s <- ws $ optionMaybe decNumber+ pure (f, s)++fields :: Bool -> Parser [Q.Field]+fields allowEmpty =+ (if allowEmpty then sepByTrail else sepByTrail1) field (wsNL $ char ',')+\end{code}++A field consists of a subtype, either an extended type or a user-defined type,+and an optional number expressing the value of this field. In case many items+of the same type are sequenced (like in a C array), the shorter array syntax+can be used.++\begin{code}+regularType :: Parser Q.AggType+regularType = Q.ARegular <$> fields True+\end{code}++Three different kinds of aggregate types are presentl ysupported: regular+types, union types and opaque types. The fields of regular types will be+packed. By default, the alignment of an aggregate type is the maximum alignment+of its members. The alignment can be explicitly specified by the programmer.++\begin{code}+unionType :: Parser Q.AggType+unionType = Q.AUnion <$> many1 (wsNL unionType')+ where+ unionType' :: Parser [Q.Field]+ unionType' = bracesNL $ fields False+\end{code}++Union types allow the same chunk of memory to be used with different layouts. They are defined by enclosing multiple regular aggregate type bodies in a pair of curly braces. Size and alignment of union types are set to the maximum size and alignment of each variation or, in the case of alignment, can be explicitly specified.++\begin{code}+opaqueType :: Parser Q.AggType+opaqueType = Q.AOpaque <$> wsNL decNumber+\end{code}++Opaque types are used when the inner structure of an aggregate cannot be specified; the alignment for opaque types is mandatory. They are defined simply by enclosing their size between curly braces.++\subsubsection{Data}+\label{sec:data}++\begin{code}+dataDef :: Parser Q.DataDef+dataDef = do+ link <- many linkage+ name <- wsNL1 (string "data") >> wsNL global+ _ <- wsNL (char '=')+ alignment <- optionMaybe alignAny+ bracesNL dataObjs <&> Q.DataDef link name alignment+ where+ -- TODO: sepByTrail is not documented in the QBE BNF.+ dataObjs = sepByTrail dataObj (wsNL $ char ',')+\end{code}++Data definitions express objects that will be emitted in the compiled+file. Their visibility and location in the compiled artifact are+controlled with linkage flags described in the \nameref{sec:linkage}+section.++They define a global identifier (starting with the sigil \texttt{\$}), that+will contain a pointer to the object specified by the definition.++\begin{code}+dataObj :: Parser Q.DataObj+dataObj =+ (Q.OZeroFill <$> (wsNL1 (char 'z') >> wsNL decNumber))+ <|> do+ t <- wsNL1 extType+ i <- many1 (wsNL dataItem)+ return $ Q.OItem t i+\end{code}++Objects are described by a sequence of fields that start with a type+letter. This letter can either be an extended type, or the \texttt{z} letter.+If the letter used is an extended type, the data item following+specifies the bits to be stored in the field.++\begin{code}+dataItem :: Parser Q.DataItem+dataItem =+ (Q.DString <$> strLit)+ <|> try+ ( do+ i <- ws global+ off <- (ws $ char '+') >> ws decNumber+ return $ Q.DSymOff i off+ )+ <|> (Q.DConst <$> constant)+\end{code}++Within each object, several items can be defined. When several data items+follow a letter, they initialize multiple fields of the same size.++\begin{code}+allocSize :: Parser Q.AllocSize+allocSize =+ choice+ [ bind "4" Q.AllocWord,+ bind "8" Q.AllocLong,+ bind "16" Q.AllocLongLong+ ]+\end{code}++The members of a struct will be packed. This means that padding has to+be emitted by the frontend when necessary. Alignment of the whole data+objects can be manually specified, and when no alignment is provided,+the maximum alignment from the platform is used.++When the \texttt{z} letter is used the number following indicates the size of+the field; the contents of the field are zero initialized. It can be+used to add padding between fields or zero-initialize big arrays.++\subsubsection{Functions}+\label{sec:functions}++\begin{code}+funcDef :: Parser Q.FuncDef+funcDef = do+ link <- many linkage+ _ <- ws1 (string "function")+ retTy <- optionMaybe (ws1 abity)+ name <- ws global+ args <- wsNL params+ body <- between (wsNL1 $ char '{') (wsNL $ char '}') $ many1 block++ case (insertJumps body) of+ Nothing -> fail $ "invalid fallthrough in " ++ show name+ Just [] -> error "unreachable" -- TODO: Use NonEmpty+ Just blocks@(startBlk:_) ->+ return $+ Q.FuncDef {+ Q.fLinkage = link,+ Q.fName = name,+ Q.fStart = Q.label startBlk,+ Q.fAbity = retTy,+ Q.fParams = args,+ Q.fBlock = blkMap blocks+ }+\end{code}++Function definitions contain the actual code to emit in the compiled+file. They define a global symbol that contains a pointer to the+function code. This pointer can be used in \texttt{call} instructions or stored+in memory.++\begin{code}+subWordType :: Parser Q.SubWordType+subWordType = choice+ [ try $ bind "sb" Q.SignedByte+ , try $ bind "ub" Q.UnsignedByte+ , bind "sh" Q.SignedHalf+ , bind "uh" Q.UnsignedHalf ]++abity :: Parser Q.Abity+abity = try (Q.ASubWordType <$> subWordType)+ <|> (Q.ABase <$> baseType)+ <|> (Q.AUserDef <$> userDef)+\end{code}++The type given right before the function name is the return type of the+function. All return values of this function must have this return type.+If the return type is missing, the function must not return any value.++\begin{code}+param :: Parser Q.FuncParam+param = (Q.Env <$> (ws1 (string "env") >> local))+ <|> (string "..." >> pure Q.Variadic)+ <|> do+ ty <- ws1 abity+ Q.Regular ty <$> local++params :: Parser [Q.FuncParam]+params = parenLst param+\end{code}++The parameter list is a comma separated list of temporary names prefixed+by types. The types are used to correctly implement C compatibility.+When an argument has an aggregate type, a pointer to the aggregate is+passed by thea caller. In the example below, we have to use a load+instruction to get the value of the first (and only) member of the+struct.++\begin{verbatim}+type :one = { w }++function w $getone(:one %p) {+@start+ %val =w loadw %p+ ret %val+}+\end{verbatim}++If a function accepts or returns values that are smaller than a word,+such as \texttt{signed char} or \texttt{unsigned short} in C, one of the sub-word type+must be used. The sub-word types \texttt{sb}, \texttt{ub}, \texttt{sh}, and \texttt{uh} stand,+respectively, for signed and unsigned 8-bit values, and signed and+unsigned 16-bit values. Parameters associated with a sub-word type of+bit width N only have their N least significant bits set and have base+type \texttt{w}. For example, the function++\begin{verbatim}+function w $addbyte(w %a, sb %b) {+@start+ %bw =w extsb %b+ %val =w add %a, %bw+ ret %val+}+\end{verbatim}++needs to sign-extend its second argument before the addition. Dually,+return values with sub-word types do not need to be sign or zero+extended.++If the parameter list ends with \texttt{...}, the function is a variadic+function: it can accept a variable number of arguments. To access the+extra arguments provided by the caller, use the \texttt{vastart} and \texttt{vaarg}+instructions described in the \nameref{sec:variadic} section.++Optionally, the parameter list can start with an environment parameter+\texttt{env \%e}. This special parameter is a 64-bit integer temporary (i.e.,+of type \texttt{l}). If the function does not use its environment parameter,+callers can safely omit it. This parameter is invisible to a C caller:+for example, the function++\begin{verbatim}+export function w $add(env %e, w %a, w %b) {+@start+ %c =w add %a, %b+ ret %c+}+\end{verbatim}++must be given the C prototype \texttt{int add(int, int)}. The intended use of+this feature is to pass the environment pointer of closures while+retaining a very good compatibility with C. The \nameref{sec:call}+section explains how to pass an environment parameter.++Since global symbols are defined mutually recursive, there is no need+for function declarations: a function can be referenced before its+definition. Similarly, functions from other modules can be used without+previous declaration. All the type information necessary to compile a+call is in the instruction itself.++The syntax and semantics for the body of functions are described in the+\nameref{sec:control} section.++\section{Control}+\label{sec:control}++The IL represents programs as textual transcriptions of control flow+graphs. The control flow is serialized as a sequence of blocks of+straight-line code which are connected using jump instructions.++\subsection{Blocks}+\label{sec:blocks}++\ignore{+\begin{code}+-- Basic block abstraction with optional exit points. The 'insertJumps'+-- function takes care of inserting fallthrough for omitted jumps.+data Block'+ = Block'+ { label' :: Q.BlockIdent,+ phi' :: [Q.Phi],+ stmt' :: [Q.Statement],+ term' :: Maybe Q.JumpInstr+ }+ deriving (Show, Eq)++blkMap :: [Q.Block] -> Map Q.BlockIdent Q.Block+blkMap = Map.fromList . map (\b -> (Q.label b, b))++insertJumps :: [Block'] -> Maybe [Q.Block]+insertJumps xs = foldM go [] $ zipWithNext xs+ where+ zipWithNext :: [a] -> [(a, Maybe a)]+ zipWithNext [] = []+ zipWithNext lst@(_ : t) = zip lst $ map Just t ++ [Nothing]++ fromBlock' :: Block' -> Q.JumpInstr -> Q.Block+ fromBlock' (Block' l p s _) = Q.Block l p s++ go :: [Q.Block] -> (Block', Maybe Block') -> Maybe [Q.Block]+ go acc (x@Block' {term' = Just ji}, _) =+ Just (acc ++ [fromBlock' x ji])+ go acc (x@Block' {term' = Nothing}, Just nxt) =+ Just (acc ++ [fromBlock' x (Q.Jump $ label' nxt)])+ go _ (Block' {term' = Nothing}, Nothing) =+ Nothing+\end{code}+}++\begin{code}+block :: Parser Block'+block = do+ l <- wsNL1 label+ p <- many (wsNL1 $ try phiInstr)+ s <- many (wsNL1 statement)+ Block' l p s <$> (optionMaybe $ wsNL1 jumpInstr)+\end{code}++All blocks have a name that is specified by a label at their beginning.+Then follows a sequence of instructions that have "fall-through" flow.+Finally one jump terminates the block. The jump can either transfer+control to another block of the same function or return; jumps are+described further below.++The first block in a function must not be the target of any jump in the+program. If a jump to the function start is needed, the frontend must+insert an empty prelude block at the beginning of the function.++When one block jumps to the next block in the IL file, it is not+necessary to write the jump instruction, it will be automatically added+by the parser. For example the start block in the example below jumps+directly to the loop block.++\subsection{Jumps}+\label{sec:jumps}++\begin{code}+jumpInstr :: Parser Q.JumpInstr+jumpInstr = (string "hlt" >> pure Q.Halt)+ -- TODO: Return requires a space if there is an optionMaybe+ <|> Q.Return <$> ((ws $ string "ret") >> optionMaybe val)+ <|> try (Q.Jump <$> ((ws1 $ string "jmp") >> label))+ <|> do+ _ <- ws1 $ string "jnz"+ v <- ws val <* ws (char ',')+ l1 <- ws label <* ws (char ',')+ l2 <- ws label+ return $ Q.Jnz v l1 l2+\end{code}++A jump instruction ends every block and transfers the control to another+program location. The target of a jump must never be the first block in+a function. The three kinds of jumps available are described in the+following list.++\begin{enumerate}+ \item \textbf{Unconditional jump.} Jumps to another block of the same function.+ \item \textbf{Conditional jump.} When its word argument is non-zero, it jumps to its first label argument; otherwise it jumps to the other label. The argument must be of word type; because of subtyping a long argument can be passed, but only its least significant 32 bits will be compared to 0.+ \item \textbf{Function return.} Terminates the execution of the current function, optionally returning a value to the caller. The value returned must be of the type given in the function prototype. If the function prototype does not specify a return type, no return value can be used.+ \item \textbf{Program termination.} Terminates the execution of the program with a target-dependent error. This instruction can be used when it is expected that the execution never reaches the end of the block it closes; for example, after having called a function such as \texttt{exit()}.+\end{enumerate}++\section{Instructions}+\label{sec:instructions}++\begin{code}+instr :: Parser Q.Instr+instr =+ choice+ [ try $ binaryInstr Q.Add "add",+ try $ binaryInstr Q.Sub "sub",+ try $ binaryInstr Q.Mul "mul",+ try $ binaryInstr Q.Div "div",+ try $ binaryInstr Q.URem "urem",+ try $ binaryInstr Q.Rem "rem",+ try $ binaryInstr Q.UDiv "udiv",+ try $ binaryInstr Q.Or "or",+ try $ binaryInstr Q.Xor "xor",+ try $ binaryInstr Q.And "and",+ try $ binaryInstr Q.Sar "sar",+ try $ binaryInstr Q.Shr "shr",+ try $ binaryInstr Q.Shl "shl",+ try $ unaryInstr Q.Neg "neg",+ try $ unaryInstr Q.Cast "cast",+ try $ unaryInstr Q.Copy "copy",+ try $ unaryInstr Q.VAArg "vaarg",+ try $ loadInstr,+ try $ allocInstr,+ try $ compareInstr,+ try $ extInstr,+ try $ truncInstr,+ try $ fromFloatInstr,+ try $ toFloatInstr+ ]+\end{code}++Instructions are the smallest piece of code in the IL, they form the body of+\nameref{sec:blocks}. This specification distinguishes instructions and+volatile instructions, the latter do not return a value. For the former, the IL+uses a three-address code, which means that one instruction computes an+operation between two operands and assigns the result to a third one.++\begin{code}+assign :: Parser Q.Statement+assign = do+ n <- ws local+ t <- ws (char '=') >> ws1 baseType+ Q.Assign n t <$> instr++volatileInstr :: Parser Q.Statement+volatileInstr =+ Q.Volatile <$>+ (storeInstr <|> blitInstr <|> vastartInstr <|> dbglocInstr)++-- TODO: Not documented in the QBE BNF.+statement :: Parser Q.Statement+statement = (try callInstr) <|> assign <|> volatileInstr+\end{code}++An instruction has both a name and a return type, this return type is a base+type that defines the size of the instruction's result. The type of the+arguments can be unambiguously inferred using the instruction name and the+return type. For example, for all arithmetic instructions, the type of the+arguments is the same as the return type. The two additions below are valid if+\texttt{\%y} is a word or a long (because of \nameref{sec:subtyping}).++\begin{verbatim}+%x =w add 0, %y+%z =w add %x, %x+\end{verbatim}++Some instructions, like comparisons and memory loads have operand types+that differ from their return types. For instance, two floating points+can be compared to give a word result (0 if the comparison succeeds, 1+if it fails).++\begin{verbatim}+%c =w cgts %a, %b+\end{verbatim}++In the example above, both operands have to have single type. This is+made explicit by the instruction suffix.++\subsection{Arithmetic and Bits}++\begin{quote}+\begin{itemize}+\item \texttt{add}, \texttt{sub}, \texttt{div}, \texttt{mul}+\item \texttt{neg}+\item \texttt{udiv}, \texttt{rem}, \texttt{urem}+\item \texttt{or}, \texttt{xor}, \texttt{and}+\item \texttt{sar}, \texttt{shr}, \texttt{shl}+\end{itemize}+\end{quote}++The base arithmetic instructions in the first bullet are available for+all types, integers and floating points.++When \texttt{div} is used with word or long return type, the arguments are+treated as signed. The unsigned integral division is available as \texttt{udiv}+instruction. When the result of a division is not an integer, it is truncated+towards zero.++The signed and unsigned remainder operations are available as \texttt{rem} and+\texttt{urem}. The sign of the remainder is the same as the one of the+dividend. Its magnitude is smaller than the divisor one. These two instructions+and \texttt{udiv} are only available with integer arguments and result.++Bitwise OR, AND, and XOR operations are available for both integer+types. Logical operations of typical programming languages can be+implemented using \nameref{sec:comparisions} and \nameref{sec:jumps}.++Shift instructions \texttt{sar}, \texttt{shr}, and \texttt{shl}, shift right or+left their first operand by the amount from the second operand. The shifting+amount is taken modulo the size of the result type. Shifting right can either+preserve the sign of the value (using \texttt{sar}), or fill the newly freed+bits with zeroes (using \texttt{shr}). Shifting left always fills the freed+bits with zeroes.++Remark that an arithmetic shift right (\texttt{sar}) is only equivalent to a+division by a power of two for non-negative numbers. This is because the shift+right "truncates" towards minus infinity, while the division truncates towards+zero.++\subsection{Memory}+\label{sec:memory}++The following sections discuss instructions for interacting with values stored in memory.++\subsubsection{Store instructions}++\begin{code}+storeInstr :: Parser Q.VolatileInstr+storeInstr = do+ t <- string "store" >> ws1 extType+ v <- ws val+ _ <- ws $ char ','+ ws val <&> Q.Store t v+\end{code}++Store instructions exist to store a value of any base type and any extended+type. Since halfwords and bytes are not first class in the IL, \texttt{storeh}+and \texttt{storeb} take a word as argument. Only the first 16 or 8 bits of+this word will be stored in memory at the address specified in the second+argument.++\subsubsection{Load instructions}++\begin{code}+loadInstr :: Parser Q.Instr+loadInstr = do+ _ <- string "load"+ t <- ws1 $ choice+ [ try $ bind "sw" (Q.LBase Q.Word),+ try $ bind "uw" (Q.LBase Q.Word),+ try $ Q.LSubWord <$> subWordType,+ Q.LBase <$> baseType+ ]+ ws val <&> Q.Load t+\end{code}++For types smaller than long, two variants of the load instruction are+available: one will sign extend the loaded value, while the other will zero+extend it. Note that all loads smaller than long can load to either a long or a+word.++The two instructions \texttt{loadsw} and \texttt{loaduw} have the same effect+when they are used to define a word temporary. A \texttt{loadw} instruction is+provided as syntactic sugar for \texttt{loadsw} to make explicit that the+extension mechanism used is irrelevant.++\subsubsection{Blits}++\begin{code}+blitInstr :: Parser Q.VolatileInstr+blitInstr = do+ v1 <- (ws1 $ string "blit") >> ws val <* (ws $ char ',')+ v2 <- ws val <* (ws $ char ',')+ nb <- decNumber+ return $ Q.Blit v1 v2 nb+\end{code}++The blit instruction copies in-memory data from its first address argument to+its second address argument. The third argument is the number of bytes to copy.+The source and destination spans are required to be either non-overlapping, or+fully overlapping (source address identical to the destination address). The+byte count argument must be a nonnegative numeric constant; it cannot be a+temporary.++One blit instruction may generate a number of instructions proportional to its+byte count argument, consequently, it is recommended to keep this argument+relatively small. If large copies are necessary, it is preferable that+frontends generate calls to a supporting \texttt{memcpy} function.++\subsubsection{Stack Allocation}++\begin{code}+allocInstr :: Parser Q.Instr+allocInstr = do+ siz <- (ws $ string "alloc") >> (ws1 allocSize)+ val <&> Q.Alloc siz+\end{code}++These instructions allocate a chunk of memory on the stack. The number ending+the instruction name is the alignment required for the allocated slot. QBE will+make sure that the returned address is a multiple of that alignment value.++Stack allocation instructions are used, for example, when compiling the C local+variables, because their address can be taken. When compiling Fortran,+temporaries can be used directly instead, because it is illegal to take the+address of a variable.++\subsection{Comparisons}+\label{sec:comparisions}++\begin{code}+compareInstr :: Parser Q.Instr+compareInstr = do+ _ <- char 'c'+ (try intCompare) <|> floatCompare++compareArgs :: Parser (Q.Value, Q.Value)+compareArgs = do+ lhs <- ws val <* ws (char ',')+ rhs <- ws val+ pure (lhs, rhs)++intCompare :: Parser Q.Instr+intCompare = do+ op <- compareIntOp+ ty <- ws1 intArg++ (lhs, rhs) <- compareArgs+ pure $ Q.CompareInt ty op lhs rhs++floatCompare :: Parser Q.Instr+floatCompare = do+ op <- compareFloatOp+ ty <- ws1 floatArg++ (lhs, rhs) <- compareArgs+ pure $ Q.CompareFloat ty op lhs rhs+\end{code}++Comparison instructions return an integer value (either a word or a long), and+compare values of arbitrary types. The returned value is 1 if the two operands+satisfy the comparison relation, or 0 otherwise. The names of comparisons+respect a standard naming scheme in three parts:++\begin{enumerate}+ \item All comparisons start with the letter \texttt{c}.+ \item Then comes a comparison type.+ \item Finally, the instruction name is terminated with a basic type suffix precising the type of the operands to be compared.+\end{enumerate}++The following instruction are available for integer comparisons:++\begin{code}+compareIntOp :: Parser Q.IntCmpOp+compareIntOp = choice+ [ bind "eq" Q.IEq+ , bind "ne" Q.INe+ , try $ bind "sle" Q.ISle+ , try $ bind "slt" Q.ISlt+ , try $ bind "sge" Q.ISge+ , try $ bind "sgt" Q.ISgt+ , try $ bind "ule" Q.IUle+ , try $ bind "ult" Q.IUlt+ , try $ bind "uge" Q.IUge+ , try $ bind "ugt" Q.IUgt ]+\end{code}++For floating point comparisons use one of these instructions:++\begin{code}+compareFloatOp :: Parser Q.FloatCmpOp+compareFloatOp = choice+ [ bind "eq" Q.FEq+ , bind "ne" Q.FNe+ , try $ bind "le" Q.FLe+ , bind "lt" Q.FLt+ , try $ bind "ge" Q.FGe+ , bind "gt" Q.FGt+ , bind "o" Q.FOrd+ , bind "uo" Q.FUnord ]+\end{code}++For example, \texttt{cod} compares two double-precision floating point numbers+and returns 1 if the two floating points are not NaNs, or 0 otherwise. The+\texttt{csltw} instruction compares two words representing signed numbers and+returns 1 when the first argument is smaller than the second one.++\subsection{Conversions}++Conversion operations change the representation of a value, possibly modifying+it if the target type cannot hold the value of the source type. Conversions can+extend the precision of a temporary (e.g., from signed 8-bit to 32-bit), or+convert a floating point into an integer and vice versa.++\begin{code}+extInstr :: Parser Q.Instr+extInstr = do+ _ <- string "ext"+ ty <- ws1 extArg+ ws val <&> Q.Ext ty+ where+ extArg :: Parser Q.ExtArg+ extArg = try (Q.ExtSubWord <$> subWordType)+ <|> try (bind "sw" Q.ExtSignedWord)+ <|> bind "s" Q.ExtSingle+ <|> bind "uw" Q.ExtUnsignedWord+\end{code}++Extending the precision of a temporary is done using the \texttt{ext} family of+instructions. Because QBE types do not specify the signedness (like in LLVM),+extension instructions exist to sign-extend and zero-extend a value. For+example, \texttt{extsb} takes a word argument and sign-extends the 8+least-significant bits to a full word or long, depending on the return type.++\begin{code}+truncInstr :: Parser Q.Instr+truncInstr = do+ _ <- ws1 $ string "truncd"+ ws val <&> Q.TruncDouble+\end{code}++The instructions \texttt{exts} (extend single) and \texttt{truncd} (truncate+double) are provided to change the precision of a floating point value. When+the double argument of truncd cannot be represented as a single-precision+floating point, it is truncated towards zero.++\begin{code}+floatArg :: Parser Q.FloatArg+floatArg = bind "d" Q.FDouble <|> bind "s" Q.FSingle++fromFloatInstr :: Parser Q.Instr+fromFloatInstr = do+ arg <- floatArg <* string "to"+ isSigned <- signageChar+ _ <- ws1 $ char 'i'+ ws val <&> Q.FloatToInt arg isSigned++intArg :: Parser Q.IntArg+intArg = bind "w" Q.IWord <|> bind "l" Q.ILong++toFloatInstr :: Parser Q.Instr+toFloatInstr = do+ isSigned <- signageChar+ arg <- intArg+ _ <- ws1 $ string "tof"+ ws val <&> Q.IntToFloat arg isSigned+\end{code}++Converting between signed integers and floating points is done using+\texttt{stosi} (single to signed integer), \texttt{stoui} (single to unsigned+integer), \texttt{dtosi} (double to signed integer), \texttt{dtoui} (double to+unsigned integer), \texttt{swtof} (signed word to float), \texttt{uwtof}+(unsigned word to float), \texttt{sltof} (signed long to float) and+\texttt{ultof} (unsigned long to float).++\subsection{Cast and Copy}++The \texttt{cast} and \texttt{copy} instructions return the bits of their+argument verbatim. However a cast will change an integer into a floating point+of the same width and vice versa.++Casts can be used to make bitwise operations on the representation of floating+point numbers. For example the following program will compute the opposite of+the single-precision floating point number \texttt{\%f} into \texttt{\%rs}.++\begin{verbatim}+%b0 =w cast %f+%b1 =w xor 2147483648, %b0 # flip the msb+%rs =s cast %b1+\end{verbatim}++\subsection{Call}+\label{sec:call}++\begin{code}+-- TODO: Code duplication with 'param'.+callArg :: Parser Q.FuncArg+callArg = (Q.ArgEnv <$> (ws1 (string "env") >> val))+ <|> (string "..." >> pure Q.ArgVar)+ <|> do+ ty <- ws1 abity+ Q.ArgReg ty <$> val++callArgs :: Parser [Q.FuncArg]+callArgs = parenLst callArg++callInstr :: Parser Q.Statement+callInstr = do+ retValue <- optionMaybe $ do+ i <- ws local <* ws (char '=')+ a <- ws1 abity+ return (i, a)+ toCall <- ws1 (string "call") >> ws val+ fnArgs <- callArgs+ return $ Q.Call retValue toCall fnArgs+\end{code}++The call instruction is special in several ways. It is not a three-address+instruction and requires the type of all its arguments to be given. Also, the+return type can be either a base type or an aggregate type. These specifics are+required to compile calls with C compatibility (i.e., to respect the ABI).++When an aggregate type is used as argument type or return type, the value+respectively passed or returned needs to be a pointer to a memory location+holding the value. This is because aggregate types are not first-class+citizens of the IL.++Sub-word types are used for arguments and return values of width less than a+word. Details on these types are presented in the \nameref{sec:functions} section.+Arguments with sub-word types need not be sign or zero extended according to+their type. Calls with a sub-word return type define a temporary of base type+\texttt{w} with its most significant bits unspecified.++Unless the called function does not return a value, a return temporary must be+specified, even if it is never used afterwards.++An environment parameter can be passed as first argument using the \texttt{env}+keyword. The passed value must be a 64-bit integer. If the called function does+not expect an environment parameter, it will be safely discarded. See the+\nameref{sec:functions} section for more information about environment+parameters.++When the called function is variadic, there must be a \texttt{...} marker+separating the named and variadic arguments.++\subsection{Variadic}+\label{sec:variadic}++\begin{code}+vastartInstr :: Parser Q.VolatileInstr+vastartInstr = do+ _ <- ws1 (string "vastart")+ Q.VAStart <$> ws val+\end{code}++The \texttt{vastart} and \texttt{vaarg} instructions provide a portable way to+access the extra parameters of a variadic function.++\begin{enumerate}+ \item \texttt{vastart} -- \texttt{(m)}+ \item \texttt{vaarg} -- \texttt{T(mmmm)}+\end{enumerate}++The \texttt{vastart} instruction initializes a variable argument list used to+access the extra parameters of the enclosing variadic function. It is safe to+call it multiple times.++The \texttt{vaarg} instruction fetches the next argument from a variable+argument list. It is currently limited to fetching arguments that have a base+type. This instruction is essentially effectful: calling it twice in a row will+return two consecutive arguments from the argument list.++Both instructions take a pointer to a variable argument list as the sole argument.+The size and alignment of the variable argument lists depends on the target used.++\subsection{Phi}++\begin{code}+phiBranch :: Parser (Q.BlockIdent, Q.Value)+phiBranch = do+ n <- ws1 label+ v <- val+ pure (n, v)++phiInstr :: Parser Q.Phi+phiInstr = do+ -- TODO: code duplication with 'assign'+ n <- ws local+ t <- ws (char '=') >> ws1 baseType++ _ <- ws1 (string "phi")+ -- TODO: combinator for sepBy+ p <- Map.fromList <$> sepBy1 (ws phiBranch) (ws $ char ',')+ return $ Q.Phi n t p+\end{code}++First and foremost, phi instructions are NOT necessary when writing a frontend+to QBE. One solution to avoid having to deal with SSA form is to use stack+allocated variables for all source program variables and perform assignments+and lookups using \nameref{sec:memory} operations. This is what LLVM users+typically do.++Another solution is to simply emit code that is not in SSA form! Contrary to+LLVM, QBE is able to fixup programs not in SSA form without requiring the+boilerplate of loading and storing in memory. For example, the following+program will be correctly compiled by QBE.++\begin{verbatim}+@start+ %x =w copy 100+ %s =w copy 0+@loop+ %s =w add %s, %x+ %x =w sub %x, 1+ jnz %x, @loop, @end+@end+ ret %s+\end{verbatim}++Now, if you want to know what phi instructions are and how to use them in QBE,+you can read the following.++Phi instructions are specific to SSA form. In SSA form values can only be+assigned once, without phi instructions, this requirement is too strong to+represent many programs. For example consider the following C program.++\begin{verbatim}+int f(int x) {+ int y;+ if (x)+ y = 1;+ else+ y = 2;+ return y;+}+\end{verbatim}++The variable \texttt{y} is assigned twice, the solution to translate it in SSA+form is to insert a phi instruction.++\begin{verbatim}+@ifstmt+ jnz %x, @ift, @iff+@ift+ jmp @retstmt+@iff+ jmp @retstmt+@retstmt+ %y =w phi @ift 1, @iff 2+ ret %y+\end{verbatim}++Phi instructions return one of their arguments depending on where the control+came from. In the example, \texttt{\%y} is set to 1 if the+\texttt{\textbackslash{}ift} branch is taken, or it is set to 2 otherwise.++An important remark about phi instructions is that QBE assumes that if a+variable is defined by a phi it respects all the SSA invariants. So it is+critical to not use phi instructions unless you know exactly what you are+doing.++\subsection{Debug Information}++QBE supports the inclusion of debug information. Specifically, it allows+defining from which source file type, data, and function definitions originated.+For this purpose, it provides the \texttt{dbgfile} definition, which receives a+file name (string literal) as its sole argument. Every type, data and function+definition thereafter are assumed to originate in this file.++\begin{code}+-- TODO: not documnted in the QBE BNF.+fileDef :: Parser String+fileDef = do+ _ <- ws1 $ string "dbgfile"+ wsNL1 strLit+\end{code}++Further, instructions within a function can be associated with a specific line+and column number of a previously defined \texttt{dbgfile}. The+\texttt{dbgfile} is referenced by index using the first argument to+\texttt{dbgloc}. The second argument represents the line number, the third+(optional) argument the column number.++\begin{code}+-- TODO: not documnted in the QBE BNF.+dbglocInstr :: Parser Q.VolatileInstr+dbglocInstr = do+ _ <- ws1 $ string "dbgloc"+ file <- ws decNumber <* ws (char ',')+ line <- ws decNumber+ col <- optionMaybe (ws (char ',') >> ws decNumber)+ return $ Q.DBGLoc file line col+\end{code}++\end{document}
+ src/Language/QBE/Types.hs view
@@ -0,0 +1,410 @@+-- SPDX-FileCopyrightText: 2025-2026 Sören Tempel <soeren+git@soeren-tempel.net>+--+-- SPDX-License-Identifier: GPL-3.0-only++module Language.QBE.Types+ ( -- * Identifiers+ UserIdent (..),+ LocalIdent (..),+ BlockIdent (..),+ GlobalIdent (..),++ -- * Types+ BaseType (..),+ baseTypeByteSize,+ baseTypeBitSize,+ ExtType (..),+ extTypeBitSize,+ extTypeByteSize,+ SubWordType (..),+ SubType (..),+ LoadType (..),+ loadByteSize,++ -- * Values+ Const (..),+ DynConst (..),+ Value (..),++ -- * Definitions+ TypeDef (..),+ DataDef (..),+ Linkage (..),+ Field,+ AggType (..),+ dataSize,+ DataObj (..),+ objAlign,+ objSize,+ DataItem (..),+ JumpInstr (..),++ -- * Functions+ FuncDef (..),+ FuncParam (..),+ FuncArg (..),+ Abity (..),+ abityToBase,+ Block (..),+ fEntry,++ -- * Instructions+ Statement (..),+ Instr (..),+ VolatileInstr (..),+ ExtArg (..),+ toExtType,+ FloatArg (..),+ f2BaseType,+ IntArg (..),+ i2BaseType,+ IntCmpOp (..),+ FloatCmpOp (..),+ Phi (..),+ AllocSize (..),+ getSize,+ )+where++import Data.Map (Map)+import Data.Map qualified as Map+import Data.Maybe (fromJust)+import Data.Word (Word64)++-- TODO: Prefix all constructors++newtype UserIdent = UserIdent {userIdent :: String}+ deriving (Eq, Ord)++instance Show UserIdent where+ show (UserIdent s) = ':' : s++newtype LocalIdent = LocalIdent {localIdent :: String}+ deriving (Eq, Ord)++instance Show LocalIdent where+ show (LocalIdent s) = '%' : s++newtype BlockIdent = BlockIdent {blockIdent :: String}+ deriving (Eq, Ord)++instance Show BlockIdent where+ show (BlockIdent s) = '@' : s++newtype GlobalIdent = GlobalIdent {globalIdent :: String}+ deriving (Eq, Ord)++instance Show GlobalIdent where+ show (GlobalIdent s) = '$' : s++------------------------------------------------------------------------++data BaseType+ = Word+ | Long+ | Single+ | Double+ deriving (Show, Eq)++baseTypeByteSize :: BaseType -> Int+baseTypeByteSize Word = 4+baseTypeByteSize Long = 8+baseTypeByteSize Single = 4+baseTypeByteSize Double = 8++baseTypeBitSize :: BaseType -> Int+baseTypeBitSize ty = baseTypeByteSize ty * 8++data ExtType+ = Base BaseType+ | Byte+ | HalfWord+ deriving (Show, Eq)++extTypeByteSize :: ExtType -> Int+extTypeByteSize (Base b) = baseTypeByteSize b+extTypeByteSize Byte = 1+extTypeByteSize HalfWord = 2++extTypeBitSize :: ExtType -> Int+extTypeBitSize ty = extTypeByteSize ty * 8++data SubWordType+ = SignedByte+ | UnsignedByte+ | SignedHalf+ | UnsignedHalf+ deriving (Show, Eq)++data Abity+ = ABase BaseType+ | ASubWordType SubWordType+ | AUserDef UserIdent+ deriving (Show, Eq)++abityToBase :: Abity -> BaseType+-- Calls with a sub-word return type define a temporary of base type+-- w with its most significant bits unspecified.+abityToBase (ASubWordType _) = Word+-- When an aggregate type is used as argument type or return type, the+-- value respectively passed or returned needs to be a pointer to a+-- memory location holding the value.+abityToBase (AUserDef _) = Long+abityToBase (ABase ty) = ty++data Const+ = Number Word64+ | SFP Float+ | DFP Double+ | Global GlobalIdent+ deriving (Show, Eq)++data DynConst+ = Const Const+ | Thread GlobalIdent+ | Extern GlobalIdent+ | ExternThread GlobalIdent+ deriving (Show, Eq)++data Value+ = VConst DynConst+ | VLocal LocalIdent+ deriving (Show, Eq)++data Linkage+ = LExport+ | LThread+ | LSection String (Maybe String)+ deriving (Show, Eq)++data AllocSize+ = AllocWord+ | AllocLong+ | AllocLongLong+ deriving (Show, Eq)++getSize :: AllocSize -> Int+getSize AllocWord = 4+getSize AllocLong = 8+getSize AllocLongLong = 16++data TypeDef+ = TypeDef+ { aggName :: UserIdent,+ aggAlign :: Maybe Word64,+ aggType :: AggType+ }+ deriving (Show, Eq)++data SubType+ = SExtType ExtType+ | SUserDef UserIdent+ deriving (Show, Eq)++type Field = (SubType, Maybe Word64)++-- TODO: Type for tuple+data AggType+ = ARegular [Field]+ | AUnion [[Field]]+ | AOpaque Word64+ deriving (Show, Eq)++data DataDef+ = DataDef+ { linkage :: [Linkage],+ name :: GlobalIdent,+ align :: Maybe Word64,+ objs :: [DataObj]+ }+ deriving (Show, Eq)++dataSize :: DataDef -> Int+dataSize dataDef =+ sum $ map objSize (objs dataDef)++data DataObj+ = OItem ExtType [DataItem]+ | OZeroFill Word64+ deriving (Show, Eq)++objAlign :: DataObj -> Word64+objAlign (OZeroFill _) = 1 :: Word64+objAlign (OItem ty _) = fromIntegral $ extTypeByteSize ty++objSize :: DataObj -> Int+objSize (OZeroFill n) = fromIntegral n+objSize (OItem ty items) = extTypeByteSize ty * cnt items+ where+ cnt :: [DataItem] -> Int+ cnt [] = 0+ cnt ((DString s) : xs) = length s + cnt xs+ cnt (_ : xs) = 1 + cnt xs++data DataItem+ = DSymOff GlobalIdent Word64+ | DString String+ | DConst Const+ deriving (Show, Eq)++data FuncDef+ = FuncDef+ { fLinkage :: [Linkage],+ fName :: GlobalIdent,+ fStart :: BlockIdent,+ fAbity :: Maybe Abity,+ fParams :: [FuncParam],+ fBlock :: Map BlockIdent Block+ }+ deriving (Show, Eq)++fEntry :: FuncDef -> Block+fEntry func = fromJust $ Map.lookup (fStart func) (fBlock func)++data FuncParam+ = Regular Abity LocalIdent+ | Env LocalIdent+ | Variadic+ deriving (Show, Eq)++data FuncArg+ = ArgReg Abity Value+ | ArgEnv Value+ | ArgVar+ deriving (Show, Eq)++data JumpInstr+ = Jump BlockIdent+ | Jnz Value BlockIdent BlockIdent+ | Return (Maybe Value)+ | Halt+ deriving (Show, Eq)++data LoadType+ = LSubWord SubWordType+ | LBase BaseType+ deriving (Show, Eq)++-- TODO: Could/Should define this on ExtType instead.+loadByteSize :: LoadType -> Word64+loadByteSize (LSubWord UnsignedByte) = 1+loadByteSize (LSubWord SignedByte) = 1+loadByteSize (LSubWord SignedHalf) = 2+loadByteSize (LSubWord UnsignedHalf) = 2+loadByteSize (LBase Word) = 4+loadByteSize (LBase Long) = 8+loadByteSize (LBase Single) = 4+loadByteSize (LBase Double) = 8++data ExtArg+ = ExtSingle+ | ExtSubWord SubWordType+ | ExtSignedWord+ | ExtUnsignedWord+ deriving (Show, Eq)++toExtType :: ExtArg -> (Bool, ExtType)+toExtType (ExtSubWord SignedByte) = (True, Byte)+toExtType (ExtSubWord UnsignedByte) = (False, Byte)+toExtType (ExtSubWord SignedHalf) = (True, HalfWord)+toExtType (ExtSubWord UnsignedHalf) = (False, HalfWord)+toExtType ExtSignedWord = (True, Base Word)+toExtType ExtUnsignedWord = (False, Base Word)+toExtType ExtSingle = (True, Base Single)++data FloatArg = FDouble | FSingle+ deriving (Show, Eq)++f2BaseType :: FloatArg -> BaseType+f2BaseType FSingle = Single+f2BaseType FDouble = Double++data IntArg = IWord | ILong+ deriving (Show, Eq)++i2BaseType :: IntArg -> BaseType+i2BaseType IWord = Word+i2BaseType ILong = Long++-- TODO: Distinict types for floating point comparison?+data IntCmpOp+ = IEq+ | INe+ | ISle+ | ISlt+ | ISge+ | ISgt+ | IUle+ | IUlt+ | IUge+ | IUgt+ deriving (Show, Eq)++data FloatCmpOp+ = FEq+ | FNe+ | FLe+ | FLt+ | FGe+ | FGt+ | FOrd+ | FUnord+ deriving (Show, Eq)++data Instr+ = Add Value Value+ | Sub Value Value+ | Div Value Value+ | Mul Value Value+ | Neg Value+ | URem Value Value+ | Rem Value Value+ | UDiv Value Value+ | Or Value Value+ | Xor Value Value+ | And Value Value+ | Sar Value Value+ | Shr Value Value+ | Shl Value Value+ | Alloc AllocSize Value+ | Load LoadType Value+ | CompareInt IntArg IntCmpOp Value Value+ | CompareFloat FloatArg FloatCmpOp Value Value+ | Ext ExtArg Value+ | FloatToInt FloatArg Bool Value+ | IntToFloat IntArg Bool Value+ | TruncDouble Value+ | Cast Value+ | Copy Value+ | VAArg Value+ deriving (Show, Eq)++data VolatileInstr+ = Store ExtType Value Value+ | VAStart Value+ | Blit Value Value Word64+ | DBGLoc Word64 Word64 (Maybe Word64)+ deriving (Show, Eq)++data Statement+ = Assign LocalIdent BaseType Instr+ | Call (Maybe (LocalIdent, Abity)) Value [FuncArg]+ | Volatile VolatileInstr+ deriving (Show, Eq)++data Phi+ = Phi+ { pName :: LocalIdent,+ pType :: BaseType,+ pLabels :: Map BlockIdent Value+ }+ deriving (Show, Eq)++data Block+ = Block+ { label :: BlockIdent, -- TODO: Consider removing this (part of the Map)+ phi :: [Phi],+ stmt :: [Statement],+ term :: JumpInstr+ }+ deriving (Show, Eq)
+ src/Language/QBE/Util.hs view
@@ -0,0 +1,47 @@+-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>+--+-- SPDX-License-Identifier: GPL-3.0-only++module Language.QBE.Util where++import Data.Word (Word64)+import Language.QBE.Numbers+ ( decimal,+ fractExponent,+ hexnum,+ octnum,+ sign,+ signMinus,+ )+import Text.ParserCombinators.Parsec+ ( Parser,+ char,+ oneOf,+ skipMany,+ string,+ (<|>),+ )++bind :: String -> a -> Parser a+bind str val = val <$ string str++decNumber :: Parser Word64+decNumber = do+ s <- signMinus+ s <$> decimal++octNumber :: Parser Word64+octNumber = do+ char '0' >> octnum++-- A float parser that tries to be compatible with strtod(3).+float :: (Floating f, Read f) => Parser f+float = do+ _ <- skipSpace+ s <- sign+ -- TODO: Support infininty and NaN+ (decimal <|> hexnum) >>= fractExponent . s+ where+ -- See musl's isspace(3) implementation.+ skipSpace :: Parser ()+ skipSpace = skipMany $ oneOf " \t\n\v\f\r"
+ test/Golden.hs view
@@ -0,0 +1,82 @@+-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>+--+-- SPDX-License-Identifier: GPL-3.0-only++module Golden (goldenTests) where++import Language.QBE (parse)+import System.Exit (ExitCode (..))+import System.FilePath+import System.IO (IOMode (WriteMode), hClose, hGetContents, openFile)+import System.Process+import Test.Tasty+import Test.Tasty.Golden.Advanced++type QBEResult = (ExitCode, String)++runQBE :: FilePath -> IO QBEResult+runQBE filePath = do+ devNull <- openFile "/dev/null" WriteMode++ (_, _, Just herr, p) <-+ createProcess+ (proc "qbe" [filePath])+ { std_out = UseHandle devNull,+ std_err = CreatePipe+ }++ ret <- waitForProcess p <* hClose devNull+ out <- hGetContents herr+ return (ret, out)++runQute :: FilePath -> IO QBEResult+runQute filePath = do+ content <- readFile filePath+ case parse filePath content of+ Right _ -> pure (ExitSuccess, "")+ Left err -> pure (ExitFailure 1, show err)++simpleCmp :: QBEResult -> QBEResult -> IO (Maybe String)+simpleCmp (exit, out) (exit', out') =+ return $+ if exit == exit'+ then Nothing+ else Just ("Parsing mismatch: " ++ err)+ where+ err :: String+ err = "qbe=(" ++ show exit ++ "): " ++ out ++ " qute=(" ++ show exit' ++ "):" ++ out'++runTest :: TestName -> TestTree+runTest testName =+ goldenTest+ testName+ (runQBE fullPath)+ (runQute fullPath)+ simpleCmp+ (\_ -> pure ())+ where+ fullPath :: FilePath+ fullPath = "test" </> "golden" </> (testName ++ ".qbe")++------------------------------------------------------------------------++goldenTests :: TestTree+goldenTests =+ testGroup+ "goldenTests"+ [ runTest "data-definition-whitespace",+ runTest "empty-definitions",+ runTest "function-definition",+ runTest "call-instruction",+ runTest "load-instructions",+ runTest "value-global",+ runTest "bubble-sort",+ runTest "phi-instructions",+ runTest "data",+ runTest "comments",+ runTest "number-literal-plus-sign",+ runTest "float-literal-plus-sign",+ runTest "hare-hello-world",+ runTest "dynconst",+ runTest "scc-prime-numbers"+ ]
+ test/Main.hs view
@@ -0,0 +1,16 @@+-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>+--+-- SPDX-License-Identifier: GPL-3.0-only++module Main (main) where++import Golden+import Parser+import Test.Tasty+import Types++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [mkParser, goldenTests, typesTests]
+ test/Parser.hs view
@@ -0,0 +1,310 @@+-- SPDX-FileCopyrightText: 2025-2026 Sören Tempel <soeren+git@soeren-tempel.net>+--+-- SPDX-License-Identifier: GPL-3.0-only++module Parser where++import Data.Map (Map)+import Data.Map qualified as Map+import Language.QBE.Parser (dataDef, funcDef, typeDef)+import Language.QBE.Types+import Test.Tasty+import Test.Tasty.HUnit+import Text.ParserCombinators.Parsec qualified as P++blkMap :: [Block] -> Map BlockIdent Block+blkMap = Map.fromList . map (\b -> (label b, b))++------------------------------------------------------------------------++typeTests :: TestTree+typeTests =+ testGroup+ "Aggregate Type Definition"+ [ testCase "Opaque type with alignment" $+ let v = TypeDef (UserIdent "opaque") (Just 16) (AOpaque 32)+ in parse "type :opaque = align 16 { 32 }" @?= Right v,+ testCase "Regular empty type" $+ let v = TypeDef (UserIdent "empty") Nothing (ARegular [])+ in parse "type :empty = {}" @?= Right v,+ testCase "Regular type with multiple fields" $+ let f = [(SExtType (Base Single), Nothing), (SExtType (Base Single), Nothing)]+ v = TypeDef (UserIdent "twofloats") Nothing (ARegular f)+ in parse "type :twofloats = { s, s }" @?= Right v,+ testCase "Regular type with trailing whitespaces" $+ let f = [(SExtType Byte, Nothing), (SExtType (Base Word), Just 100)]+ v = TypeDef (UserIdent "abyteandmanywords") Nothing (ARegular f)+ in parse "type :abyteandmanywords = { b, w 100 }" @?= Right v,+ testCase "Union type with multiple fields" $+ let f = [[(SExtType Byte, Nothing)], [(SExtType (Base Single), Nothing)]]+ v = TypeDef (UserIdent "un9") Nothing (AUnion f)+ in parse "type :un9 = { { b } { s } }" @?= Right v,+ testCase "Union type with multiple nested fields" $+ let f =+ [ [(SExtType (Base Long), Nothing), (SExtType (Base Single), Nothing)],+ [(SExtType (Base Word), Nothing), (SExtType (Base Long), Nothing)]+ ]+ v = TypeDef (UserIdent "un9") Nothing (AUnion f)+ in parse "type :un9 = { { l, s } { w, l } }" @?= Right v,+ testCase "Type definition with trailing comma" $+ let f = [(SExtType (Base Single), Nothing), (SExtType (Base Single), Nothing)]+ v = TypeDef (UserIdent "twofloats") Nothing (ARegular f)+ in parse "type :twofloats = { s, s, }" @?= Right v+ ]+ where+ parse :: String -> Either P.ParseError TypeDef+ parse = P.parse typeDef ""++dataTests :: TestTree+dataTests =+ testGroup+ "Data Definition"+ [ testCase "Data definition with zero fill" $+ let v = DataDef [] (GlobalIdent "foo") Nothing [OZeroFill 42]+ in parse "data $foo = { z 42 }" @?= Right v,+ testCase "Data definition with empty value" $+ let v = DataDef [] (GlobalIdent "foo") Nothing []+ in parse "data $foo = {}" @?= Right v,+ testCase "Data definition without optional spaces" $+ let v = DataDef [] (GlobalIdent "foo") Nothing [OZeroFill 42]+ in parse "data $foo={z 42}" @?= Right v,+ testCase "Data definition with newlines as spaces" $+ let v = DataDef [] (GlobalIdent "foo") Nothing [OZeroFill 42]+ in parse "data\n$foo={z\n42}" @?= Right v,+ testCase "Data definition with comments" $+ let v = DataDef [] (GlobalIdent "foo") Nothing [OZeroFill 42]+ in parse "data\n#test\n$foo={z\n#foo\n42}" @?= Right v,+ testCase "Data definition with comments and whitespaces" $+ let v = DataDef [] (GlobalIdent "foo") Nothing [OZeroFill 42]+ in parse "data\n#test1 \n #test2\n$foo={z\n#foo\n42}" @?= Right v,+ testCase "Data definition with linkage" $+ let v = DataDef [LExport] (GlobalIdent "foo") Nothing [OZeroFill 42]+ in parse "export data $foo = { z 42 }" @?= Right v,+ testCase "Data definition with linkage, newlines, and comments" $+ let v = DataDef [LExport, LThread] (GlobalIdent "foo") Nothing [OZeroFill 42]+ in parse "export\nthread\n#foo\ndata $foo = { z 42 }" @?= Right v,+ testCase "Data definition with types" $+ let w = [DConst (Number 23), DConst (Number 42)]+ v = DataDef [] (GlobalIdent "bar") Nothing [OItem (Base Word) w]+ in parse "data $bar = { w 23 42 }" @?= Right v,+ testCase "An object containing two 64-bit fields" $+ let o =+ [ OItem (Base Long) [DConst (Number 0xffffffffffffffff)],+ OItem (Base Long) [DConst (Number 23)]+ ]+ v = DataDef [] (GlobalIdent "c") Nothing o+ in parse "data $c = { l -1, l 23 }" @?= Right v,+ testCase "Data definition with specified alignment and linkage" $+ let v = DataDef [LExport] (GlobalIdent "b") (Just 8) [OZeroFill 1000]+ in parse "export data $b = align 8 { z 1000 }" @?= Right v,+ testCase "Data definition with linkage section and string escape sequences" $+ let v = DataDef [LSection "f\\oo\\\"bar" Nothing] (GlobalIdent "b") (Just 8) [OZeroFill 1]+ in parse "section \"f\\oo\\\"bar\" data $b =align 8 {z 1}" @?= Right v,+ testCase "Data definition with symbol offset" $+ let v = DataDef {linkage = [], name = GlobalIdent "b", align = Just 8, objs = [OItem (Base Long) [DSymOff (GlobalIdent "s") 1]]}+ in parse "data $b = align 8 { l $s + 1 }" @?= Right v,+ testCase "Data definition with symbol offset and without whitespaces" $+ let v = DataDef {linkage = [], name = GlobalIdent "b", align = Just 8, objs = [OItem (Base Long) [DSymOff (GlobalIdent "s") 1]]}+ in parse "data $b = align 8 {l $s+1}" @?= Right v,+ testCase "Data definition with symbol but without offset" $+ let v = DataDef {linkage = [], name = GlobalIdent "b", align = Just 8, objs = [OItem (Base Long) [DConst (Global (GlobalIdent "s"))]]}+ in parse "data $b = align 8 {l $s}" @?= Right v,+ testCase "Data definition with octal character sequence" $+ let v = DataDef {linkage = [], name = GlobalIdent "b", align = Just 1, objs = [OItem Byte [DString "f\too\NUL"]]}+ in parse "data $b = align 1 { b \"f\\011oo\\000\" }" @?= Right v,+ testCase "Data definition with trailing comma" $+ let v = DataDef {linkage = [], name = GlobalIdent "b", align = Just 1, objs = [OItem Byte [DConst (Number 1)], OItem Byte [DConst (Number 2)]]}+ in parse "data $b = align 1 { b 1, b 2,}" @?= Right v+ ]+ where+ parse :: String -> Either P.ParseError DataDef+ parse = P.parse dataDef ""++funcTests :: TestTree+funcTests =+ testGroup+ "Function Definition"+ [ testCase "Minimal function definition" $+ let p = [Regular (ABase Word) (LocalIdent "argc")]+ b = [Block {label = BlockIdent "start", phi = [], stmt = [], term = Return Nothing}]+ f = FuncDef [] (GlobalIdent "main") (BlockIdent "start") Nothing p $ blkMap b+ in parse "function $main(w %argc) {\n@start\nret\n}" @?= Right f,+ testCase "Function definition with load instruction" $+ let s = [Assign (LocalIdent "v") Word (Load (LBase Word) (VLocal $ LocalIdent "addr"))]+ b = [Block {label = BlockIdent "begin", phi = [], stmt = s, term = Return Nothing}]+ f = FuncDef [] (GlobalIdent "main") (BlockIdent "begin") Nothing [] $ blkMap b+ in parse "function $main() {\n@begin\n%v =w loadw %addr\nret\n}" @?= Right f,+ testCase "Function definition with linkage and return type" $+ let p = [Regular (ABase Long) (LocalIdent "v")]+ b = [Block {label = BlockIdent "start", phi = [], stmt = [], term = Return Nothing}]+ f = FuncDef [LExport, LThread] (GlobalIdent "example") (BlockIdent "start") (Just (ABase Word)) p $ blkMap b+ in parse "export\nthread function w $example(l %v) {\n@start\nret\n}" @?= Right f,+ testCase "Function definition with section linkage" $+ let p = [Regular (ABase Long) (LocalIdent "v")]+ b = [Block {label = BlockIdent "start", phi = [], stmt = [], term = Return Nothing}]+ f = FuncDef [LSection "foo" Nothing] (GlobalIdent "bla") (BlockIdent "start") (Just (ABase Word)) p $ blkMap b+ in parse "section \"foo\"\nfunction w $bla(l %v) {\n@start\nret\n}" @?= Right f,+ testCase "Function definition with subword return type" $+ let b = [Block {label = BlockIdent "here", phi = [], stmt = [], term = Halt}]+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "here") (Just (ASubWordType SignedHalf)) [] $ blkMap b+ in parse "function sh $f() {\n@here\nhlt\n}" @?= Right f,+ testCase "Function definition with comments" $+ let p = [Regular (ABase Long) (LocalIdent "v")]+ b = [Block {label = BlockIdent "start", phi = [], stmt = [], term = Return Nothing}]+ f = FuncDef [LSection "foo" (Just "bar")] (GlobalIdent "bla") (BlockIdent "start") (Just (ABase Word)) p $ blkMap b+ in parse "section \"foo\" \"bar\"\n#test\nfunction w $bla(l %v) {\n#foo\n@start\n# bar \nret\n#bllubbb\n#bllaaa\n}" @?= Right f,+ testCase "Function definition with comparison instruction" $+ let c = CompareInt IWord ISlt (VConst (Const (Number 23))) (VConst (Const (Number 42)))+ b = [Block {label = BlockIdent "start", phi = [], stmt = [Assign (LocalIdent "res") Word c], term = Return Nothing}]+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "start") Nothing [] $ blkMap b+ in parse "function $f() {\n@start\n%res =w csltw 23, 42\nret\n}" @?= Right f,+ testCase "Function definition with extend instruction" $+ let c = Ext ExtSignedWord (VConst (Const (Number 42)))+ b = [Block {label = BlockIdent "start", phi = [], stmt = [Assign (LocalIdent "res") Word c], term = Return Nothing}]+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "start") Nothing [] $ blkMap b+ in parse "function $f() {\n@start\n%res =w extsw 42\nret\n}" @?= Right f,+ testCase "Function definition with fallthrough block" $+ let b1 = Block {label = BlockIdent "b1", phi = [], stmt = [], term = Jump (BlockIdent "b2")}+ b2 = Block {label = BlockIdent "b2", phi = [], stmt = [], term = Return Nothing}+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "b1") Nothing [] $ blkMap [b1, b2]+ in parse "function $f() {\n@b1\n@b2\nret\n}" @?= Right f,+ testCase "Block with phi instrunction" $+ let v1 = VConst (Const (Number 1))+ v2 = VConst (Const (Number 2))+ p1 = Phi (LocalIdent "v") Word $ Map.fromList [(BlockIdent "b1", v1), (BlockIdent "b2", v2)]+ b1 = Block {label = BlockIdent "b1", phi = [], stmt = [], term = Jump (BlockIdent "b2")}+ b2 = Block {label = BlockIdent "b2", phi = [], stmt = [], term = Jump (BlockIdent "b3")}+ b3 = Block {label = BlockIdent "b3", phi = [p1], stmt = [], term = Return Nothing}+ fn = FuncDef [] (GlobalIdent "f") (BlockIdent "b1") Nothing [] $ blkMap [b1, b2, b3]+ in parse "function $f() {\n@b1\njmp @b2\n@b2\njmp @b3\n@b3\n%v =w phi @b1 1, @b2 2\nret\n}" @?= Right fn,+ testCase "Call instruction with integer literal value" $+ let c = Call Nothing (VConst (Const $ Global (GlobalIdent "foo"))) [ArgReg (ABase Word) (VConst (Const (Number 42)))]+ b = [Block {label = BlockIdent "s", phi = [], stmt = [c], term = Return Nothing}]+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "s") Nothing [] $ blkMap b+ in parse "function $f() {\n@s\ncall $foo(w 42)\nret\n}" @?= Right f,+ testCase "Unary neg instruction" $+ let i1 = Assign (LocalIdent "r") Word $ Neg (VConst (Const (Number 1)))+ i2 = Assign (LocalIdent "r") Word $ Neg (VLocal $ LocalIdent "r")+ b = Block {label = BlockIdent "s", phi = [], stmt = [i1, i2], term = Halt}+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "s") Nothing [] $ blkMap [b]+ in parse "function $f() {\n@s\n%r =w neg 1\n%r =w neg %r\nhlt\n}" @?= Right f,+ testCase "cast instruction" $+ let c = Assign (LocalIdent "r") Word $ Cast (VLocal $ LocalIdent "f")+ b = Block {label = BlockIdent "s", phi = [], stmt = [c], term = Halt}+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "s") Nothing [Regular (ABase Single) (LocalIdent "f")] $ blkMap [b]+ in parse "function $f(s %f) {\n@s\n%r =w cast %f\nhlt\n}" @?= Right f,+ testCase "trunc instruction" $+ let c = Assign (LocalIdent "r") Single $ TruncDouble (VLocal $ LocalIdent "d")+ b = Block {label = BlockIdent "s", phi = [], stmt = [c], term = Halt}+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "s") Nothing [Regular (ABase Double) (LocalIdent "d")] $ blkMap [b]+ in parse "function $f(d %d) {\n@s\n%r =s truncd %d\nhlt\n}" @?= Right f,+ testCase "exts instruction" $+ let c = Assign (LocalIdent "d") Double $ Ext ExtSingle (VLocal $ LocalIdent "s")+ b = Block {label = BlockIdent "s", phi = [], stmt = [c], term = Halt}+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "s") Nothing [Regular (ABase Single) (LocalIdent "s")] $ blkMap [b]+ in parse "function $f(s %s) {\n@s\n%d =d exts %s\nhlt\n}" @?= Right f,+ testCase "float literals" $+ let c = Assign (LocalIdent "f.1") Single (Copy $ VConst (Const $ SFP 2.0))+ b = Block {label = BlockIdent "start", phi = [], stmt = [c, c, c, c], term = Halt}+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "start") Nothing [] $ blkMap [b]+ in parse+ "function $f() { \n\+ \@start\n\+ \%f.1 =s copy s_2\n\+ \%f.1 =s copy s_2.\n\+ \%f.1 =s copy s_2.0\n\+ \%f.1 =s copy s_2.000000\n\+ \hlt\n\+ \}"+ @?= Right f,+ testCase "float to int conversions" $+ let c1 = Assign (LocalIdent "w.1") Word (FloatToInt FSingle True (VLocal $ LocalIdent "s"))+ c2 = Assign (LocalIdent "w.2") Word (FloatToInt FSingle False (VLocal $ LocalIdent "s"))+ c3 = Assign (LocalIdent "w.3") Word (FloatToInt FDouble True (VLocal $ LocalIdent "d"))+ c4 = Assign (LocalIdent "w.4") Word (FloatToInt FDouble False (VLocal $ LocalIdent "d"))+ b = Block {label = BlockIdent "start", phi = [], stmt = [c1, c2, c3, c4], term = Halt}+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "start") Nothing [Regular (ABase Single) (LocalIdent "s"), Regular (ABase Double) (LocalIdent "d")] $ blkMap [b]+ in parse+ "function $f(s %s, d %d) { \n\+ \@start\n\+ \%w.1 =w stosi %s\n\+ \%w.2 =w stoui %s\n\+ \%w.3 =w dtosi %d\n\+ \%w.4 =w dtoui %d\n\+ \hlt\n\+ \}"+ @?= Right f,+ testCase "int to float conversions" $+ let c1 = Assign (LocalIdent "f.1") Single (IntToFloat IWord True (VLocal $ LocalIdent "w"))+ c2 = Assign (LocalIdent "f.2") Single (IntToFloat IWord False (VLocal $ LocalIdent "w"))+ c3 = Assign (LocalIdent "f.3") Double (IntToFloat ILong True (VLocal $ LocalIdent "l"))+ c4 = Assign (LocalIdent "f.4") Double (IntToFloat ILong False (VLocal $ LocalIdent "l"))+ b = Block {label = BlockIdent "start", phi = [], stmt = [c1, c2, c3, c4], term = Halt}+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "start") Nothing [Regular (ABase Word) (LocalIdent "w"), Regular (ABase Long) (LocalIdent "l")] $ blkMap [b]+ in parse+ "function $f(w %w, l %l) { \n\+ \@start\n\+ \%f.1 =s swtof %w\n\+ \%f.2 =s uwtof %w\n\+ \%f.3 =d sltof %l\n\+ \%f.4 =d ultof %l\n\+ \hlt\n\+ \}"+ @?= Right f,+ testCase "floating point comparision" $+ let c1 = Assign (LocalIdent "w.1") Word $ CompareFloat FDouble FOrd (VLocal $ LocalIdent "lhs") (VLocal $ LocalIdent "rhs")+ c2 = Assign (LocalIdent "w.2") Word $ CompareFloat FSingle FOrd (VLocal $ LocalIdent "lhs") (VLocal $ LocalIdent "rhs")+ c3 = Assign (LocalIdent "w.3") Word $ CompareFloat FDouble FLe (VLocal $ LocalIdent "lhs") (VLocal $ LocalIdent "rhs")+ c4 = Assign (LocalIdent "w.4") Word $ CompareFloat FDouble FLt (VLocal $ LocalIdent "lhs") (VLocal $ LocalIdent "rhs")+ c5 = Assign (LocalIdent "w.5") Word $ CompareFloat FDouble FGe (VLocal $ LocalIdent "lhs") (VLocal $ LocalIdent "rhs")+ c6 = Assign (LocalIdent "w.6") Word $ CompareFloat FDouble FGt (VLocal $ LocalIdent "lhs") (VLocal $ LocalIdent "rhs")+ b = Block {label = BlockIdent "start", phi = [], stmt = [c1, c2, c3, c4, c5, c6], term = Halt}+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "start") Nothing [Regular (ABase Double) (LocalIdent "lhs"), Regular (ABase Double) (LocalIdent "rhs")] $ blkMap [b]+ in parse+ "function $f(d %lhs, d %rhs) { \n\+ \@start\n\+ \%w.1 =w cod %lhs, %rhs\n\+ \%w.2 =w cos %lhs, %rhs\n\+ \%w.3 =w cled %lhs, %rhs\n\+ \%w.4 =w cltd %lhs, %rhs\n\+ \%w.5 =w cged %lhs, %rhs\n\+ \%w.6 =w cgtd %lhs, %rhs\n\+ \hlt\n\+ \}"+ @?= Right f,+ testCase "variadic function" $+ let c0 = Volatile (VAStart $ VLocal (LocalIdent "ap"))+ c1 = Assign (LocalIdent ".1") Word $ VAArg (VLocal $ LocalIdent "ap")+ b = Block {label = BlockIdent "start", phi = [], stmt = [c0, c1], term = Halt}+ f = FuncDef [] (GlobalIdent "f") (BlockIdent "start") Nothing [Regular (ABase Word) (LocalIdent "w"), Variadic] $ blkMap [b]+ in parse+ "function $f(w %w, ...) { \n\+ \@start\n\+ \vastart %ap\n\+ \%.1 =w vaarg %ap\n\+ \hlt\n\+ \}"+ @?= Right f,+ testCase "debug information" $+ let s1 = Volatile (DBGLoc 1 2 Nothing)+ s2 = Volatile (DBGLoc 23 42 $ Just 1337)+ b = Block {label = BlockIdent "start", phi = [], stmt = [s1, s2], term = Halt}+ f = FuncDef [] (GlobalIdent "main") (BlockIdent "start") Nothing [] $ blkMap [b]+ in parse+ "function $main() { \n\+ \@start\n\+ \dbgloc 1, 2\n\+ \dbgloc 23, 42, 1337\n\+ \hlt\n\+ \}"+ @?= Right f+ ]+ where+ parse :: String -> Either P.ParseError FuncDef+ parse = P.parse funcDef ""++mkParser :: TestTree+mkParser =+ testGroup+ "Tests for the QBE parser"+ [typeTests, dataTests, funcTests]
+ test/Types.hs view
@@ -0,0 +1,21 @@+-- SPDX-FileCopyrightText: 2026 Sören Tempel <soeren+git@soeren-tempel.net>+--+-- SPDX-License-Identifier: GPL-3.0-only++module Types (typesTests) where++import Language.QBE.Types qualified as QBE+import Test.Tasty+import Test.Tasty.HUnit++typesTests :: TestTree+typesTests =+ testGroup+ "Utility functions provided by the Types module"+ [ testCase "objSize" $ do+ let o1 = QBE.OItem QBE.Byte [QBE.DString "foobar"]+ o2 = QBE.OItem (QBE.Base QBE.Word) [QBE.DConst $ QBE.Number 2342]++ let dataDef = QBE.DataDef [] (QBE.GlobalIdent "d") Nothing [o1, o2]+ 10 @?= QBE.dataSize dataDef+ ]