allocate body types with "ghost fields".
"ghost fields" are fields that are unused in certain types, and
-consequently dont need to actually exist. They are declared because
+consequently don't need to actually exist. They are declared because
they're part of a "base type", which allows use of functions as
methods. The simplest examples are AVs and HVs, 2 aggregate types
which don't use the fields which support SCALAR semantics.
-For these types, the arenas are carved up into *_allocated size
+For these types, the arenas are carved up into appropriately sized
chunks, we thus avoid wasted memory for those unaccessed members.
When bodies are allocated, we adjust the pointer back in memory by the
-size of the bit not allocated, so it's as if we allocated the full
+size of the part not allocated, so it's as if we allocated the full
structure. (But things will all go boom if you write to the part that
is "not there", because you'll be overwriting the last members of the
preceding structure in memory.)
-We calculate the correction using the STRUCT_OFFSET macro. For
-example, if xpv_allocated is the same structure as XPV then the two
-OFFSETs sum to zero, and the pointer is unchanged. If the allocated
-structure is smaller (no initial NV actually allocated) then the net
-effect is to subtract the size of the NV from the pointer, to return a
-new pointer as if an initial NV were actually allocated.
+We calculate the correction using the STRUCT_OFFSET macro on the first
+member present. If the allocated structure is smaller (no initial NV
+actually allocated) then the net effect is to subtract the size of the NV
+from the pointer, to return a new pointer as if an initial NV were actually
+allocated. (We were using structures named *_allocated for this, but
+this turned out to be a subtle bug, because a structure without an NV
+could have a lower alignment constraint, but the compiler is allowed to
+optimised accesses based on the alignment constraint of the actual pointer
+to the full structure, for example, using a single 64 bit load instruction
+because it "knows" that two adjacent 32 bit members will be 8-byte aligned.)
This is the same trick as was used for NV and IV bodies. Ironically it
doesn't need to be used for NV bodies any more, because NV is now at
Body_size determines how big a body is, and therefore how many fit into
each arena. Offset carries the body-pointer adjustment needed for
-*_allocated body types, and is used in *_allocated macros.
+"ghost fields", and is used in *_allocated macros.
But its main purpose is to parameterize info needed in
Perl_sv_upgrade(). The info here dramatically simplifies the function
-vs the implementation in 5.8.7, making it table-driven. All fields
+vs the implementation in 5.8.8, making it table-driven. All fields
are used for this, except for arena_size.
For the sv-types that have no bodies, arenas are not used, so those
? FIT_ARENAn (count, body_size) \
: FIT_ARENA0 (body_size)
-/* A macro to work out the offset needed to subtract from a pointer to (say)
-
-typedef struct {
- STRLEN xpv_cur;
- STRLEN xpv_len;
-} xpv_allocated;
-
-to make its members accessible via a pointer to (say)
-
-struct xpv {
- NV xnv_nv;
- STRLEN xpv_cur;
- STRLEN xpv_len;
-};
-
-*/
-
-#define relative_STRUCT_OFFSET(longer, shorter, member) \
- (STRUCT_OFFSET(shorter, member) - STRUCT_OFFSET(longer, member))
-
/* Calculate the length to copy. Specifically work out the length less any
final padding the compiler needed to add. See the comment in sv_upgrade
for why copying the padding proved to be a bug. */
FIT_ARENA(0, sizeof(NV)) },
/* 8 bytes on most ILP32 with IEEE doubles */
- { sizeof(xpv_allocated),
- copy_length(XPV, xpv_len)
- - relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur),
- + relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur),
- SVt_PV, FALSE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpv_allocated)) },
+ { sizeof(XPV) - STRUCT_OFFSET(XPV, xpv_cur),
+ copy_length(XPV, xpv_len) - STRUCT_OFFSET(XPV, xpv_cur),
+ + STRUCT_OFFSET(XPV, xpv_cur),
+ SVt_PV, FALSE, NONV, HASARENA,
+ FIT_ARENA(0, sizeof(XPV) - STRUCT_OFFSET(XPV, xpv_cur)) },
/* 12 */
- { sizeof(xpviv_allocated),
- copy_length(XPVIV, xiv_u)
- - relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur),
- + relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur),
- SVt_PVIV, FALSE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpviv_allocated)) },
+ { sizeof(XPVIV) - STRUCT_OFFSET(XPV, xpv_cur),
+ copy_length(XPVIV, xiv_u) - STRUCT_OFFSET(XPV, xpv_cur),
+ + STRUCT_OFFSET(XPVIV, xpv_cur),
+ SVt_PVIV, FALSE, NONV, HASARENA,
+ FIT_ARENA(0, sizeof(XPV) - STRUCT_OFFSET(XPV, xpv_cur)) },
/* 20 */
{ sizeof(XPVNV), copy_length(XPVNV, xiv_u), 0, SVt_PVNV, FALSE, HADNV,
HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
/* something big */
- { sizeof(struct regexp_allocated), sizeof(struct regexp_allocated),
- + relative_STRUCT_OFFSET(struct regexp_allocated, regexp, xpv_cur),
+ { sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur),
+ sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur),
+ + STRUCT_OFFSET(regexp, xpv_cur),
SVt_REGEXP, FALSE, NONV, HASARENA,
- FIT_ARENA(0, sizeof(struct regexp_allocated))
+ FIT_ARENA(0, sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur))
},
/* 48 */
{ sizeof(XPVLV), sizeof(XPVLV), 0, SVt_PVLV, TRUE, HADNV,
HASARENA, FIT_ARENA(0, sizeof(XPVLV)) },
- { sizeof(xpvav_allocated),
- copy_length(XPVAV, xmg_stash)
- - relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill),
- + relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill),
- SVt_PVAV, TRUE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpvav_allocated)) },
+ { sizeof(XPVAV) - STRUCT_OFFSET(XPVAV, xav_fill),
+ copy_length(XPVAV, xmg_stash) - STRUCT_OFFSET(XPVAV, xav_fill),
+ + STRUCT_OFFSET(XPVAV, xav_fill),
+ SVt_PVAV, TRUE, NONV, HASARENA,
+ FIT_ARENA(0, sizeof(XPVAV) - STRUCT_OFFSET(XPVAV, xav_fill)) },
- { sizeof(xpvhv_allocated),
- copy_length(XPVHV, xmg_stash)
- - relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill),
- + relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill),
- SVt_PVHV, TRUE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpvhv_allocated)) },
+ { sizeof(XPVHV) - STRUCT_OFFSET(XPVHV, xhv_fill),
+ copy_length(XPVHV, xmg_stash) - STRUCT_OFFSET(XPVHV, xhv_fill),
+ + STRUCT_OFFSET(XPVHV, xhv_fill),
+ SVt_PVHV, TRUE, NONV, HASARENA,
+ FIT_ARENA(0, sizeof(XPVHV) - STRUCT_OFFSET(XPVHV, xhv_fill)) },
/* 56 */
- { sizeof(xpvcv_allocated), sizeof(xpvcv_allocated),
- + relative_STRUCT_OFFSET(xpvcv_allocated, XPVCV, xpv_cur),
- SVt_PVCV, TRUE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpvcv_allocated)) },
-
- { sizeof(xpvfm_allocated), sizeof(xpvfm_allocated),
- + relative_STRUCT_OFFSET(xpvfm_allocated, XPVFM, xpv_cur),
- SVt_PVFM, TRUE, NONV, NOARENA, FIT_ARENA(20, sizeof(xpvfm_allocated)) },
+ { sizeof(XPVCV) - STRUCT_OFFSET(XPVCV, xpv_cur),
+ sizeof(XPVCV) - STRUCT_OFFSET(XPVCV, xpv_cur),
+ + STRUCT_OFFSET(XPVCV, xpv_cur),
+ SVt_PVCV, TRUE, NONV, HASARENA,
+ FIT_ARENA(0, sizeof(XPVCV) - STRUCT_OFFSET(XPVCV, xpv_cur)) },
+
+ { sizeof(XPVFM) - STRUCT_OFFSET(XPVFM, xpv_cur),
+ sizeof(XPVFM) - STRUCT_OFFSET(XPVFM, xpv_cur),
+ + STRUCT_OFFSET(XPVFM, xpv_cur),
+ SVt_PVFM, TRUE, NONV, NOARENA,
+ FIT_ARENA(20, sizeof(XPVFM) - STRUCT_OFFSET(XPVFM, xpv_cur)) },
/* XPVIO is 84 bytes, fits 48x */
- { sizeof(xpvio_allocated), sizeof(xpvio_allocated),
- + relative_STRUCT_OFFSET(xpvio_allocated, XPVIO, xpv_cur),
- SVt_PVIO, TRUE, NONV, HASARENA, FIT_ARENA(24, sizeof(xpvio_allocated)) },
+ { sizeof(XPVIO) - STRUCT_OFFSET(XPVIO, xpv_cur),
+ sizeof(XPVIO) - STRUCT_OFFSET(XPVIO, xpv_cur),
+ + STRUCT_OFFSET(XPVIO, xpv_cur),
+ SVt_PVIO, TRUE, NONV, HASARENA,
+ FIT_ARENA(24, sizeof(XPVIO) - STRUCT_OFFSET(XPVIO, xpv_cur)) },
};
#define new_body_type(sv_type) \
PERL_ARGS_ASSERT_SV_UPGRADE;
+ if (old_type == new_type)
+ return;
+
+ /* This clause was purposefully added ahead of the early return above to
+ the shared string hackery for (sort {$a <=> $b} keys %hash), with the
+ inference by Nick I-S that it would fix other troublesome cases. See
+ changes 7162, 7163 (f130fd4589cf5fbb24149cd4db4137c8326f49c1 and parent)
+
+ Given that shared hash key scalars are no longer PVIV, but PV, there is
+ no longer need to unshare so as to free up the IVX slot for its proper
+ purpose. So it's safe to move the early return earlier. */
+
if (new_type != SVt_PV && SvIsCOW(sv)) {
sv_force_normal_flags(sv, 0);
}
- if (old_type == new_type)
- return;
-
old_body = SvANY(sv);
/* Copying structures onto other structures that have been neatly zeroed
SvNV_set(sv, 0);
#endif
- if (new_type == SVt_PVIO)
+ if (new_type == SVt_PVIO) {
+ IO * const io = MUTABLE_IO(sv);
+ GV *iogv = gv_fetchpvs("FileHandle::", 0, SVt_PVHV);
+
+ SvOBJECT_on(io);
+ /* Clear the stashcache because a new IO could overrule a package
+ name */
+ hv_clear(PL_stashcache);
+
+ /* unless exists($main::{FileHandle}) and
+ defined(%main::FileHandle::) */
+ if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
+ iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV);
+ SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
IoPAGE_LEN(sv) = 60;
+ }
if (old_type < SVt_PV) {
/* referant will be NULL unless the old type was SVt_IV emulating
SVt_RV */
SV **location;
U8 import_flag = 0;
const U32 stype = SvTYPE(sref);
+ bool mro_changes = FALSE;
PERL_ARGS_ASSERT_GLOB_ASSIGN_REF;
goto common;
case SVt_PVAV:
location = (SV **) &GvAV(dstr);
+ if (strEQ(GvNAME((GV*)dstr), "ISA"))
+ mro_changes = TRUE;
import_flag = GVf_IMPORTED_AV;
goto common;
case SVt_PVIO:
goto common;
case SVt_PVFM:
location = (SV **) &GvFORM(dstr);
+ goto common;
default:
location = &GvSV(dstr);
import_flag = GVf_IMPORTED_SV;
SvREFCNT_dec(dref);
if (SvTAINTED(sstr))
SvTAINT(dstr);
+ if (mro_changes) mro_isa_changed_in(GvSTASH(dstr));
return;
}
SV_CHECK_THINKFIRST_COW_DROP(sv);
if (SvREFCNT(nsv) != 1) {
- Perl_croak(aTHX_ "panic: reference miscount on nsv in sv_replace() (%"
- UVuf " != 1)", (UV) SvREFCNT(nsv));
+ Perl_croak(aTHX_ "panic: reference miscount on nsv in sv_replace()"
+ " (%" UVuf " != 1)", (UV) SvREFCNT(nsv));
}
if (SvMAGICAL(sv)) {
if (SvMAGICAL(nsv))
else {
eptr = SvPV_const(argsv, elen);
if (DO_UTF8(argsv)) {
- I32 old_precis = precis;
+ STRLEN old_precis = precis;
if (has_precis && precis < elen) {
- I32 p = precis;
+ STRLEN ulen = sv_len_utf8(argsv);
+ I32 p = precis > ulen ? ulen : precis;
sv_pos_u2b(argsv, &p, 0); /* sticks at end */
precis = p;
}
}
string:
- if (has_precis && elen > precis)
+ if (has_precis && precis < elen)
elen = precis;
break;
Copy(proto->nexttype, parser->nexttype, 5, I32);
parser->nexttoke = proto->nexttoke;
#endif
+
+ /* XXX should clone saved_curcop here, but we aren't passed
+ * proto_perl; so do it in perl_clone_using instead */
+
return parser;
}
PL_parser = parser_dup(proto_perl->Iparser, param);
+ /* XXX this only works if the saved cop has already been cloned */
+ if (proto_perl->Iparser) {
+ PL_parser->saved_curcop = (COP*)any_dup(
+ proto_perl->Iparser->saved_curcop,
+ proto_perl);
+ }
+
PL_subline = proto_perl->Isubline;
PL_subname = sv_dup_inc(proto_perl->Isubname, param);
PL_glob_index = proto_perl->Iglob_index;
PL_srand_called = proto_perl->Isrand_called;
- PL_bitcount = NULL; /* reinits on demand */
if (proto_perl->Ipsig_pend) {
Newxz(PL_psig_pend, SIG_SIZE, int);
PL_psig_pend = (int*)NULL;
}
- if (proto_perl->Ipsig_ptr) {
- Newx(PL_psig_ptr, SIG_SIZE, SV*);
- Newx(PL_psig_name, SIG_SIZE, SV*);
- sv_dup_inc_multiple(proto_perl->Ipsig_ptr, PL_psig_ptr, SIG_SIZE,
- param);
- sv_dup_inc_multiple(proto_perl->Ipsig_name, PL_psig_name, SIG_SIZE,
+ if (proto_perl->Ipsig_name) {
+ Newx(PL_psig_name, 2 * SIG_SIZE, SV*);
+ sv_dup_inc_multiple(proto_perl->Ipsig_name, PL_psig_name, 2 * SIG_SIZE,
param);
+ PL_psig_ptr = PL_psig_name + SIG_SIZE;
}
else {
PL_psig_ptr = (SV**)NULL;
PL_tmps_ix = proto_perl->Itmps_ix;
PL_tmps_max = proto_perl->Itmps_max;
PL_tmps_floor = proto_perl->Itmps_floor;
- Newxz(PL_tmps_stack, PL_tmps_max, SV*);
- i = 0;
- while (i <= PL_tmps_ix) {
- PL_tmps_stack[i] = sv_dup_inc(proto_perl->Itmps_stack[i], param);
- ++i;
- }
+ Newx(PL_tmps_stack, PL_tmps_max, SV*);
+ sv_dup_inc_multiple(proto_perl->Itmps_stack, PL_tmps_stack, PL_tmps_ix,
+ param);
/* next PUSHMARK() sets *(PL_markstack_ptr+1) */
i = proto_perl->Imarkstack_max - proto_perl->Imarkstack;
/* Pluggable optimizer */
PL_peepp = proto_perl->Ipeepp;
+ /* op_free() hook */
+ PL_opfreehook = proto_perl->Iopfreehook;
PL_stashcache = newHV();
PL_registered_mros = hv_dup_inc(proto_perl->Iregistered_mros, param);
- if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
- ptr_table_free(PL_ptr_table);
- PL_ptr_table = NULL;
- }
-
/* Call the ->CLONE method, if it exists, for each of the stashes
identified by sv_dup() above.
*/
}
}
+ if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
+ ptr_table_free(PL_ptr_table);
+ PL_ptr_table = NULL;
+ }
+
+
SvREFCNT_dec(param->stashes);
/* orphaned? eg threads->new inside BEGIN or use */
Need a better fix at dome point. DAPM 11/2007 */
break;
+ case OP_FLIP:
+ case OP_FLOP:
+ {
+ GV * const gv = gv_fetchpvs(".", GV_NOTQUAL, SVt_PV);
+ if (gv && GvSV(gv) == uninit_sv)
+ return newSVpvs_flags("$.", SVs_TEMP);
+ goto do_op;
+ }
case OP_POS:
/* def-ness of rval pos() is independent of the def-ness of its arg */
https://perl5.git.perl.org / perl5.git / blobdiff