Commit 8c2aa498 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Merge branch 'master' of http://darcs.haskell.org/ghc

parents a0f8b3ac 9e452874
......@@ -158,7 +158,6 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
test -z "[$]2" || eval "[$]2=ArchX86"
;;
x86_64)
GET_ARM_ISA()
test -z "[$]2" || eval "[$]2=ArchX86_64"
;;
powerpc)
......@@ -174,7 +173,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
GET_ARM_ISA()
test -z "[$]2" || eval "[$]2=\"ArchARM {armISA = \$ARM_ISA, armISAExt = \$ARM_ISA_EXT}\""
;;
hppa|hppa1_1|ia64|m68k|rs6000|s390|s390x|sparc64|vax)
alpha|mips|mipseb|mipsel|hppa|hppa1_1|ia64|m68k|rs6000|s390|s390x|sparc64|vax)
test -z "[$]2" || eval "[$]2=ArchUnknown"
;;
*)
......
......@@ -105,7 +105,7 @@ ofZgraph g = Old.ListGraph $ mapMaybe convert_block $ postorderDfs g
, Just expr' <- maybeInvertCmmExpr expr -> Old.CmmCondBranch expr' fid : tail_of tid
| otherwise -> [Old.CmmCondBranch expr tid, Old.CmmBranch fid]
CmmSwitch arg ids -> [Old.CmmSwitch arg ids]
CmmCall e _ _ _ _ -> [Old.CmmJump e []]
CmmCall e _ _ _ _ -> [Old.CmmJump e]
CmmForeignCall {} -> panic "ofZgraph: CmmForeignCall"
tail_of bid = case foldBlockNodesB3 (first, middle, last) block () of
Old.BasicBlock _ stmts -> stmts
......
......@@ -143,9 +143,9 @@ lintCmmStmt platform labels = lint
then return ()
else cmmLintErr (text "switch scrutinee is not a word: " <> pprPlatform platform e <>
text " :: " <> ppr erep)
lint (CmmJump e args) = lintCmmExpr platform e >> mapM_ (lintCmmExpr platform . hintlessCmm) args
lint (CmmReturn ress) = mapM_ (lintCmmExpr platform . hintlessCmm) ress
lint (CmmBranch id) = checkTarget id
lint (CmmJump e) = lintCmmExpr platform e >> return ()
lint (CmmReturn) = return ()
lint (CmmBranch id) = checkTarget id
checkTarget id = if setMember id labels then return ()
else cmmLintErr (text "Branch to nonexistent id" <+> ppr id)
......
......@@ -65,8 +65,8 @@ cmmEliminateDeadBlocks blocks@(BasicBlock base_id _:_) =
stmt m (CmmBranch b) = b:m
stmt m (CmmCondBranch e b) = b:(expr m e)
stmt m (CmmSwitch e bs) = catMaybes bs ++ expr m e
stmt m (CmmJump e as) = expr (actuals m as) e
stmt m (CmmReturn as) = actuals m as
stmt m (CmmJump e) = expr m e
stmt m (CmmReturn) = m
actuals m as = foldl' (\m h -> expr m (hintlessCmm h)) m as
-- We have to do a deep fold into CmmExpr because
-- there may be a BlockId in the CmmBlock literal.
......@@ -273,7 +273,7 @@ inlineStmt u a (CmmCall target regs es ret)
es' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ]
inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
inlineStmt u a (CmmJump e d) = CmmJump (inlineExpr u a e) d
inlineStmt u a (CmmJump e) = CmmJump (inlineExpr u a e)
inlineStmt _ _ other_stmt = other_stmt
inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
......@@ -669,7 +669,7 @@ cmmLoopifyForC (CmmProc (Just info@(Statics info_lbl _)) entry_lbl
where blocks' = [ BasicBlock id (map do_stmt stmts)
| BasicBlock id stmts <- blocks ]
do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
do_stmt (CmmJump (CmmLit (CmmLabel lbl))) | lbl == jump_lbl
= CmmBranch top_id
do_stmt stmt = stmt
......
......@@ -411,10 +411,10 @@ stmt :: { ExtCode }
{ do as <- sequence $5; doSwitch $2 $3 as $6 }
| 'goto' NAME ';'
{ do l <- lookupLabel $2; stmtEC (CmmBranch l) }
| 'jump' expr maybe_actuals ';'
{ do e1 <- $2; e2 <- sequence $3; stmtEC (CmmJump e1 e2) }
| 'return' maybe_actuals ';'
{ do e <- sequence $2; stmtEC (CmmReturn e) }
| 'jump' expr ';'
{ do e <- $2; stmtEC (CmmJump e) }
| 'return' ';'
{ stmtEC CmmReturn }
| 'if' bool_expr 'goto' NAME
{ do l <- lookupLabel $4; cmmRawIf $2 l }
| 'if' bool_expr '{' body '}' else
......@@ -945,8 +945,7 @@ emitRetUT args = do
-- or regs that we assign to, so better use
-- simultaneous assignments here (#3546)
when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW spReg (-sp)))
stmtC (CmmJump (entryCode (CmmLoad (cmmRegOffW spReg sp) bWord)) [])
-- TODO (when using CPS): emitStmt (CmmReturn (map snd args))
stmtC $ CmmJump (entryCode (CmmLoad (cmmRegOffW spReg sp) bWord))
-- -----------------------------------------------------------------------------
-- If-then-else and boolean expressions
......
......@@ -6,42 +6,41 @@
--
-----------------------------------------------------------------------------
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module OldCmm (
CmmGroup, GenCmmGroup, RawCmmGroup, CmmDecl, RawCmmDecl,
ListGraph(..),
CmmInfo(..), UpdateFrame(..), CmmInfoTable(..), ClosureTypeInfo(..),
CmmInfo(..), CmmInfoTable(..), ClosureTypeInfo(..), UpdateFrame(..),
CmmStatic(..), CmmStatics(..), CmmFormal, CmmActual,
cmmMapGraph, cmmTopMapGraph,
GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
CmmStmt(..), CmmReturnInfo(..), CmmHinted(..),
HintedCmmFormal, HintedCmmActual,
CmmSafety(..), CmmCallTarget(..),
New.GenCmmDecl(..),
New.ForeignHint(..),
New.GenCmmDecl(..), New.ForeignHint(..),
module CmmExpr,
Section(..),
ProfilingInfo(..), C_SRT(..)
) where
Section(..), ProfilingInfo(..), C_SRT(..)
) where
#include "HsVersions.h"
import qualified Cmm as New
import Cmm ( CmmInfoTable(..), GenCmmGroup, CmmStatics(..), GenCmmDecl(..),
CmmFormal, CmmActual, Section(..), CmmStatic(..),
ProfilingInfo(..), ClosureTypeInfo(..) )
import Cmm ( CmmInfoTable(..), GenCmmGroup, CmmStatics(..), GenCmmDecl(..),
CmmFormal, CmmActual, Section(..), CmmStatic(..),
ProfilingInfo(..), ClosureTypeInfo(..) )
import BlockId
import CmmExpr
import ForeignCall
import ClosureInfo
import CmmExpr
import FastString
import ForeignCall
-- A [[BlockId]] is a local label.
......@@ -55,17 +54,17 @@ import FastString
data CmmInfo
= CmmInfo
(Maybe BlockId) -- GC target. Nothing <=> CPS won't do stack check
-- JD: NOT USED BY NEW CODE GEN
(Maybe UpdateFrame) -- Update frame
CmmInfoTable -- Info table
(Maybe BlockId) -- GC target. Nothing <=> CPS won't do stack check
-- JD: NOT USED BY NEW CODE GEN
(Maybe UpdateFrame) -- Update frame
CmmInfoTable -- Info table
-- | A frame that is to be pushed before entry to the function.
-- Used to handle 'update' frames.
data UpdateFrame =
UpdateFrame
CmmExpr -- Frame header. Behaves like the target of a 'jump'.
[CmmExpr] -- Frame remainder. Behaves like the arguments of a 'jump'.
data UpdateFrame
= UpdateFrame
CmmExpr -- Frame header. Behaves like the target of a 'jump'.
[CmmExpr] -- Frame remainder. Behaves like the arguments of a 'jump'.
-----------------------------------------------------------------------------
-- Cmm, CmmDecl, CmmBasicBlock
......@@ -75,14 +74,15 @@ data UpdateFrame =
-- re-orderd during code generation.
-- | A control-flow graph represented as a list of extended basic blocks.
--
-- Code, may be empty. The first block is the entry point. The
-- order is otherwise initially unimportant, but at some point the
-- code gen will fix the order.
--
-- BlockIds must be unique across an entire compilation unit, since
-- they are translated to assembly-language labels, which scope
-- across a whole compilation unit.
newtype ListGraph i = ListGraph [GenBasicBlock i]
-- ^ Code, may be empty. The first block is the entry point. The
-- order is otherwise initially unimportant, but at some point the
-- code gen will fix the order.
-- BlockIds must be unique across an entire compilation unit, since
-- they are translated to assembly-language labels, which scope
-- across a whole compilation unit.
-- | Cmm with the info table as a data type
type CmmGroup = GenCmmGroup CmmStatics CmmInfo (ListGraph CmmStmt)
......@@ -108,84 +108,90 @@ type CmmBasicBlock = GenBasicBlock CmmStmt
instance UserOfLocalRegs i => UserOfLocalRegs (GenBasicBlock i) where
foldRegsUsed f set (BasicBlock _ l) = foldRegsUsed f set l
blockId :: GenBasicBlock i -> BlockId
-- The branch block id is that of the first block in
-- | The branch block id is that of the first block in
-- the branch, which is that branch's entry point
blockId :: GenBasicBlock i -> BlockId
blockId (BasicBlock blk_id _ ) = blk_id
blockStmts :: GenBasicBlock i -> [i]
blockStmts (BasicBlock _ stmts) = stmts
mapBlockStmts :: (i -> i') -> GenBasicBlock i -> GenBasicBlock i'
mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
----------------------------------------------------------------
-- graph maps
----------------------------------------------------------------
cmmMapGraph :: (g -> g') -> GenCmmGroup d h g -> GenCmmGroup d h g'
cmmTopMapGraph :: (g -> g') -> GenCmmDecl d h g -> GenCmmDecl d h g'
cmmMapGraph f tops = map (cmmTopMapGraph f) tops
cmmTopMapGraph :: (g -> g') -> GenCmmDecl d h g -> GenCmmDecl d h g'
cmmTopMapGraph f (CmmProc h l g) = CmmProc h l (f g)
cmmTopMapGraph _ (CmmData s ds) = CmmData s ds
data CmmReturnInfo = CmmMayReturn
| CmmNeverReturns
deriving ( Eq )
data CmmReturnInfo
= CmmMayReturn
| CmmNeverReturns
deriving ( Eq )
-----------------------------------------------------------------------------
-- CmmStmt
-- CmmStmt
-- A "statement". Note that all branches are explicit: there are no
-- control transfers to computed addresses, except when transfering
-- control to a new function.
-----------------------------------------------------------------------------
data CmmStmt -- Old-style
data CmmStmt
= CmmNop
| CmmComment FastString
| CmmAssign CmmReg CmmExpr -- Assign to register
| CmmAssign CmmReg CmmExpr -- Assign to register
| CmmStore CmmExpr CmmExpr -- Assign to memory location. Size is
-- given by cmmExprType of the rhs.
| CmmCall -- A call (foreign, native or primitive), with
CmmCallTarget
[HintedCmmFormal] -- zero or more results
[HintedCmmActual] -- zero or more arguments
CmmReturnInfo
-- Some care is necessary when handling the arguments of these, see
-- [Register parameter passing] and the hack in cmm/CmmOpt.hs
| CmmCall -- A call (foreign, native or primitive), with
CmmCallTarget
[HintedCmmFormal] -- zero or more results
[HintedCmmActual] -- zero or more arguments
CmmReturnInfo
-- Some care is necessary when handling the arguments of these, see
-- [Register parameter passing] and the hack in cmm/CmmOpt.hs
| CmmBranch BlockId -- branch to another BB in this fn
| CmmCondBranch CmmExpr BlockId -- conditional branch
| CmmSwitch CmmExpr [Maybe BlockId] -- Table branch
-- The scrutinee is zero-based;
-- zero -> first block
-- one -> second block etc
-- Undefined outside range, and when there's a Nothing
-- The scrutinee is zero-based;
-- zero -> first block
-- one -> second block etc
-- Undefined outside range, and when there's a Nothing
| CmmJump CmmExpr -- Jump to another C-- function,
[HintedCmmActual] -- with these parameters. (parameters never used)
| CmmJump CmmExpr -- Jump to another C-- function,
| CmmReturn -- Return from a native C-- function,
[HintedCmmActual] -- with these return values. (parameters never used)
| CmmReturn -- Return from a native C-- function,
data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: New.ForeignHint }
deriving( Eq )
data CmmHinted a
= CmmHinted {
hintlessCmm :: a,
cmmHint :: New.ForeignHint
}
deriving( Eq )
type HintedCmmFormal = CmmHinted CmmFormal
type HintedCmmActual = CmmHinted CmmActual
type HintedCmmFormal = CmmHinted CmmFormal
type HintedCmmActual = CmmHinted CmmActual
data CmmSafety = CmmUnsafe | CmmSafe C_SRT | CmmInterruptible
data CmmSafety
= CmmUnsafe
| CmmSafe C_SRT
| CmmInterruptible
-- | enable us to fold used registers over '[CmmActual]' and '[CmmFormal]'
instance UserOfLocalRegs CmmStmt where
foldRegsUsed f (set::b) s = stmt s set
where
where
stmt :: CmmStmt -> b -> b
stmt (CmmNop) = id
stmt (CmmComment {}) = id
......@@ -195,8 +201,8 @@ instance UserOfLocalRegs CmmStmt where
stmt (CmmBranch _) = id
stmt (CmmCondBranch e _) = gen e
stmt (CmmSwitch e _) = gen e
stmt (CmmJump e es) = gen e . gen es
stmt (CmmReturn es) = gen es
stmt (CmmJump e) = gen e
stmt (CmmReturn) = id
gen :: UserOfLocalRegs a => a -> b -> b
gen a set = foldRegsUsed f set a
......@@ -210,13 +216,13 @@ instance UserOfSlots CmmCallTarget where
foldSlotsUsed _ set (CmmPrim {}) = set
instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where
foldRegsUsed f set a = foldRegsUsed f set (hintlessCmm a)
foldRegsUsed f set a = foldRegsUsed f set (hintlessCmm a)
instance UserOfSlots a => UserOfSlots (CmmHinted a) where
foldSlotsUsed f set a = foldSlotsUsed f set (hintlessCmm a)
foldSlotsUsed f set a = foldSlotsUsed f set (hintlessCmm a)
instance DefinerOfLocalRegs a => DefinerOfLocalRegs (CmmHinted a) where
foldRegsDefd f set a = foldRegsDefd f set (hintlessCmm a)
foldRegsDefd f set a = foldRegsDefd f set (hintlessCmm a)
{-
Discussion
......@@ -232,7 +238,7 @@ conditional jump are explicit. ---NR]
One possible way to fix this would be:
data CmmStat =
data CmmStat =
...
| CmmJump CmmBranchDest
| CmmCondJump CmmExpr CmmBranchDest
......@@ -259,18 +265,19 @@ So we'll stick with the way it is, and add the optimisation to the NCG.
-}
-----------------------------------------------------------------------------
-- CmmCallTarget
-- CmmCallTarget
--
-- The target of a CmmCall.
-----------------------------------------------------------------------------
data CmmCallTarget
= CmmCallee -- Call a function (foreign or native)
CmmExpr -- literal label <=> static call
-- other expression <=> dynamic call
CCallConv -- The calling convention
| CmmPrim -- Call a "primitive" (eg. sin, cos)
CallishMachOp -- These might be implemented as inline
-- code by the backend.
= CmmCallee -- Call a function (foreign or native)
CmmExpr -- literal label <=> static call
-- other expression <=> dynamic call
CCallConv -- The calling convention
| CmmPrim -- Call a "primitive" (eg. sin, cos)
CallishMachOp -- These might be implemented as inline
-- code by the backend.
deriving Eq
......@@ -153,8 +153,8 @@ pprStmt platform stmt = case stmt of
CmmBranch ident -> genBranch ident
CmmCondBranch expr ident -> genCondBranch platform expr ident
CmmJump expr params -> genJump platform expr params
CmmReturn params -> genReturn platform params
CmmJump expr -> genJump platform expr
CmmReturn -> genReturn platform
CmmSwitch arg ids -> genSwitch platform arg ids
-- Just look like a tuple, since it was a tuple before
......@@ -203,8 +203,8 @@ genCondBranch platform expr ident =
--
-- jump foo(a, b, c);
--
genJump :: Platform -> CmmExpr -> [CmmHinted CmmExpr] -> SDoc
genJump platform expr args =
genJump :: Platform -> CmmExpr -> SDoc
genJump platform expr =
hcat [ ptext (sLit "jump")
, space
, if isTrivialCmmExpr expr
......@@ -212,8 +212,6 @@ genJump platform expr args =
else case expr of
CmmLoad (CmmReg _) _ -> pprExpr platform expr
_ -> parens (pprExpr platform expr)
, space
, parens ( commafy $ map (pprPlatform platform) args )
, semi ]
......@@ -222,12 +220,9 @@ genJump platform expr args =
--
-- return (a, b, c);
--
genReturn :: Platform -> [CmmHinted CmmExpr] -> SDoc
genReturn platform args =
hcat [ ptext (sLit "return")
, space
, parens ( commafy $ map (pprPlatform platform) args )
, semi ]
genReturn :: Platform -> SDoc
genReturn _ =
hcat [ ptext (sLit "return") , semi ]
-- --------------------------------------------------------------------------
-- Tabled jump to local label
......
......@@ -172,7 +172,7 @@ pprLocalness lbl | not $ externallyVisibleCLabel lbl = ptext (sLit "static ")
pprStmt :: Platform -> CmmStmt -> SDoc
pprStmt platform stmt = case stmt of
CmmReturn _ -> panic "pprStmt: return statement should have been cps'd away"
CmmReturn -> panic "pprStmt: return statement should have been cps'd away"
CmmNop -> empty
CmmComment _ -> empty -- (hang (ptext (sLit "/*")) 3 (ftext s)) $$ ptext (sLit "*/")
-- XXX if the string contains "*/", we need to fix it
......@@ -248,7 +248,7 @@ pprStmt platform stmt = case stmt of
CmmBranch ident -> pprBranch ident
CmmCondBranch expr ident -> pprCondBranch platform expr ident
CmmJump lbl _params -> mkJMP_(pprExpr platform lbl) <> semi
CmmJump lbl -> mkJMP_(pprExpr platform lbl) <> semi
CmmSwitch arg ids -> pprSwitch platform arg ids
pprCFunType :: SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual] -> SDoc
......@@ -757,12 +757,14 @@ isStrangeTypeReg (CmmLocal _) = False
isStrangeTypeReg (CmmGlobal g) = isStrangeTypeGlobal g
isStrangeTypeGlobal :: GlobalReg -> Bool
isStrangeTypeGlobal CCCS = True
isStrangeTypeGlobal CurrentTSO = True
isStrangeTypeGlobal CurrentNursery = True
isStrangeTypeGlobal BaseReg = True
isStrangeTypeGlobal r = isFixedPtrGlobalReg r
strangeRegType :: CmmReg -> Maybe SDoc
strangeRegType (CmmGlobal CCCS) = Just (ptext (sLit "struct CostCentreStack_ *"))
strangeRegType (CmmGlobal CurrentTSO) = Just (ptext (sLit "struct StgTSO_ *"))
strangeRegType (CmmGlobal CurrentNursery) = Just (ptext (sLit "struct bdescr_ *"))
strangeRegType (CmmGlobal BaseReg) = Just (ptext (sLit "struct StgRegTable_ *"))
......@@ -928,7 +930,7 @@ te_Stmt (CmmCall _ rs es _) = mapM_ (te_temp.hintlessCmm) rs >>
mapM_ (te_Expr.hintlessCmm) es
te_Stmt (CmmCondBranch e _) = te_Expr e
te_Stmt (CmmSwitch e _) = te_Expr e
te_Stmt (CmmJump e _) = te_Expr e
te_Stmt (CmmJump e) = te_Expr e
te_Stmt _ = return ()
te_Expr :: CmmExpr -> TE ()
......
This diff is collapsed.
......@@ -4,34 +4,27 @@
--
-- CgCallConv
--
-- The datatypes and functions here encapsulate the
-- The datatypes and functions here encapsulate the
-- calling and return conventions used by the code generator.
--
-----------------------------------------------------------------------------
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module CgCallConv (
-- Argument descriptors
mkArgDescr,
-- Argument descriptors
mkArgDescr,
-- Liveness
mkRegLiveness,
-- Liveness
mkRegLiveness,
-- Register assignment
assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
-- Register assignment
assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
-- Calls
constructSlowCall, slowArgs, slowCallPattern,
-- Calls
constructSlowCall, slowArgs, slowCallPattern,
-- Returns
dataReturnConvPrim,
getSequelAmode
-- Returns
dataReturnConvPrim,
getSequelAmode
) where
import CgMonad
......@@ -57,11 +50,11 @@ import Data.Bits
-------------------------------------------------------------------------
--
-- Making argument descriptors
-- Making argument descriptors
--
-- An argument descriptor describes the layout of args on the stack,
-- both for * GC (stack-layout) purposes, and
-- * saving/restoring registers when a heap-check fails
-- both for * GC (stack-layout) purposes, and
-- * saving/restoring registers when a heap-check fails
--
-- Void arguments aren't important, therefore (contrast constructSlowCall)
--
......@@ -72,29 +65,29 @@ import Data.Bits
-------------------------
mkArgDescr :: Name -> [Id] -> FCode ArgDescr
mkArgDescr _nm args
mkArgDescr _nm args
= case stdPattern arg_reps of
Just spec_id -> return (ArgSpec spec_id)
Nothing -> return (ArgGen arg_bits)
Just spec_id -> return (ArgSpec spec_id)
Nothing -> return (ArgGen arg_bits)
where
arg_bits = argBits arg_reps
arg_reps = filter nonVoidArg (map idCgRep args)
-- Getting rid of voids eases matching of standard patterns
-- Getting rid of voids eases matching of standard patterns
argBits :: [CgRep] -> [Bool] -- True for non-ptr, False for ptr
argBits [] = []
argBits :: [CgRep] -> [Bool] -- True for non-ptr, False for ptr
argBits [] = []
argBits (PtrArg : args) = False : argBits args
argBits (arg : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args
stdPattern :: [CgRep] -> Maybe StgHalfWord
stdPattern [] = Just ARG_NONE -- just void args, probably
stdPattern [] = Just ARG_NONE -- just void args, probably
stdPattern [PtrArg] = Just ARG_P
stdPattern [FloatArg] = Just ARG_F
stdPattern [DoubleArg] = Just ARG_D
stdPattern [LongArg] = Just ARG_L
stdPattern [NonPtrArg] = Just ARG_N
stdPattern [NonPtrArg,NonPtrArg] = Just ARG_NN
stdPattern [NonPtrArg,PtrArg] = Just ARG_NP
stdPattern [PtrArg,NonPtrArg] = Just ARG_PN
......@@ -103,13 +96,13 @@ stdPattern [PtrArg,PtrArg] = Just ARG_PP
stdPattern [NonPtrArg,NonPtrArg,NonPtrArg] = Just ARG_NNN
stdPattern [NonPtrArg,NonPtrArg,PtrArg] = Just ARG_NNP
stdPattern [NonPtrArg,PtrArg,NonPtrArg] = Just ARG_NPN
stdPattern [NonPtrArg,PtrArg,PtrArg] = Just ARG_NPP
stdPattern [NonPtrArg,PtrArg,PtrArg] = Just ARG_NPP
stdPattern [PtrArg,NonPtrArg,NonPtrArg] = Just ARG_PNN
stdPattern [PtrArg,NonPtrArg,PtrArg] = Just ARG_PNP
stdPattern [PtrArg,PtrArg,NonPtrArg] = Just ARG_PPN
stdPattern [PtrArg,PtrArg,PtrArg] = Just ARG_PPP
stdPattern [PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPP
stdPattern [PtrArg,NonPtrArg,PtrArg] = Just ARG_PNP
stdPattern [PtrArg,PtrArg,NonPtrArg] = Just ARG_PPN
stdPattern [PtrArg,PtrArg,PtrArg] = Just ARG_PPP
stdPattern [PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPP
stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPP
stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPPP
stdPattern _ = Nothing
......@@ -117,17 +110,17 @@ stdPattern _ = Nothing
-------------------------------------------------------------------------
--
-- Bitmap describing register liveness
-- across GC when doing a "generic" heap check
-- (a RET_DYN stack frame).
-- Bitmap describing register liveness
-- across GC when doing a "generic" heap check
-- (a RET_DYN stack frame).
--
-- NB. Must agree with these macros (currently in StgMacros.h):
-- NB. Must agree with these macros (currently in StgMacros.h):
-- GET_NON_PTRS(), GET_PTRS(), GET_LIVENESS().
-------------------------------------------------------------------------