This adds an additional property to magic: prechange magic, which is deleted
before modification (possibly triggering a deletion callback).  Such a 
deletion should not have any side-effects on behaviour of SV, it 
may be used for bookkeeping purposes only (for backward compatibility).

There is no explicit way to call this magic.  Before modification of sv is 
performed, one should check SvREADONLY(sv), which will automatically trigger
the prechange magic - if present.  (Since triggering this magic is 
transparent, there should be no problem with change of semantic of 
SvREADONLY().)

There is a way to check that SV is not modifiable without triggering the
magic, it is called SvREADONLY_TEST(sv).  I did not find a place in
perl code which requires this macro, though.

The macro SvIMMUTABLE(sv) may be used to check that the fields of SV
may be changed directly.  If not, they may be changed via Perl API
only (triggering prechange magic), or the SV is SvREADONLY_TEST(sv).

In perl code SvREADONLY_on()/off() are not used on SVs which may have
RMAGICAL flag, so the existing macros are safe.



--- ./mg.h~	Tue Nov 25 09:52:56 1997
+++ ./mg.h	Tue Mar 17 18:34:36 1998
@@ -29,8 +29,10 @@ struct magic {
 #define MGf_TAINTEDDIR 1
 #define MGf_REFCOUNTED 2
 #define MGf_GSKIP      4
+#define MGf_PRE_CHANGE 8
 
 #define MGf_MINMATCH   1
+#define MGf_NOT_RO     1		/* The SV was not READONLY. */
 
 #define MgTAINTEDDIR(mg)	(mg->mg_flags & MGf_TAINTEDDIR)
 #define MgTAINTEDDIR_on(mg)	(mg->mg_flags |= MGf_TAINTEDDIR)
--- ./global.sym.orig	Mon Jun  8 21:01:54 1998
+++ ./global.sym	Tue Jun  9 00:00:36 1998
@@ -389,6 +389,7 @@ magic_clearsig
 magic_existspack
 magic_freedefelem
 magic_freeregexp
+magic_free_weakref
 magic_get
 magic_getarylen
 magic_getdefelem
@@ -401,6 +402,7 @@ magic_getsubstr
 magic_gettaint
 magic_getuvar
 magic_getvec
+magic_kill_weakrefs
 magic_len
 magic_mutexfree
 magic_nextpack
@@ -421,6 +423,7 @@ magic_setnkeys
 magic_setpack
 magic_setpos
 magic_setsig
+magic_set_weakref
 magic_setsubstr
 magic_settaint
 magic_setuvar
@@ -983,6 +986,7 @@ sv_2uv
 sv_add_arena
 sv_backoff
 sv_bless
+sv_cannot_modify
 sv_catpv
 sv_catpv_mg
 sv_catpvf
@@ -1025,7 +1029,9 @@ sv_ref
 sv_reftype
 sv_replace
 sv_report_used
+sv_request_modify
 sv_reset
+sv_rv2weak
 sv_setiv
 sv_setiv_mg
 sv_setnv
--- ./perl.h.orig	Mon Mar 16 06:31:22 1998
+++ ./perl.h	Tue Mar 17 18:31:48 1998
@@ -1834,6 +1834,11 @@ EXT MGVTBL vtbl_amagicelem =   {0,     m
                                         0,      0,      magic_setamagic};
 #endif /* OVERLOAD */
 
+EXT MGVTBL vtbl_weakref =   {0,     magic_set_weakref,
+                                        0,      0,      magic_free_weakref};
+EXT MGVTBL vtbl_weakref_target =   {0,     0,
+                                        0,      0,      magic_kill_weakrefs};
+
 #else /* !DOINIT */
 
 EXT MGVTBL vtbl_sv;
@@ -1857,6 +1862,8 @@ EXT MGVTBL vtbl_pos;
 EXT MGVTBL vtbl_bm;
 EXT MGVTBL vtbl_fm;
 EXT MGVTBL vtbl_uvar;
+EXT MGVTBL vtbl_weakref;
+EXT MGVTBL vtbl_weakref_target;
 
 #ifdef USE_THREADS
 EXT MGVTBL vtbl_mutex;
--- ./proto.h.orig	Mon Jun  8 21:03:16 1998
+++ ./proto.h	Tue Jun  9 00:02:08 1998
@@ -226,6 +226,7 @@ VIRTUAL int	magic_clearsig	_((SV* sv, MA
 VIRTUAL int	magic_existspack _((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_freedefelem _((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_freeregexp _((SV* sv, MAGIC* mg));
+VIRTUAL int	magic_free_weakref _((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_get	_((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_getarylen	_((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_getdefelem _((SV* sv, MAGIC* mg));
@@ -238,6 +239,7 @@ VIRTUAL int	magic_getsubstr	_((SV* sv, M
 VIRTUAL int	magic_gettaint	_((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_getuvar	_((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_getvec	_((SV* sv, MAGIC* mg));
+VIRTUAL int	magic_kill_weakrefs _((SV* sv, MAGIC* mg));
 VIRTUAL U32	magic_len	_((SV* sv, MAGIC* mg));
 #ifdef USE_THREADS
 VIRTUAL int	magic_mutexfree	_((SV* sv, MAGIC* mg));
@@ -263,6 +265,7 @@ VIRTUAL int	magic_setnkeys	_((SV* sv, MA
 VIRTUAL int	magic_setpack	_((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_setpos	_((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_setsig	_((SV* sv, MAGIC* mg));
+VIRTUAL int	magic_set_weakref _((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_setsubstr	_((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_settaint	_((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_setuvar	_((SV* sv, MAGIC* mg));
@@ -603,6 +606,7 @@ VIRTUAL void	sv_vcatpvfn _((SV* sv, cons
 VIRTUAL void	sv_vsetpvfn _((SV* sv, const char* pat, STRLEN patlen,
 		       va_list* args, SV** svargs, I32 svmax,
 		       bool *used_locale));
+VIRTUAL SV*	sv_rv2weak _((SV* rv));
 VIRTUAL void	taint_env _((void));
 VIRTUAL void	taint_proper _((const char* f, char* s));
 #ifdef UNLINK_ALL_VERSIONS
@@ -672,6 +676,8 @@ void del_xrv _((XRV* p));
 void sv_mortalgrow _((void));
 void sv_unglob _((SV* sv));
 void sv_check_thinkfirst _((SV *sv));
+int sv_cannot_modify _((SV *sv));
+int sv_request_modify _((SV *sv));
 
 SV *newSVpvn _((char *s, STRLEN len));
 
--- ./av.c~	Thu May 28 13:02:16 1998
+++ ./av.c	Mon Jun  8 23:25:54 1998
@@ -208,7 +208,7 @@ av_store(register AV *av, I32 key, SV *v
 	    return 0;
     }
 
-    if (SvREADONLY(av) && key >= AvFILL(av))
+    if (AvREADONLY(av) && key >= AvFILL(av))
 	croak(no_modify);
 
     if (SvRMAGICAL(av)) {
@@ -384,7 +384,7 @@ av_push(register AV *av, SV *val)
     MAGIC *mg;
     if (!av)
 	return;
-    if (SvREADONLY(av))
+    if (AvREADONLY(av))
 	croak(no_modify);
 
     if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
@@ -412,7 +412,7 @@ av_pop(register AV *av)
 
     if (!av || AvFILL(av) < 0)
 	return &sv_undef;
-    if (SvREADONLY(av))
+    if (AvREADONLY(av))
 	croak(no_modify);
     if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
 	dSP;    
@@ -446,7 +446,7 @@ av_unshift(register AV *av, register I32
 
     if (!av || num <= 0)
 	return;
-    if (SvREADONLY(av))
+    if (AvREADONLY(av))
 	croak(no_modify);
 
     if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
@@ -498,7 +498,7 @@ av_shift(register AV *av)
 
     if (!av || AvFILL(av) < 0)
 	return &sv_undef;
-    if (SvREADONLY(av))
+    if (AvREADONLY(av))
 	croak(no_modify);
     if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
 	dSP;
--- ./av.h~	Tue Feb  3 08:14:18 1998
+++ ./av.h	Mon Jun  8 23:24:44 1998
@@ -49,3 +49,4 @@ struct xpvav {
 #define AvFILL(av)	((SvRMAGICAL((SV *) (av))) \
 			  ? mg_size((SV *) av) : AvFILLp(av))
 
+#define AvREADONLY SvIMMUTABLE
--- ./op.c~	Fri May 29 07:00:14 1998
+++ ./op.c	Mon Jun  8 23:41:48 1998
@@ -3354,7 +3354,7 @@ op_const_sv(OP *o, CV *cv)
 	else if (type == OP_PADSV && cv) {
 	    AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
 	    sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
-	    if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
+	    if (!sv || (!SvIMMUTABLE(sv) && SvREFCNT(sv) > 1))
 		return Nullsv;
 	}
 	else
--- ./perl.c~	Fri May 29 07:00:14 1998
+++ ./perl.c	Mon Jun  8 23:42:26 1998
@@ -168,7 +168,7 @@ perl_construct(register PerlInterpreter 
 	linestr = NEWSV(65,80);
 	sv_upgrade(linestr,SVt_PVIV);
 
-	if (!SvREADONLY(&sv_undef)) {
+	if (!SvIMMUTABLE(&sv_undef)) {
 	    SvREADONLY_on(&sv_undef);
 
 	    sv_setpv(&sv_no,No);
--- ./sv.h~	Fri May 29 07:00:22 1998
+++ ./sv.h	Mon Jun  8 23:38:06 1998
@@ -434,9 +434,19 @@ struct xpvio {
 #define SvOBJECT_on(sv)		(SvFLAGS(sv) |= SVs_OBJECT)
 #define SvOBJECT_off(sv)	(SvFLAGS(sv) &= ~SVs_OBJECT)
 
-#define SvREADONLY(sv)		(SvFLAGS(sv) & SVf_READONLY)
+    /* Should be modified via Perl API only, no direct change of
+       fields allowed.  */
+#define SvIMMUTABLE(sv)		(SvFLAGS(sv) & SVf_READONLY)
+
+    /* Should not be modified at all.  */
+#define SvREADONLY(sv)	(SvIMMUTABLE(sv) && (!SvRMAGICAL(sv) || sv_cannot_modify(sv)))
 #define SvREADONLY_on(sv)	(SvFLAGS(sv) |= SVf_READONLY)
 #define SvREADONLY_off(sv)	(SvFLAGS(sv) &= ~SVf_READONLY)
+
+    /* Request modification permission: */
+#define SvTRY_PRECHANGE(sv)	(!SvIMMUTABLE(sv) || (SvRMAGICAL(sv) && sv_request_modify(sv)))
+
+    /* Backward compatibility mode: assume they want to modify.  */
 
 #define SvSCREAM(sv)		(SvFLAGS(sv) & SVp_SCREAM)
 #define SvSCREAM_on(sv)		(SvFLAGS(sv) |= SVp_SCREAM)
--- ./doio.c~	Tue Jun  9 23:46:36 1998
+++ ./doio.c	Fri Jun 19 00:12:35 1998
@@ -1541,7 +1541,7 @@ do_msgrcv(SV **mark, SV **sp)
     mtype = (long)SvIVx(*++mark);
     flags = SvIVx(*++mark);
     if (SvTHINKFIRST(mstr)) {
-	if (SvREADONLY(mstr))
+	if (!SvTRY_PRECHANGE(mstr))
 	    croak("Can't msgrcv to readonly var");
 	if (SvROK(mstr))
 	    sv_unref(mstr);
--- ./doop.c~	Fri Jun 19 00:10:11 1998
+++ ./doop.c	Fri Jun 19 00:13:34 1998
@@ -32,7 +32,7 @@ do_trans(SV *sv, OP *arg)
     register U8 *p;
     STRLEN len;
 
-    if (!(op->op_private & OPpTRANS_COUNTONLY) && SvREADONLY(sv))
+    if (!(op->op_private & OPpTRANS_COUNTONLY) && !SvTRY_PRECHANGE(sv))
 	croak(no_modify);
     tbl = (short*)cPVOP->op_pv;
     s = (U8*)SvPV(sv, len);
--- ./mg.c~	Fri Jun 19 00:10:11 1998
+++ ./mg.c	Fri Jun 19 00:15:47 1998
@@ -52,7 +52,7 @@ save_magic(MGS *mgs, SV *sv)
     assert(SvMAGICAL(sv));
 
     mgs->mgs_sv = sv;
-    mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
+    mgs->mgs_flags = SvMAGICAL(sv) | SvIMMORTAL(sv) ;
     SAVEDESTRUCTOR(restore_magic, mgs);
 
     SvMAGICAL_off(sv);
--- ./pp.c~	Thu Jun 11 02:32:20 1998
+++ ./pp.c	Fri Jun 19 00:18:20 1998
@@ -759,7 +759,7 @@ PP(pp_undef)
 	RETPUSHUNDEF;
 
     if (SvTHINKFIRST(sv)) {
-	if (SvREADONLY(sv))
+	if (!SvTRY_PRECHANGE(sv))
 	    RETPUSHUNDEF;
 	if (SvROK(sv))
 	    sv_unref(sv);
@@ -815,7 +815,7 @@ PP(pp_undef)
 PP(pp_predec)
 {
     djSP;
-    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+    if (!SvTRY_PRECHANGE(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
 	croak(no_modify);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
     	SvIVX(TOPs) != IV_MIN)
@@ -832,7 +832,7 @@ PP(pp_predec)
 PP(pp_postinc)
 {
     djSP; dTARGET;
-    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+    if (!SvTRY_PRECHANGE(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
 	croak(no_modify);
     sv_setsv(TARG, TOPs);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
@@ -853,7 +853,7 @@ PP(pp_postinc)
 PP(pp_postdec)
 {
     djSP; dTARGET;
-    if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+    if(!SvTRY_PRECHANGE(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
 	croak(no_modify);
     sv_setsv(TARG, TOPs);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
@@ -1000,7 +1000,7 @@ PP(pp_repeat)
 
 	tmpstr = POPs;
 	if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
-	    if (SvREADONLY(tmpstr) && curcop != &compiling)
+	    if (!SvTRY_PRECHANGE(tmpstr) && curcop != &compiling)
 		DIE("Can't x= to readonly value");
 	    if (SvROK(tmpstr))
 		sv_unref(tmpstr);
--- ./pp_hot.c~	Tue Jun  9 23:46:53 1998
+++ ./pp_hot.c	Fri Jun 19 00:20:17 1998
@@ -211,7 +211,7 @@ PP(pp_eq)
 PP(pp_preinc)
 {
     djSP;
-    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+    if (!SvTRY_PRECHANGE(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
 	croak(no_modify);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
     	SvIVX(TOPs) != IV_MAX)
@@ -658,7 +658,7 @@ PP(pp_aassign)
 	    break;
 	default:
 	    if (SvTHINKFIRST(sv)) {
-		if (SvREADONLY(sv) && curcop != &compiling) {
+		if (!SvTRY_PRECHANGE(sv) && curcop != &compiling) {
 		    if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
 			DIE(no_modify);
 		    if (relem <= lastrelem)
@@ -1468,7 +1468,7 @@ PP(pp_subst)
 	TARG = DEFSV;
 	EXTEND(SP,1);
     }                  
-    if (SvREADONLY(TARG)
+    if (!SvTRY_PRECHANGE(TARG)
 	|| (SvTYPE(TARG) > SVt_PVLV
 	    && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
 	croak(no_modify);
@@ -2297,7 +2297,7 @@ vivify_ref(SV *sv, U32 to_what)
     if (SvGMAGICAL(sv))
 	mg_get(sv);
     if (!SvOK(sv)) {
-	if (SvREADONLY(sv))
+	if (!SvTRY_PRECHANGE(sv))
 	    croak(no_modify);
 	if (SvTYPE(sv) < SVt_RV)
 	    sv_upgrade(sv, SVt_RV);
--- ./toke.c~	Thu Jun 18 22:08:14 1998
+++ ./toke.c	Fri Jun 19 00:30:54 1998
@@ -276,7 +276,7 @@ lex_start(SV *line)
     lex_inpat = 0;
     lex_inwhat = 0;
     linestr = line;
-    if (SvREADONLY(linestr))
+    if (SvIMMUTABLE(linestr))
 	linestr = sv_2mortal(newSVsv(linestr));
     s = SvPV(linestr, len);
     if (len && s[len-1] != ';') {
--- ./sv.c~	Fri Jun 19 00:10:11 1998
+++ ./sv.c	Fri Jun 19 00:30:04 1998
@@ -2388,7 +2388,7 @@ sv_usepvn_mg(register SV *sv, register c
 STATIC void
 sv_check_thinkfirst(register SV *sv)
 {
-    if (SvREADONLY(sv)) {
+    if (!SvTRY_PRECHANGE(sv)) {
 	dTHR;
 	if (curcop != &compiling)
 	    croak(no_modify);
@@ -3032,7 +3032,7 @@ sv_free(SV *sv)
 
     if (!sv)
 	return;
-    if (SvREADONLY(sv)) {
+    if (SvIMMUTABLE(sv)) {
 	if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
 	    return;
     }
@@ -3503,7 +3503,7 @@ sv_inc(register SV *sv)
     if (!sv)
 	return;
     if (SvTHINKFIRST(sv)) {
-	if (SvREADONLY(sv)) {
+	if (!SvTRY_PRECHANGE(sv)) {
 	    dTHR;
 	    if (curcop != &compiling)
 		croak(no_modify);
@@ -3580,7 +3580,7 @@ sv_dec(register SV *sv)
     if (!sv)
 	return;
     if (SvTHINKFIRST(sv)) {
-	if (SvREADONLY(sv)) {
+	if (!SvTRY_PRECHANGE(sv)) {
 	    dTHR;
 	    if (curcop != &compiling)
 		croak(no_modify);
@@ -3675,7 +3675,7 @@ sv_2mortal(register SV *sv)
     dTHR;
     if (!sv)
 	return sv;
-    if (SvREADONLY(sv) && curcop != &compiling)
+    if (!SvTRY_PRECHANGE(sv) && curcop != &compiling)
 	croak(no_modify);
     if (++tmps_ix >= tmps_max)
 	sv_mortalgrow();
@@ -4216,7 +4216,7 @@ sv_bless(SV *sv, HV *stash)
         croak("Can't bless non-reference value");
     tmpRef = SvRV(sv);
     if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
-	if (SvREADONLY(tmpRef))
+	if (!SvTRY_PRECHANGE(tmpRef))
 	    croak(no_modify);
 	if (SvOBJECT(tmpRef)) {
 	    if (SvTYPE(tmpRef) != SVt_PVIO)
@@ -4265,7 +4265,7 @@ sv_unref(SV *sv)
     
     SvRV(sv) = 0;
     SvROK_off(sv);
-    if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
+    if (SvREFCNT(rv) != 1 || !SvTRY_PRECHANGE(rv))
 	SvREFCNT_dec(rv);
     else
 	sv_2mortal(rv);		/* Schedule for freeing later */
--- ./scope.c~	Mon Jun 15 04:41:16 1998
+++ ./scope.c	Fri Jun 19 00:21:22 1998
@@ -705,7 +705,7 @@ leave_scope(I32 base)
 	    /* Can clear pad variable in place? */
 	    if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
 		if (SvTHINKFIRST(sv)) {
-		    if (SvREADONLY(sv))
+		    if (!SvTRY_PRECHANGE(sv))
 			croak("panic: leave_scope clearsv");
 		    if (SvROK(sv))
 			sv_unref(sv);
