/* -----------------------------------------------------------------------------
- * $Id: Regs.h,v 1.9 2000/03/23 17:45:31 simonpj Exp $
+ * $Id: Regs.h,v 1.10 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
StgClosure **tl;
} StgSparkPool;
+typedef struct {
+ StgFunPtr stgChk0;
+ StgFunPtr stgChk1;
+ StgFunPtr stgGCEnter1;
+ StgFunPtr stgUpdatePAP;
+} StgFunTable;
+
typedef struct StgRegTable_ {
StgUnion rR1;
StgUnion rR2;
StgUnion rR6;
StgUnion rR7;
StgUnion rR8;
- StgUnion rR9; /* used occasionally by heap/stack checks */
- StgUnion rR10; /* used occasionally by heap/stack checks */
+ StgUnion rR9; // used occasionally by heap/stack checks
+ StgUnion rR10; // used occasionally by heap/stack checks
StgFloat rF1;
StgFloat rF2;
StgFloat rF3;
StgTSO *rCurrentTSO;
struct _bdescr *rNursery;
struct _bdescr *rCurrentNursery;
+ StgWord rHpAlloc; // number of words being allocated in heap
#if defined(SMP) || defined(PAR)
- StgSparkPool rSparks; /* per-task spark pool */
+ StgSparkPool rSparks; // per-task spark pool
#endif
#if defined(SMP)
- struct StgRegTable_ *link; /* per-task register tables are linked together */
+ struct StgRegTable_ *link; // per-task register tables are linked together
#endif
} StgRegTable;
+
+/* A capability is a combination of a FunTable and a RegTable. In STG
+ * code, BaseReg normally points to the RegTable portion of this
+ * structure, so that we can index both forwards and backwards to take
+ * advantage of shorter instruction forms on some archs (eg. x86).
+ */
+typedef struct {
+ StgFunTable f;
+ StgRegTable r;
+} Capability;
+
/* No such thing as a MainRegTable under SMP - each thread must
* have its own MainRegTable.
*/
#ifndef SMP
-extern DLL_IMPORT_RTS StgRegTable MainRegTable;
+extern DLL_IMPORT_RTS Capability MainCapability;
#endif
#if IN_STG_CODE
#define SAVE_CurrentTSO (BaseReg->rCurrentTSO)
#define SAVE_CurrentNursery (BaseReg->rCurrentNursery)
+#define SAVE_HpAlloc (BaseReg->rHpAlloc)
#if defined(SMP) || defined(PAR)
#define SAVE_SparkHd (BaseReg->rSparks.hd)
#define SAVE_SparkTl (BaseReg->rSparks.tl)
#ifdef SMP
#error BaseReg must be in a register for SMP
#endif
-#define BaseReg (&MainRegTable)
+#define BaseReg (&MainCapability.r)
#endif
#ifdef REG_Sp
#define CurrentNursery (BaseReg->rCurrentNursery)
#endif
+#ifdef REG_HpAlloc
+GLOBAL_REG_DECL(bdescr *,HpAlloc,REG_HpAlloc)
+#else
+#define HpAlloc (BaseReg->rHpAlloc)
+#endif
+
#ifdef REG_SparkHd
GLOBAL_REG_DECL(bdescr *,SparkHd,REG_SparkHd)
#else
#endif
/* -----------------------------------------------------------------------------
+ Get absolute function pointers from the register table, to save
+ code space. On x86,
+
+ jmp *-12(%ebx)
+
+ is shorter than
+
+ jmp absolute_address
+
+ as long as the offset is within the range of a signed byte
+ (-128..+127). So we pick some common absolute_addresses and put
+ them in the register table. As a bonus, linking time should also
+ be reduced.
+
+ Other possible candidates in order of importance:
+
+ stg_upd_frame_info
+ stg_CAF_BLACKHOLE_info
+ stg_IND_STATIC_info
+
+ anything else probably isn't worth the effort.
+
+ -------------------------------------------------------------------------- */
+
+
+#define FunReg ((StgFunTable *)((void *)BaseReg - sizeof(StgFunTable)))
+
+#define stg_chk_0 (FunReg->stgChk0)
+#define stg_chk_1 (FunReg->stgChk1)
+#define stg_gc_enter_1 (FunReg->stgGCEnter1)
+#define stg_update_PAP (FunReg->stgUpdatePAP)
+
+/* -----------------------------------------------------------------------------
For any registers which are denoted "caller-saves" by the C calling
convention, we have to emit code to save and restore them across C
calls.
#define CALLER_RESTORE_CurrentNursery /* nothing */
#endif
+#ifdef CALLER_SAVES_HpAlloc
+#define CALLER_SAVE_HpAlloc SAVE_HpAlloc = HpAlloc;
+#define CALLER_RESTORE_HpAlloc HpAlloc = SAVE_HpAlloc;
+#else
+#define CALLER_SAVE_HpAlloc /* nothing */
+#define CALLER_RESTORE_HpAlloc /* nothing */
+#endif
+
#ifdef CALLER_SAVES_SparkHd
#define CALLER_SAVE_SparkHd SAVE_SparkHd = SparkHd;
#define CALLER_RESTORE_SparkHd SparkHd = SAVE_SparkHd;
/* -----------------------------------------------------------------------------
- * $Id: StgMacros.h,v 1.38 2001/07/24 06:31:35 ken Exp $
+ * $Id: StgMacros.h,v 1.39 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#define STK_CHK(headroom,ret,r,layout,tag_assts) \
if (Sp - headroom < SpLim) { \
- EXTFUN_RTS(stg_chk_##layout); \
tag_assts \
(r) = (P_)ret; \
JMP_(stg_chk_##layout); \
#define HP_CHK(headroom,ret,r,layout,tag_assts) \
DO_GRAN_ALLOCATE(headroom) \
if ((Hp += headroom) > HpLim) { \
- EXTFUN_RTS(stg_chk_##layout); \
+ HpAlloc = (headroom); \
tag_assts \
(r) = (P_)ret; \
JMP_(stg_chk_##layout); \
#define HP_STK_CHK(stk_headroom,hp_headroom,ret,r,layout,tag_assts) \
DO_GRAN_ALLOCATE(hp_headroom) \
if (Sp - stk_headroom < SpLim || (Hp += hp_headroom) > HpLim) { \
- EXTFUN_RTS(stg_chk_##layout); \
+ HpAlloc = (hp_headroom); \
tag_assts \
(r) = (P_)ret; \
JMP_(stg_chk_##layout); \
#define STK_CHK_NP(headroom,ptrs,tag_assts) \
if ((Sp - (headroom)) < SpLim) { \
- EXTFUN_RTS(stg_gc_enter_##ptrs); \
tag_assts \
JMP_(stg_gc_enter_##ptrs); \
}
#define HP_CHK_NP(headroom,ptrs,tag_assts) \
DO_GRAN_ALLOCATE(headroom) \
if ((Hp += (headroom)) > HpLim) { \
- EXTFUN_RTS(stg_gc_enter_##ptrs); \
+ HpAlloc = (headroom); \
tag_assts \
JMP_(stg_gc_enter_##ptrs); \
}
#define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts) \
DO_GRAN_ALLOCATE(headroom) \
if ((Hp += (headroom)) > HpLim) { \
- EXTFUN_RTS(stg_gc_seq_##ptrs); \
+ HpAlloc = (headroom); \
tag_assts \
JMP_(stg_gc_seq_##ptrs); \
}
#define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \
DO_GRAN_ALLOCATE(hp_headroom) \
if ((Sp - (stk_headroom)) < SpLim || (Hp += (hp_headroom)) > HpLim) { \
- EXTFUN_RTS(stg_gc_enter_##ptrs); \
+ HpAlloc = (hp_headroom); \
tag_assts \
JMP_(stg_gc_enter_##ptrs); \
}
DO_GRAN_ALLOCATE(headroom) \
if ((Hp += (headroom)) > HpLim) { \
EXTFUN_RTS(lbl); \
+ HpAlloc = (headroom); \
tag_assts \
JMP_(lbl); \
}
#define HP_CHK_GEN(headroom,liveness,reentry,tag_assts) \
if ((Hp += (headroom)) > HpLim ) { \
- EXTFUN_RTS(stg_gen_chk); \
+ HpAlloc = (headroom); \
tag_assts \
R9.w = (W_)LIVENESS_MASK(liveness); \
R10.w = (W_)reentry; \
#define STK_CHK_GEN(headroom,liveness,reentry,tag_assts) \
if ((Sp - (headroom)) < SpLim) { \
- EXTFUN_RTS(stg_gen_chk); \
tag_assts \
R9.w = (W_)LIVENESS_MASK(liveness); \
R10.w = (W_)reentry; \
#define MAYBE_GC(liveness,reentry) \
if (doYouWantToGC()) { \
- EXTFUN_RTS(stg_gen_hp); \
R9.w = (W_)LIVENESS_MASK(liveness); \
R10.w = (W_)reentry; \
JMP_(stg_gen_hp); \
* Suspending/resuming threads for doing external C-calls (_ccall_GC).
* These functions are defined in rts/Schedule.c.
*/
-StgInt suspendThread ( StgRegTable *cap );
-StgRegTable * resumeThread ( StgInt );
+StgInt suspendThread ( Capability *cap );
+Capability * resumeThread ( StgInt );
#define SUSPEND_THREAD(token) \
SaveThreadState(); \
- token = suspendThread(BaseReg);
+ token = suspendThread((Capability *)((void *)BaseReg - sizeof(StgFunTable)));
#ifdef SMP
-#define RESUME_THREAD(token) \
- BaseReg = resumeThread(token); \
- LoadThreadState();
+#define RESUME_THREAD(token) \
+ { Capability c; \
+ c = resumeThread(token); \
+ BaseReg = &c.r; \
+ LoadThreadState(); \
+ }
#else
#define RESUME_THREAD(token) \
(void)resumeThread(token); \
/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.h,v 1.39 2001/07/09 19:45:16 sof Exp $
+ * $Id: StgMiscClosures.h,v 1.40 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
EXTINFO_RTS stg_ap_7_upd_info;
EXTINFO_RTS stg_ap_8_upd_info;
+/* standard GC & stack check entry points */
+
+EXTFUN(stg_gc_entertop);
+EXTFUN(stg_gc_enter_1_hponly);
+EXTFUN(__stg_gc_enter_1);
+EXTFUN(stg_gc_enter_2);
+EXTFUN(stg_gc_enter_3);
+EXTFUN(stg_gc_enter_4);
+EXTFUN(stg_gc_enter_5);
+EXTFUN(stg_gc_enter_6);
+EXTFUN(stg_gc_enter_7);
+EXTFUN(stg_gc_enter_8);
+EXTFUN(stg_gc_seq_1);
+
+EI_(stg_gc_noregs_ret_info);
+EF_(stg_gc_noregs);
+
+EI_(stg_gc_unpt_r1_ret_info);
+EF_(stg_gc_unpt_r1);
+
+EI_(stg_gc_unbx_r1_ret_info);
+EF_(stg_gc_unbx_r1);
+
+EI_(stg_gc_f1_ret_info);
+EF_(stg_gc_f1);
+
+EI_(stg_gc_d1_ret_info);
+EF_(stg_gc_d1);
+
+EI_(stg_gc_ut_1_0_ret_info);
+EF_(stg_gc_ut_1_0);
+
+EI_(stg_gc_ut_0_1_ret_info);
+EF_(stg_gc_ut_0_1);
+
+EXTFUN(__stg_chk_0);
+EXTFUN(__stg_chk_1);
+EXTFUN(stg_chk_1n);
+EXTFUN(stg_chk_2);
+EXTFUN(stg_chk_3);
+EXTFUN(stg_chk_4);
+EXTFUN(stg_chk_5);
+EXTFUN(stg_chk_6);
+EXTFUN(stg_chk_7);
+EXTFUN(stg_chk_8);
+EXTFUN(stg_gen_chk_ret);
+EXTFUN(stg_gen_chk);
+EXTFUN(stg_gen_hp);
+EXTFUN(stg_gen_yield);
+EXTFUN(stg_yield_noregs);
+EXTFUN(stg_yield_to_interpreter);
+EXTFUN(stg_gen_block);
+EXTFUN(stg_block_noregs);
+EXTFUN(stg_block_1);
+EXTFUN(stg_block_takemvar);
+EXTFUN(stg_block_putmvar);
+
/* -----------------------------------------------------------------------------
- * $Id: StgStorage.h,v 1.10 2001/07/24 16:36:44 simonmar Exp $
+ * $Id: StgStorage.h,v 1.11 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#define OpenNursery(hp,hplim) \
(hp = CurrentNursery->free-1, \
- hplim = CurrentNursery->start + BLOCK_SIZE_W - 1)
+ hplim = CurrentNursery->start + CurrentNursery->blocks*BLOCK_SIZE_W - 1)
#define CloseNursery(hp) (CurrentNursery->free = (P_)(hp)+1)
/* -----------------------------------------------------------------------------
- * $Id: Updates.h,v 1.24 2001/03/22 03:51:09 hwloidl Exp $
+ * $Id: Updates.h,v 1.25 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
Update-related prototypes
-------------------------------------------------------------------------- */
+EXTFUN_RTS(__stg_update_PAP);
+
DLL_IMPORT_RTS extern STGFUN(stg_upd_frame_entry);
extern DLL_IMPORT_RTS const StgInfoTable stg_PAP_info;
DLL_IMPORT_RTS STGFUN(stg_PAP_entry);
-EXTFUN_RTS(stg_update_PAP);
-
extern DLL_IMPORT_RTS const StgInfoTable stg_AP_UPD_info;
DLL_IMPORT_RTS STGFUN(stg_AP_UPD_entry);
/* --------------------------------------------------------------------------
- * $Id: mkNativeHdr.c,v 1.5 2000/08/17 14:30:26 simonmar Exp $
+ * $Id: mkNativeHdr.c,v 1.6 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1992-1998
*
#define OFFSET_HpLim OFFSET(RegTable, RegTable.rHpLim)
#define OFFSET_CurrentTSO OFFSET(RegTable, RegTable.rCurrentTSO)
#define OFFSET_CurrentNursery OFFSET(RegTable, RegTable.rCurrentNursery)
+#define OFFSET_HpAlloc OFFSET(RegTable, RegTable.rHpAlloc)
+
+#define FUN_OFFSET(sym) ((StgPtr)&cap.f.sym - (StgPtr)&cap.r)
+
+#define OFFSET_stgChk0 FUN_OFFSET(stgChk0)
+#define OFFSET_stgChk1 FUN_OFFSET(stgChk1)
+#define OFFSET_stgGCEnter1 FUN_OFFSET(stgGCEnter1)
+#define OFFSET_stgUpdatePAP FUN_OFFSET(stgUpdatePAP)
#define TSO_SP OFFSET(tso, tso.sp)
#define TSO_SU OFFSET(tso, tso.su)
#define BDESCR_FREE OFFSET(bd, bd.free)
StgRegTable RegTable;
+
+Capability cap;
+
StgTSO tso;
bdescr bd;
printf("#define OFFSET_HpLim %d\n", OFFSET_HpLim);
printf("#define OFFSET_CurrentTSO %d\n", OFFSET_CurrentTSO);
printf("#define OFFSET_CurrentNursery %d\n", OFFSET_CurrentNursery);
+ printf("#define OFFSET_HpAlloc %d\n", OFFSET_HpAlloc);
+
+ printf("#define OFFSET_stgChk0 (%d)\n", OFFSET_stgChk0);
+ printf("#define OFFSET_stgChk1 (%d)\n", OFFSET_stgChk1);
+ printf("#define OFFSET_stgGCEnter1 (%d)\n", OFFSET_stgGCEnter1);
+ printf("#define OFFSET_stgUpdatePAP (%d)\n", OFFSET_stgUpdatePAP);
printf("\n-- Storage Manager offsets for the Native Code Generator\n");
/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.125 2001/10/19 09:41:11 sewardj Exp $
+ * $Id: GC.c,v 1.126 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
}
resizeNursery((nat)blocks);
+
+ } else {
+ // we might have added extra large blocks to the nursery, so
+ // resize back to minAllocAreaSize again.
+ resizeNursery(RtsFlags.GcFlags.minAllocAreaSize);
}
}
if (HEAP_ALLOCED(q)) {
bd = Bdescr((P_)q);
+ // not a group head: find the group head
+ if (bd->blocks == 0) { bd = bd->link; }
+
if (bd->gen_no > N) {
/* Can't evacuate this object, because it's in a generation
* older than the ones we're collecting. Let's hope that it's
+++ /dev/null
-/* -----------------------------------------------------------------------------
- * $Id: HeapStackCheck.h,v 1.7 2001/07/06 14:11:38 simonmar Exp $
- *
- * (c) The GHC Team, 1998-1999
- *
- * Prototypes for functions in HeapStackCheck.hc
- *
- * ---------------------------------------------------------------------------*/
-
-
-EXTFUN(stg_gc_entertop);
-EXTFUN(stg_gc_enter_1_hponly);
-EXTFUN(stg_gc_enter_1);
-EXTFUN(stg_gc_enter_2);
-EXTFUN(stg_gc_enter_3);
-EXTFUN(stg_gc_enter_4);
-EXTFUN(stg_gc_enter_5);
-EXTFUN(stg_gc_enter_6);
-EXTFUN(stg_gc_enter_7);
-EXTFUN(stg_gc_enter_8);
-EXTFUN(stg_gc_seq_1);
-
-EI_(stg_gc_noregs_ret_info);
-EF_(stg_gc_noregs);
-
-EI_(stg_gc_unpt_r1_ret_info);
-EF_(stg_gc_unpt_r1);
-
-EI_(stg_gc_unbx_r1_ret_info);
-EF_(stg_gc_unbx_r1);
-
-EI_(stg_gc_f1_ret_info);
-EF_(stg_gc_f1);
-
-EI_(stg_gc_d1_ret_info);
-EF_(stg_gc_d1);
-
-EI_(stg_gc_ut_1_0_ret_info);
-EF_(stg_gc_ut_1_0);
-
-EI_(stg_gc_ut_0_1_ret_info);
-EF_(stg_gc_ut_0_1);
-
-EXTFUN(stg_chk_0);
-EXTFUN(stg_chk_1);
-EXTFUN(stg_chk_1n);
-EXTFUN(stg_chk_2);
-EXTFUN(stg_chk_3);
-EXTFUN(stg_chk_4);
-EXTFUN(stg_chk_5);
-EXTFUN(stg_chk_6);
-EXTFUN(stg_chk_7);
-EXTFUN(stg_chk_8);
-EXTFUN(stg_gen_chk_ret);
-EXTFUN(stg_gen_chk);
-EXTFUN(stg_gen_hp);
-EXTFUN(stg_gen_yield);
-EXTFUN(stg_yield_noregs);
-EXTFUN(stg_yield_to_interpreter);
-EXTFUN(stg_gen_block);
-EXTFUN(stg_block_noregs);
-EXTFUN(stg_block_1);
-EXTFUN(stg_block_takemvar);
-EXTFUN(stg_block_putmvar);
/* -----------------------------------------------------------------------------
- * $Id: HeapStackCheck.hc,v 1.17 2001/07/06 14:11:38 simonmar Exp $
+ * $Id: HeapStackCheck.hc,v 1.18 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#include "Storage.h" /* for CurrentTSO */
#include "StgRun.h" /* for StgReturn and register saving */
#include "Schedule.h" /* for context_switch */
-#include "HeapStackCheck.h"
/* Stack/Heap Check Failure
* ------------------------
#define GC_GENERIC \
if (Hp > HpLim) { \
- if (ExtendNursery(Hp,HpLim)) { \
+ Hp -= HpAlloc; \
+ if (HpAlloc <= BLOCK_SIZE_W && ExtendNursery(Hp,HpLim)) {\
if (context_switch) { \
R1.i = ThreadYielding; \
} else { \
#define GC_ENTER \
if (Hp > HpLim) { \
- if (ExtendNursery(Hp,HpLim)) { \
+ Hp -= HpAlloc; \
+ if (HpAlloc <= BLOCK_SIZE_W && ExtendNursery(Hp,HpLim)) {\
if (context_switch) { \
R1.i = ThreadYielding; \
} else { \
There are canned sequences for 'n' pointer values in registers.
-------------------------------------------------------------------------- */
-EXTFUN(stg_gc_enter_1)
+EXTFUN(__stg_gc_enter_1)
{
FB_
Sp -= 1;
/*- 0 Regs -------------------------------------------------------------------*/
-EXTFUN(stg_chk_0)
+EXTFUN(__stg_chk_0)
{
FB_
Sp -= 1;
/*- 1 Reg --------------------------------------------------------------------*/
-EXTFUN(stg_chk_1)
+EXTFUN(__stg_chk_1)
{
FB_
Sp -= 2;
* Copyright (c) 1994-2000.
*
* $RCSfile: Interpreter.c,v $
- * $Revision: 1.30 $
- * $Date: 2001/08/14 13:40:09 $
+ * $Revision: 1.31 $
+ * $Date: 2001/11/08 12:46:31 $
* ---------------------------------------------------------------------------*/
#include "PosixSource.h"
#define BCO_ITBL(n) itbls[n]
#define LOAD_STACK_POINTERS \
- iSp = cap->rCurrentTSO->sp; \
- iSu = cap->rCurrentTSO->su; \
+ iSp = cap->r.rCurrentTSO->sp; \
+ iSu = cap->r.rCurrentTSO->su; \
/* We don't change this ... */ \
- iSpLim = cap->rCurrentTSO->stack + RESERVED_STACK_WORDS;
+ iSpLim = cap->r.rCurrentTSO->stack + RESERVED_STACK_WORDS;
#define SAVE_STACK_POINTERS \
- cap->rCurrentTSO->sp = iSp; \
- cap->rCurrentTSO->su = iSu;
+ cap->r.rCurrentTSO->sp = iSp; \
+ cap->r.rCurrentTSO->su = iSu;
#define RETURN(retcode) \
SAVE_STACK_POINTERS; return retcode;
// checkSanity(1);
// iSp--; StackWord(0) = obj;
- // checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
+ // checkStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
// iSp++;
- printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
+ printStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
fprintf(stderr, "\n\n");
);
/* Heap check */
if (doYouWantToGC()) {
iSp--; StackWord(0) = (W_)bco;
- cap->rCurrentTSO->what_next = ThreadEnterInterp;
+ cap->r.rCurrentTSO->what_next = ThreadEnterInterp;
RETURN(HeapOverflow);
}
if (iSp - (INTERP_STACK_CHECK_THRESH+1) < iSpLim) {
iSp--;
StackWord(0) = (W_)obj;
- cap->rCurrentTSO->what_next = ThreadEnterInterp;
+ cap->r.rCurrentTSO->what_next = ThreadEnterInterp;
RETURN(StackOverflow);
}
if (context_switch) {
iSp--;
StackWord(0) = (W_)obj;
- cap->rCurrentTSO->what_next = ThreadEnterInterp;
+ cap->r.rCurrentTSO->what_next = ThreadEnterInterp;
RETURN(ThreadYielding);
}
IF_DEBUG(evaluator,
//if (do_print_stack) {
//fprintf(stderr, "\n-- BEGIN stack\n");
- //printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
+ //printStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
//fprintf(stderr, "-- END stack\n\n");
//}
do_print_stack = 1;
fprintf(stderr, "%d %p\n", i, (StgPtr)(*(iSp+i)));
fprintf(stderr,"\n");
}
- //if (do_print_stack) checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
+ //if (do_print_stack) checkStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
);
# ifdef INTERP_STATS
if (iSp - stk_words_reqd < iSpLim) {
iSp--;
StackWord(0) = (W_)obj;
- cap->rCurrentTSO->what_next = ThreadEnterInterp;
+ cap->r.rCurrentTSO->what_next = ThreadEnterInterp;
RETURN(StackOverflow);
}
goto nextInsn;
fprintf(stderr,"\tBuilt ");
printObj((StgClosure*)pap);
);
- cap->rCurrentTSO->what_next = ThreadEnterGHC;
+ cap->r.rCurrentTSO->what_next = ThreadEnterGHC;
RETURN(ThreadYielding);
}
case bci_PUSH_L: {
StgInfoTable* magic_itbl = BCO_ITBL(o_itoc_itbl);
if (magic_itbl != NULL) {
StackWord(0) = (W_)magic_itbl;
- cap->rCurrentTSO->what_next = ThreadRunGHC;
+ cap->r.rCurrentTSO->what_next = ThreadRunGHC;
RETURN(ThreadYielding);
} else {
/* Special case -- returning a VoidRep to
tag and enter the itbl. */
ASSERT(StackWord(0) == (W_)NULL);
iSp ++;
- cap->rCurrentTSO->what_next = ThreadRunGHC;
+ cap->r.rCurrentTSO->what_next = ThreadRunGHC;
RETURN(ThreadYielding);
}
}
printObj(obj);
);
iSp--; StackWord(0) = (W_)obj;
- cap->rCurrentTSO->what_next = ThreadEnterGHC;
+ cap->r.rCurrentTSO->what_next = ThreadEnterGHC;
RETURN(ThreadYielding);
}
} /* switch on object kind */
/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.72 2001/10/26 11:33:13 sewardj Exp $
+ * $Id: Linker.c,v 1.73 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 2000, 2001
*
Sym(StgReturn) \
Sym(__stginit_PrelGHC) \
Sym(init_stack) \
- Sym(stg_chk_0) \
- Sym(stg_chk_1) \
+ SymX(__stg_chk_0) \
+ SymX(__stg_chk_1) \
Sym(stg_enterStackTop) \
- Sym(stg_gc_d1) \
- Sym(stg_gc_enter_1) \
- Sym(stg_gc_f1) \
- Sym(stg_gc_noregs) \
- Sym(stg_gc_seq_1) \
- Sym(stg_gc_unbx_r1) \
- Sym(stg_gc_unpt_r1) \
- Sym(stg_gc_ut_0_1) \
- Sym(stg_gc_ut_1_0) \
- Sym(stg_gen_chk) \
- Sym(stg_yield_to_interpreter) \
+ SymX(stg_gc_d1) \
+ SymX(__stg_gc_enter_1) \
+ SymX(stg_gc_f1) \
+ SymX(stg_gc_noregs) \
+ SymX(stg_gc_seq_1) \
+ SymX(stg_gc_unbx_r1) \
+ SymX(stg_gc_unpt_r1) \
+ SymX(stg_gc_ut_0_1) \
+ SymX(stg_gc_ut_1_0) \
+ SymX(stg_gen_chk) \
+ SymX(stg_yield_to_interpreter) \
SymX(ErrorHdrHook) \
- SymX(MainRegTable) \
+ SymX(MainCapability) \
SymX(MallocFailHook) \
SymX(NoRunnableThreadsHook) \
SymX(OnExitHook) \
SymX(stg_sel_9_upd_info) \
SymX(stg_seq_frame_info) \
SymX(stg_upd_frame_info) \
- SymX(stg_update_PAP) \
+ SymX(__stg_update_PAP) \
SymX(suspendThread) \
SymX(takeMVarzh_fast) \
SymX(timesIntegerzh_fast) \
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.83 2001/08/08 10:50:37 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.84 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
#include "Storage.h"
#include "BlockAlloc.h" /* tmp */
#include "StablePriv.h"
-#include "HeapStackCheck.h"
#include "StgRun.h"
#include "Itimer.h"
#include "Prelude.h"
/* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.54 2001/10/31 10:34:29 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.55 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
#ifdef SMP
Capability cap;
#else
-#define cap MainRegTable
+#define cap MainCapability
#endif
init_sp = 0;
init_stack[init_sp++] = (F_)init_root;
}
- cap.rSp = (P_)(init_stack + init_sp);
- StgRun((StgFunPtr)stg_init, &cap);
+ cap.r.rSp = (P_)(init_stack + init_sp);
+ StgRun((StgFunPtr)stg_init, &cap.r);
}
/* -----------------------------------------------------------------------------
/* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.104 2001/10/31 10:34:29 simonmar Exp $
+ * $Id: Schedule.c,v 1.105 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
* Locks required: sched_mutex.
*/
#ifdef SMP
-//@cindex free_capabilities
-//@cindex n_free_capabilities
Capability *free_capabilities; /* Available capabilities for running threads */
nat n_free_capabilities; /* total number of available capabilities */
#else
-//@cindex MainRegTable
-Capability MainRegTable; /* for non-SMP, we have one global capability */
+Capability MainCapability; /* for non-SMP, we have one global capability */
#endif
#if defined(GRAN)
}
}
-#else
+#else // not SMP
+
# if defined(PAR)
/* in GUM do this only on the Main PE */
if (IAmMainThread)
pthread_cond_signal(&thread_ready_cond);
}
}
-#endif /* SMP */
+#endif // SMP
/* check for signals each time around the scheduler */
#ifndef mingw32_TARGET_OS
*/
ASSERT(run_queue_hd != END_TSO_QUEUE);
t = POP_RUN_QUEUE();
+
+ // Sanity check the thread we're about to run. This can be
+ // expensive if there is lots of thread switching going on...
IF_DEBUG(sanity,checkTSO(t));
#endif
free_capabilities = cap->link;
n_free_capabilities--;
#else
- cap = &MainRegTable;
+ cap = &MainCapability;
#endif
- cap->rCurrentTSO = t;
+ cap->r.rCurrentTSO = t;
/* context switches are now initiated by the timer signal, unless
* the user specified "context switch as often as possible", with
/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* Run the current thread
*/
- switch (cap->rCurrentTSO->what_next) {
+ switch (cap->r.rCurrentTSO->what_next) {
case ThreadKilled:
case ThreadComplete:
/* Thread already finished, return to scheduler. */
ret = ThreadFinished;
break;
case ThreadEnterGHC:
- ret = StgRun((StgFunPtr) stg_enterStackTop, cap);
+ ret = StgRun((StgFunPtr) stg_enterStackTop, &cap->r);
break;
case ThreadRunGHC:
- ret = StgRun((StgFunPtr) stg_returnToStackTop, cap);
+ ret = StgRun((StgFunPtr) stg_returnToStackTop, &cap->r);
break;
case ThreadEnterInterp:
ret = interpretBCO(cap);
#elif !defined(GRAN) && !defined(PAR)
IF_DEBUG(scheduler,fprintf(stderr,"scheduler: "););
#endif
- t = cap->rCurrentTSO;
+ t = cap->r.rCurrentTSO;
#if defined(PAR)
/* HACK 675: if the last thread didn't yield, make sure to print a
switch (ret) {
case HeapOverflow:
#if defined(GRAN)
- IF_DEBUG(gran,
- DumpGranEvent(GR_DESCHEDULE, t));
+ IF_DEBUG(gran, DumpGranEvent(GR_DESCHEDULE, t));
globalGranStats.tot_heapover++;
#elif defined(PAR)
- // IF_DEBUG(par,
- //DumpGranEvent(GR_DESCHEDULE, t);
globalParStats.tot_heapover++;
#endif
+
+ // did the task ask for a large block?
+ if (cap->r.rHpAlloc > BLOCK_SIZE_W) {
+ // if so, get one and push it on the front of the nursery.
+ bdescr *bd;
+ nat blocks;
+
+ blocks = (nat)BLOCK_ROUND_UP(cap->r.rHpAlloc * sizeof(W_)) / BLOCK_SIZE;
+
+ IF_DEBUG(scheduler,belch("--<< thread %ld (%p; %s) stopped: requesting a large block (size %d)",
+ t->id, t,
+ whatNext_strs[t->what_next], blocks));
+
+ // don't do this if it would push us over the
+ // alloc_blocks_lim limit; we'll GC first.
+ if (alloc_blocks + blocks < alloc_blocks_lim) {
+
+ alloc_blocks += blocks;
+ bd = allocGroup( blocks );
+
+ // link the new group into the list
+ bd->link = cap->r.rCurrentNursery;
+ bd->u.back = cap->r.rCurrentNursery->u.back;
+ if (cap->r.rCurrentNursery->u.back != NULL) {
+ cap->r.rCurrentNursery->u.back->link = bd;
+ } else {
+ ASSERT(g0s0->blocks == cap->r.rCurrentNursery &&
+ g0s0->blocks == cap->r.rNursery);
+ cap->r.rNursery = g0s0->blocks = bd;
+ }
+ cap->r.rCurrentNursery->u.back = bd;
+
+ // initialise it as a nursery block
+ bd->step = g0s0;
+ bd->gen_no = 0;
+ bd->flags = 0;
+ bd->free = bd->start;
+
+ // don't forget to update the block count in g0s0.
+ g0s0->n_blocks += blocks;
+ ASSERT(countBlocks(g0s0->blocks) == g0s0->n_blocks);
+
+ // now update the nursery to point to the new block
+ cap->r.rCurrentNursery = bd;
+
+ // we might be unlucky and have another thread get on the
+ // run queue before us and steal the large block, but in that
+ // case the thread will just end up requesting another large
+ // block.
+ PUSH_ON_RUN_QUEUE(t);
+ break;
+ }
+ }
+
/* make all the running tasks block on a condition variable,
* maybe set context_switch and wait till they all pile in,
* then have them wait on a GC condition variable.
G_CURR_THREADQ(0));
#endif /* GRAN */
}
+
#if defined(GRAN)
next_thread:
IF_GRAN_DEBUG(unused,
print_eventq(EventHd));
event = get_next_event();
-
#elif defined(PAR)
next_thread:
/* ToDo: wait for next message to arrive rather than busy wait */
-
-#else /* GRAN */
- /* not any more
- next_thread:
- t = take_off_run_queue(END_TSO_QUEUE);
- */
#endif /* GRAN */
+
} /* end of while(1) */
+
IF_PAR_DEBUG(verbose,
belch("== Leaving schedule() after having received Finish"));
}
ACQUIRE_LOCK(&sched_mutex);
IF_DEBUG(scheduler,
- sched_belch("thread %d did a _ccall_gc", cap->rCurrentTSO->id));
+ sched_belch("thread %d did a _ccall_gc", cap->r.rCurrentTSO->id));
- threadPaused(cap->rCurrentTSO);
- cap->rCurrentTSO->link = suspended_ccalling_threads;
- suspended_ccalling_threads = cap->rCurrentTSO;
+ threadPaused(cap->r.rCurrentTSO);
+ cap->r.rCurrentTSO->link = suspended_ccalling_threads;
+ suspended_ccalling_threads = cap->r.rCurrentTSO;
/* Use the thread ID as the token; it should be unique */
- tok = cap->rCurrentTSO->id;
+ tok = cap->r.rCurrentTSO->id;
#ifdef SMP
cap->link = free_capabilities;
free_capabilities = cap->link;
n_free_capabilities--;
#else
- cap = &MainRegTable;
+ cap = &MainCapability;
#endif
- cap->rCurrentTSO = tso;
+ cap->r.rCurrentTSO = tso;
RELEASE_LOCK(&sched_mutex);
return cap;
}
#endif
-//@cindex initScheduler
+static void
+initCapability( Capability *cap )
+{
+ cap->f.stgChk0 = (F_)__stg_chk_0;
+ cap->f.stgChk1 = (F_)__stg_chk_1;
+ cap->f.stgGCEnter1 = (F_)__stg_gc_enter_1;
+ cap->f.stgUpdatePAP = (F_)__stg_update_PAP;
+}
+
void
initScheduler(void)
{
prev = NULL;
for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
cap = stgMallocBytes(sizeof(Capability), "initScheduler:capabilities");
+ initCapability(cap);
cap->link = prev;
prev = cap;
}
}
IF_DEBUG(scheduler,fprintf(stderr,"scheduler: Allocated %d capabilities\n",
n_free_capabilities););
+#else
+ initCapability(&MainCapability);
#endif
#if defined(SMP) || defined(PAR)
/* -----------------------------------------------------------------------------
- * $Id: Schedule.h,v 1.22 2001/03/22 03:51:10 hwloidl Exp $
+ * $Id: Schedule.h,v 1.23 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
extern nat timestamp;
extern nat ticks_since_timestamp;
-//@cindex Capability
-/* Capability type
- */
-typedef StgRegTable Capability;
-
/* Free capability list.
* Locks required: sched_mutex.
*/
extern Capability *free_capabilities;
extern nat n_free_capabilities;
#else
-extern Capability MainRegTable;
+extern Capability MainCapability;
#endif
/* Thread queues.
/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.68 2001/08/10 09:41:17 simonmar Exp $
+ * $Id: StgMiscClosures.hc,v 1.69 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
#include "RtsUtils.h"
#include "RtsFlags.h"
#include "StgMiscClosures.h"
-#include "HeapStackCheck.h" /* for stg_gen_yield */
#include "Storage.h"
#include "StoragePriv.h"
#include "Profiling.h"
/* -----------------------------------------------------------------------------
- * $Id: StgStdThunks.hc,v 1.16 2001/05/31 10:59:14 simonmar Exp $
+ * $Id: StgStdThunks.hc,v 1.17 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
#include "Stg.h"
#include "Rts.h"
#include "StoragePriv.h"
-#include "HeapStackCheck.h"
/* -----------------------------------------------------------------------------
The code for a thunk that simply extracts a field from a
* in the compiler that means stg_ap_1 is generated occasionally (ToDo)
*/
-INFO_TABLE_SRT(stg_ap_1_upd_info,stg_ap_1_upd_entry,1,1,0,0,0,THUNK,,EF_,"stg_ap_1_upd_info","stg_ap_1_upd_info");
+INFO_TABLE_SRT(stg_ap_1_upd_info,stg_ap_1_upd_entry,1,1,0,0,0,THUNK_1_0,,EF_,"stg_ap_1_upd_info","stg_ap_1_upd_info");
FN_(stg_ap_1_upd_entry) {
FB_
STK_CHK_NP(sizeofW(StgUpdateFrame),1,);
FE_
}
-INFO_TABLE_SRT(stg_ap_2_upd_info,stg_ap_2_upd_entry,2,0,0,0,0,THUNK,,EF_,"stg_ap_2_upd_info","stg_ap_2_upd_info");
+INFO_TABLE_SRT(stg_ap_2_upd_info,stg_ap_2_upd_entry,2,0,0,0,0,THUNK_2_0,,EF_,"stg_ap_2_upd_info","stg_ap_2_upd_info");
FN_(stg_ap_2_upd_entry) {
FB_
STK_CHK_NP(sizeofW(StgUpdateFrame)+1,1,);
/* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.52 2001/10/18 14:41:01 simonmar Exp $
+ * $Id: Storage.c,v 1.53 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#include "Schedule.h"
#include "StoragePriv.h"
-#ifndef SMP
-nat nursery_blocks; /* number of blocks in the nursery */
-#endif
-
StgClosure *caf_list = NULL;
bdescr *small_alloc_list; /* allocate()d small objects */
*/
}
#else /* SMP */
- nursery_blocks = RtsFlags.GcFlags.minAllocAreaSize;
- g0s0->blocks = allocNursery(NULL, nursery_blocks);
- g0s0->n_blocks = nursery_blocks;
+ g0s0->blocks = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
+ g0s0->n_blocks = RtsFlags.GcFlags.minAllocAreaSize;
g0s0->to_blocks = NULL;
g0s0->n_to_blocks = 0;
- MainRegTable.rNursery = g0s0->blocks;
- MainRegTable.rCurrentNursery = g0s0->blocks;
+ MainCapability.r.rNursery = g0s0->blocks;
+ MainCapability.r.rCurrentNursery = g0s0->blocks;
/* hp, hpLim, hp_bd, to_space etc. aren't used in G0S0 */
#endif
}
ASSERT(bd->step == g0s0);
IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
}
- MainRegTable.rNursery = g0s0->blocks;
- MainRegTable.rCurrentNursery = g0s0->blocks;
+ MainCapability.r.rNursery = g0s0->blocks;
+ MainCapability.r.rCurrentNursery = g0s0->blocks;
#endif
}
bdescr *
-allocNursery (bdescr *last_bd, nat blocks)
+allocNursery (bdescr *tail, nat blocks)
{
bdescr *bd;
nat i;
- /* Allocate a nursery */
+ // Allocate a nursery: we allocate fresh blocks one at a time and
+ // cons them on to the front of the list, not forgetting to update
+ // the back pointer on the tail of the list to point to the new block.
for (i=0; i < blocks; i++) {
bd = allocBlock();
- bd->link = last_bd;
+ bd->link = tail;
+ // double-link the nursery: we might need to insert blocks
+ if (tail != NULL) {
+ tail->u.back = bd;
+ }
bd->step = g0s0;
bd->gen_no = 0;
bd->flags = 0;
bd->free = bd->start;
- last_bd = bd;
+ tail = bd;
}
- return last_bd;
+ tail->u.back = NULL;
+ return tail;
}
void
resizeNursery ( nat blocks )
{
bdescr *bd;
+ nat nursery_blocks;
#ifdef SMP
barf("resizeNursery: can't resize in SMP mode");
#endif
+ nursery_blocks = g0s0->n_blocks;
if (nursery_blocks == blocks) {
- ASSERT(g0s0->n_blocks == blocks);
return;
}
IF_DEBUG(gc, fprintf(stderr, "Decreasing size of nursery to %d blocks\n",
blocks));
- for (bd = g0s0->blocks; nursery_blocks > blocks; nursery_blocks--) {
- next_bd = bd->link;
- freeGroup(bd);
- bd = next_bd;
+
+ bd = g0s0->blocks;
+ while (nursery_blocks > blocks) {
+ next_bd = bd->link;
+ next_bd->u.back = NULL;
+ nursery_blocks -= bd->blocks; // might be a large block
+ freeGroup(bd);
+ bd = next_bd;
}
g0s0->blocks = bd;
+ // might have gone just under, by freeing a large block, so make
+ // up the difference.
+ if (nursery_blocks < blocks) {
+ g0s0->blocks = allocNursery(g0s0->blocks, blocks-nursery_blocks);
+ }
}
- g0s0->n_blocks = nursery_blocks = blocks;
+ g0s0->n_blocks = blocks;
+ ASSERT(countBlocks(g0s0->blocks) == g0s0->n_blocks);
}
/* -----------------------------------------------------------------------------
}
#else /* !SMP */
- bdescr *current_nursery = MainRegTable.rCurrentNursery;
+ bdescr *current_nursery = MainCapability.r.rCurrentNursery;
- allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
+ allocated = (g0s0->n_blocks * BLOCK_SIZE_W) + allocated_bytes();
for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
allocated -= BLOCK_SIZE_W;
}
ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK);
}
-static nat
+
+nat
countBlocks(bdescr *bd)
{
nat n;
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
for (s = 0; s < generations[g].n_steps; s++) {
- if (g == 0 && s == 0) { continue; }
- checkHeap(generations[g].steps[s].blocks);
- checkChain(generations[g].steps[s].large_objects);
ASSERT(countBlocks(generations[g].steps[s].blocks)
== generations[g].steps[s].n_blocks);
ASSERT(countBlocks(generations[g].steps[s].large_objects)
== generations[g].steps[s].n_large_blocks);
+ if (g == 0 && s == 0) { continue; }
+ checkHeap(generations[g].steps[s].blocks);
+ checkChain(generations[g].steps[s].large_objects);
if (g > 0) {
checkMutableList(generations[g].mut_list, g);
checkMutOnceList(generations[g].mut_once_list, g);
/* -----------------------------------------------------------------------------
- * $Id: StoragePriv.h,v 1.18 2001/10/19 09:41:11 sewardj Exp $
+ * $Id: StoragePriv.h,v 1.19 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
extern bdescr *nursery;
-extern nat nursery_blocks;
extern nat alloc_blocks;
extern nat alloc_blocks_lim;
#ifdef DEBUG
extern void memInventory(void);
extern void checkSanity(void);
+extern nat countBlocks(bdescr *);
#endif
/*
/* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.34 2001/07/24 06:31:36 ken Exp $
+ * $Id: Updates.hc,v 1.35 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#include "Rts.h"
#include "RtsUtils.h"
#include "RtsFlags.h"
-#include "HeapStackCheck.h"
#include "Storage.h"
#if defined(GRAN) || defined(PAR)
# include "FetchMe.h"
This function is called whenever an argument satisfaction check fails.
-------------------------------------------------------------------------- */
-EXTFUN(stg_update_PAP)
+EXTFUN(__stg_update_PAP)
{
nat Words, PapSize;
#ifdef PROFILING
projects / ghc-hetmet.git / commitdiff