Commit a6b16f2c authored by simonm's avatar simonm
Browse files

[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.
parent 2ea4eabd
/* -----------------------------------------------------------------------------
* $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
......
/* -----------------------------------------------------------------------------
* $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[];
......
......@@ -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))
......
......@@ -291,7 +291,8 @@ __export PrelGHC
Weakzh
mkWeakzh
deRefWeakzh
finaliseWeakzh
ForeignObjzh
makeForeignObjzh
writeForeignObjzh
......
......@@ -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
......
/* -----------------------------------------------------------------------------
* $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_
}
......
/* -----------------------------------------------------------------------------
* $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.
*
......@@ -239,6 +239,19 @@ NON_ENTERABLE_ENTRY_CODE(WEAK);
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.
-------------------------------------------------------------------------- */
......
/* -----------------------------------------------------------------------------
* $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;
}
}
......
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