Change 29951 by [EMAIL PROTECTED] on 2007/01/24 16:24:04
Integrate:
[ 27840]
Merge sv_usepvn and sv_usepvn_mg into sv_usepvn_flags. "Promote" the
other two to mathoms.c
[ 27841]
Provide a new flag for sv_usepvn_flags, SV_HAS_TRAILING_NUL, which
signals that the buffer passed in is already well-formed for use as
SvPVX (i.e. it is followed by a trailing NUL), and hence the realloc()
to add a NUL can be skipped.
[ 27842]
In Perl_sv_usepvn_flags, assert() that the caller has RTFM.
[ 27843]
Perl_do_vop can profitably use Perl_sv_usepvn_flags, as it has
allocated space for an initialised a trailing NUL.
[ 27846]
Stray pod/perlapi.pod change found after a regen.
[ 27852]
Fix bug introduced with change 27841. (len + 1, not just len).
Affected files ...
... //depot/maint-5.8/perl/doop.c#45 integrate
... //depot/maint-5.8/perl/embed.fnc#183 integrate
... //depot/maint-5.8/perl/embed.h#137 integrate
... //depot/maint-5.8/perl/global.sym#52 integrate
... //depot/maint-5.8/perl/mathoms.c#20 integrate
... //depot/maint-5.8/perl/pod/perlapi.pod#87 integrate
... //depot/maint-5.8/perl/pp.c#121 integrate
... //depot/maint-5.8/perl/proto.h#172 integrate
... //depot/maint-5.8/perl/sv.c#309 integrate
... //depot/maint-5.8/perl/sv.h#72 integrate
Differences ...
==== //depot/maint-5.8/perl/doop.c#45 (text) ====
Index: perl/doop.c
--- perl/doop.c#44~29950~ 2007-01-24 07:42:09.000000000 -0800
+++ perl/doop.c 2007-01-24 08:24:04.000000000 -0800
@@ -1219,7 +1219,7 @@
needlen = ((optype == OP_BIT_AND)
? len : (leftlen > rightlen ? leftlen : rightlen));
Newxz(dc, needlen + 1, char);
- (void)sv_usepvn(sv, dc, needlen);
+ sv_usepvn_flags(sv, dc, needlen, SV_HAS_TRAILING_NUL);
dc = SvPVX(sv); /* sv_usepvn() calls Renew() */
}
if (left_utf || right_utf) {
==== //depot/maint-5.8/perl/embed.fnc#183 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#182~29948~ 2007-01-24 07:13:14.000000000 -0800
+++ perl/embed.fnc 2007-01-24 08:24:04.000000000 -0800
@@ -839,7 +839,9 @@
Apd |void |sv_unref_flags |NN SV* sv|U32 flags
Apd |void |sv_untaint |NN SV* sv
Apd |bool |sv_upgrade |NN SV* sv|U32 mt
-Apd |void |sv_usepvn |NN SV* sv|NULLOK char* ptr|STRLEN len
+Apdmb |void |sv_usepvn |NN SV* sv|NULLOK char* ptr|STRLEN len
+Apd |void |sv_usepvn_flags|NN SV* sv|NULLOK char* ptr|STRLEN len\
+ |U32 flags
Apd |void |sv_vcatpvfn |NN SV* sv|NN const char* pat|STRLEN patlen \
|NULLOK va_list* args|NULLOK SV** svargs|I32
svmax \
|NULLOK bool *maybe_tainted
@@ -954,7 +956,7 @@
Apd |void |sv_setpv_mg |NN SV *sv|NULLOK const char *ptr
Apd |void |sv_setpvn_mg |NN SV *sv|NN const char *ptr|STRLEN len
Apd |void |sv_setsv_mg |NN SV *dstr|NULLOK SV *sstr
-Apd |void |sv_usepvn_mg |NN SV *sv|NULLOK char *ptr|STRLEN len
+Apdbm |void |sv_usepvn_mg |NN SV *sv|NULLOK char *ptr|STRLEN len
ApR |MGVTBL*|get_vtbl |int vtbl_id
Ap |char* |pv_display |NN SV *dsv|NN char *pv|STRLEN cur|STRLEN len \
|STRLEN pvlim
==== //depot/maint-5.8/perl/embed.h#137 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#136~29947~ 2007-01-24 05:54:09.000000000 -0800
+++ perl/embed.h 2007-01-24 08:24:04.000000000 -0800
@@ -871,7 +871,7 @@
#define sv_unref_flags Perl_sv_unref_flags
#define sv_untaint Perl_sv_untaint
#define sv_upgrade Perl_sv_upgrade
-#define sv_usepvn Perl_sv_usepvn
+#define sv_usepvn_flags Perl_sv_usepvn_flags
#define sv_vcatpvfn Perl_sv_vcatpvfn
#define sv_vsetpvfn Perl_sv_vsetpvfn
#define str_to_version Perl_str_to_version
@@ -982,7 +982,6 @@
#define sv_setpv_mg Perl_sv_setpv_mg
#define sv_setpvn_mg Perl_sv_setpvn_mg
#define sv_setsv_mg Perl_sv_setsv_mg
-#define sv_usepvn_mg Perl_sv_usepvn_mg
#define get_vtbl Perl_get_vtbl
#define pv_display Perl_pv_display
#define dump_indent Perl_dump_indent
@@ -2955,7 +2954,7 @@
#define sv_unref_flags(a,b) Perl_sv_unref_flags(aTHX_ a,b)
#define sv_untaint(a) Perl_sv_untaint(aTHX_ a)
#define sv_upgrade(a,b) Perl_sv_upgrade(aTHX_ a,b)
-#define sv_usepvn(a,b,c) Perl_sv_usepvn(aTHX_ a,b,c)
+#define sv_usepvn_flags(a,b,c,d) Perl_sv_usepvn_flags(aTHX_ a,b,c,d)
#define sv_vcatpvfn(a,b,c,d,e,f,g) Perl_sv_vcatpvfn(aTHX_ a,b,c,d,e,f,g)
#define sv_vsetpvfn(a,b,c,d,e,f,g) Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g)
#define str_to_version(a) Perl_str_to_version(aTHX_ a)
@@ -3062,7 +3061,6 @@
#define sv_setpv_mg(a,b) Perl_sv_setpv_mg(aTHX_ a,b)
#define sv_setpvn_mg(a,b,c) Perl_sv_setpvn_mg(aTHX_ a,b,c)
#define sv_setsv_mg(a,b) Perl_sv_setsv_mg(aTHX_ a,b)
-#define sv_usepvn_mg(a,b,c) Perl_sv_usepvn_mg(aTHX_ a,b,c)
#define get_vtbl(a) Perl_get_vtbl(aTHX_ a)
#define pv_display(a,b,c,d,e) Perl_pv_display(aTHX_ a,b,c,d,e)
#define dump_vindent(a,b,c,d) Perl_dump_vindent(aTHX_ a,b,c,d)
==== //depot/maint-5.8/perl/global.sym#52 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#51~29926~ 2007-01-22 14:47:32.000000000 -0800
+++ perl/global.sym 2007-01-24 08:24:04.000000000 -0800
@@ -521,6 +521,7 @@
Perl_sv_untaint
Perl_sv_upgrade
Perl_sv_usepvn
+Perl_sv_usepvn_flags
Perl_sv_vcatpvfn
Perl_sv_vsetpvfn
Perl_str_to_version
==== //depot/maint-5.8/perl/mathoms.c#20 (text) ====
Index: perl/mathoms.c
--- perl/mathoms.c#19~29897~ 2007-01-20 10:14:46.000000000 -0800
+++ perl/mathoms.c 2007-01-24 08:24:04.000000000 -0800
@@ -1194,6 +1194,36 @@
/*
+=for apidoc sv_usepvn_mg
+
+Like C<sv_usepvn>, but also handles 'set' magic.
+
+=cut
+*/
+
+void
+Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
+{
+ sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
+}
+
+/*
+=for apidoc sv_usepvn
+
+Tells an SV to use C<ptr> to find its string value. Implemented by
+calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
+magic. See C<sv_usepvn_flags>.
+
+=cut
+*/
+
+void
+Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
+{
+ sv_usepvn_flags(sv,ptr,len, 0);
+}
+
+/*
=for apidoc unpack_str
The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
==== //depot/maint-5.8/perl/pod/perlapi.pod#87 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod#86~29950~ 2007-01-24 07:42:09.000000000 -0800
+++ perl/pod/perlapi.pod 2007-01-24 08:24:04.000000000 -0800
@@ -968,6 +968,28 @@
=for hackers
Found in file mathoms.c
+=item sv_usepvn
+X<sv_usepvn>
+
+Tells an SV to use C<ptr> to find its string value. Implemented by
+calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
+magic. See C<sv_usepvn_flags>.
+
+ void sv_usepvn(SV* sv, char* ptr, STRLEN len)
+
+=for hackers
+Found in file mathoms.c
+
+=item sv_usepvn_mg
+X<sv_usepvn_mg>
+
+Like C<sv_usepvn>, but also handles 'set' magic.
+
+ void sv_usepvn_mg(SV *sv, char *ptr, STRLEN len)
+
+=for hackers
+Found in file mathoms.c
+
=item sv_uv
X<sv_uv>
@@ -5565,30 +5587,24 @@
=for hackers
Found in file sv.c
-=item sv_usepvn
-X<sv_usepvn>
+=item sv_usepvn_flags
+X<sv_usepvn_flags>
Tells an SV to use C<ptr> to find its string value. Normally the
string is stored inside the SV but sv_usepvn allows the SV to use an
outside string. The C<ptr> should point to memory that was allocated
-by C<malloc>. The string length, C<len>, must be supplied. This
-function will realloc (i.e. move) the memory pointed to by C<ptr>,
+by C<malloc>. The string length, C<len>, must be supplied. By default
+this function will realloc (i.e. move) the memory pointed to by C<ptr>,
so that pointer should not be freed or used by the programmer after
giving it to sv_usepvn, and neither should any pointers from "behind"
-that pointer (e.g. ptr + 1) be used. Does not handle 'set' magic.
-See C<sv_usepvn_mg>.
+that pointer (e.g. ptr + 1) be used.
- void sv_usepvn(SV* sv, char* ptr, STRLEN len)
+If C<flags> & SV_SMAGIC is true, will call SvSETMAGIC. If C<flags> &
+SV_HAS_TRAILING_NUL is true, then C<ptr[len]> must be NUL, and the realloc
+I<may> be skipped. (i.e. the buffer is actually at least 1 byte longer than
+C<len>, and already meets the requirements for storing in C<SvPVX>)
-=for hackers
-Found in file sv.c
-
-=item sv_usepvn_mg
-X<sv_usepvn_mg>
-
-Like C<sv_usepvn>, but also handles 'set' magic.
-
- void sv_usepvn_mg(SV *sv, char *ptr, STRLEN len)
+ void sv_usepvn_flags(SV* sv, char* ptr, STRLEN len, U32 flags)
=for hackers
Found in file sv.c
==== //depot/maint-5.8/perl/pp.c#121 (text) ====
Index: perl/pp.c
--- perl/pp.c#120~29949~ 2007-01-24 07:28:38.000000000 -0800
+++ perl/pp.c 2007-01-24 08:24:04.000000000 -0800
@@ -2480,9 +2480,9 @@
p = uvchr_to_utf8_flags(p, ~c, UNICODE_ALLOW_ANY);
}
*p = '\0';
- sv_setpvn(TARG, (char*)result, targlen);
+ sv_usepvn_flags(TARG, (char*)result, targlen,
+ SV_HAS_TRAILING_NUL);
SvUTF8_on(TARG);
- Safefree(result);
}
else {
U8 *result;
@@ -2496,9 +2496,8 @@
*p++ = ~c;
}
*p = '\0';
- sv_setpvn(TARG, (char*)result, nchar);
+ sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL);
SvUTF8_off(TARG);
- Safefree(result);
}
SETs(TARG);
RETURN;
==== //depot/maint-5.8/perl/proto.h#172 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#171~29948~ 2007-01-24 07:13:14.000000000 -0800
+++ perl/proto.h 2007-01-24 08:24:04.000000000 -0800
@@ -1260,7 +1260,8 @@
PERL_CALLCONV void Perl_sv_unref_flags(pTHX_ SV* sv, U32 flags);
PERL_CALLCONV void Perl_sv_untaint(pTHX_ SV* sv);
PERL_CALLCONV bool Perl_sv_upgrade(pTHX_ SV* sv, U32 mt);
-PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len);
+/* PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len); */
+PERL_CALLCONV void Perl_sv_usepvn_flags(pTHX_ SV* sv, char* ptr, STRLEN
len, U32 flags);
PERL_CALLCONV void Perl_sv_vcatpvfn(pTHX_ SV* sv, const char* pat, STRLEN
patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted);
PERL_CALLCONV void Perl_sv_vsetpvfn(pTHX_ SV* sv, const char* pat, STRLEN
patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted);
PERL_CALLCONV NV Perl_str_to_version(pTHX_ SV *sv)
@@ -1398,7 +1399,7 @@
PERL_CALLCONV void Perl_sv_setpv_mg(pTHX_ SV *sv, const char *ptr);
PERL_CALLCONV void Perl_sv_setpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN
len);
PERL_CALLCONV void Perl_sv_setsv_mg(pTHX_ SV *dstr, SV *sstr);
-PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
+/* PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
*/
PERL_CALLCONV MGVTBL* Perl_get_vtbl(pTHX_ int vtbl_id)
__attribute__warn_unused_result__;
==== //depot/maint-5.8/perl/sv.c#309 (text) ====
Index: perl/sv.c
--- perl/sv.c#308~29950~ 2007-01-24 07:42:09.000000000 -0800
+++ perl/sv.c 2007-01-24 08:24:04.000000000 -0800
@@ -3612,57 +3612,58 @@
}
/*
-=for apidoc sv_usepvn
+=for apidoc sv_usepvn_flags
Tells an SV to use C<ptr> to find its string value. Normally the
string is stored inside the SV but sv_usepvn allows the SV to use an
outside string. The C<ptr> should point to memory that was allocated
-by C<malloc>. The string length, C<len>, must be supplied. This
-function will realloc (i.e. move) the memory pointed to by C<ptr>,
+by C<malloc>. The string length, C<len>, must be supplied. By default
+this function will realloc (i.e. move) the memory pointed to by C<ptr>,
so that pointer should not be freed or used by the programmer after
giving it to sv_usepvn, and neither should any pointers from "behind"
-that pointer (e.g. ptr + 1) be used. Does not handle 'set' magic.
-See C<sv_usepvn_mg>.
+that pointer (e.g. ptr + 1) be used.
+
+If C<flags> & SV_SMAGIC is true, will call SvSETMAGIC. If C<flags> &
+SV_HAS_TRAILING_NUL is true, then C<ptr[len]> must be NUL, and the realloc
+I<may> be skipped. (i.e. the buffer is actually at least 1 byte longer than
+C<len>, and already meets the requirements for storing in C<SvPVX>)
=cut
*/
void
-Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
+Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
{
STRLEN allocate;
SV_CHECK_THINKFIRST(sv);
(void)SvUPGRADE(sv, SVt_PV);
if (!ptr) {
(void)SvOK_off(sv);
+ if (flags & SV_SMAGIC)
+ SvSETMAGIC(sv);
return;
}
if (SvPVX_const(sv))
SvPV_free(sv);
- allocate = PERL_STRLEN_ROUNDUP(len + 1);
- ptr = saferealloc (ptr, allocate);
+ if (flags & SV_HAS_TRAILING_NUL)
+ assert(ptr[len] == '\0');
+
+ allocate = (flags & SV_HAS_TRAILING_NUL)
+ ? len + 1: PERL_STRLEN_ROUNDUP(len + 1);
+ if (!(flags & SV_HAS_TRAILING_NUL)) {
+ ptr = saferealloc (ptr, allocate);
+ }
SvPV_set(sv, ptr);
SvCUR_set(sv, len);
SvLEN_set(sv, allocate);
- *SvEND(sv) = '\0';
+ if (!(flags & SV_HAS_TRAILING_NUL)) {
+ *SvEND(sv) = '\0';
+ }
(void)SvPOK_only_UTF8(sv); /* validate pointer */
SvTAINT(sv);
-}
-
-/*
-=for apidoc sv_usepvn_mg
-
-Like C<sv_usepvn>, but also handles 'set' magic.
-
-=cut
-*/
-
-void
-Perl_sv_usepvn_mg(pTHX_ register SV *sv, register char *ptr, register STRLEN
len)
-{
- sv_usepvn(sv,ptr,len);
- SvSETMAGIC(sv);
+ if (flags & SV_SMAGIC)
+ SvSETMAGIC(sv);
}
/*
==== //depot/maint-5.8/perl/sv.h#72 (text) ====
Index: perl/sv.h
--- perl/sv.h#71~29925~ 2007-01-22 14:10:59.000000000 -0800
+++ perl/sv.h 2007-01-24 08:24:04.000000000 -0800
@@ -1392,9 +1392,12 @@
#define SV_CONST_RETURN 32
#define SV_MUTABLE_RETURN 64
#define SV_SMAGIC 128
+#define SV_HAS_TRAILING_NUL 256
#define sv_unref(sv) sv_unref_flags(sv, 0)
#define sv_force_normal(sv) sv_force_normal_flags(sv, 0)
+#define sv_usepvn(sv, p, l) sv_usepvn_flags(sv, p, l, 0)
+#define sv_usepvn_mg(sv, p, l) sv_usepvn_flags(sv, p, l, SV_SMAGIC)
/* all these 'functions' are now just macros */
End of Patch.
