Commit 49a8e5c0 authored by dterei's avatar dterei

Add new LLVM code generator to GHC. (Version 2)

This was done as part of an honours thesis at UNSW, the paper describing the
work and results can be found at:

http://www.cse.unsw.edu.au/~pls/thesis/davidt-thesis.pdf

A Homepage for the backend can be found at:

http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/Backends/LLVM

Quick summary of performance is that for the 'nofib' benchmark suite, runtimes
are within 5% slower than the NCG and generally better than the C code
generator.  For some code though, such as the DPH projects benchmark, the LLVM
code generator outperforms the NCG and C code generator by about a 25%
reduction in run times.
parent 0c41772c
......@@ -181,6 +181,7 @@ data ClosureTypeInfo
data CmmReturnInfo = CmmMayReturn
| CmmNeverReturns
deriving ( Eq )
-- TODO: These types may need refinement
data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc
......
......@@ -6,7 +6,7 @@
--
-----------------------------------------------------------------------------
module CmmUtils(
module CmmUtils(
CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
isNopStmt,
......
......@@ -122,9 +122,10 @@ emitForeignCall' safety results target args vols _srt ret
| not (playSafe safety) = do
temp_args <- load_args_into_temps args
let (caller_save, caller_load) = callerSaveVolatileRegs vols
let caller_load' = if ret == CmmNeverReturns then [] else caller_load
stmtsC caller_save
stmtC (CmmCall target results temp_args CmmUnsafe ret)
stmtsC caller_load
stmtsC caller_load'
| otherwise = do
-- Both 'id' and 'new_base' are GCKindNonPtr because they're
......
......@@ -26,6 +26,7 @@ module CgUtils (
tagToClosure,
callerSaveVolatileRegs, get_GlobalReg_addr,
activeStgRegs, fixStgRegisters,
cmmAndWord, cmmOrWord, cmmNegate, cmmEqWord, cmmNeWord,
cmmUGtWord,
......@@ -423,33 +424,6 @@ callerSaveVolatileRegs vols = (caller_save, caller_load)
: next
| otherwise = next
-- -----------------------------------------------------------------------------
-- Global registers
-- We map STG registers onto appropriate CmmExprs. Either they map
-- to real machine registers or stored as offsets from BaseReg. Given
-- a GlobalReg, get_GlobalReg_addr always produces the
-- register table address for it.
-- (See also get_GlobalReg_reg_or_addr in MachRegs)
get_GlobalReg_addr :: GlobalReg -> CmmExpr
get_GlobalReg_addr BaseReg = regTableOffset 0
get_GlobalReg_addr mid = get_Regtable_addr_from_offset
(globalRegType mid) (baseRegOffset mid)
-- Calculate a literal representing an offset into the register table.
-- Used when we don't have an actual BaseReg to offset from.
regTableOffset n =
CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r + n))
get_Regtable_addr_from_offset :: CmmType -> Int -> CmmExpr
get_Regtable_addr_from_offset rep offset =
#ifdef REG_Base
CmmRegOff (CmmGlobal BaseReg) offset
#else
regTableOffset offset
#endif
-- | Returns @True@ if this global register is stored in a caller-saves
-- machine register.
......@@ -1010,3 +984,181 @@ clHasCafRefs (ClosureInfo {closureSRT = srt}) =
case srt of NoC_SRT -> NoCafRefs
_ -> MayHaveCafRefs
clHasCafRefs (ConInfo {}) = NoCafRefs
-- -----------------------------------------------------------------------------
--
-- STG/Cmm GlobalReg
--
-- -----------------------------------------------------------------------------
-- | Here is where the STG register map is defined for each target arch.
-- The order matters (for the llvm backend anyway)! We must make sure to
-- maintain the order here with the order used in the LLVM calling conventions.
-- Note that also, this isn't all registers, just the ones that are currently
-- possbily mapped to real registers.
activeStgRegs :: [GlobalReg]
activeStgRegs = [
#ifdef REG_Base
BaseReg
#endif
#ifdef REG_Sp
,Sp
#endif
#ifdef REG_Hp
,Hp
#endif
#ifdef REG_R1
,VanillaReg 1 VGcPtr
#endif
#ifdef REG_R2
,VanillaReg 2 VGcPtr
#endif
#ifdef REG_R3
,VanillaReg 3 VGcPtr
#endif
#ifdef REG_R4
,VanillaReg 4 VGcPtr
#endif
#ifdef REG_R5
,VanillaReg 5 VGcPtr
#endif
#ifdef REG_R6
,VanillaReg 6 VGcPtr
#endif
#ifdef REG_R7
,VanillaReg 7 VGcPtr
#endif
#ifdef REG_R8
,VanillaReg 8 VGcPtr
#endif
#ifdef REG_SpLim
,SpLim
#endif
#ifdef REG_F1
,FloatReg 1
#endif
#ifdef REG_F2
,FloatReg 2
#endif
#ifdef REG_F3
,FloatReg 3
#endif
#ifdef REG_F4
,FloatReg 4
#endif
#ifdef REG_D1
,DoubleReg 1
#endif
#ifdef REG_D2
,DoubleReg 2
#endif
]
-- | We map STG registers onto appropriate CmmExprs. Either they map
-- to real machine registers or stored as offsets from BaseReg. Given
-- a GlobalReg, get_GlobalReg_addr always produces the
-- register table address for it.
get_GlobalReg_addr :: GlobalReg -> CmmExpr
get_GlobalReg_addr BaseReg = regTableOffset 0
get_GlobalReg_addr mid = get_Regtable_addr_from_offset
(globalRegType mid) (baseRegOffset mid)
-- Calculate a literal representing an offset into the register table.
-- Used when we don't have an actual BaseReg to offset from.
regTableOffset n =
CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r + n))
get_Regtable_addr_from_offset :: CmmType -> Int -> CmmExpr
get_Regtable_addr_from_offset rep offset =
#ifdef REG_Base
CmmRegOff (CmmGlobal BaseReg) offset
#else
regTableOffset offset
#endif
-- | Fixup global registers so that they assign to locations within the
-- RegTable if they aren't pinned for the current target.
fixStgRegisters :: RawCmmTop -> RawCmmTop
fixStgRegisters top@(CmmData _ _) = top
fixStgRegisters (CmmProc info lbl params (ListGraph blocks)) =
let blocks' = map fixStgRegBlock blocks
in CmmProc info lbl params $ ListGraph blocks'
fixStgRegBlock :: CmmBasicBlock -> CmmBasicBlock
fixStgRegBlock (BasicBlock id stmts) =
let stmts' = map fixStgRegStmt stmts
in BasicBlock id stmts'
fixStgRegStmt :: CmmStmt -> CmmStmt
fixStgRegStmt stmt
= case stmt of
CmmAssign (CmmGlobal reg) src ->
let src' = fixStgRegExpr src
baseAddr = get_GlobalReg_addr reg
in case reg `elem` activeStgRegs of
True -> CmmAssign (CmmGlobal reg) src'
False -> CmmStore baseAddr src'
CmmAssign reg src ->
let src' = fixStgRegExpr src
in CmmAssign reg src'
CmmStore addr src -> CmmStore (fixStgRegExpr addr) (fixStgRegExpr src)
CmmCall target regs args srt returns ->
let target' = case target of
CmmCallee e conv -> CmmCallee (fixStgRegExpr e) conv
other -> other
args' = map (\(CmmHinted arg hint) ->
(CmmHinted (fixStgRegExpr arg) hint)) args
in CmmCall target' regs args' srt returns
CmmCondBranch test dest -> CmmCondBranch (fixStgRegExpr test) dest
CmmSwitch expr ids -> CmmSwitch (fixStgRegExpr expr) ids
CmmJump addr regs -> CmmJump (fixStgRegExpr addr) regs
-- CmmNop, CmmComment, CmmBranch, CmmReturn
_other -> stmt
fixStgRegExpr :: CmmExpr -> CmmExpr
fixStgRegExpr expr
= case expr of
CmmLoad addr ty -> CmmLoad (fixStgRegExpr addr) ty
CmmMachOp mop args -> CmmMachOp mop args'
where args' = map fixStgRegExpr args
CmmReg (CmmGlobal reg) ->
-- Replace register leaves with appropriate StixTrees for
-- the given target. MagicIds which map to a reg on this
-- arch are left unchanged. For the rest, BaseReg is taken
-- to mean the address of the reg table in MainCapability,
-- and for all others we generate an indirection to its
-- location in the register table.
case reg `elem` activeStgRegs of
True -> expr
False ->
let baseAddr = get_GlobalReg_addr reg
in case reg of
BaseReg -> fixStgRegExpr baseAddr
_other -> fixStgRegExpr
(CmmLoad baseAddr (globalRegType reg))
CmmRegOff (CmmGlobal reg) offset ->
-- RegOf leaves are just a shorthand form. If the reg maps
-- to a real reg, we keep the shorthand, otherwise, we just
-- expand it and defer to the above code.
case reg `elem` activeStgRegs of
True -> expr
False -> fixStgRegExpr (CmmMachOp (MO_Add wordWidth) [
CmmReg (CmmGlobal reg),
CmmLit (CmmInt (fromIntegral offset)
wordWidth)])
-- CmmLit, CmmReg (CmmLocal), CmmStackSlot
_other -> expr
......@@ -130,7 +130,9 @@ Library
ghci
hsSyn
iface
llvmGen
main
nativeGen
parser
prelude
profiling
......@@ -153,6 +155,16 @@ Library
Id
IdInfo
Literal
Llvm
Llvm.AbsSyn
Llvm.PpLlvm
Llvm.Types
LlvmCodeGen
LlvmCodeGen.Base
LlvmCodeGen.CodeGen
LlvmCodeGen.Data
LlvmCodeGen.Ppr
LlvmCodeGen.Regs
MkId
Module
Name
......@@ -198,6 +210,7 @@ Library
MkZipCfg
MkZipCfgCmm
OptimizationFuel
PprBase
PprC
PprCmm
PprCmmZ
......@@ -447,10 +460,9 @@ Library
VectUtils
Vectorise
-- We only need to expose more modules as some of the ncg code is used
-- by the LLVM backend so its always included
if flag(ncg)
hs-source-dirs:
nativeGen
Exposed-Modules:
AsmCodeGen
TargetReg
......@@ -459,7 +471,6 @@ Library
Size
Reg
RegClass
PprBase
PIC
Platform
Alpha.Regs
......
......@@ -43,6 +43,12 @@ compiler/stage2/package-data.mk : $(compiler_CONFIG_HS)
compiler/stage3/package-data.mk : $(compiler_CONFIG_HS)
endif
ifeq "$(GhcEnableTablesNextToCode)" "NO"
GhcWithLlvmCodeGen = YES
else
GhcWithLlvmCodeGen = NO
endif
$(compiler_CONFIG_HS) : mk/config.mk mk/project.mk
"$(RM)" $(RM_OPTS) $@
@echo "Creating $@ ... "
......@@ -67,6 +73,8 @@ $(compiler_CONFIG_HS) : mk/config.mk mk/project.mk
@echo "cGhcWithInterpreter = \"$(GhcWithInterpreter)\"" >> $@
@echo "cGhcWithNativeCodeGen :: String" >> $@
@echo "cGhcWithNativeCodeGen = \"$(GhcWithNativeCodeGen)\"" >> $@
@echo "cGhcWithLlvmCodeGen :: String" >> $@
@echo "cGhcWithLlvmCodeGen = \"$(GhcWithLlvmCodeGen)\"" >> $@
@echo "cGhcWithSMP :: String" >> $@
@echo "cGhcWithSMP = \"$(GhcWithSMP)\"" >> $@
@echo "cGhcRTSWays :: String" >> $@
......@@ -313,7 +321,7 @@ ifeq "$(GhcEnableTablesNextToCode) $(GhcUnregisterised)" "YES NO"
# or not?
# XXX This should logically be a CPP option, but there doesn't seem to
# be a flag for that
compiler_stage2_CONFIGURE_OPTS += --ghc-option=-DGHCI_TABLES_NEXT_TO_CODE
compiler_CONFIGURE_OPTS += --ghc-option=-DGHCI_TABLES_NEXT_TO_CODE
endif
# Should the debugger commands be enabled?
......@@ -338,6 +346,8 @@ ifeq "$(HOSTPLATFORM)" "ia64-unknown-linux"
# needed for generating proper relocation in large binaries: trac #856
compiler_CONFIGURE_OPTS += --ld-option=-Wl,--relax
endif
else
compiler_CONFIGURE_OPTS += --ghc-option=-DNO_REGS
endif
# We need to turn on profiling either if we have been asked to
......
-- ----------------------------------------------------------------------------
-- | This module supplies bindings to generate Llvm IR from Haskell
-- (<http://www.llvm.org/docs/LangRef.html>).
--
-- Note: this module is developed in a demand driven way. It is no complete
-- LLVM binding library in Haskell, but enough to generate code for GHC.
--
-- This code is derived from code taken from the Essential Haskell Compiler
-- (EHC) project (<http://www.cs.uu.nl/wiki/Ehc/WebHome>).
--
module Llvm (
-- * Modules, Functions and Blocks
LlvmModule(..),
LlvmFunction(..), LlvmFunctionDecl(..),
LlvmFunctions, LlvmFunctionDecls,
LlvmStatement(..), LlvmExpression(..),
LlvmBlocks, LlvmBlock(..), LlvmBlockId,
-- * Call Handling
LlvmCallConvention(..), LlvmCallType(..), LlvmParameterListType(..),
LlvmLinkageType(..), LlvmFuncAttr(..),
-- * Operations and Comparisons
LlvmCmpOp(..), LlvmMachOp(..), LlvmCastOp(..),
-- * Variables and Type System
LlvmVar(..), LlvmStatic(..), LlvmLit(..), LlvmType(..),
LMGlobal, LMString, LMConstant,
-- ** Some basic types
i64, i32, i16, i8, i1, llvmWord, llvmWordPtr,
-- ** Operations on the type system.
isGlobal, getLitType, getLit, getName, getPlainName, getVarType,
getStatType, getGlobalVar, getGlobalType, pVarLower, pLift, pLower,
isInt, isFloat, isPointer, llvmWidthInBits,
-- * Pretty Printing
ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmConstants,
ppLlvmConstant, ppLlvmGlobals, ppLlvmGlobal, ppLlvmFunctionDecls,
ppLlvmFunctionDecl, ppLlvmFunctions, ppLlvmFunction, ppLlvmType,
ppLlvmTypes, llvmSDoc
) where
import Llvm.AbsSyn
import Llvm.PpLlvm
import Llvm.Types
--------------------------------------------------------------------------------
-- | The LLVM abstract syntax.
--
module Llvm.AbsSyn where
import Llvm.Types
import Unique
-- | Block labels
type LlvmBlockId = Unique
-- | A block of LLVM code.
data LlvmBlock = LlvmBlock {
-- | The code label for this block
blockLabel :: LlvmBlockId,
-- | A list of LlvmStatement's representing the code for this block.
-- This list must end with a control flow statement.
blockStmts :: [LlvmStatement]
}
type LlvmBlocks = [LlvmBlock]
-- | An LLVM Module. This is a top level contianer in LLVM.
data LlvmModule = LlvmModule {
-- | Comments to include at the start of the module.
modComments :: [LMString],
-- | Constants to include in the module.
modConstants :: [LMConstant],
-- | Global variables to include in the module.
modGlobals :: [LMGlobal],
-- | LLVM Functions used in this module but defined in other modules.
modFwdDecls :: LlvmFunctionDecls,
-- | LLVM Functions defined in this module.
modFuncs :: LlvmFunctions
}
-- | An LLVM Function
data LlvmFunction = LlvmFunction {
-- | The signature of this declared function.
funcDecl :: LlvmFunctionDecl,
-- | The function attributes.
funcAttrs :: [LlvmFuncAttr],
-- | The body of the functions.
funcBody :: LlvmBlocks
}
type LlvmFunctions = [LlvmFunction]
-- | Llvm Statements
data LlvmStatement
{- |
Assign an expression to an variable:
* dest: Variable to assign to
* source: Source expression
-}
= Assignment LlvmVar LlvmExpression
{- |
Always branch to the target label
-}
| Branch LlvmVar
{- |
Branch to label targetTrue if cond is true otherwise to label targetFalse
* cond: condition that will be tested, must be of type i1
* targetTrue: label to branch to if cond is true
* targetFalse: label to branch to if cond is false
-}
| BranchIf LlvmVar LlvmVar LlvmVar
{- |
Comment
Plain comment.
-}
| Comment [LMString]
{- |
Set a label on this position.
* name: Identifier of this label, unique for this module
-}
| MkLabel LlvmBlockId
{- |
Store variable value in pointer ptr. If value is of type t then ptr must
be of type t*.
* value: Variable/Constant to store.
* ptr: Location to store the value in
-}
| Store LlvmVar LlvmVar
{- |
Mutliway branch
* scrutinee: Variable or constant which must be of integer type that is
determines which arm is chosen.
* def: The default label if there is no match in target.
* target: A list of (value,label) where the value is an integer
constant and label the corresponding label to jump to if the
scrutinee matches the value.
-}
| Switch LlvmVar LlvmVar [(LlvmVar, LlvmVar)]
{- |
Return a result.
* result: The variable or constant to return
-}
| Return (Maybe LlvmVar)
{- |
An instruction for the optimizer that the code following is not reachable
-}
| Unreachable
{- |
Raise an expression to a statement (if don't want result or want to use
Llvm unamed values.
-}
| Expr LlvmExpression
deriving (Show, Eq)
-- | Llvm Expressions
data LlvmExpression
{- |
Allocate amount * sizeof(tp) bytes on the stack
* tp: LlvmType to reserve room for
* amount: The nr of tp's which must be allocated
-}
= Alloca LlvmType Int
{- |
Perform the machine operator op on the operands left and right
* op: operator
* left: left operand
* right: right operand
-}
| LlvmOp LlvmMachOp LlvmVar LlvmVar
{- |
Perform a compare operation on the operands left and right
* op: operator
* left: left operand
* right: right operand
-}
| Compare LlvmCmpOp LlvmVar LlvmVar
{- |
Allocate amount * sizeof(tp) bytes on the heap
* tp: LlvmType to reserve room for
* amount: The nr of tp's which must be allocated
-}
| Malloc LlvmType Int
{- |
Load the value at location ptr
-}
| Load LlvmVar
{- |
Navigate in an structure, selecting elements
* ptr: Location of the structure
* indexes: A list of indexes to select the correct value. For example
the first element of the third element of the structure ptr
is selected with [3,1] (zero indexed)
-}
| GetElemPtr LlvmVar [Int]
{- |
Cast the variable from to the to type. This is an abstraction of three
cast operators in Llvm, inttoptr, prttoint and bitcast.
* cast: Cast type
* from: Variable to cast
* to: type to cast to
-}
| Cast LlvmCastOp LlvmVar LlvmType
{- |
Call a function. The result is the value of the expression.
* tailJumps: CallType to signal if the function should be tail called
* fnptrval: An LLVM value containing a pointer to a function to be
invoked. Can be indirect. Should be LMFunction type.
* args: Concrete arguments for the parameters
* attrs: A list of function attributes for the call. Only NoReturn,
NoUnwind, ReadOnly and ReadNone are valid here.
-}
| Call LlvmCallType LlvmVar [LlvmVar] [LlvmFuncAttr]
{- |
Merge variables from different basic blocks which are predecessors of this
basic block in a new variable of type tp.
* tp: type of the merged variable, must match the types of the
precessors variables.
* precessors: A list of variables and the basic block that they originate
from.
-}
| Phi LlvmType [(LlvmVar,LlvmVar)]
deriving (Show, Eq)
--------------------------------------------------------------------------------
-- | Pretty print LLVM IR Code.
--
module Llvm.PpLlvm (
-- * Top level LLVM objects.
ppLlvmModule,
ppLlvmComments,
ppLlvmComment,
ppLlvmConstants,
ppLlvmConstant,
ppLlvmGlobals,
ppLlvmGlobal,
ppLlvmType,
ppLlvmTypes,
ppLlvmFunctionDecls,
ppLlvmFunctionDecl,
ppLlvmFunctions,
ppLlvmFunction,
llvmSDoc
) where
#include "HsVersions.h"
import Llvm.AbsSyn
import Llvm.Types
import Data.List ( intersperse )
import Pretty
import qualified Outputable as Outp