From a6b16f2cac06c9583c362bad0416886a3a7bf85c Mon Sep 17 00:00:00 2001 From: simonm Date: Mon, 1 Feb 1999 18:05:35 +0000 Subject: [PATCH] [project @ 1999-02-01 18:05:30 by simonm] - Add finalise# - Add mkWeakNoFinaliser - Move deRefWeak# from an out-of-line primop to an inline one. --- ghc/includes/PrimOps.h | 14 ++++++++++++-- ghc/includes/StgMiscClosures.h | 5 ++++- ghc/lib/exts/Weak.lhs | 1 + ghc/lib/std/PrelGHC.hi-boot | 3 ++- ghc/lib/std/PrelWeak.lhs | 5 +++++ ghc/rts/PrimOps.hc | 29 ++++++++++++++++++++--------- ghc/rts/StgMiscClosures.hc | 15 ++++++++++++++- ghc/rts/Weak.c | 12 ++++++++---- 8 files changed, 66 insertions(+), 18 deletions(-) diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index b637bf9..2a7ce94 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.12 1999/01/29 09:32:37 simonm Exp $ + * $Id: PrimOps.h,v 1.13 1999/02/01 18:05:30 simonm Exp $ * * Macros for primitive operations in STG-ish C code. * @@ -685,7 +685,17 @@ EF_(seqzh_fast); #ifndef PAR EF_(mkWeakzh_fast); -EF_(deRefWeakzh_fast); +EF_(finaliseWeakzh_fast); + +#define deRefWeakzh(code,val,w) \ + if (((StgWeak *)w)->header.info == &WEAK_info) { \ + code = 1; \ + val = ((StgWeak *)w)->value; \ + } else { \ + code = 0; \ + val = (StgClosure *)w; \ + } + #define sameWeakzh(w1,w2) ((w1)==(w2)) #endif diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h index 990385c..ee948dc 100644 --- a/ghc/includes/StgMiscClosures.h +++ b/ghc/includes/StgMiscClosures.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.h,v 1.6 1999/01/26 11:12:58 simonm Exp $ + * $Id: StgMiscClosures.h,v 1.7 1999/02/01 18:05:31 simonm Exp $ * * Entry code for various built-in closure types. * @@ -26,6 +26,7 @@ STGFUN(BCO_entry); STGFUN(EVACUATED_entry); STGFUN(FOREIGN_entry); STGFUN(WEAK_entry); +STGFUN(NO_FINALISER_entry); STGFUN(DEAD_WEAK_entry); STGFUN(STABLE_NAME_entry); STGFUN(TSO_entry); @@ -58,6 +59,7 @@ extern const StgInfoTable EVACUATED_info; extern const StgInfoTable FOREIGN_info; extern const StgInfoTable WEAK_info; extern const StgInfoTable DEAD_WEAK_info; +extern const StgInfoTable NO_FINALISER_info; extern const StgInfoTable STABLE_NAME_info; extern const StgInfoTable FULL_MVAR_info; extern const StgInfoTable EMPTY_MVAR_info; @@ -85,6 +87,7 @@ extern const StgInfoTable ret_bco_info; extern StgClosure END_TSO_QUEUE_closure; extern StgClosure END_MUT_LIST_closure; +extern StgClosure NO_FINALISER_closure; extern StgClosure dummy_ret_closure; extern StgIntCharlikeClosure CHARLIKE_closure[]; diff --git a/ghc/lib/exts/Weak.lhs b/ghc/lib/exts/Weak.lhs index 18a8577..be0c025 100644 --- a/ghc/lib/exts/Weak.lhs +++ b/ghc/lib/exts/Weak.lhs @@ -15,6 +15,7 @@ module Weak ( deRefWeak, -- :: Weak v -> IO (Maybe v) -- finalise -- :: Weak v -> IO () -- replaceFinaliser -- :: Weak v -> IO () -> IO () + mkWeakNoFinaliser, -- :: k -> v -> IO (Weak v) mkWeakPtr, -- :: k -> IO () -> IO (Weak k) mkWeakPair, -- :: k -> v -> IO () -> IO (Weak (k,v)) diff --git a/ghc/lib/std/PrelGHC.hi-boot b/ghc/lib/std/PrelGHC.hi-boot index c43a288..35bd436 100644 --- a/ghc/lib/std/PrelGHC.hi-boot +++ b/ghc/lib/std/PrelGHC.hi-boot @@ -291,7 +291,8 @@ __export PrelGHC Weakzh mkWeakzh deRefWeakzh - + finaliseWeakzh + ForeignObjzh makeForeignObjzh writeForeignObjzh diff --git a/ghc/lib/std/PrelWeak.lhs b/ghc/lib/std/PrelWeak.lhs index cbe510a..d684460 100644 --- a/ghc/lib/std/PrelWeak.lhs +++ b/ghc/lib/std/PrelWeak.lhs @@ -26,6 +26,11 @@ mkWeak key val finaliser = IO $ \s -> case mkWeak# key val finaliser s of { (# s1, w #) -> (# s1, Weak w #) } +mkWeakNoFinaliser key val = IO $ \s -> + -- zero is a valid finaliser argument to mkWeak#, and means "no finaliser" + case mkWeak# key val (unsafeCoerce# 0#) s of { (# s1, w #) -> + (# s1, Weak w #) } + deRefWeak :: Weak v -> IO (Maybe v) deRefWeak (Weak w) = IO $ \s -> case deRefWeak# w s of diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index cfcca50..e865fb1 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.hc,v 1.9 1999/01/27 14:51:20 simonpj Exp $ + * $Id: PrimOps.hc,v 1.10 1999/02/01 18:05:34 simonm Exp $ * * Primitive functions / data * @@ -313,7 +313,11 @@ FN_(mkWeakzh_fast) w->key = R1.cl; w->value = R2.cl; - w->finaliser = R3.cl; + if (R3.cl) { + w->finaliser = R3.cl; + } else + w->finaliser = &NO_FINALISER_closure; + } w->link = weak_ptr_list; weak_ptr_list = w; @@ -324,20 +328,27 @@ FN_(mkWeakzh_fast) FE_ } -FN_(deRefWeakzh_fast) +FN_(finaliseWeakzh_fast) { /* R1.p = weak ptr */ StgWeak *w; FB_ - - TICK_RET_UNBOXED_TUP(2); + TICK_RET_UNBOXED_TUP(0); w = (StgWeak *)R1.p; - if (w->header.info == &WEAK_info) { - RET_NP(1, w->value); - } else { - RET_NP(0, w); + + if (w->finaliser != &NO_FINALISER_info) { +#ifdef INTERPRETER + STGCALL2(StgTSO *, createGenThread, + RtsFlags.GcFlags.initialStkSize, w->finaliser); +#else + STGCALL2(StgTSO *, createIOThread, + RtsFlags.GcFlags.initialStkSize, w->finaliser); +#endif } + w->header.info = &DEAD_WEAK_info; + + JMP_(ENTRY_CODE(Sp[0])); FE_ } diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index a511113..e724233 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.hc,v 1.9 1999/01/27 14:51:22 simonpj Exp $ + * $Id: StgMiscClosures.hc,v 1.10 1999/02/01 18:05:34 simonm Exp $ * * Entry code for various built-in closure types. * @@ -240,6 +240,19 @@ INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,const,EF_,0,0); NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK); /* ----------------------------------------------------------------------------- + NO_FINALISER + + This is a static nullary constructor (like []) that we use to mark an empty + finaliser in a weak pointer object. + -------------------------------------------------------------------------- */ + +INFO_TABLE_CONSTR(NO_FINALISER_info,NO_FINALISER_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0); +NON_ENTERABLE_ENTRY_CODE(NO_FINALISER); + +SET_STATIC_HDR(NO_FINALISER_closure,NO_FINALISER_info,0/*CC*/,,EI_) +}; + +/* ----------------------------------------------------------------------------- Foreign Objects are unlifted and therefore never entered. -------------------------------------------------------------------------- */ diff --git a/ghc/rts/Weak.c b/ghc/rts/Weak.c index 48e7310..5f038db 100644 --- a/ghc/rts/Weak.c +++ b/ghc/rts/Weak.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Weak.c,v 1.4 1999/01/26 11:12:53 simonm Exp $ + * $Id: Weak.c,v 1.5 1999/02/01 18:05:35 simonm Exp $ * * Weak pointers / finalisers * @@ -27,7 +27,9 @@ finaliseWeakPointersNow(void) for (w = weak_ptr_list; w; w = w->link) { IF_DEBUG(weak,fprintf(stderr,"Finalising weak pointer at %p -> %p\n", w, w->key)); w->header.info = &DEAD_WEAK_info; - rts_evalIO(w->finaliser,NULL); + if (w->finaliser != &NO_FINALISER_info) { + rts_evalIO(w->finaliser,NULL); + } } } @@ -44,11 +46,13 @@ scheduleFinalisers(StgWeak *list) for (w = list; w; w = w->link) { IF_DEBUG(weak,fprintf(stderr,"Finalising weak pointer at %p -> %p\n", w, w->key)); + if (w->finaliser != &NO_FINALISER_info) { #ifdef INTERPRETER - createGenThread(RtsFlags.GcFlags.initialStkSize, w->finaliser); + createGenThread(RtsFlags.GcFlags.initialStkSize, w->finaliser); #else - createIOThread(RtsFlags.GcFlags.initialStkSize, w->finaliser); + createIOThread(RtsFlags.GcFlags.initialStkSize, w->finaliser); #endif + } w->header.info = &DEAD_WEAK_info; } } -- 1.7.10.4