SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
sv->sv_debug_optype = PL_op ? PL_op->op_type : 0;
- sv->sv_debug_line = (U16) ((PL_parser && PL_parser->copline == NOLINE) ?
- (PL_curcop ? CopLINE(PL_curcop) : 0) : PL_parser->copline);
+ sv->sv_debug_line = (U16) (PL_parser
+ ? PL_parser->copline == NOLINE
+ ? PL_curcop
+ ? CopLINE(PL_curcop)
+ : 0
+ : PL_parser->copline
+ : 0);
sv->sv_debug_inpad = 0;
sv->sv_debug_cloned = 0;
sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;
#ifdef DEBUGGING
SvREFCNT(sv) = 0;
#endif
- /* Must always set typemask because it's awlays checked in on cleanup
+ /* Must always set typemask because it's always checked in on cleanup
when the arenas are walked looking for objects. */
SvFLAGS(sv) = SVTYPEMASK;
sv++;
SvOBJECT(GvSV(sv))) ||
(GvAV(sv) && SvOBJECT(GvAV(sv))) ||
(GvHV(sv) && SvOBJECT(GvHV(sv))) ||
- (GvIO(sv) && SvOBJECT(GvIO(sv))) ||
+ /* In certain rare cases GvIOp(sv) can be NULL, which would make SvOBJECT(GvIO(sv)) dereference NULL. */
+ (GvIO(sv) ? (SvFLAGS(GvIOp(sv)) & SVs_OBJECT) : 0) ||
(GvCV(sv) && SvOBJECT(GvCV(sv))) )
{
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv)));
For the sv-types that have no bodies, arenas are not used, so those
PL_body_roots[sv_type] are unused, and can be overloaded. In
something of a special case, SVt_NULL is borrowed for HE arenas;
-PL_body_roots[SVt_NULL] is filled by S_more_he, but the
+PL_body_roots[HE_SVSLOT=SVt_NULL] is filled by S_more_he, but the
bodies_by_type[SVt_NULL] slot is not used, as the table is not
-available in hv.c,
+available in hv.c.
-PTEs also use arenas, but are never seen in Perl_sv_upgrade.
-Nonetheless, they get their own slot in bodies_by_type[SVt_NULL], so
-they can just use the same allocation semantics. At first, PTEs were
-also overloaded to a non-body sv-type, but this yielded hard-to-find
-malloc bugs, so was simplified by claiming a new slot. This choice
-has no consequence at this time.
+PTEs also use arenas, but are never seen in Perl_sv_upgrade. Nonetheless,
+they get their own slot in bodies_by_type[PTE_SVSLOT =SVt_IV], so they can
+just use the same allocation semantics. At first, PTEs were also
+overloaded to a non-body sv-type, but this yielded hard-to-find malloc
+bugs, so was simplified by claiming a new slot. This choice has no
+consequence at this time.
*/
FALSE, NONV, NOARENA, FIT_ARENA(0, sizeof(HE)) },
/* The bind placeholder pretends to be an RV for now.
- Also it's marked as "can't upgrade" top stop anyone using it before it's
+ 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 },
const U32 isUIOK = SvIsUV(sv);
char buf[TYPE_CHARS(UV)];
char *ebuf, *ptr;
+ STRLEN len;
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv, SVt_PVIV);
ptr = uiv_2buf(buf, SvIVX(sv), SvUVX(sv), isUIOK, &ebuf);
+ len = ebuf - ptr;
/* inlined from sv_setpvn */
- SvGROW_mutable(sv, (STRLEN)(ebuf - ptr + 1));
- Move(ptr,SvPVX_mutable(sv),ebuf - ptr,char);
- SvCUR_set(sv, ebuf - ptr);
- s = SvEND(sv);
+ s = SvGROW_mutable(sv, len + 1);
+ Move(ptr, s, len, char);
+ s += len;
*s = '\0';
}
else if (SvNOKp(sv)) {
/* and won't be needed again, potentially */
!(PL_op && PL_op->op_type == OP_AASSIGN))
#ifdef PERL_OLD_COPY_ON_WRITE
- && !((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
- && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
- && SvTYPE(sstr) >= SVt_PVIV)
+ && ((flags & SV_COW_SHARED_HASH_KEYS)
+ ? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
+ && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
+ && SvTYPE(sstr) >= SVt_PVIV))
+ : 1)
#endif
) {
/* Failed the swipe test, and it's not a shared hash key either.
SvCUR_set(sv, len);
SvLEN_set(sv, allocate);
if (!(flags & SV_HAS_TRAILING_NUL)) {
- *SvEND(sv) = '\0';
+ ptr[len] = '\0';
}
(void)SvPOK_only_UTF8(sv); /* validate pointer */
SvTAINT(sv);
if (PL_utf8cache) {
STRLEN ulen;
- MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : 0;
+ MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL;
if (mg && mg->mg_len != -1) {
ulen = mg->mg_len;
Creates a new SV with its SvPVX_const pointing to a shared string in the string
table. If the string does not already exist in the table, it is created
-first. Turns on READONLY and FAKE. The string's hash is stored in the UV
-slot of the SV; if the C<hash> parameter is non-zero, that value is used;
-otherwise the hash is computed. The idea here is that as the string table
-is used for shared hash keys these strings will have SvPVX_const == HeKEY and
-hash lookup will avoid string compare.
+first. Turns on READONLY and FAKE. If the C<hash> parameter is non-zero, that
+value is used; otherwise the hash is computed. The string's hash can be later
+be retrieved from the SV with the C<SvSHARED_HASH()> macro. The idea here is
+that as the string table is used for shared hash keys these strings will have
+SvPVX_const == HeKEY and hash lookup will avoid string compare.
=cut
*/
SvGROW(sv, len + 1);
Move(s,SvPVX(sv),len,char);
SvCUR_set(sv, len);
- *SvEND(sv) = '\0';
+ SvPVX(sv)[len] = '\0';
}
if (!SvPOK(sv)) {
SvPOK_on(sv); /* validate pointer */
: SvNV(argsv);
need = 0;
- if (c != 'e' && c != 'E') {
+ /* nv * 0 will be NaN for NaN, +Inf and -Inf, and 0 for anything
+ else. frexp() has some unspecified behaviour for those three */
+ if (c != 'e' && c != 'E' && (nv * 0) == 0) {
i = PERL_INT_MIN;
/* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
will cast our (long double) to (double) */
parser->rsfp_filters= av_dup_inc(proto->rsfp_filters, param);
parser->in_my = proto->in_my;
parser->in_my_stash = hv_dup(proto->in_my_stash, param);
+ parser->error_count = proto->error_count;
parser->linestr = sv_dup_inc(proto->linestr, param);
PL_savestack_ix = 0;
PL_savestack_max = -1;
PL_sig_pending = 0;
+ PL_parser = NULL;
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
# else /* !DEBUGGING */
Zero(my_perl, 1, PerlInterpreter);
PL_savestack_ix = 0;
PL_savestack_max = -1;
PL_sig_pending = 0;
+ PL_parser = NULL;
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
# else /* !DEBUGGING */
Zero(my_perl, 1, PerlInterpreter);
PL_DBsingle = sv_dup(proto_perl->IDBsingle, param);
PL_DBtrace = sv_dup(proto_perl->IDBtrace, param);
PL_DBsignal = sv_dup(proto_perl->IDBsignal, param);
- PL_DBassertion = sv_dup(proto_perl->IDBassertion, param);
- PL_lineary = av_dup(proto_perl->Ilineary, param);
PL_dbargs = av_dup(proto_perl->Idbargs, param);
/* symbol tables */
PL_sub_generation = proto_perl->Isub_generation;
PL_isarev = hv_dup_inc(proto_perl->Iisarev, param);
- PL_delayedisa = hv_dup_inc(proto_perl->Idelayedisa, param);
/* funky return mechanisms */
PL_forkprocess = proto_perl->Iforkprocess;
PL_parser = parser_dup(proto_perl->Iparser, param);
- PL_error_count = proto_perl->Ierror_count;
PL_subline = proto_perl->Isubline;
PL_subname = sv_dup_inc(proto_perl->Isubname, param);
PL_unlockhook = proto_perl->Iunlockhook;
PL_threadhook = proto_perl->Ithreadhook;
- PL_runops_std = proto_perl->Irunops_std;
- PL_runops_dbg = proto_perl->Irunops_dbg;
-
#ifdef THREADS_HAVE_PIDS
PL_ppid = proto_perl->Ippid;
#endif
}
}
else {
- U32 unused;
- CV * const cv = find_runcv(&unused);
+ CV * const cv = find_runcv(NULL);
SV *sv;
AV *av;
match = 1; /* XS or custom code could trigger random warnings */
goto do_op;
+ case OP_POS:
+ /* def-ness of rval pos() is independent of the def-ness of its arg */
+ if ( !(obase->op_flags & OPf_MOD))
+ break;
+
case OP_SCHOMP:
case OP_CHOMP:
if (SvROK(PL_rs) && uninit_sv == SvRV(PL_rs))
projects / p5sagit/p5-mst-13.2.git / blobdiff