X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCgCallConv.hs;h=60f25d0686922541d82f16ddcdaf1b3ee5fc913d;hp=351375d1e4e5e64010f3c6de363b4e4af9155e79;hb=984a288119983912d40a80845c674ee4b83a19ce;hpb=6e232f498ba600e7d7cc4938f5f2e6ce5d300bbc diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs index 351375d..60f25d0 100644 --- a/compiler/codeGen/CgCallConv.hs +++ b/compiler/codeGen/CgCallConv.hs @@ -209,7 +209,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) @@ -227,28 +227,28 @@ slowArgs amodes = (NonPtrArg, mkLblExpr stg_ap_pat) : args ++ slowArgs rest stg_ap_pat = mkRtsRetInfoLabel 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" ------------------------------------------------------------------------- --