X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FApply.cmm;h=f9ac3b353c385bbe4af3c4cf3e143902330fce97;hp=e0ca03944cc1c4e7fa9dec54b0931b4783b3f842;hb=e5c3b478b3cd1707cf122833822f44b2ac09b8e9;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1 diff --git a/rts/Apply.cmm b/rts/Apply.cmm index e0ca039..f9ac3b3 100644 --- a/rts/Apply.cmm +++ b/rts/Apply.cmm @@ -30,9 +30,7 @@ stg_ap_0_fast foreign "C" printClosure(R1 "ptr") [R1]); IF_DEBUG(sanity, - foreign "C" checkStackChunk(Sp "ptr", - CurrentTSO + TSO_OFFSET_StgTSO_stack + - WDS(TO_W_(StgTSO_stack_size(CurrentTSO))) "ptr") [R1]); + foreign "C" checkStackFrame(Sp "ptr") [R1]); ENTER(); } @@ -58,7 +56,7 @@ stg_ap_0_fast -------------------------------------------------------------------------- */ INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP") -{ foreign "C" barf("PAP object entered!"); } +{ foreign "C" barf("PAP object entered!") never returns; } stg_PAP_apply { @@ -90,8 +88,6 @@ stg_PAP_apply // Enter PAP cost centre ENTER_CCS_PAP_CL(pap); - R1 = StgPAP_fun(pap); - // Reload the stack W_ i; W_ p; @@ -105,14 +101,30 @@ for: goto for; } + R1 = StgPAP_fun(pap); + +/* DEBUGGING CODE, ensures that arity 1 and 2 functions are entered tagged + if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 1 ) { + if (GETTAG(R1)!=1) { + W_[0]=1; + } + } + + if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 2 ) { + if (GETTAG(R1)!=2) { + W_[0]=1; + } + } +*/ + // Off we go! TICK_ENT_VIA_NODE(); #ifdef NO_ARG_REGS - jump %GET_ENTRY(R1); + jump %GET_ENTRY(UNTAG(R1)); #else W_ info; - info = %GET_FUN_INFO(R1); + info = %GET_FUN_INFO(UNTAG(R1)); W_ type; type = TO_W_(StgFunInfoExtra_fun_type(info)); if (type == ARG_GEN) { @@ -167,8 +179,76 @@ INFO_TABLE(stg_AP,/*special layout*/0,0,AP,"AP","AP") // Enter PAP cost centre ENTER_CCS_PAP_CL(ap); // ToDo: ENTER_CC_AP_CL + // Reload the stack + W_ i; + W_ p; + p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload; + i = 0; +for: + if (i < Words) { + Sp(i) = W_[p]; + p = p + WDS(1); + i = i + 1; + goto for; + } + R1 = StgAP_fun(ap); + // Off we go! + TICK_ENT_VIA_NODE(); + +#ifdef NO_ARG_REGS + jump %GET_ENTRY(UNTAG(R1)); +#else + W_ info; + info = %GET_FUN_INFO(UNTAG(R1)); + W_ type; + type = TO_W_(StgFunInfoExtra_fun_type(info)); + if (type == ARG_GEN) { + jump StgFunInfoExtra_slow_apply(info); + } + if (type == ARG_GEN_BIG) { + jump StgFunInfoExtra_slow_apply(info); + } + if (type == ARG_BCO) { + Sp_adj(-2); + Sp(1) = R1; + Sp(0) = stg_apply_interp_info; + jump stg_yield_to_interpreter; + } + jump W_[stg_ap_stack_entries + + WDS(TO_W_(StgFunInfoExtra_fun_type(info)))]; +#endif +} + +/* AP_NOUPD is exactly like AP, except that no update frame is pushed. + Use for thunks that are guaranteed to be entered once only, such as + those generated by the byte-code compiler for inserting breakpoints. */ + +INFO_TABLE(stg_AP_NOUPD,/*special layout*/0,0,AP,"AP_NOUPD","AP_NOUPD") +{ + W_ Words; + W_ ap; + + ap = R1; + + Words = TO_W_(StgAP_n_args(ap)); + + /* + * Check for stack overflow. IMPORTANT: use a _NP check here, + * because if the check fails, we might end up blackholing this very + * closure, in which case we must enter the blackhole on return rather + * than continuing to evaluate the now-defunct closure. + */ + STK_CHK_NP(WDS(Words)); + Sp = Sp - WDS(Words); + + TICK_ENT_AP(); + LDV_ENTER(ap); + + // Enter PAP cost centre + ENTER_CCS_PAP_CL(ap); // ToDo: ENTER_CC_AP_CL + // Reload the stack W_ i; W_ p; @@ -182,14 +262,16 @@ for: goto for; } + R1 = StgAP_fun(ap); + // Off we go! TICK_ENT_VIA_NODE(); #ifdef NO_ARG_REGS - jump %GET_ENTRY(R1); + jump %GET_ENTRY(UNTAG(R1)); #else W_ info; - info = %GET_FUN_INFO(R1); + info = %GET_FUN_INFO(UNTAG(R1)); W_ type; type = TO_W_(StgFunInfoExtra_fun_type(info)); if (type == ARG_GEN) { @@ -235,7 +317,9 @@ INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK") * closure, in which case we must enter the blackhole on return rather * than continuing to evaluate the now-defunct closure. */ - STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame); + STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame + WDS(AP_STACK_SPLIM)); + /* ensure there is at least AP_STACK_SPLIM words of headroom available + * after unpacking the AP_STACK. See bug #1466 */ PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1); Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words); @@ -246,8 +330,59 @@ INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK") // Enter PAP cost centre ENTER_CCS_PAP_CL(ap); // ToDo: ENTER_CC_AP_CL + // Reload the stack + W_ i; + W_ p; + p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload; + i = 0; +for: + if (i < Words) { + Sp(i) = W_[p]; + p = p + WDS(1); + i = i + 1; + goto for; + } + + // Off we go! + TICK_ENT_VIA_NODE(); + R1 = StgAP_STACK_fun(ap); + ENTER(); +} + +/* ----------------------------------------------------------------------------- + AP_STACK_NOUPD - exactly like AP_STACK, but doesn't push an update frame. + -------------------------------------------------------------------------- */ + +INFO_TABLE(stg_AP_STACK_NOUPD,/*special layout*/0,0,AP_STACK, + "AP_STACK_NOUPD","AP_STACK_NOUPD") +{ + W_ Words; + W_ ap; + + ap = R1; + + Words = StgAP_STACK_size(ap); + + /* + * Check for stack overflow. IMPORTANT: use a _NP check here, + * because if the check fails, we might end up blackholing this very + * closure, in which case we must enter the blackhole on return rather + * than continuing to evaluate the now-defunct closure. + */ + STK_CHK_NP(WDS(Words) + WDS(AP_STACK_SPLIM)); + /* ensure there is at least AP_STACK_SPLIM words of headroom available + * after unpacking the AP_STACK. See bug #1466 */ + + Sp = Sp - WDS(Words); + + TICK_ENT_AP(); + LDV_ENTER(ap); + + // Enter PAP cost centre + ENTER_CCS_PAP_CL(ap); // ToDo: ENTER_CC_AP_CL + // Reload the stack W_ i; W_ p; @@ -264,5 +399,7 @@ for: // Off we go! TICK_ENT_VIA_NODE(); + R1 = StgAP_STACK_fun(ap); + ENTER(); }