} else {
SvROK_off(ref);
SvRV_set(ref, NULL);
- SvREFCNT_dec(target);
+ SvREFCNT_dec_NN(target);
}
}
}
DEBUG_D((PerlIO_printf(Perl_debug_log,
"Cleaning named glob SV object:\n "), sv_dump(obj)));
GvSV(sv) = NULL;
- SvREFCNT_dec(obj);
+ SvREFCNT_dec_NN(obj);
}
if ( ((obj = MUTABLE_SV(GvAV(sv)) )) && SvOBJECT(obj)) {
DEBUG_D((PerlIO_printf(Perl_debug_log,
"Cleaning named glob AV object:\n "), sv_dump(obj)));
GvAV(sv) = NULL;
- SvREFCNT_dec(obj);
+ SvREFCNT_dec_NN(obj);
}
if ( ((obj = MUTABLE_SV(GvHV(sv)) )) && SvOBJECT(obj)) {
DEBUG_D((PerlIO_printf(Perl_debug_log,
"Cleaning named glob HV object:\n "), sv_dump(obj)));
GvHV(sv) = NULL;
- SvREFCNT_dec(obj);
+ SvREFCNT_dec_NN(obj);
}
if ( ((obj = MUTABLE_SV(GvCV(sv)) )) && SvOBJECT(obj)) {
DEBUG_D((PerlIO_printf(Perl_debug_log,
"Cleaning named glob CV object:\n "), sv_dump(obj)));
GvCV_set(sv, NULL);
- SvREFCNT_dec(obj);
+ SvREFCNT_dec_NN(obj);
}
- SvREFCNT_dec(sv); /* undo the inc above */
+ SvREFCNT_dec_NN(sv); /* undo the inc above */
}
/* clear any IO slots in a GV which hold objects (except stderr, defout);
DEBUG_D((PerlIO_printf(Perl_debug_log,
"Cleaning named glob IO object:\n "), sv_dump(obj)));
GvIOp(sv) = NULL;
- SvREFCNT_dec(obj);
+ SvREFCNT_dec_NN(obj);
}
- SvREFCNT_dec(sv); /* undo the inc above */
+ SvREFCNT_dec_NN(sv); /* undo the inc above */
}
/* Void wrapper to pass to visit() */
}
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
SvFLAGS(sv) |= SVf_BREAK;
- SvREFCNT_dec(sv);
+ SvREFCNT_dec_NN(sv);
}
/*
/* The bind placeholder pretends to be an RV for now.
Also it's marked as "can't upgrade" to stop anyone using it before it's
implemented. */
- { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
+ { 0, 0, 0, SVt_DUMMY, TRUE, NONV, NOARENA, 0 },
/* IVs are in the head, so the allocation size is 0. */
{ 0,
assert(!SvPAD_TYPED(sv));
break;
default:
- if (old_type_details->cant_upgrade)
+ if (UNLIKELY(old_type_details->cant_upgrade))
Perl_croak(aTHX_ "Can't upgrade %s (%" UVuf ") to %" UVuf,
sv_reftype(sv, 0), (UV) old_type, (UV) new_type);
}
- if (old_type > new_type)
+ if (UNLIKELY(old_type > new_type))
Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
(int)old_type, (int)new_type);
SvNV_set(sv, 0);
#endif
- if (new_type == SVt_PVIO) {
+ if (UNLIKELY(new_type == SVt_PVIO)) {
IO * const io = MUTABLE_IO(sv);
GV *iogv = gv_fetchpvs("IO::File::", GV_ADD, SVt_PVHV);
SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
IoPAGE_LEN(sv) = 60;
}
- if (new_type == SVt_REGEXP)
+ if (UNLIKELY(new_type == SVt_REGEXP))
sv->sv_u.svu_rx = (regexp *)new_body;
else if (old_type < SVt_PV) {
/* referant will be NULL unless the old type was SVt_IV emulating
}
break;
- /* case SVt_BIND: */
+ /* case SVt_DUMMY: */
case SVt_PVLV:
case SVt_PVGV:
case SVt_PVMG:
SvANY(temp) = temp_p;
temp->sv_u.svu_rx = (regexp *)temp_p;
- SvREFCNT_dec(temp);
+ SvREFCNT_dec_NN(temp);
}
else if (SvVOK(sv)) sv_unmagic(sv, PERL_MAGIC_vstring);
}
tsv = SvRV(sv);
Perl_sv_add_backref(aTHX_ tsv, sv);
SvWEAKREF_on(sv);
- SvREFCNT_dec(tsv);
+ SvREFCNT_dec_NN(tsv);
return sv;
}
}
if (is_array) {
AvFILLp(av) = -1;
- SvREFCNT_dec(av); /* remove extra count added by sv_add_backref() */
+ SvREFCNT_dec_NN(av); /* remove extra count added by sv_add_backref() */
}
return;
}
: newSVpvn_flags( "__ANON__", 8, 0 );
sv_catpvs(gvname, "::__ANON__");
anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV);
- SvREFCNT_dec(gvname);
+ SvREFCNT_dec_NN(gvname);
CvANON_on(cv);
CvCVGV_RC_on(cv);
SvREFCNT_dec(SvSTASH(sv));
}
switch (type) {
- /* case SVt_BIND: */
+ /* case SVt_DUMMY: */
case SVt_PVIO:
if (IoIFP(sv) &&
IoIFP(sv) != PerlIO_stdin() &&
PL_last_in_gv = NULL;
else if ((const GV *)sv == PL_statgv)
PL_statgv = NULL;
+ else if ((const GV *)sv == PL_stderrgv)
+ PL_stderrgv = NULL;
case SVt_PVMG:
case SVt_PVNV:
case SVt_PVIV:
continue;
}
#endif
- if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ if (SvIMMORTAL(sv)) {
/* make sure SvREFCNT(sv)==0 happens very seldom */
- SvREFCNT(sv) = (~(U32)0)/2;
+ SvREFCNT(sv) = SvREFCNT_IMMORTAL;
continue;
}
break;
SvRV_set(tmpref, NULL);
SvROK_off(tmpref);
}
- SvREFCNT_dec(tmpref);
+ SvREFCNT_dec_NN(tmpref);
}
}
} while (SvOBJECT(sv) && SvSTASH(sv) != stash);
SvOBJECT_off(sv); /* Curse the object. */
SvSTASH_set(sv,0); /* SvREFCNT_dec may try to read this */
SvREFCNT_dec(stash); /* possibly of changed persuasion */
- if (SvTYPE(sv) != SVt_PVIO)
- --PL_sv_objcount;/* XXX Might want something more general */
}
return TRUE;
}
return;
}
#endif
- if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ if (SvIMMORTAL(sv)) {
/* make sure SvREFCNT(sv)==0 happens very seldom */
- SvREFCNT(sv) = (~(U32)0)/2;
+ SvREFCNT(sv) = SvREFCNT_IMMORTAL;
return;
}
sv_clear(sv);
return;
if (PL_in_clean_all) /* All is fair */
return;
- if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ if (SvIMMORTAL(sv)) {
/* make sure SvREFCNT(sv)==0 happens very seldom */
- SvREFCNT(sv) = (~(U32)0)/2;
+ SvREFCNT(sv) = SvREFCNT_IMMORTAL;
return;
}
if (ckWARN_d(WARN_INTERNAL)) {
}
/* Now both are in UTF-8. */
if (cur1 != cur2) {
- SvREFCNT_dec(svrecode);
+ SvREFCNT_dec_NN(svrecode);
return FALSE;
}
}
dVAR;
STRLEN cur1, cur2;
const char *pv1, *pv2;
- char *tpv = NULL;
I32 cmp;
SV *svrecode = NULL;
}
SvREFCNT_dec(svrecode);
- if (tpv)
- Safefree(tpv);
return cmp;
}
const STRLEN recsize = SvUV(SvRV(PL_rs)); /* RsRECORD() guarantees > 0. */
/* Grab the size of the record we're getting */
char *buffer = SvGROW(sv, (STRLEN)(recsize + append + 1)) + append;
+
+ /* Go yank in */
#ifdef VMS
+#include <rms.h>
int fd;
-#endif
+ Stat_t st;
- /* Go yank in */
-#ifdef VMS
- /* VMS wants read instead of fread, because fread doesn't respect */
- /* RMS record boundaries. This is not necessarily a good thing to be */
- /* doing, but we've got no other real choice - except avoid stdio
- as implementation - perhaps write a :vms layer ?
- */
+ /* With a true, record-oriented file on VMS, we need to use read directly
+ * to ensure that we respect RMS record boundaries. The user is responsible
+ * for providing a PL_rs value that corresponds to the FAB$W_MRS (maximum
+ * record size) field. N.B. This is likely to produce invalid results on
+ * varying-width character data when a record ends mid-character.
+ */
fd = PerlIO_fileno(fp);
- if (fd != -1) {
+ if (fd != -1
+ && PerlLIO_fstat(fd, &st) == 0
+ && (st.st_fab_rfm == FAB$C_VAR
+ || st.st_fab_rfm == FAB$C_VFC
+ || st.st_fab_rfm == FAB$C_FIX)) {
+
bytesread = PerlLIO_read(fd, buffer, recsize);
}
- else /* in-memory file from PerlIO::Scalar */
+ else /* in-memory file from PerlIO::Scalar
+ * or not a record-oriented file
+ */
#endif
{
bytesread = PerlIO_read(fp, buffer, recsize);
if (morebytesread <= 0) {
/* we're done, if we still have incomplete
characters the check code in sv_gets() will
- warn and zero them.
+ warn about them.
- FIXME: If we've read more than one lead
- character for an incomplete character, push
- it back.
+ I'd originally considered doing
+ PerlIO_ungetc() on all but the lead
+ character of the incomplete character, but
+ read() doesn't do that, so I don't.
*/
break;
}
dVAR;
if (!sv)
return NULL;
- if (SvREADONLY(sv) && SvIMMORTAL(sv))
+ if (SvIMMORTAL(sv))
return sv;
PUSH_EXTEND_MORTAL__SV_C(sv);
SvTEMP_on(sv);
? "GLOB" : "SCALAR");
case SVt_PVFM: return "FORMAT";
case SVt_PVIO: return "IO";
- case SVt_BIND: return "BIND";
+ case SVt_DUMMY: return "DUMMY";
case SVt_REGEXP: return "REGEXP";
default: return "UNKNOWN";
}
/*
=for apidoc newSVrv
-Creates a new SV for the RV, C<rv>, to point to. If C<rv> is not an RV then
-it will be upgraded to one. If C<classname> is non-null then the new SV will
-be blessed in the specified package. The new SV is returned and its
-reference count is 1.
+Creates a new SV for the existing RV, C<rv>, to point to. If C<rv> is not an
+RV then it will be upgraded to one. If C<classname> is non-null then the new
+SV will be blessed in the specified package. The new SV is returned and its
+reference count is 1. The reference count 1 is owned by C<rv>.
=cut
*/
if (SvREADONLY(tmpRef) && !SvIsCOW(tmpRef))
Perl_croak_no_modify();
if (SvOBJECT(tmpRef)) {
- if (SvTYPE(tmpRef) != SVt_PVIO)
- --PL_sv_objcount;
SvREFCNT_dec(SvSTASH(tmpRef));
}
}
SvOBJECT_on(tmpRef);
- if (SvTYPE(tmpRef) != SVt_PVIO)
- ++PL_sv_objcount;
SvUPGRADE(tmpRef, SVt_PVMG);
SvSTASH_set(tmpRef, MUTABLE_HV(SvREFCNT_inc_simple(stash)));
/* You can't have a || SvREADONLY(target) here, as $a = $$a, where $a was
assigned to as BEGIN {$a = \"Foo"} will fail. */
if (SvREFCNT(target) != 1 || (flags & SV_IMMEDIATE_UNREF))
- SvREFCNT_dec(target);
+ SvREFCNT_dec_NN(target);
else /* XXX Hack, but hard to make $a=$a->[1] work otherwise */
sv_2mortal(target); /* Schedule for freeing later */
}
have = esignlen + zeros + elen;
if (have < zeros)
- croak_memory_wrap();
+ Perl_croak_memory_wrap();
need = (have > width ? have : width);
gap = need - have;
if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1))
- croak_memory_wrap();
+ Perl_croak_memory_wrap();
SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
p = SvEND(sv);
if (esignlen && fill == '0') {
SvANY(dstr) = new_XNV();
SvNV_set(dstr, SvNVX(sstr));
break;
- /* case SVt_BIND: */
+ /* case SVt_DUMMY: */
default:
{
/* These are all the types that need complex bodies allocating. */
}
daux->xhv_name_count = saux->xhv_name_count;
+ daux->xhv_fill_lazy = saux->xhv_fill_lazy;
daux->xhv_riter = saux->xhv_riter;
daux->xhv_eiter = saux->xhv_eiter
? he_dup(saux->xhv_eiter,
}
}
- if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO)
- ++PL_sv_objcount;
-
return dstr;
}
Zero(&PL_body_roots, 1, PL_body_roots);
PL_sv_count = 0;
- PL_sv_objcount = 0;
PL_sv_root = NULL;
PL_sv_arenaroot = NULL;
PL_last_swash_tmps = (U8*)NULL;
PL_last_swash_slen = 0;
- PL_glob_index = proto_perl->Iglob_index;
PL_srand_called = proto_perl->Isrand_called;
if (flags & CLONEf_COPY_STACKS) {
PL_ASCII = sv_dup_inc(proto_perl->IASCII, param);
PL_Latin1 = sv_dup_inc(proto_perl->ILatin1, param);
- PL_PerlSpace = sv_dup_inc(proto_perl->IPerlSpace, param);
- PL_XPerlSpace = sv_dup_inc(proto_perl->IXPerlSpace, param);
-
- PL_L1PosixAlnum = sv_dup_inc(proto_perl->IL1PosixAlnum, param);
- PL_PosixAlnum = sv_dup_inc(proto_perl->IPosixAlnum, param);
-
- PL_L1PosixAlpha = sv_dup_inc(proto_perl->IL1PosixAlpha, param);
- PL_PosixAlpha = sv_dup_inc(proto_perl->IPosixAlpha, param);
-
- PL_PosixBlank = sv_dup_inc(proto_perl->IPosixBlank, param);
- PL_XPosixBlank = sv_dup_inc(proto_perl->IXPosixBlank, param);
-
- PL_L1Cased = sv_dup_inc(proto_perl->IL1Cased, param);
-
- PL_PosixCntrl = sv_dup_inc(proto_perl->IPosixCntrl, param);
- PL_XPosixCntrl = sv_dup_inc(proto_perl->IXPosixCntrl, param);
-
- PL_PosixDigit = sv_dup_inc(proto_perl->IPosixDigit, param);
-
- PL_L1PosixGraph = sv_dup_inc(proto_perl->IL1PosixGraph, param);
- PL_PosixGraph = sv_dup_inc(proto_perl->IPosixGraph, param);
-
- PL_L1PosixLower = sv_dup_inc(proto_perl->IL1PosixLower, param);
- PL_PosixLower = sv_dup_inc(proto_perl->IPosixLower, param);
-
- PL_L1PosixPrint = sv_dup_inc(proto_perl->IL1PosixPrint, param);
- PL_PosixPrint = sv_dup_inc(proto_perl->IPosixPrint, param);
-
- PL_L1PosixPunct = sv_dup_inc(proto_perl->IL1PosixPunct, param);
- PL_PosixPunct = sv_dup_inc(proto_perl->IPosixPunct, param);
-
- PL_PosixSpace = sv_dup_inc(proto_perl->IPosixSpace, param);
- PL_XPosixSpace = sv_dup_inc(proto_perl->IXPosixSpace, param);
-
- PL_L1PosixUpper = sv_dup_inc(proto_perl->IL1PosixUpper, param);
- PL_PosixUpper = sv_dup_inc(proto_perl->IPosixUpper, param);
-
- PL_L1PosixWord = sv_dup_inc(proto_perl->IL1PosixWord, param);
- PL_PosixWord = sv_dup_inc(proto_perl->IPosixWord, param);
-
- PL_PosixXDigit = sv_dup_inc(proto_perl->IPosixXDigit, param);
- PL_XPosixXDigit = sv_dup_inc(proto_perl->IXPosixXDigit, param);
-
- PL_VertSpace = sv_dup_inc(proto_perl->IVertSpace, param);
-
PL_NonL1NonFinalFold = sv_dup_inc(proto_perl->INonL1NonFinalFold, param);
PL_HasMultiCharFold= sv_dup_inc(proto_perl->IHasMultiCharFold, param);
/* utf8 character class swashes */
- PL_utf8_alnum = sv_dup_inc(proto_perl->Iutf8_alnum, param);
- PL_utf8_alpha = sv_dup_inc(proto_perl->Iutf8_alpha, param);
- PL_utf8_graph = sv_dup_inc(proto_perl->Iutf8_graph, param);
- PL_utf8_digit = sv_dup_inc(proto_perl->Iutf8_digit, param);
- PL_utf8_upper = sv_dup_inc(proto_perl->Iutf8_upper, param);
- PL_utf8_lower = sv_dup_inc(proto_perl->Iutf8_lower, param);
- PL_utf8_print = sv_dup_inc(proto_perl->Iutf8_print, param);
- PL_utf8_punct = sv_dup_inc(proto_perl->Iutf8_punct, param);
+ for (i = 0; i < POSIX_SWASH_COUNT; i++) {
+ PL_utf8_swash_ptrs[i] = sv_dup_inc(proto_perl->Iutf8_swash_ptrs[i], param);
+ }
+ for (i = 0; i < POSIX_CC_COUNT; i++) {
+ PL_Posix_ptrs[i] = sv_dup_inc(proto_perl->IPosix_ptrs[i], param);
+ PL_L1Posix_ptrs[i] = sv_dup_inc(proto_perl->IL1Posix_ptrs[i], param);
+ PL_XPosix_ptrs[i] = sv_dup_inc(proto_perl->IXPosix_ptrs[i], param);
+ }
PL_utf8_mark = sv_dup_inc(proto_perl->Iutf8_mark, param);
PL_utf8_X_regular_begin = sv_dup_inc(proto_perl->Iutf8_X_regular_begin, param);
PL_utf8_X_extend = sv_dup_inc(proto_perl->Iutf8_X_extend, param);
- PL_utf8_X_LVT = sv_dup_inc(proto_perl->Iutf8_X_LVT, param);
PL_utf8_toupper = sv_dup_inc(proto_perl->Iutf8_toupper, param);
PL_utf8_totitle = sv_dup_inc(proto_perl->Iutf8_totitle, param);
PL_utf8_tolower = sv_dup_inc(proto_perl->Iutf8_tolower, param);
PL_utf8_idstart = sv_dup_inc(proto_perl->Iutf8_idstart, param);
PL_utf8_xidstart = sv_dup_inc(proto_perl->Iutf8_xidstart, param);
PL_utf8_perl_idstart = sv_dup_inc(proto_perl->Iutf8_perl_idstart, param);
+ PL_utf8_perl_idcont = sv_dup_inc(proto_perl->Iutf8_perl_idcont, param);
PL_utf8_idcont = sv_dup_inc(proto_perl->Iutf8_idcont, param);
PL_utf8_xidcont = sv_dup_inc(proto_perl->Iutf8_xidcont, param);
PL_utf8_foldable = sv_dup_inc(proto_perl->Iutf8_foldable, param);
} while (++svp <= last);
AvREAL_off(unreferenced);
}
- SvREFCNT_dec(unreferenced);
+ SvREFCNT_dec_NN(unreferenced);
}
void
void
Perl_init_constants(pTHX)
{
- SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
+ SvREFCNT(&PL_sv_undef) = SvREFCNT_IMMORTAL;
SvFLAGS(&PL_sv_undef) = SVf_READONLY|SVt_NULL;
SvANY(&PL_sv_undef) = NULL;
SvANY(&PL_sv_no) = new_XPVNV();
- SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
+ SvREFCNT(&PL_sv_no) = SvREFCNT_IMMORTAL;
SvFLAGS(&PL_sv_no) = SVt_PVNV|SVf_READONLY
|SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
|SVp_POK|SVf_POK;
SvANY(&PL_sv_yes) = new_XPVNV();
- SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
+ SvREFCNT(&PL_sv_yes) = SvREFCNT_IMMORTAL;
SvFLAGS(&PL_sv_yes) = SVt_PVNV|SVf_READONLY
|SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
|SVp_POK|SVf_POK;
Perl_sv_catpvf(aTHX_ name, "{%s}",
pv_pretty(sv, SvPVX_const(keyname), SvCUR(keyname), 32, NULL, NULL,
PERL_PV_PRETTY_DUMP | PERL_PV_ESCAPE_UNI_DETECT ));
- SvREFCNT_dec(sv);
+ SvREFCNT_dec_NN(sv);
}
else if (subscript_type == FUV_SUBSCRIPT_ARRAY) {
*SvPVX(name) = '$';