summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2006-03-17 13:38:34 +0000
committerNicholas Clark <nick@ccl4.org>2006-03-17 13:38:34 +0000
commitd83f0a8247ea7458731c8479d8cbf3ee1fa81243 (patch)
treec7b22a3a0257894aa9ec9c70af39e396f7212d7b
parentb4a415570dc258ddaff4bbab5c0f83c1af645b29 (diff)
downloadperl-d83f0a8247ea7458731c8479d8cbf3ee1fa81243.tar.gz
sv_find() returning false, followed by sv_magic() to add the magic,
followed immediately by sv_find() to find it, is somewhat wasteful. So use sv_magicext(). (All cases are also correct w.r.t. SvREADONLY()) p4raw-id: //depot/perl@27533
-rw-r--r--mg.c8
-rw-r--r--pp_ctl.c8
-rw-r--r--pp_hot.c16
-rw-r--r--regexec.c9
-rw-r--r--sv.c8
5 files changed, 36 insertions, 13 deletions
diff --git a/mg.c b/mg.c
index d82e9f0df6..2a38ddadf7 100644
--- a/mg.c
+++ b/mg.c
@@ -1803,8 +1803,12 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
if (!mg) {
if (!SvOK(sv))
return 0;
- sv_magic(lsv, NULL, PERL_MAGIC_regex_global, NULL, 0);
- mg = mg_find(lsv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(lsv))
+ sv_force_normal_flags(lsv, 0);
+#endif
+ mg = sv_magicext(lsv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
+ NULL, 0);
}
else if (!SvOK(sv)) {
mg->mg_len = -1;
diff --git a/pp_ctl.c b/pp_ctl.c
index 4b0703b861..87a383d259 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -284,8 +284,12 @@ PP(pp_substcont)
if (SvTYPE(sv) < SVt_PVMG)
SvUPGRADE(sv, SVt_PVMG);
if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
- sv_magic(sv, NULL, PERL_MAGIC_regex_global, NULL, 0);
- mg = mg_find(sv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(lsv))
+ sv_force_normal_flags(sv, 0);
+#endif
+ mg = sv_magicext(sv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
+ NULL, 0);
}
i = m - orig;
if (DO_UTF8(sv))
diff --git a/pp_hot.c b/pp_hot.c
index f28b0421c3..c34fb90fb2 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1405,8 +1405,12 @@ play_it_again:
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
mg = mg_find(TARG, PERL_MAGIC_regex_global);
if (!mg) {
- sv_magic(TARG, NULL, PERL_MAGIC_regex_global, NULL, 0);
- mg = mg_find(TARG, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(TARG))
+ sv_force_normal_flags(TARG, 0);
+#endif
+ mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
+ &PL_vtbl_mglob, NULL, 0);
}
if (rx->startp[0] != -1) {
mg->mg_len = rx->endp[0];
@@ -1435,8 +1439,12 @@ play_it_again:
else
mg = NULL;
if (!mg) {
- sv_magic(TARG, NULL, PERL_MAGIC_regex_global, NULL, 0);
- mg = mg_find(TARG, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(TARG))
+ sv_force_normal_flags(TARG, 0);
+#endif
+ mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
+ &PL_vtbl_mglob, NULL, 0);
}
if (rx->startp[0] != -1) {
mg->mg_len = rx->endp[0];
diff --git a/regexec.c b/regexec.c
index eb2480cda1..e802282ac8 100644
--- a/regexec.c
+++ b/regexec.c
@@ -2130,9 +2130,12 @@ S_regtry(pTHX_ regexp *prog, char *startpos)
if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
&& (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
/* prepare for quick setting of pos */
- sv_magic(PL_reg_sv, (SV*)0,
- PERL_MAGIC_regex_global, NULL, 0);
- mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(sv))
+ sv_force_normal_flags(sv, 0);
+#endif
+ mg = sv_magicext(PL_reg_sv, (SV*)0, PERL_MAGIC_regex_global,
+ &PL_vtbl_mglob, NULL, 0);
mg->mg_len = -1;
}
PL_reg_magic = mg;
diff --git a/sv.c b/sv.c
index 147d13bf73..1ec559ce67 100644
--- a/sv.c
+++ b/sv.c
@@ -5943,8 +5943,12 @@ Perl_sv_collxfrm(pTHX_ SV *sv, STRLEN *nxp)
return xf + sizeof(PL_collation_ix);
}
if (! mg) {
- sv_magic(sv, 0, PERL_MAGIC_collxfrm, 0, 0);
- mg = mg_find(sv, PERL_MAGIC_collxfrm);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(sv))
+ sv_force_normal_flags(sv, 0);
+#endif
+ mg = sv_magicext(sv, 0, PERL_MAGIC_collxfrm, &PL_vtbl_collxfrm,
+ 0, 0);
assert(mg);
}
mg->mg_ptr = xf;