From: simonmar Date: Thu, 21 Nov 2002 11:27:05 +0000 (+0000) Subject: [project @ 2002-11-21 11:27:05 by simonmar] X-Git-Tag: Approx_11550_changesets_converted~1412 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=49c120b93b0688863d46582eee6b20bfbed6c077;p=ghc-hetmet.git [project @ 2002-11-21 11:27:05 by simonmar] these files should be on eval-apply-branch --- diff --git a/ghc/rts/Apply.h b/ghc/rts/Apply.h deleted file mode 100644 index fe41341..0000000 --- a/ghc/rts/Apply.h +++ /dev/null @@ -1,72 +0,0 @@ -// ----------------------------------------------------------------------------- -// Apply.h -// -// (c) The University of Glasgow 2002 -// -// Helper bits for the generic apply code (AutoApply.hc) -// ----------------------------------------------------------------------------- - -#ifndef APPLY_H -#define APPLY_H - -// Build a new PAP: function is in R1,p -// ret addr and m arguments taking up n words are on the stack. -#define BUILD_PAP(m,n,f) \ - { \ - StgPAP *pap; \ - nat size, i; \ - TICK_SLOW_CALL_BUILT_PAP(); \ - size = PAP_sizeW(n); \ - HP_CHK_NP(size, Sp[0] = f;); \ - TICK_ALLOC_PAP(n, 0); \ - pap = (StgPAP *) (Hp + 1 - size); \ - SET_HDR(pap, &stg_PAP_info, CCCS); \ - pap->arity = arity - m; \ - pap->fun = R1.cl; \ - pap->n_args = n; \ - for (i = 0; i < n; i++) { \ - pap->payload[i] = (StgClosure *)Sp[1+i]; \ - } \ - R1.p = (P_)pap; \ - Sp += 1 + n; \ - JMP_(ENTRY_CODE(Sp[0])); \ - } - -// Copy the old PAP, build a new one with the extra arg(s) -// ret addr and m arguments taking up n words are on the stack. -#define NEW_PAP(m,n,f) \ - { \ - StgPAP *pap, *new_pap; \ - nat size, i; \ - TICK_SLOW_CALL_NEW_PAP(); \ - pap = (StgPAP *)R1.p; \ - size = PAP_sizeW(pap->n_args + n); \ - HP_CHK_NP(size, Sp[0] = f;); \ - TICK_ALLOC_PAP(n, 0); \ - new_pap = (StgPAP *) (Hp + 1 - size); \ - SET_HDR(new_pap, &stg_PAP_info, CCCS); \ - new_pap->arity = arity - m; \ - new_pap->n_args = pap->n_args + n; \ - new_pap->fun = pap->fun; \ - for (i = 0; i < pap->n_args; i++) { \ - new_pap->payload[i] = pap->payload[i]; \ - } \ - for (i = 0; i < n; i++) { \ - new_pap->payload[pap->n_args+i] = (StgClosure *)Sp[1+i]; \ - } \ - R1.p = (P_)new_pap; \ - Sp += n+1; \ - JMP_(ENTRY_CODE(Sp[0])); \ - } - -// canned slow entry points, indexed by arg type (ARG_P, ARG_PP, etc.) -extern StgFun * stg_ap_stack_entries[]; - -// canned register save code for heap check failure in a function -extern StgFun * stg_stack_save_entries[]; - -// canned bitmap for each arg type -extern StgWord stg_arg_bitmaps[]; - -#endif // APPLY_H - diff --git a/ghc/rts/Apply.hc b/ghc/rts/Apply.hc deleted file mode 100644 index 39ca488..0000000 --- a/ghc/rts/Apply.hc +++ /dev/null @@ -1,131 +0,0 @@ -// ----------------------------------------------------------------------------- -// Apply.hc -// -// (c) The University of Glasgow 2002 -// -// Application-related bits. -// -// ----------------------------------------------------------------------------- - -#include "Stg.h" -#include "Rts.h" -#include "RtsFlags.h" -#include "Storage.h" -#include "RtsUtils.h" -#include "Printer.h" -#include "Sanity.h" -#include "Apply.h" - -#include - -// ---------------------------------------------------------------------------- -// Evaluate a closure and return it. -// -// stg_ap_0_info <--- Sp -// -// NOTE: this needs to be a polymorphic return point, because we can't -// be sure that the thing being evaluated is not a function. - -// These names are just to keep VEC_POLY_INFO_TABLE() happy - all the -// entry points in the polymorphic info table point to the same code. -#define stg_ap_0_0_ret stg_ap_0_ret -#define stg_ap_0_1_ret stg_ap_0_ret -#define stg_ap_0_2_ret stg_ap_0_ret -#define stg_ap_0_3_ret stg_ap_0_ret -#define stg_ap_0_4_ret stg_ap_0_ret -#define stg_ap_0_5_ret stg_ap_0_ret -#define stg_ap_0_6_ret stg_ap_0_ret -#define stg_ap_0_7_ret stg_ap_0_ret - -VEC_POLY_INFO_TABLE(stg_ap_0, - MK_SMALL_BITMAP(0/*framsize*/, 0/*bitmap*/), - 0,0,0,RET_SMALL,,EF_); -F_ -stg_ap_0_ret(void) -{ - // fn is in R1, no args on the stack - StgInfoTable *info; - nat arity; - FB_; - - IF_DEBUG(apply,fprintf(stderr, "stg_ap_0_ret... "); printClosure(R1.cl)); - IF_DEBUG(sanity,checkStackChunk(Sp+1,CurrentTSO->stack + CurrentTSO->stack_size)); - - Sp++; - ENTER(); - FE_ -} - -/* ----------------------------------------------------------------------------- - Entry Code for a PAP. - - This entry code is *only* called by one of the stg_ap functions. - On entry: Sp points to the remaining arguments on the stack. If - the stack check fails, we can just push the PAP on the stack and - return to the scheduler. - - On entry: R1 points to the PAP. The rest of the function's arguments - (*all* of 'em) are on the stack, starting at Sp[0]. - - The idea is to copy the chunk of stack from the PAP object onto the - stack / into registers, and enter the function. - -------------------------------------------------------------------------- */ - -INFO_TABLE(stg_PAP_info,stg_PAP_entry,/*special layout*/0,0,PAP,,EF_,"PAP","PAP"); -STGFUN(stg_PAP_entry) -{ - nat Words; - StgPtr p; - nat i; - StgPAP *pap; - FB_ - - pap = (StgPAP *) R1.p; - - Words = pap->n_args; - - // Check for stack overflow and bump the stack pointer. - // We have a hand-rolled stack check fragment here, because none of - // the canned ones suit this situation. - if ((Sp - Words) < SpLim) { - DEBUG_ONLY(fprintf(stderr,"PAP STACK CHECK!\n")); - // there is a return address on the stack in the event of a - // stack check failure. The various stg_apply functions arrange - // this before calling stg_PAP_entry. - JMP_(stg_gc_unpt_r1); - } - // Sp is already pointing one word below the arguments... - Sp -= Words-1; - - // profiling - TICK_ENT_PAP(pap); - LDV_ENTER(pap); - // Enter PAP cost centre -- lexical scoping only - ENTER_CCS_PAP_CL(pap); - - R1.cl = pap->fun; - p = (P_)(pap->payload); - - // Reload the stack - for (i=0; ifun_type == ARG_GEN || info->fun_type == ARG_GEN_BIG) { - JMP_(info->slow_apply); - } else { - JMP_(stg_ap_stack_entries[info->fun_type]); - } - } -#endif - FE_ -}