Tim Bunce writes:
> This patch doesn't seem to be a patch over _6x or a patch over your
> previous patch. It doesn't contain sv_rv2weak for example.

Here is what is missing in sv.c.  It looks that patch on Solaris is
confiugred much worse than on my home OS/2 machine:  at home it
*always* creates .orig, on Solaris only in some (?) cases.  Is there
an environment/option to enable creations of .orig?

--- ./sv.c	Sat Jun 20 15:26:50 1998
+++ ../perl5.004_67.my/sv.c	Fri Jun 19 21:01:53 1998
@@ -645,6 +645,43 @@ my_safemalloc(MEM_SIZE size)
 #define new_XPVIO() (void*)my_safemalloc(sizeof(XPVIO))
 #define del_XPVIO(p) my_safefree((char*)p)
 
+/* Should be called with IMMUTABLE and RMAGICAL sv only. */
+int
+sv_request_modify(register SV *sv)
+{
+	/* Check whether SVt_READONLY is set only for PRE_CHANGE
+	   magic, and call this magic if present. */
+	MAGIC *mg = SvMAGIC(sv);
+
+	while (mg) {
+	    MAGIC *next = mg->mg_moremagic;
+
+	    if (mg->mg_flags & MGf_PRE_CHANGE)
+		sv_unmagic(sv, mg->mg_type); /* Trigger _free method. */
+	    mg = next;
+	}
+	return SvIMMUTABLE(sv);		/* Now the real state is restored */
+}
+
+/* Should be called with IMMUTABLE and RMAGICAL sv only. */
+int
+sv_cannot_modify(register SV *sv)
+{
+	/* Check whether SVt_READONLY is set only for PRE_CHANGE magic. */
+	MAGIC *mg = SvMAGIC(sv);
+	int cannot = 1;
+
+	while (mg) {
+	    MAGIC *next = mg->mg_moremagic;
+
+	    if (mg->mg_flags & (MGf_PRE_CHANGE|MGf_NOT_RO) 
+		== (MGf_PRE_CHANGE|MGf_NOT_RO))
+		cannot = 0;
+	    mg = next;
+	}
+	return cannot;			/* Now the real state is restored */
+}
+
 bool
 sv_upgrade(register SV *sv, U32 mt)
 {
@@ -942,7 +979,7 @@ sv_peek(SV *sv)
 	    sv_catpv(t, "SV_UNDEF");
 	    if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
 				 SVs_GMG|SVs_SMG|SVs_RMG)) &&
-		SvREADONLY(sv))
+		SvIMMUTABLE(sv))
 		goto finish;
 	}
 	else if (sv == &sv_no) {
@@ -1702,7 +1739,7 @@ sv_2pv(register SV *sv, STRLEN *lp)
 		case SVt_PVMG:
 		    if ( ((SvFLAGS(sv) &
 			   (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG)) 
-			  == (SVs_OBJECT|SVs_RMG))
+			  == (SVs_OBJECT|SVs_RMG|SVs_SMG))
 			 && strEQ(s=HvNAME(SvSTASH(sv)), "Regexp")
 			 && (mg = mg_find(sv, 'r'))) {
 			regexp *re = (regexp *)mg->mg_obj;
@@ -2609,6 +2646,18 @@ sv_magic(register SV *sv, SV *obj, int h
     case '.':
 	mg->mg_virtual = &vtbl_pos;
 	break;
+    case '>':
+	SvRMAGICAL_on(sv);
+	if (!SvIMMUTABLE(sv)) {
+	    mg->mg_flags |= (MGf_NOT_RO | MGf_PRE_CHANGE);
+	    SvREADONLY_on(sv);
+	} else
+	    mg->mg_flags |= MGf_PRE_CHANGE;
+	mg->mg_virtual = &vtbl_weakref;
+	break;
+    case '<':
+	mg->mg_virtual = &vtbl_weakref_target;
+	break;
     case '~':	/* Reserved for use by extensions not perl internals.	*/
 	/* Useful for attaching extension internal data to perl vars.	*/
 	/* Note that multiple extensions may clash if magical scalars	*/
@@ -2655,6 +2704,36 @@ sv_unmagic(SV *sv, int type)
     }
 
     return 0;
+}
+
+SV*
+sv_rv2weak(sv)
+SV *sv;
+{
+    if (!SvROK(sv))
+	croak("panic: rv2weak: not a reference");
+    if (SvREFCNT(SvRV(sv)) == 1) 
+	sv_setsv(sv, &sv_undef);
+    else {
+	AV *av;
+	SV *tsv = SvRV(sv);
+	MAGIC *mg = mg_find(tsv, '<');
+	
+	if (mg)  {
+	    av = (AV*)mg->mg_obj;
+	} else {
+	    av = newAV();
+	    sv_magic(tsv, (SV*)av, '<', NULL, 0);
+	    SvREFCNT_dec(av);		/* for sv_magic */
+	}
+	av_push(av,sv);
+	/* When sv is freeed, it will be ROK_off before tsv may be CNT_dec. */
+	sv_magic(sv, tsv, '>', NULL, 0);
+	if (tsv != sv)			/* Quirks of sv_magic... */
+	    SvREFCNT_dec(tsv);		/* for sv_magic */
+	SvREFCNT_dec(tsv);		/* for ROK_off */
+    }
+    return sv;
 }
 
 void
