+++ /dev/null
-// -----------------------------------------------------------------------------
-// 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
-
+++ /dev/null
-// -----------------------------------------------------------------------------
-// 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 <stdio.h>
-
-// ----------------------------------------------------------------------------
-// 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; i<Words; i++) {
- Sp[i] = (W_) *p++;
- }
-
- // Off we go!
- TICK_ENT_VIA_NODE();
-
-#ifdef NO_ARG_REGS
- JMP_(GET_ENTRY(R1.cl));
-#else
- {
- StgFunInfoTable *info;
- info = get_fun_itbl(R1.cl);
- if (info->fun_type == ARG_GEN || info->fun_type == ARG_GEN_BIG) {
- JMP_(info->slow_apply);
- } else {
- JMP_(stg_ap_stack_entries[info->fun_type]);
- }
- }
-#endif
- FE_
-}