Applied patch, followed by tweaks to *.sym and `perl embed.pl`

	Message-Id: <199806090216.WAA02041@monk.mps.ohio-state.edu>
	Subject: [PATCH 5.004_66] Resend of RE cache patch (modified)

p4raw-id: //depot/perl@1105

10 files changed, 26 insertions, 15 deletions

diff --git a/embed.h b/embed.h
index 71dc6837c5..c5b537ea94 100644
--- a/embed.h
+++ b/embed.h
@@ -211,7 +211,7 @@
 #define get_op_descs		Perl_get_op_descs
 #define get_op_names		Perl_get_op_names
 #define get_opargs		Perl_get_opargs
-#define get_specialsv_list  Perl_get_specialsv_list
+#define get_specialsv_list	Perl_get_specialsv_list
 #define gp_free			Perl_gp_free
 #define gp_ref			Perl_gp_ref
 #define gt_amg			Perl_gt_amg
@@ -325,6 +325,7 @@
 #define magic_setuvar		Perl_magic_setuvar
 #define magic_setvec		Perl_magic_setvec
 #define magic_sizepack		Perl_magic_sizepack
+#define magic_unchain		Perl_magic_unchain
 #define magic_wipepack		Perl_magic_wipepack
 #define magicname		Perl_magicname
 #define markstack_grow		Perl_markstack_grow
@@ -924,7 +925,6 @@
 #define sle_amg			Perl_sle_amg
 #define slt_amg			Perl_slt_amg
 #define sne_amg			Perl_sne_amg
-#define specialsv_list		Perl_specialsv_list
 #define sqrt_amg		Perl_sqrt_amg
 #define stack_grow		Perl_stack_grow
 #define start_subparse		Perl_start_subparse
diff --git a/embedvar.h b/embedvar.h
index 918d330a23..036da41701 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -220,7 +220,6 @@
 #define sortcop			(curinterp->Isortcop)
 #define sortcxix		(curinterp->Isortcxix)
 #define sortstash		(curinterp->Isortstash)
-#define specialsv_list	(curinterp->Ispecialsv_list)
 #define splitstr		(curinterp->Isplitstr)
 #define statcache		(curinterp->Istatcache)
 #define statgv			(curinterp->Istatgv)
@@ -384,7 +383,6 @@
 #define Isortcop		sortcop
 #define Isortcxix		sortcxix
 #define Isortstash		sortstash
-#define Ispecialsv_list	specialsv_list
 #define Isplitstr		splitstr
 #define Istatcache		statcache
 #define Istatgv			statgv
@@ -610,7 +608,6 @@
 #define sortcop			Perl_sortcop
 #define sortcxix		Perl_sortcxix
 #define sortstash		Perl_sortstash
-#define specialsv_list	Perl_specialsv_list
 #define splitstr		Perl_splitstr
 #define statcache		Perl_statcache
 #define statgv			Perl_statgv
@@ -855,6 +852,7 @@
 #define scrgv			(Perl_Vars.Gscrgv)
 #define sh_path			(Perl_Vars.Gsh_path)
 #define sighandlerp		(Perl_Vars.Gsighandlerp)
+#define specialsv_list		(Perl_Vars.Gspecialsv_list)
 #define sub_generation		(Perl_Vars.Gsub_generation)
 #define subline			(Perl_Vars.Gsubline)
 #define subname			(Perl_Vars.Gsubname)
@@ -974,6 +972,7 @@
 #define Gscrgv			scrgv
 #define Gsh_path		sh_path
 #define Gsighandlerp		sighandlerp
+#define Gspecialsv_list		specialsv_list
 #define Gsub_generation		sub_generation
 #define Gsubline		subline
 #define Gsubname		subname
@@ -1093,6 +1092,7 @@
 #define scrgv			Perl_scrgv
 #define sh_path			Perl_sh_path
 #define sighandlerp		Perl_sighandlerp
+#define specialsv_list		Perl_specialsv_list
 #define sub_generation		Perl_sub_generation
 #define subline			Perl_subline
 #define subname			Perl_subname
diff --git a/global.sym b/global.sym
index 5279e410fd..9b3308f42d 100644
--- a/global.sym
+++ b/global.sym
@@ -34,10 +34,6 @@ fold
 fold_locale
 freq
 ge_amg
-get_op_descs
-get_op_names
-get_no_modify
-get_opargs
 gt_amg
 inc_amg
 init_thread_intern
@@ -105,7 +101,6 @@ sin_amg
 sle_amg
 slt_amg
 sne_amg
-specialsv_list
 sqrt_amg
 string_amg
 subtr_amg
