X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FcodeGen%2FCgCallConv.hs;h=b8294ea326de471f329d8e593872f4ae273377a9;hb=5d52d9b64c21dcf77849866584744722f8121389;hp=5fa0a85dcfd81d459db634b0fb717c4f2ee6e7b2;hpb=e5e7d10bb9fc69e58a78540a4a4bf34124730f48;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs index 5fa0a85..b8294ea 100644 --- a/compiler/codeGen/CgCallConv.hs +++ b/compiler/codeGen/CgCallConv.hs @@ -45,6 +45,7 @@ import Name import Bitmap import Util import StaticFlags +import Module import FastString import Outputable import Unique @@ -64,7 +65,7 @@ import Data.Bits ------------------------------------------------------------------------- -- bring in ARG_P, ARG_N, etc. -#include "../includes/StgFun.h" +#include "../includes/rts/storage/FunTypes.h" ------------------------- argDescrType :: ArgDescr -> StgHalfWord @@ -209,7 +210,7 @@ constructSlowCall -- don't forget the zero case constructSlowCall [] - = (mkRtsApFastLabel (sLit "stg_ap_0"), [], []) + = (mkRtsApFastLabel (fsLit "stg_ap_0"), [], []) constructSlowCall amodes = (stg_ap_pat, these, rest) @@ -224,31 +225,31 @@ slowArgs :: [(CgRep,CmmExpr)] -> [(CgRep,CmmExpr)] slowArgs [] = [] slowArgs amodes = (NonPtrArg, mkLblExpr stg_ap_pat) : args ++ slowArgs rest where (arg_pat, args, rest) = matchSlowPattern amodes - stg_ap_pat = mkRtsRetInfoLabel arg_pat + stg_ap_pat = mkCmmRetInfoLabel rtsPackageId arg_pat matchSlowPattern :: [(CgRep,CmmExpr)] - -> (LitString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)]) + -> (FastString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)]) matchSlowPattern amodes = (arg_pat, these, rest) where (arg_pat, n) = slowCallPattern (map fst amodes) (these, rest) = splitAt n amodes -- These cases were found to cover about 99% of all slow calls: -slowCallPattern :: [CgRep] -> (LitString, Int) -slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_pppppp", 6) -slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_ppppp", 5) -slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_pppp", 4) -slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _) = (sLit "stg_ap_pppv", 4) -slowCallPattern (PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_ppp", 3) -slowCallPattern (PtrArg: PtrArg: VoidArg: _) = (sLit "stg_ap_ppv", 3) -slowCallPattern (PtrArg: PtrArg: _) = (sLit "stg_ap_pp", 2) -slowCallPattern (PtrArg: VoidArg: _) = (sLit "stg_ap_pv", 2) -slowCallPattern (PtrArg: _) = (sLit "stg_ap_p", 1) -slowCallPattern (VoidArg: _) = (sLit "stg_ap_v", 1) -slowCallPattern (NonPtrArg: _) = (sLit "stg_ap_n", 1) -slowCallPattern (FloatArg: _) = (sLit "stg_ap_f", 1) -slowCallPattern (DoubleArg: _) = (sLit "stg_ap_d", 1) -slowCallPattern (LongArg: _) = (sLit "stg_ap_l", 1) -slowCallPattern _ = panic "CgStackery.slowCallPattern" +slowCallPattern :: [CgRep] -> (FastString, Int) +slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_pppppp", 6) +slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_ppppp", 5) +slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_pppp", 4) +slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _) = (fsLit "stg_ap_pppv", 4) +slowCallPattern (PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_ppp", 3) +slowCallPattern (PtrArg: PtrArg: VoidArg: _) = (fsLit "stg_ap_ppv", 3) +slowCallPattern (PtrArg: PtrArg: _) = (fsLit "stg_ap_pp", 2) +slowCallPattern (PtrArg: VoidArg: _) = (fsLit "stg_ap_pv", 2) +slowCallPattern (PtrArg: _) = (fsLit "stg_ap_p", 1) +slowCallPattern (VoidArg: _) = (fsLit "stg_ap_v", 1) +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" ------------------------------------------------------------------------- -- @@ -283,7 +284,6 @@ getSequelAmode OnStack -> do { sp_rel <- getSpRelOffset virt_sp ; returnFC (CmmLoad sp_rel bWord) } - UpdateCode -> returnFC (CmmLit (CmmLabel mkUpdInfoLabel)) CaseAlts lbl _ _ -> returnFC (CmmLit (CmmLabel lbl)) }