From: simonm Date: Fri, 15 Jan 1999 17:57:11 +0000 (+0000) Subject: [project @ 1999-01-15 17:57:03 by simonm] X-Git-Tag: Approx_2487_patches~81 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=4ec89230a959370114357e4c1d45a82b430d374e;p=ghc-hetmet.git [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. --- diff --git a/ghc/includes/ClosureTypes.h b/ghc/includes/ClosureTypes.h index eb0a12a..d392b92 100644 --- a/ghc/includes/ClosureTypes.h +++ b/ghc/includes/ClosureTypes.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 diff --git a/ghc/includes/InfoTables.h b/ghc/includes/InfoTables.h index 2095026..fb7c65f 100644 --- a/ghc/includes/InfoTables.h +++ b/ghc/includes/InfoTables.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 ) diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h index a313a4d..0598ccd 100644 --- a/ghc/includes/StgMiscClosures.h +++ b/ghc/includes/StgMiscClosures.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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; diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h index 3a599c2..9ad4128 100644 --- a/ghc/includes/Updates.h +++ b/ghc/includes/Updates.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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. * @@ -31,25 +31,13 @@ (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 -------------------------------------------------------------------------- */ 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); \ } diff --git a/ghc/rts/DebugProf.c b/ghc/rts/DebugProf.c index 7fe57ca..f5ad811 100644 --- a/ghc/rts/DebugProf.c +++ b/ghc/rts/DebugProf.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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: diff --git a/ghc/rts/Evaluator.c b/ghc/rts/Evaluator.c index ce10038..b951f3c 100644 --- a/ghc/rts/Evaluator.c +++ b/ghc/rts/Evaluator.c @@ -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; diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 741c466..afe2009 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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; } } diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c index 74a8c3c..e22e6ed 100644 --- a/ghc/rts/Printer.c +++ b/ghc/rts/Printer.c @@ -1,6 +1,6 @@ /* -*- 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; diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index 874533a..1ba464d 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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: diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index f426d59..1edc735 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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,10 +132,25 @@ 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 */ CurrentTSO->link = ((StgBlackHole *)R1.p)->blocking_queue; ((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO; @@ -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 */ diff --git a/ghc/rts/Updates.hc b/ghc/rts/Updates.hc index a74e805..c98dfa1 100644 --- a/ghc/rts/Updates.hc +++ b/ghc/rts/Updates.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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();