return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv);
}
-/* sv_2uv() is now a macro using Perl_sv_2uv_flags();
- * this function provided for binary compatibility only
- */
-
-UV
-Perl_sv_2uv(pTHX_ register SV *sv)
-{
- return sv_2uv_flags(sv, SV_GMAGIC);
-}
-
/*
=for apidoc sv_2uv_flags
return U_V(Atof(SvPVX_const(sv)));
}
-/*
-=for apidoc sv_2pv_nolen
-
-Like C<sv_2pv()>, but doesn't return the length too. You should usually
-use the macro wrapper C<SvPV_nolen(sv)> instead.
-=cut
-*/
-
-char *
-Perl_sv_2pv_nolen(pTHX_ register SV *sv)
-{
- return sv_2pv(sv, 0);
-}
-
/* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
* UV as a string towards the end of buf, and return pointers to start and
* end of it.
}
tsv = NEWSV(0,0);
if (SvOBJECT(sv)) {
- const char *name = HvNAME_get(SvSTASH(sv));
+ const char * const name = HvNAME_get(SvSTASH(sv));
Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
name ? name : "__ANON__" , typestr, PTR2UV(sv));
}
}
/*
-=for apidoc sv_2pvbyte_nolen
-
-Return a pointer to the byte-encoded representation of the SV.
-May cause the SV to be downgraded from UTF-8 as a side-effect.
-
-Usually accessed via the C<SvPVbyte_nolen> macro.
-
-=cut
-*/
-
-char *
-Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
-{
- return sv_2pvbyte(sv, 0);
-}
-
-/*
=for apidoc sv_2pvbyte
Return a pointer to the byte-encoded representation of the SV, and set *lp
}
/*
-=for apidoc sv_2pvutf8_nolen
-
-Return a pointer to the UTF-8-encoded representation of the SV.
-May cause the SV to be upgraded to UTF-8 as a side-effect.
-
-Usually accessed via the C<SvPVutf8_nolen> macro.
-
-=cut
-*/
-
-char *
-Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv)
-{
- return sv_2pvutf8(sv, 0);
-}
-
-/*
* =for apidoc sv_2pvutf8
*
* Return a pointer to the UTF-8-encoded representation of the SV, and set *lp
}
}
-/* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags();
- * this function provided for binary compatibility only
- */
-
-
-STRLEN
-Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
-{
- return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
-}
-
/*
=for apidoc sv_utf8_upgrade
* chars in the PV. Given that there isn't such a flag
* make the loop as fast as possible. */
const U8 *s = (U8 *) SvPVX_const(sv);
- const U8 *e = (U8 *) SvEND(sv);
+ const U8 * const e = (U8 *) SvEND(sv);
const U8 *t = s;
int hibit = 0;
GvNAMELEN(dstr) = len;
SvFAKE_on(dstr); /* can coerce to non-glob */
}
- /* ahem, death to those who redefine active sort subs */
- else if (PL_curstackinfo->si_type == PERLSI_SORT
- && GvCV(dstr) && PL_sortcop == CvSTART(GvCV(dstr)))
- Perl_croak(aTHX_ "Can't redefine active sort subroutine %s",
- GvNAME(dstr));
#ifdef GV_UNIQUE_CHECK
if (GvUNIQUE((GV*)dstr)) {
if (!GvCVGEN((GV*)dstr) &&
(CvROOT(cv) || CvXSUB(cv)))
{
- /* ahem, death to those who redefine
- * active sort subs */
- if (PL_curstackinfo->si_type == PERLSI_SORT &&
- PL_sortcop == CvSTART(cv))
- Perl_croak(aTHX_
- "Can't redefine active sort subroutine %s",
- GvENAME((GV*)dstr));
/* Redefining a sub - warning is mandatory if
it was a const and its value changed. */
if (ckWARN(WARN_REDEFINE)
}
/*
-=for apidoc sv_force_normal
-
-Undo various types of fakery on an SV: if the PV is a shared string, make
-a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
-an xpvmg. See also C<sv_force_normal_flags>.
-
-=cut
-*/
-
-void
-Perl_sv_force_normal(pTHX_ register SV *sv)
-{
- sv_force_normal_flags(sv, 0);
-}
-
-/*
=for apidoc sv_chop
Efficient removal of characters from the beginning of the string buffer.
*SvEND(dsv) = '\0';
(void)SvPOK_only_UTF8(dsv); /* validate pointer */
SvTAINT(dsv);
-}
-
-/*
-=for apidoc sv_catpvn_mg
-
-Like C<sv_catpvn>, but also handles 'set' magic.
-
-=cut
-*/
-
-void
-Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
-{
- sv_catpvn(sv,ptr,len);
- SvSETMAGIC(sv);
+ if (flags & SV_SMAGIC)
+ SvSETMAGIC(dsv);
}
/*
{
const char *spv;
STRLEN slen;
- if (!ssv)
- return;
- if ((spv = SvPV_const(ssv, slen))) {
- /* sutf8 and dutf8 were type bool, but under USE_ITHREADS,
- gcc version 2.95.2 20000220 (Debian GNU/Linux) for
- Linux xxx 2.2.17 on sparc64 with gcc -O2, we erroneously
- get dutf8 = 0x20000000, (i.e. SVf_UTF8) even though
- dsv->sv_flags doesn't have that bit set.
+ if (ssv) {
+ if ((spv = SvPV_const(ssv, slen))) {
+ /* sutf8 and dutf8 were type bool, but under USE_ITHREADS,
+ gcc version 2.95.2 20000220 (Debian GNU/Linux) for
+ Linux xxx 2.2.17 on sparc64 with gcc -O2, we erroneously
+ get dutf8 = 0x20000000, (i.e. SVf_UTF8) even though
+ dsv->sv_flags doesn't have that bit set.
Andy Dougherty 12 Oct 2001
- */
- const I32 sutf8 = DO_UTF8(ssv);
- I32 dutf8;
+ */
+ const I32 sutf8 = DO_UTF8(ssv);
+ I32 dutf8;
- if (SvGMAGICAL(dsv) && (flags & SV_GMAGIC))
- mg_get(dsv);
- dutf8 = DO_UTF8(dsv);
+ if (SvGMAGICAL(dsv) && (flags & SV_GMAGIC))
+ mg_get(dsv);
+ dutf8 = DO_UTF8(dsv);
- if (dutf8 != sutf8) {
- if (dutf8) {
- /* Not modifying source SV, so taking a temporary copy. */
- SV* csv = sv_2mortal(newSVpvn(spv, slen));
+ if (dutf8 != sutf8) {
+ if (dutf8) {
+ /* Not modifying source SV, so taking a temporary copy. */
+ SV* csv = sv_2mortal(newSVpvn(spv, slen));
- sv_utf8_upgrade(csv);
- spv = SvPV_const(csv, slen);
+ sv_utf8_upgrade(csv);
+ spv = SvPV_const(csv, slen);
+ }
+ else
+ sv_utf8_upgrade_nomg(dsv);
}
- else
- sv_utf8_upgrade_nomg(dsv);
+ sv_catpvn_nomg(dsv, spv, slen);
}
- sv_catpvn_nomg(dsv, spv, slen);
}
-}
-
-/*
-=for apidoc sv_catsv_mg
-
-Like C<sv_catsv>, but also handles 'set' magic.
-
-=cut
-*/
-
-void
-Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv)
-{
- sv_catsv(dsv,ssv);
- SvSETMAGIC(dsv);
+ if (flags & SV_SMAGIC)
+ SvSETMAGIC(dsv);
}
/*
av_clear(GvAV(gv));
}
if (GvHV(gv) && !HvNAME_get(GvHV(gv))) {
+#if defined(VMS)
+ Perl_die(aTHX_ "Can't reset %%ENV on this system");
+#else /* ! VMS */
hv_clear(GvHV(gv));
-#ifndef PERL_MICRO
-#ifdef USE_ENVIRON_ARRAY
- if (gv == PL_envgv
-# ifdef USE_ITHREADS
- && PL_curinterp == aTHX
-# endif
- )
- {
- environ[0] = Nullch;
- }
-#endif
-#endif /* !PERL_MICRO */
+# if defined(USE_ENVIRON_ARRAY)
+ if (gv == PL_envgv)
+ my_clearenv();
+# endif /* USE_ENVIRON_ARRAY */
+#endif /* VMS */
}
}
}
}
/*
-=for apidoc sv_iv
-
-A private implementation of the C<SvIVx> macro for compilers which can't
-cope with complex macro expressions. Always use the macro instead.
-
-=cut
-*/
-
-IV
-Perl_sv_iv(pTHX_ register SV *sv)
-{
- if (SvIOK(sv)) {
- if (SvIsUV(sv))
- return (IV)SvUVX(sv);
- return SvIVX(sv);
- }
- return sv_2iv(sv);
-}
-
-/*
-=for apidoc sv_uv
-
-A private implementation of the C<SvUVx> macro for compilers which can't
-cope with complex macro expressions. Always use the macro instead.
-
-=cut
-*/
-
-UV
-Perl_sv_uv(pTHX_ register SV *sv)
-{
- if (SvIOK(sv)) {
- if (SvIsUV(sv))
- return SvUVX(sv);
- return (UV)SvIVX(sv);
- }
- return sv_2uv(sv);
-}
-
-/*
-=for apidoc sv_nv
-
-A private implementation of the C<SvNVx> macro for compilers which can't
-cope with complex macro expressions. Always use the macro instead.
-
-=cut
-*/
-
-NV
-Perl_sv_nv(pTHX_ register SV *sv)
-{
- if (SvNOK(sv))
- return SvNVX(sv);
- return sv_2nv(sv);
-}
-
-/*
-=for apidoc sv_pv
-
-Use the C<SvPV_nolen> macro instead
-
-=for apidoc sv_pvn
-
-A private implementation of the C<SvPV> macro for compilers which can't
-cope with complex macro expressions. Always use the macro instead.
-
-=cut
-*/
-
-char *
-Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
-{
- if (SvPOK(sv)) {
- *lp = SvCUR(sv);
- return SvPVX(sv);
- }
- return sv_2pv(sv, lp);
-}
-
-
-char *
-Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
-{
- if (SvPOK(sv)) {
- *lp = SvCUR(sv);
- return SvPVX(sv);
- }
- return sv_2pv_flags(sv, lp, 0);
-}
-
-/*
=for apidoc sv_pvn_force
Get a sensible string out of the SV somehow.
}
/*
-=for apidoc sv_pvbyte
-
-Use C<SvPVbyte_nolen> instead.
-
-=for apidoc sv_pvbyten
-
-A private implementation of the C<SvPVbyte> macro for compilers
-which can't cope with complex macro expressions. Always use the macro
-instead.
-
-=cut
-*/
-
-char *
-Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
-{
- sv_utf8_downgrade(sv,0);
- return sv_pvn(sv,lp);
-}
-
-/*
=for apidoc sv_pvbyten_force
-A private implementation of the C<SvPVbytex_force> macro for compilers
-which can't cope with complex macro expressions. Always use the macro
-instead.
+The backend for the C<SvPVbytex_force> macro. Always use the macro instead.
=cut
*/
}
/*
-=for apidoc sv_pvutf8
-
-Use the C<SvPVutf8_nolen> macro instead
-
-=for apidoc sv_pvutf8n
-
-A private implementation of the C<SvPVutf8> macro for compilers
-which can't cope with complex macro expressions. Always use the macro
-instead.
-
-=cut
-*/
-
-char *
-Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
-{
- sv_utf8_upgrade(sv);
- return sv_pvn(sv,lp);
-}
-
-/*
=for apidoc sv_pvutf8n_force
-A private implementation of the C<SvPVutf8_force> macro for compilers
-which can't cope with complex macro expressions. Always use the macro
-instead.
+The backend for the C<SvPVutf8x_force> macro. Always use the macro instead.
=cut
*/
void
Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv)
{
- char buf[TYPE_CHARS(UV)];
- char *ebuf;
- char * const ptr = uiv_2buf(buf, iv, 0, 0, &ebuf);
-
- sv_setpvn(sv, ptr, ebuf - ptr);
+ sv_setpviv(sv, iv);
SvSETMAGIC(sv);
}
&& (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)
&& ckWARN(WARN_PRINTF))
{
- SV *msg = sv_newmortal();
+ SV * const msg = sv_newmortal();
Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %sprintf: ",
(PL_op->op_type == OP_PRTF) ? "" : "s");
if (c) {
PL_sortstash = hv_dup(proto_perl->Tsortstash, param);
PL_firstgv = gv_dup(proto_perl->Tfirstgv, param);
PL_secondgv = gv_dup(proto_perl->Tsecondgv, param);
- PL_sortcxix = proto_perl->Tsortcxix;
PL_efloatbuf = Nullch; /* reinits on demand */
PL_efloatsize = 0; /* reinits on demand */
projects / p5sagit/p5-mst-13.2.git / blobdiff