Commit 4ec89230 authored by simonm's avatar simonm
Browse files

[project @ 1999-01-15 17:57:03 by simonm]

- Add new object BLACKHOLE_BQ: now a BLACKHOLE is defined as having an
  empty blocking queue, and the first time a thread blocks on a BLACKHOLE
  it is changed into a BLACKHOLE_BQ.

- Remove UPD_INPLACE1 and replace it with UPD_IND in the two places it
  was used.  UPD_INPLACE1 wouldn't have worked in a generational setting.
parent b9bd8aed
/* ----------------------------------------------------------------------------
* $Id: ClosureTypes.h,v 1.4 1999/01/14 16:57:07 simonm Exp $
* $Id: ClosureTypes.h,v 1.5 1999/01/15 17:57:03 simonm Exp $
*
* Closure Type Constants
*
......@@ -46,17 +46,18 @@
#define STOP_FRAME 30
#define SEQ_FRAME 31
#define BLACKHOLE 32
#define MVAR 33
#define ARR_WORDS 34
#define MUT_ARR_WORDS 35
#define MUT_ARR_PTRS 36
#define MUT_ARR_PTRS_FROZEN 37
#define MUT_VAR 38
#define WEAK 49
#define FOREIGN 40
#define TSO 41
#define BLOCKED_FETCH 42
#define FETCH_ME 43
#define EVACUATED 44
#define BLACKHOLE_BQ 33
#define MVAR 34
#define ARR_WORDS 35
#define MUT_ARR_WORDS 36
#define MUT_ARR_PTRS 37
#define MUT_ARR_PTRS_FROZEN 38
#define MUT_VAR 49
#define WEAK 40
#define FOREIGN 41
#define TSO 42
#define BLOCKED_FETCH 43
#define FETCH_ME 44
#define EVACUATED 45
#endif CLOSURETYPES_H
/* ----------------------------------------------------------------------------
* $Id: InfoTables.h,v 1.3 1999/01/13 17:25:53 simonm Exp $
* $Id: InfoTables.h,v 1.4 1999/01/15 17:57:03 simonm Exp $
*
* Info Tables
*
......@@ -127,13 +127,16 @@ typedef enum {
, SEQ_FRAME
, BLACKHOLE
, BLACKHOLE_BQ
, MVAR
, ARR_WORDS
, MUT_ARR_WORDS
, MUT_ARR_PTRS
, MUT_ARR_PTRS_FROZEN
, MUT_VAR
, WEAK
......@@ -199,6 +202,7 @@ typedef enum {
#define FLAGS_FOREIGN (_HNF| _NS| _UPT )
#define FLAGS_WEAK (_HNF| _NS| _UPT )
#define FLAGS_BLACKHOLE ( _NS| _UPT )
#define FLAGS_BLACKHOLE_BQ ( _NS| _UPT )
#define FLAGS_MVAR (_HNF| _NS| _MUT|_UPT )
#define FLAGS_FETCH_ME (_HNF| _NS )
#define FLAGS_TSO (_HNF| _NS| _MUT|_UPT )
......
/* -----------------------------------------------------------------------------
* $Id: StgMiscClosures.h,v 1.4 1999/01/15 12:47:19 sewardj Exp $
* $Id: StgMiscClosures.h,v 1.5 1999/01/15 17:57:04 simonm Exp $
*
* Entry code for various built-in closure types.
*
......@@ -21,6 +21,7 @@ STGFUN(CAF_UNENTERED_entry);
STGFUN(CAF_ENTERED_entry);
STGFUN(CAF_BLACKHOLE_entry);
STGFUN(BLACKHOLE_entry);
STGFUN(BLACKHOLE_BQ_entry);
STGFUN(BCO_entry);
STGFUN(EVACUATED_entry);
STGFUN(FOREIGN_entry);
......@@ -50,6 +51,7 @@ extern const StgInfoTable CAF_UNENTERED_info;
extern const StgInfoTable CAF_ENTERED_info;
extern const StgInfoTable CAF_BLACKHOLE_info;
extern const StgInfoTable BLACKHOLE_info;
extern const StgInfoTable BLACKHOLE_BQ_info;
extern const StgInfoTable BCO_info;
extern const StgInfoTable EVACUATED_info;
extern const StgInfoTable FOREIGN_info;
......
/* -----------------------------------------------------------------------------
* $Id: Updates.h,v 1.3 1999/01/13 17:25:55 simonm Exp $
* $Id: Updates.h,v 1.4 1999/01/15 17:57:04 simonm Exp $
*
* Definitions related to updates.
*
......@@ -30,18 +30,6 @@
updateWithIndirection((StgClosure *)updclosure, \
(StgClosure *)heapptr);
/* -----------------------------------------------------------------------------
Update a closure inplace with an infotable that expects 1 (closure)
argument.
Also may wake up BQs.
-------------------------------------------------------------------------- */
#define UPD_INPLACE1(updclosure,info,c0) \
TICK_UPDATED_SET_UPDATED(updclosure); \
AWAKEN_BQ(updclosure); \
SET_INFO(updclosure,info); \
payloadCPtr(updclosure,0) = (c0)
/* -----------------------------------------------------------------------------
Awaken any threads waiting on this computation
-------------------------------------------------------------------------- */
......@@ -49,7 +37,7 @@
extern void awaken_blocked_queue(StgTSO *q);
#define AWAKEN_BQ(closure) \
if (closure->header.info == &BLACKHOLE_info) { \
if (closure->header.info == &BLACKHOLE_BQ_info) { \
StgTSO *bq = ((StgBlackHole *)closure)->blocking_queue; \
if (bq != (StgTSO *)&END_TSO_QUEUE_closure) { \
STGCALL1(awaken_blocked_queue, bq); \
......@@ -111,8 +99,6 @@ extern void newCAF(StgClosure*);
{ \
SET_INFO((StgInd *)cafptr,&IND_STATIC_info); \
((StgInd *)cafptr)->indirectee = (StgClosure *)(bhptr); \
((StgBlackHole *)(bhptr))->blocking_queue = \
(StgTSO *)&END_TSO_QUEUE_closure; \
STGCALL1(newCAF,(StgClosure *)cafptr); \
}
......
/* -----------------------------------------------------------------------------
* $Id: DebugProf.c,v 1.3 1999/01/13 17:25:38 simonm Exp $
* $Id: DebugProf.c,v 1.4 1999/01/15 17:57:05 simonm Exp $
*
* (c) The GHC Team 1998
*
......@@ -157,6 +157,7 @@ static char *type_names[] = {
, "SEQ_FRAME"
, "BLACKHOLE"
, "BLACKHOLE_BQ"
, "MVAR"
, "ARR_WORDS"
......@@ -282,6 +283,7 @@ heapCensus(bdescr *bd)
case IND_PERM:
case IND_OLDGEN_PERM:
case BLACKHOLE:
case BLACKHOLE_BQ:
case WEAK:
case FOREIGN:
case MVAR:
......
......@@ -5,8 +5,8 @@
* Copyright (c) 1994-1998.
*
* $RCSfile: Evaluator.c,v $
* $Revision: 1.2 $
* $Date: 1998/12/02 13:28:17 $
* $Revision: 1.3 $
* $Date: 1999/01/15 17:57:06 $
* ---------------------------------------------------------------------------*/
#include "Rts.h"
......@@ -402,10 +402,20 @@ static inline void PopSeqFrame( void )
static inline StgClosure* raiseAnError( StgClosure* errObj )
{
StgClosure *raise_closure;
/* This closure represents the expression 'raise# E' where E
* is the exception raise. It is used to overwrite all the
* thunks which are currently under evaluataion.
*/
raise_closure = (StgClosure *)allocate(sizeofW(StgClosure)+1);
raise_closure->header.info = &raise_info;
raise_closure->payload[0] = R1.cl;
while (1) {
switch (get_itbl(Su)->type) {
case UPDATE_FRAME:
UPD_INPLACE1(Su->updatee,&raise_info,errObj);
UPD_IND(Su->updatee,raise_closure);
Sp = stgCast(StgStackPtr,Su) + sizeofW(StgUpdateFrame);
Su = Su->link;
break;
......
/* -----------------------------------------------------------------------------
* $Id: GC.c,v 1.8 1999/01/14 11:11:29 simonm Exp $
* $Id: GC.c,v 1.9 1999/01/15 17:57:08 simonm Exp $
*
* Two-space garbage collector
*
......@@ -926,7 +926,11 @@ loop:
case CAF_BLACKHOLE:
case BLACKHOLE:
to = copy(q,BLACKHOLE_sizeW(),bd);
case BLACKHOLE_BQ:
/* ToDo: don't need to copy all the blackhole, some of it is
* just padding.
*/
to = copy(q,BLACKHOLE_sizeW(),bd);
upd_evacuee(q,to);
return to;
......@@ -994,6 +998,7 @@ loop:
case CAF_UNENTERED:
case CAF_BLACKHOLE:
case BLACKHOLE:
case BLACKHOLE_BQ:
/* not evaluated yet */
break;
......@@ -1347,6 +1352,10 @@ scavenge(step *step)
case CAF_BLACKHOLE:
case BLACKHOLE:
p += BLACKHOLE_sizeW();
break;
case BLACKHOLE_BQ:
{
StgBlackHole *bh = (StgBlackHole *)p;
(StgClosure *)bh->blocking_queue =
......@@ -1520,6 +1529,9 @@ scavenge_one(StgPtr p)
case CAF_BLACKHOLE:
case BLACKHOLE:
break;
case BLACKHOLE_BQ:
{
StgBlackHole *bh = (StgBlackHole *)p;
(StgClosure *)bh->blocking_queue =
......@@ -1858,8 +1870,8 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
goto follow_srt;
/* Specialised code for update frames, since they're so common.
* We *know* the updatee points to a BLACKHOLE or CAF_BLACKHOLE,
* so just inline the code to evacuate it here.
* We *know* the updatee points to a BLACKHOLE, CAF_BLACKHOLE,
* or BLACKHOLE_BQ, so just inline the code to evacuate it here.
*/
case UPDATE_FRAME:
{
......@@ -1873,8 +1885,15 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
continue;
} else {
bdescr *bd = Bdescr((P_)frame->updatee);
ASSERT(type == BLACKHOLE || type == CAF_BLACKHOLE);
if (bd->gen->no >= evac_gen && bd->gen->no > N) { continue; }
ASSERT(type == BLACKHOLE ||
type == CAF_BLACKHOLE ||
type == BLACKHOLE_BQ);
if (bd->gen->no > N) {
if (bd->gen->no < evac_gen) {
failed_to_evac = rtsTrue;
}
continue;
}
to = copy(frame->updatee, BLACKHOLE_sizeW(), bd);
upd_evacuee(frame->updatee,to);
frame->updatee = to;
......@@ -2212,9 +2231,9 @@ threadLazyBlackHole(StgTSO *tso)
* above optimisation doesn't apply.
*/
if (bh->header.info != &BLACKHOLE_info
&& bh->header.info != &BLACKHOLE_BQ_info
&& bh->header.info != &CAF_BLACKHOLE_info) {
SET_INFO(bh,&BLACKHOLE_info);
bh->blocking_queue = END_TSO_QUEUE;
}
update_frame = update_frame->link;
......@@ -2332,13 +2351,9 @@ threadSqueezeStack(StgTSO *tso)
* slower --SDM
*/
#if 0 /* do it properly... */
if (GET_INFO(updatee_bypass) == BLACKHOLE_info
|| GET_INFO(updatee_bypass) == CAF_BLACKHOLE_info
) {
if (GET_INFO(updatee_bypass) == BLACKHOLE_BQ_info) {
/* Sigh. It has one. Don't lose those threads! */
if (GET_INFO(updatee_keep) == BLACKHOLE_info
|| GET_INFO(updatee_keep) == CAF_BLACKHOLE_info
) {
if (GET_INFO(updatee_keep) == BLACKHOLE_BQ_info) {
/* Urgh. Two queues. Merge them. */
P_ keep_tso = ((StgBlackHole *)updatee_keep)->blocking_queue;
......@@ -2375,10 +2390,10 @@ threadSqueezeStack(StgTSO *tso)
if (is_update_frame) {
StgBlackHole *bh = (StgBlackHole *)frame->updatee;
if (bh->header.info != &BLACKHOLE_info
&& bh->header.info != &BLACKHOLE_BQ_info
&& bh->header.info != &CAF_BLACKHOLE_info
) {
SET_INFO(bh,&BLACKHOLE_info);
bh->blocking_queue = END_TSO_QUEUE;
}
}
......
/* -*- mode: hugs-c; -*- */
/* -----------------------------------------------------------------------------
* $Id: Printer.c,v 1.2 1998/12/02 13:28:33 simonm Exp $
* $Id: Printer.c,v 1.3 1999/01/15 17:57:09 simonm Exp $
*
* Copyright (c) 1994-1998.
*
......@@ -145,7 +145,10 @@ void printClosure( StgClosure *obj )
fprintf(stderr,")\n");
break;
case BLACKHOLE:
fprintf(stderr,"BH(");
fprintf(stderr,"BH\n");
break;
case BLACKHOLE_BQ:
fprintf(stderr,"BQ(");
printPtr((StgPtr)stgCast(StgBlackHole*,obj)->blocking_queue);
fprintf(stderr,")\n");
break;
......
/* -----------------------------------------------------------------------------
* $Id: Sanity.c,v 1.3 1999/01/13 17:25:43 simonm Exp $
* $Id: Sanity.c,v 1.4 1999/01/15 17:57:10 simonm Exp $
*
* Sanity checking code for the heap and stack.
*
......@@ -203,6 +203,7 @@ checkClosure( StgClosure* p )
case CAF_ENTERED:
case CAF_BLACKHOLE:
case BLACKHOLE:
case BLACKHOLE_BQ:
case FOREIGN:
case MVAR:
case MUT_VAR:
......
/* -----------------------------------------------------------------------------
* $Id: StgMiscClosures.hc,v 1.4 1999/01/15 12:47:20 sewardj Exp $
* $Id: StgMiscClosures.hc,v 1.5 1999/01/15 17:57:11 simonm Exp $
*
* Entry code for various built-in closure types.
*
......@@ -132,8 +132,23 @@ STGFUN(CAF_ENTERED_entry)
* should be big enough for an old-generation indirection.
*/
INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,1,1,BLACKHOLE,const,EF_,0,0);
INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,const,EF_,0,0);
STGFUN(BLACKHOLE_entry)
{
FB_
/* Change the BLACKHOLE into a BLACKHOLE_BQ */
((StgBlackHole *)R1.p)->header.info = &BLACKHOLE_BQ_info;
/* Put ourselves on the blocking queue for this black hole */
CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO;
/* stg_gen_block is too heavyweight, use a specialised one */
BLOCK_NP(1);
FE_
}
INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,const,EF_,0,0);
STGFUN(BLACKHOLE_BQ_entry)
{
FB_
/* Put ourselves on the blocking queue for this black hole */
......@@ -146,12 +161,14 @@ STGFUN(BLACKHOLE_entry)
}
/* identical to BLACKHOLEs except for the infotag */
INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,1,1,CAF_BLACKHOLE,const,EF_,0,0);
INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0);
STGFUN(CAF_BLACKHOLE_entry)
{
FB_
/* Change the BLACKHOLE into a BLACKHOLE_BQ */
((StgBlackHole *)R1.p)->header.info = &BLACKHOLE_BQ_info;
/* Put ourselves on the blocking queue for this black hole */
CurrentTSO->link = ((StgBlackHole *)R1.p)->blocking_queue;
CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO;
/* stg_gen_block is too heavyweight, use a specialised one */
......
/* -----------------------------------------------------------------------------
* $Id: Updates.hc,v 1.5 1999/01/14 14:43:46 simonm Exp $
* $Id: Updates.hc,v 1.6 1999/01/15 17:57:11 simonm Exp $
*
* Code to perform updates.
*
......@@ -305,10 +305,10 @@ EXTFUN(stg_update_PAP)
case SEQ_FRAME:
/* Set Sp to just above the SEQ frame (should be an activation rec.)*/
Sp = stgCast(StgPtr,Su) + sizeofW(StgSeqFrame);
Sp = (P_)Su + sizeofW(StgSeqFrame);
/* restore Su */
Su = stgCast(StgSeqFrame*,Su)->link;
Su = ((StgSeqFrame *)Su)->link;
/* return to the activation record, with the address of the PAP in R1 */
R1.p = (P_)PapClosure;
......@@ -316,10 +316,10 @@ EXTFUN(stg_update_PAP)
case CATCH_FRAME:
/* Set Sp to just above the CATCH frame (should be an activation rec.)*/
Sp = stgCast(StgPtr,Su) + sizeofW(StgCatchFrame);
Sp = (P_)Su + sizeofW(StgCatchFrame);
/* restore Su */
Su = stgCast(StgCatchFrame*,Su)->link;
Su = ((StgCatchFrame *)Su)->link;
/* restart by entering the PAP */
R1.p = (P_)PapClosure;
......@@ -455,7 +455,7 @@ STGFUN(AP_UPD_entry)
IFN_(label) \
{ \
FB_ \
Su = stgCast(StgSeqFrame*,Sp)->link; \
Su = ((StgSeqFrame *)Sp)->link; \
Sp += sizeofW(StgSeqFrame); \
JMP_(ret); \
FE_ \
......@@ -566,11 +566,11 @@ FN_(catchZh_fast)
/* args: R1 = m, R2 = k */
STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchZh_fast, );
Sp -= sizeofW(StgCatchFrame);
fp = stgCast(StgCatchFrame*,Sp);
fp = (StgCatchFrame *)Sp;
SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
fp -> handler = R2.cl;
fp -> link = Su;
Su = stgCast(StgUpdateFrame*,fp);
Su = (StgUpdateFrame *)fp;
TICK_ENT_VIA_NODE();
JMP_(ENTRY_CODE(*R1.p));
......@@ -591,7 +591,7 @@ INFO_TABLE(raise_info,raise_entry,1,0,FUN,const,EF_,0,0);
STGFUN(raise_entry)
{
FB_
R1.cl = payloadCPtr(R1.cl,0);
R1.cl = R1.cl->payload[0];
JMP_(raiseZh_fast);
FE_
}
......@@ -600,22 +600,32 @@ FN_(raiseZh_fast)
{
StgClosure *handler;
StgUpdateFrame *p;
StgClosure *raise_closure;
FB_
/* args : R1 = error */
p = Su;
/* This closure represents the expression 'raise# E' where E
* is the exception raise. It is used to overwrite all the
* thunks which are currently under evaluataion.
*/
raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
sizeofW(StgClosure)+1);
raise_closure->header.info = &raise_info;
raise_closure->payload[0] = R1.cl;
while (1) {
switch (get_itbl(p)->type) {
case UPDATE_FRAME:
UPD_INPLACE1(p->updatee,&raise_info,R1.cl);
UPD_IND(p->updatee,raise_closure);
p = p->link;
continue;
case SEQ_FRAME:
p = stgCast(StgSeqFrame*,p)->link;
p = ((StgSeqFrame *)p)->link;
continue;
case CATCH_FRAME:
......@@ -639,7 +649,7 @@ FN_(raiseZh_fast)
Su = ((StgCatchFrame *)p)->link;
handler = ((StgCatchFrame *)p)->handler;
Sp = stgCast(StgPtr,p) + sizeofW(StgCatchFrame) - 1;
Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
*Sp = R1.w;
TICK_ENT_VIA_NODE();
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment