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

diff --git a/embed.h b/embed.h
index 71dc683..c5b537e 100644 (file)
--- 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 918d330..036da41 100644 (file)
--- 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 5279e41..9b3308f 100644 (file)
--- 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 062d016..6ee52ca 100644 (file)
--- 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 d6ea1d2..b981c12 100644 (file)
--- 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 c8bd8b5..60f7dd5 100644 (file)
--- 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 954a99f..025f7c4 100644 (file)
--- 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 444036e..9b924bc 100644 (file)
--- 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 22f49a4..2356e68 100644 (file)
--- 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 023693f..f098efa 100644 (file)
--- 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':