U32 arena_size; /* Size of arena to allocate */
};
+#define ALIGNED_TYPE_NAME(name) name##_aligned
+#define ALIGNED_TYPE(name) \
+ typedef union { \
+ name align_me; \
+ NV nv; \
+ IV iv; \
+ } ALIGNED_TYPE_NAME(name);
+
+ALIGNED_TYPE(regexp);
+ALIGNED_TYPE(XPVGV);
+ALIGNED_TYPE(XPVLV);
+ALIGNED_TYPE(XPVAV);
+ALIGNED_TYPE(XPVHV);
+ALIGNED_TYPE(XPVCV);
+ALIGNED_TYPE(XPVFM);
+ALIGNED_TYPE(XPVIO);
+
#define HADNV FALSE
#define NONV TRUE
{ sizeof(XPVMG), copy_length(XPVMG, xnv_u), 0, SVt_PVMG, FALSE, HADNV,
HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
- { sizeof(regexp),
+ { sizeof(ALIGNED_TYPE_NAME(regexp)),
sizeof(regexp),
0,
SVt_REGEXP, TRUE, NONV, HASARENA,
- FIT_ARENA(0, sizeof(regexp))
+ FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(regexp)))
},
- { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
- HASARENA, FIT_ARENA(0, sizeof(XPVGV)) },
+ { sizeof(ALIGNED_TYPE_NAME(XPVGV)), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
+ HASARENA, FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVGV))) },
- { sizeof(XPVLV), sizeof(XPVLV), 0, SVt_PVLV, TRUE, HADNV,
- HASARENA, FIT_ARENA(0, sizeof(XPVLV)) },
+ { sizeof(ALIGNED_TYPE_NAME(XPVLV)), sizeof(XPVLV), 0, SVt_PVLV, TRUE, HADNV,
+ HASARENA, FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVLV))) },
- { sizeof(XPVAV),
+ { sizeof(ALIGNED_TYPE_NAME(XPVAV)),
copy_length(XPVAV, xav_alloc),
0,
SVt_PVAV, TRUE, NONV, HASARENA,
- FIT_ARENA(0, sizeof(XPVAV)) },
+ FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVAV))) },
- { sizeof(XPVHV),
+ { sizeof(ALIGNED_TYPE_NAME(XPVHV)),
copy_length(XPVHV, xhv_max),
0,
SVt_PVHV, TRUE, NONV, HASARENA,
- FIT_ARENA(0, sizeof(XPVHV)) },
+ FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVHV))) },
- { sizeof(XPVCV),
+ { sizeof(ALIGNED_TYPE_NAME(XPVCV)),
sizeof(XPVCV),
0,
SVt_PVCV, TRUE, NONV, HASARENA,
- FIT_ARENA(0, sizeof(XPVCV)) },
+ FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVCV))) },
- { sizeof(XPVFM),
+ { sizeof(ALIGNED_TYPE_NAME(XPVFM)),
sizeof(XPVFM),
0,
SVt_PVFM, TRUE, NONV, NOARENA,
- FIT_ARENA(20, sizeof(XPVFM)) },
+ FIT_ARENA(20, sizeof(ALIGNED_TYPE_NAME(XPVFM))) },
- { sizeof(XPVIO),
+ { sizeof(ALIGNED_TYPE_NAME(XPVIO)),
sizeof(XPVIO),
0,
SVt_PVIO, TRUE, NONV, HASARENA,
- FIT_ARENA(24, sizeof(XPVIO)) },
+ FIT_ARENA(24, sizeof(ALIGNED_TYPE_NAME(XPVIO))) },
};
#define new_body_allocated(sv_type) \
char *start;
const char *end;
const size_t good_arena_size = Perl_malloc_good_size(arena_size);
-#if defined(DEBUGGING) && defined(PERL_GLOBAL_STRUCT)
- dVAR;
-#endif
-#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT)
+#if defined(DEBUGGING)
static bool done_sanity_check;
- /* PERL_GLOBAL_STRUCT cannot coexist with global
- * variables like done_sanity_check. */
if (!done_sanity_check) {
unsigned int i = SVt_LAST;
SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
}
}
- else {
+ else {
if (isGV_with_GP(sv))
return glob_2number(MUTABLE_GV(sv));
SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
#endif /* NV_PRESERVES_UV */
}
- else {
+ else {
if (isGV_with_GP(sv)) {
glob_2number(MUTABLE_GV(sv));
return 0.0;
return RX_WRAPPED(re);
} else {
- const char *const typestr = sv_reftype(referent, 0);
- const STRLEN typelen = strlen(typestr);
+ const char *const typestring = sv_reftype(referent, 0);
+ const STRLEN typelen = strlen(typestring);
UV addr = PTR2UV(referent);
const char *stashname = NULL;
STRLEN stashnamelen = 0; /* hush, gcc */
*--retval = '(';
retval -= typelen;
- memcpy(retval, typestr, typelen);
+ memcpy(retval, typestring, typelen);
if (stashname) {
*--retval = '=';
void
Perl_sv_clear(pTHX_ SV *const orig_sv)
{
- dVAR;
HV *stash;
U32 type;
const struct body_details *sv_type_details;
void
Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
{
- dVAR;
PERL_ARGS_ASSERT_SV_FREE2;
else
{
/*The big, slow, and stupid way. */
-#ifdef USE_HEAP_INSTEAD_OF_STACK /* Even slower way. */
- STDCHAR *buf = NULL;
- Newx(buf, 8192, STDCHAR);
- assert(buf);
-#else
STDCHAR buf[8192];
-#endif
screamer2:
if (rslen) {
goto screamer2;
}
-#ifdef USE_HEAP_INSTEAD_OF_STACK
- Safefree(buf);
-#endif
}
if (rspara) { /* have to do this both before and after */
SV *
Perl_sv_2mortal(pTHX_ SV *const sv)
{
- dVAR;
if (!sv)
return sv;
if (SvIMMORTAL(sv))
SV *
Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
{
- dVAR;
SV *sv;
bool is_utf8 = FALSE;
const char *const orig_src = src;
* being allowed for %c (ideally we should warn on e.g. '%hc').
* Setting a default intsize, along with a positive
* (which signals unsigned) base, causes, for C-ish use, the
- * va_arg to be interpreted as as unsigned int, when it's
+ * va_arg to be interpreted as an unsigned int, when it's
* actually signed, which will convert -ve values to high +ve
* values. Note that unlike the libc %c, values > 255 will
* convert to high unicode points rather than being truncated
(!UVCHR_IS_INVARIANT(uv) && SvUTF8(sv)))
&& !IN_BYTES)
{
- assert(sizeof(ebuf) >= UTF8_MAXBYTES + 1);
+ STATIC_ASSERT_STMT(sizeof(ebuf) >= UTF8_MAXBYTES + 1);
eptr = ebuf;
elen = uvchr_to_utf8((U8*)eptr, uv) - (U8*)ebuf;
is_utf8 = TRUE;
static SV *
S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
{
- dVAR;
SV *dstr;
PERL_ARGS_ASSERT_SV_DUP_COMMON;
/* XXX should this sv_dup_inc? Or only if CxEVAL_TXT_REFCNTED ???? */
ncx->blk_eval.cur_text = sv_dup(ncx->blk_eval.cur_text, param);
ncx->blk_eval.cv = cv_dup(ncx->blk_eval.cv, param);
- /* XXX what do do with cur_top_env ???? */
+ /* XXX what to do with cur_top_env ???? */
break;
case CXt_LOOP_LAZYSV:
ncx->blk_loop.state_u.lazysv.end
ANY *
Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
{
- dVAR;
ANY * const ss = proto_perl->Isavestack;
const I32 max = proto_perl->Isavestack_max + SS_MAXPUSH;
I32 ix = proto_perl->Isavestack_ix;
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = ptr;
break;
+ case SAVEt_HINTS_HH:
+ hv = (const HV *)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = hv_dup_inc(hv, param);
+ /* FALLTHROUGH */
case SAVEt_HINTS:
ptr = POPPTR(ss,ix);
ptr = cophh_copy((COPHH*)ptr);
TOPPTR(nss,ix) = ptr;
i = POPINT(ss,ix);
TOPINT(nss,ix) = i;
- if (i & HINT_LOCALIZE_HH) {
- hv = (const HV *)POPPTR(ss,ix);
- TOPPTR(nss,ix) = hv_dup_inc(hv, param);
- }
break;
case SAVEt_PADSV_AND_MORTALIZE:
longval = (long)POPLONG(ss,ix);
PerlInterpreter *
perl_clone(PerlInterpreter *proto_perl, UV flags)
{
- dVAR;
#ifdef PERL_IMPLICIT_SYS
PERL_ARGS_ASSERT_PERL_CLONE;
PL_cv_has_eval = proto_perl->Icv_has_eval;
-#ifdef FCRYPT
- PL_cryptseen = proto_perl->Icryptseen;
-#endif
-
#ifdef USE_LOCALE_COLLATE
PL_collation_ix = proto_perl->Icollation_ix;
PL_collation_standard = proto_perl->Icollation_standard;
/* Recursion stopper for PerlIO_find_layer */
PL_in_load_module = proto_perl->Iin_load_module;
- /* sort() routine */
- PL_sort_RealCmp = proto_perl->Isort_RealCmp;
-
/* Not really needed/useful since the reenrant_retint is "volatile",
* but do it for consistency's sake. */
PL_reentrant_retint = proto_perl->Ireentrant_retint;
#ifdef HAS_MBRLEN
PL_mbrlen_ps = proto_perl->Imbrlen_ps;
#endif
+#ifdef HAS_MBRTOWC
+ PL_mbrtowc_ps = proto_perl->Imbrtowc_ps;
+#endif
+#ifdef HAS_WCRTOMB
+ PL_wcrtomb_ps = proto_perl->Iwcrtomb_ps;
+#endif
PL_langinfo_buf = NULL;
PL_langinfo_bufsize = 0;
PL_SCX_invlist = sv_dup_inc(proto_perl->ISCX_invlist, param);
PL_UpperLatin1 = sv_dup_inc(proto_perl->IUpperLatin1, param);
PL_in_some_fold = sv_dup_inc(proto_perl->Iin_some_fold, param);
+ PL_utf8_foldclosures = sv_dup_inc(proto_perl->Iutf8_foldclosures, param);
PL_utf8_idcont = sv_dup_inc(proto_perl->Iutf8_idcont, param);
PL_utf8_idstart = sv_dup_inc(proto_perl->Iutf8_idstart, param);
PL_utf8_perl_idcont = sv_dup_inc(proto_perl->Iutf8_perl_idcont, param);
void
Perl_clone_params_del(CLONE_PARAMS *param)
{
- /* This seemingly funky ordering keeps the build with PERL_GLOBAL_STRUCT
- happy: */
+ PerlInterpreter *const was = PERL_GET_THX;
PerlInterpreter *const to = param->new_perl;
dTHXa(to);
- PerlInterpreter *const was = PERL_GET_THX;
PERL_ARGS_ASSERT_CLONE_PARAMS_DEL;
CLONE_PARAMS *
Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
{
- dVAR;
/* Need to play this game, as newAV() can call safesysmalloc(), and that
does a dTHX; to get the context from thread local storage.
FIXME - under PERL_CORE Newx(), Safefree() and friends should expand to
void
Perl_init_constants(pTHX)
{
- dVAR;
SvREFCNT(&PL_sv_undef) = SvREFCNT_IMMORTAL;
SvFLAGS(&PL_sv_undef) = SVf_READONLY|SVf_PROTECT|SVt_NULL;
STATIC SV*
S_find_hash_subscript(pTHX_ const HV *const hv, const SV *const val)
{
- dVAR;
HE **array;
I32 i;
S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
bool match, const char **desc_p)
{
- dVAR;
SV *sv;
const GV *gv;
const OP *o, *o2, *kid;
negate ? - SvIV(cSVOPx_sv(kid)) : SvIV(cSVOPx_sv(kid)),
FUV_SUBSCRIPT_ARRAY);
}
- else {
+ else {
/* index is an expression;
* attempt to find a match within the aggregate */
if (obase->op_type == OP_HELEM) {
: varname(agg_gv, '@', agg_targ,
NULL, index_const_iv, FUV_SUBSCRIPT_ARRAY);
}
- else {
+ else {
/* index is an var */
if (is_hv) {
SV * const keysv = find_hash_subscript((const HV*)sv, uninit_sv);
return varname(agg_gv, '@', agg_targ,
NULL, index, FUV_SUBSCRIPT_ARRAY);
}
+ /* look for an element not found */
+ if (!SvMAGICAL(sv)) {
+ SV *index_sv = NULL;
+ if (index_targ) {
+ index_sv = PL_curpad[index_targ];
+ }
+ else if (index_gv) {
+ index_sv = GvSV(index_gv);
+ }
+ if (index_sv && !SvMAGICAL(index_sv) && !SvROK(index_sv)) {
+ if (is_hv) {
+ HE *he = hv_fetch_ent(MUTABLE_HV(sv), index_sv, 0, 0);
+ if (!he) {
+ return varname(agg_gv, '%', agg_targ,
+ index_sv, 0, FUV_SUBSCRIPT_HASH);
+ }
+ }
+ else {
+ SSize_t index = SvIV(index_sv);
+ SV * const * const svp =
+ av_fetch(MUTABLE_AV(sv), index, FALSE);
+ if (!svp) {
+ return varname(agg_gv, '@', agg_targ,
+ NULL, index, FUV_SUBSCRIPT_ARRAY);
+ }
+ }
+ }
+ }
if (match)
break;
return varname(agg_gv,