@@ -322,6 +317,11 @@ force_word
 form
 free_tmps
 gen_constant_list
+get_op_descs
+get_op_names
+get_no_modify
+get_opargs
+get_specialsv_list
 gp_free
 gp_ref
 gv_AVadd
@@ -425,6 +425,7 @@ magic_settaint
 magic_setuvar
 magic_setvec
 magic_sizepack
+magic_unchain
 magic_wipepack
 magicname
 markstack_grow
diff --git a/intrpvar.h b/intrpvar.h
index 062d016c20..6ee52ca153 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -232,5 +232,3 @@ PERLVARI(piDir,		IPerlDir*,  NULL)
 PERLVARI(piSock,	IPerlSock*, NULL)
 PERLVARI(piProc,	IPerlProc*, NULL)
 #endif
-
-PERLVAR(Ispecialsv_list[4], SV *)	/* from byterun.h */
diff --git a/mg.c b/mg.c
index d6ea1d2c58..b981c12fae 100644
--- a/mg.c
+++ b/mg.c
@@ -1511,6 +1511,13 @@ magic_freeregexp(SV *sv, MAGIC *mg)
     return 0;
 }
 
+int
+magic_unchain(SV *sv, MAGIC *mg)
+{
+    sv_unmagic(sv, mg->mg_type);
+    return 0;
+}
+
 #ifdef USE_LOCALE_COLLATE
 int
 magic_setcollxfrm(SV *sv, MAGIC *mg)
diff --git a/perl.h b/perl.h
index c8bd8b5e0e..60f7dd5605 100644
--- a/perl.h
+++ b/perl.h
@@ -2041,7 +2041,7 @@ EXT MGVTBL vtbl_mutex =	{0,	0,	0,	0,	magic_mutexfree};
 EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem,
 					0,	0,	magic_freedefelem};
 
-EXT MGVTBL vtbl_regexp = {0,0,0,0, magic_freeregexp};
+EXT MGVTBL vtbl_regexp = {0,magic_unchain,0,0, magic_freeregexp};
 
 #ifdef USE_LOCALE_COLLATE
 EXT MGVTBL vtbl_collxfrm = {0,
diff --git a/perlvars.h b/perlvars.h
index 954a99fb91..025f7c49ab 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -168,3 +168,5 @@ PERLVARIC(GNo,		char *, "")
 PERLVARIC(Ghexdigit,	char *, "0123456789abcdef0123456789ABCDEFx")
 PERLVARIC(Gpatleave,	char *, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}")
 
+PERLVAR(Gspecialsv_list[4], SV *)		/* from byterun.h */
+
diff --git a/pp_ctl.c b/pp_ctl.c
index 444036ea7e..9b924bc0f8 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -76,8 +76,8 @@ PP(pp_regcomp) {
     MAGIC *mg = Null(MAGIC*);
 
     tmpstr = POPs;
-    if(SvROK(tmpstr)) {
-	SV *sv = SvRV(tmpstr);
+    if(SvROK(tmpstr) || SvRMAGICAL(tmpstr)) {
+	SV *sv = SvROK(tmpstr) ? SvRV(tmpstr) : tmpstr;
 	if(SvMAGICAL(sv))
 	    mg = mg_find(sv, 'r');
     }
@@ -101,6 +101,7 @@ PP(pp_regcomp) {
 
 	    pm->op_pmflags = pm->op_pmpermflags;	/* reset case sensitivity */
 	    pm->op_pmregexp = pregcomp(t, t + len, pm);
+	    sv_magic(tmpstr,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0);
 	}
     }
 
diff --git a/proto.h b/proto.h
index 22f49a4661..2356e68852 100644
--- a/proto.h
+++ b/proto.h
@@ -269,6 +269,7 @@ VIRTUAL int	magic_setuvar	_((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_setvec	_((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_set_all_env _((SV* sv, MAGIC* mg));
 VIRTUAL U32	magic_sizepack	_((SV* sv, MAGIC* mg));
+VIRTUAL int	magic_unchain	_((SV* sv, MAGIC* mg));
 VIRTUAL int	magic_wipepack	_((SV* sv, MAGIC* mg));
 VIRTUAL void	magicname _((char* sym, char* name, I32 namlen));
 int	main _((int argc, char** argv, char** env));
diff --git a/sv.c b/sv.c
index 023693f7b0..f098efa5bb 100644
--- a/sv.c
+++ b/sv.c
@@ -2562,6 +2562,7 @@ sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen)
 	mg->mg_virtual = &vtbl_packelem;
 	break;
     case 'r':
+	SvRMAGICAL_on(sv);
 	mg->mg_virtual = &vtbl_regexp;
 	break;
     case 'S':