Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : simd
http://hackage.haskell.org/trac/ghc/changeset/d4c7d6accd94f357808e94a8868acb59cbd1c1f7 >--------------------------------------------------------------- commit d4c7d6accd94f357808e94a8868acb59cbd1c1f7 Author: Geoffrey Mainland <[email protected]> Date: Mon Nov 14 16:23:58 2011 +0000 Implement slow calls for vectors. Add implementation of slow calls for vectors with a size of 16 bytes. This covers all the primitive vector type we've implemented so far. >--------------------------------------------------------------- compiler/codeGen/CgCallConv.hs | 21 ++++++++++++------ compiler/codeGen/StgCmmLayout.hs | 18 +++++++++------ includes/rts/storage/FunTypes.h | 35 +++++++++++++++-------------- utils/genapply/GenApply.hs | 44 +++++++++++++++++++++++-------------- 4 files changed, 70 insertions(+), 48 deletions(-) diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs index fbf9c01..6941422 100644 --- a/compiler/codeGen/CgCallConv.hs +++ b/compiler/codeGen/CgCallConv.hs @@ -43,7 +43,8 @@ import CLabel import Constants import CgStackery -import ClosureInfo( CgRep(..), nonVoidArg, idCgRep, cgRepSizeW, isFollowableArg ) +import ClosureInfo( CgRep(..), argMachRep, nonVoidArg, idCgRep, + cgRepSizeB, cgRepSizeW, isFollowableArg ) import OldCmmUtils import Maybes import Id @@ -89,11 +90,13 @@ argBits (arg : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args stdPattern :: [CgRep] -> Maybe StgHalfWord 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 [PtrArg] = Just ARG_P +stdPattern [FloatArg] = Just ARG_F +stdPattern [DoubleArg] = Just ARG_D +stdPattern [LongArg] = Just ARG_L +stdPattern [arg@(VecArg {})] + | cgRepSizeB arg == 16 = Just ARG_X16 +stdPattern [NonPtrArg] = Just ARG_N stdPattern [NonPtrArg,NonPtrArg] = Just ARG_NN stdPattern [NonPtrArg,PtrArg] = Just ARG_NP @@ -200,7 +203,11 @@ slowCallPattern (NonPtrArg: _) = (fsLit "stg_ap_n", 1) slowCallPattern (FloatArg: _) = (fsLit "stg_ap_f", 1) slowCallPattern (DoubleArg: _) = (fsLit "stg_ap_d", 1) slowCallPattern (LongArg: _) = (fsLit "stg_ap_l", 1) -slowCallPattern _ = panic "CgStackery.slowCallPattern" +slowCallPattern (arg@VecArg {}: _) = (fsLit slowCallName, 1) + where + slowCallName :: String + slowCallName = "stg_ap_x" ++ (show . cgRepSizeB) arg +slowCallPattern _ = panic "CgCallConv.slowCallPattern" ------------------------------------------------------------------------- -- diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index a69aab9..5e2de7e 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -202,7 +202,10 @@ slowCallPattern (N: _) = (fsLit "stg_ap_n", 1) slowCallPattern (F: _) = (fsLit "stg_ap_f", 1) slowCallPattern (D: _) = (fsLit "stg_ap_d", 1) slowCallPattern (L: _) = (fsLit "stg_ap_l", 1) -slowCallPattern (X {} : _) = error "No slow call pattern for vector" +slowCallPattern (X len : _) = (fsLit slowCallName, 1) + where + slowCallName :: String + slowCallName = "stg_ap_x" ++ show len slowCallPattern [] = (fsLit "stg_ap_0", 0) @@ -346,12 +349,13 @@ argBits (arg : args) = take (argRepSizeW arg) (repeat True) ++ argBits args stdPattern :: [ArgRep] -> Maybe StgHalfWord stdPattern reps = case reps of - [] -> Just ARG_NONE -- just void args, probably - [N] -> Just ARG_N - [P] -> Just ARG_P - [F] -> Just ARG_F - [D] -> Just ARG_D - [L] -> Just ARG_L + [] -> Just ARG_NONE -- just void args, probably + [N] -> Just ARG_N + [P] -> Just ARG_P + [F] -> Just ARG_F + [D] -> Just ARG_D + [L] -> Just ARG_L + [X 16] -> Just ARG_X16 [N,N] -> Just ARG_NN [N,P] -> Just ARG_NP diff --git a/includes/rts/storage/FunTypes.h b/includes/rts/storage/FunTypes.h index b443667..b76bc7a 100644 --- a/includes/rts/storage/FunTypes.h +++ b/includes/rts/storage/FunTypes.h @@ -33,22 +33,23 @@ #define ARG_F 6 #define ARG_D 7 #define ARG_L 8 -#define ARG_NN 9 -#define ARG_NP 10 -#define ARG_PN 11 -#define ARG_PP 12 -#define ARG_NNN 13 -#define ARG_NNP 14 -#define ARG_NPN 15 -#define ARG_NPP 16 -#define ARG_PNN 17 -#define ARG_PNP 18 -#define ARG_PPN 19 -#define ARG_PPP 20 -#define ARG_PPPP 21 -#define ARG_PPPPP 22 -#define ARG_PPPPPP 23 -#define ARG_PPPPPPP 24 -#define ARG_PPPPPPPP 25 +#define ARG_X16 9 +#define ARG_NN 10 +#define ARG_NP 11 +#define ARG_PN 12 +#define ARG_PP 13 +#define ARG_NNN 14 +#define ARG_NNP 15 +#define ARG_NPN 16 +#define ARG_NPP 17 +#define ARG_PNN 18 +#define ARG_PNP 19 +#define ARG_PPN 20 +#define ARG_PPP 21 +#define ARG_PPPP 22 +#define ARG_PPPPP 23 +#define ARG_PPPPPP 24 +#define ARG_PPPPPPP 25 +#define ARG_PPPPPPPP 26 #endif /* RTS_STORAGE_FUNTYPES_H */ diff --git a/utils/genapply/GenApply.hs b/utils/genapply/GenApply.hs index 2ffa81b..989c4fc 100644 --- a/utils/genapply/GenApply.hs +++ b/utils/genapply/GenApply.hs @@ -32,23 +32,26 @@ data ArgRep | F -- float | D -- double | L -- long (64-bit) + | X Int -- vectors (n-bytes) -- size of a value in *words* argSize :: ArgRep -> Int -argSize N = 1 -argSize P = 1 -argSize V = 0 -argSize F = 1 -argSize D = (SIZEOF_DOUBLE `quot` SIZEOF_VOID_P :: Int) -argSize L = (8 `quot` SIZEOF_VOID_P :: Int) - -showArg :: ArgRep -> Char -showArg N = 'n' -showArg P = 'p' -showArg V = 'v' -showArg F = 'f' -showArg D = 'd' -showArg L = 'l' +argSize N = 1 +argSize P = 1 +argSize V = 0 +argSize F = 1 +argSize D = (SIZEOF_DOUBLE `quot` SIZEOF_VOID_P :: Int) +argSize L = (8 `quot` SIZEOF_VOID_P :: Int) +argSize (X n) = (n `quot` SIZEOF_VOID_P :: Int) + +showArg :: ArgRep -> String +showArg N = "n" +showArg P = "p" +showArg V = "v" +showArg F = "f" +showArg D = "d" +showArg L = "l" +showArg (X n) = "x" ++ show n -- is a value a pointer? isPtr :: ArgRep -> Bool @@ -162,7 +165,7 @@ mkBitmap args = foldr f 0 args -- when we start passing args to stg_ap_* in regs). mkApplyName args - = text "stg_ap_" <> text (map showArg args) + = text "stg_ap_" <> text (concatMap showArg args) mkApplyRetName args = mkApplyName args <> text "_ret" @@ -726,7 +729,7 @@ genApplyFast regstatus args = -- void arguments. mkStackApplyEntryLabel:: [ArgRep] -> Doc -mkStackApplyEntryLabel args = text "stg_ap_stk_" <> text (map showArg args) +mkStackApplyEntryLabel args = text "stg_ap_stk_" <> text (concatMap showArg args) genStackApply :: RegStatus -> [ArgRep] -> Doc genStackApply regstatus args = @@ -751,7 +754,7 @@ genStackApply regstatus args = -- in HeapStackCheck.hc for more details. mkStackSaveEntryLabel :: [ArgRep] -> Doc -mkStackSaveEntryLabel args = text "stg_stk_save_" <> text (map showArg args) +mkStackSaveEntryLabel args = text "stg_stk_save_" <> text (concatMap showArg args) genStackSave :: RegStatus -> [ArgRep] -> Doc genStackSave regstatus args = @@ -817,6 +820,7 @@ applyTypes = [ [F], [D], [L], + [X 16], [N], [P], [P,V], @@ -833,6 +837,11 @@ applyTypes = [ -- ToDo: the stack apply and stack save code doesn't make a distinction -- between N and P (they both live in the same register), only the bitmap -- changes, so we could share the apply/save code between lots of cases. +-- +-- NOTE: other places to change if you change stackApplyTypes: +-- - includes/rts/storage/FunTypes.h +-- - compiler/codeGen/CgCallConv.lhs: stdPattern +-- - compiler/codeGen/StgCmmLayout.hs: stdPattern stackApplyTypes = [ [], [N], @@ -840,6 +849,7 @@ stackApplyTypes = [ [F], [D], [L], + [X 16], [N,N], [N,P], [P,N], _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
