--- ./sv.c~	Fri Jan  9 13:12:40 1998
+++ ./sv.c	Thu Jan 15 11:25:36 1998
@@ -2356,7 +2356,8 @@ sv_magic(register SV *sv, SV *obj, int h
 	if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
 	    if (how == 't')
 		mg->mg_len |= 1;
-	    return;
+	    if (how != 'w')		/* XXXX Maybe '~' and 'U' too? */
+		return;
 	}
     }
     else {
@@ -2464,6 +2465,9 @@ sv_magic(register SV *sv, SV *obj, int h
     case 'v':
 	mg->mg_virtual = &vtbl_vec;
 	break;
+    case 'w':
+	mg->mg_virtual = &vtbl_cached;
+	break;
     case 'x':
 	mg->mg_virtual = &vtbl_substr;
 	break;
@@ -2525,6 +2529,17 @@ sv_unmagic(SV *sv, int type)
     }
 
     return 0;
+}
+
+void
+sv_call_afterchange(SV *sv, cache_destroy_func fnc, ANY any) 
+{
+    struct cachefunc *cf;
+
+    New(777, cf, 1, struct cachefunc);
+    cf->cf_func = fnc;
+    cf->cf_any = any;
+    sv_magic(sv, Nullsv, 'c', (char*)cf, sizeof(struct cachefunc));
 }
 
 void
--- ./mg.c~	Wed Dec 17 05:30:40 1997
+++ ./mg.c	Mon Jan 12 18:28:58 1998
@@ -1306,6 +1306,25 @@ magic_setuvar(SV *sv, MAGIC *mg)
 }
 
 int
+magic_cache_postchange(SV *sv, MAGIC *mg)
+{
+    /* Caller has mg->mg_moremagic cached, so we cannot free it.  
+       This postpones the freeing until next iteration.  */
+    if (!mg->mg_moremagic || mg->mg_moremagic->mg_type != 'w')
+	sv_unmagic(sv, 'w');		/* Delegate to magic_cache_free().  */
+    return 0;
+}
+
+int
+magic_cache_free(SV *sv, MAGIC *mg)
+{
+    struct cachefunc *cf = (struct cachefunc *)mg->mg_ptr;
+
+    (*cf->cf_func)(sv, cf->cf_any);
+    return 0;
+}
+
+int
 magic_freeregexp(SV *sv, MAGIC *mg)
 {
     regexp *re = (regexp *)mg->mg_obj;
--- ./perl.h~	Thu Dec 18 05:27:28 1997
+++ ./perl.h	Mon Jan 12 18:23:46 1998
@@ -1673,6 +1673,13 @@ struct perl_thread {
 
 typedef struct perl_thread *Thread;
 
+typedef void (*cache_destroy_func)(SV *, ANY);
+
+struct cachefunc {
+    cache_destroy_func cf_func;
+    ANY cf_any;
+};
+
 #include "thread.h"
 #include "pp.h"
 #include "proto.h"
@@ -1801,6 +1808,8 @@ EXT MGVTBL vtbl_amagic =       {0,     m
                                         0,      0,      magic_setamagic};
 EXT MGVTBL vtbl_amagicelem =   {0,     magic_setamagic,
                                         0,      0,      magic_setamagic};
+EXT MGVTBL vtbl_cached =   {0,     magic_cache_postchange,
+                                        0,      0,      magic_cache_free};
 #endif /* OVERLOAD */
 
 #else /* !DOINIT */
@@ -1826,6 +1835,7 @@ EXT MGVTBL vtbl_pos;
 EXT MGVTBL vtbl_bm;
 EXT MGVTBL vtbl_fm;
 EXT MGVTBL vtbl_uvar;
+EXT MGVTBL vtbl_cached;
 
 #ifdef USE_THREADS
 EXT MGVTBL vtbl_mutex;
--- ./proto.h~	Wed Dec 17 06:16:34 1997
+++ ./proto.h	Mon Jan 12 18:22:42 1998
@@ -205,6 +205,8 @@ OP*	list _((OP* o));
 OP*	listkids _((OP* o));
 OP*	localize _((OP* arg, I32 lexical));
 I32	looks_like_number _((SV* sv));
+int	magic_cache_free _((SV *sv, MAGIC *mg));
+int	magic_cache_postchange _((SV *sv, MAGIC *mg));
 int	magic_clearenv	_((SV* sv, MAGIC* mg));
 int	magic_clear_all_env _((SV* sv, MAGIC* mg));
 int	magic_clearpack	_((SV* sv, MAGIC* mg));
@@ -484,6 +486,7 @@ I32	sv_true _((SV *));
 void	sv_add_arena _((char* ptr, U32 size, U32 flags));
 int	sv_backoff _((SV* sv));
 SV*	sv_bless _((SV* sv, HV* stash));
+void	sv_call_afterchange _((SV *sv, cache_destroy_func fnc, ANY any)); 
 void	sv_catpvf _((SV* sv, const char* pat, ...));
 void	sv_catpv _((SV* sv, char* ptr));
 void	sv_catpvn _((SV* sv, char* ptr, STRLEN len));
--- ./global.sym~	Sat Dec 20 21:26:44 1997
+++ ./global.sym	Mon Jan 12 18:25:24 1998
@@ -121,6 +121,7 @@ vtbl_amagicelem
 vtbl_arylen
 vtbl_bm
 vtbl_collxfrm
+vtbl_cached
 vtbl_dbline
 vtbl_defelem
 vtbl_env
@@ -385,6 +386,8 @@ list
 listkids
 localize
 looks_like_number
+magic_cache_free
+magic_cache_postchange
 magic_clearenv
 magic_clear_all_env
 magic_clearpack
@@ -976,6 +979,7 @@ sv_2uv
 sv_add_arena
 sv_backoff
 sv_bless
+sv_call_afterchange
 sv_catpvf
 sv_catpv
 sv_catpvn
