summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ghc/includes/PrimOps.h14
-rw-r--r--ghc/includes/StgMiscClosures.h5
-rw-r--r--ghc/lib/exts/Weak.lhs1
-rw-r--r--ghc/lib/std/PrelGHC.hi-boot3
-rw-r--r--ghc/lib/std/PrelWeak.lhs5
-rw-r--r--ghc/rts/PrimOps.hc29
-rw-r--r--ghc/rts/StgMiscClosures.hc15
-rw-r--r--ghc/rts/Weak.c12
8 files changed, 66 insertions, 18 deletions
diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index b637bf998a..2a7ce94c62 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 990385cc4c..ee948dc09c 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 18a8577571..be0c0251ff 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 c43a288d40..35bd43699c 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 cbe510ae1f..d6844605dc 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 cfcca50338..e865fb1079 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 a5111137a0..e724233cbe 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 48e7310112..5f038db6d3 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;
}
}
View Lorry Controller Status