This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Make it possible to have read-only glob copies
[perl5.git]
/
scope.c
diff --git
a/scope.c
b/scope.c
index
6ee1254
..
e0ba9a3
100644
(file)
--- a/
scope.c
+++ b/
scope.c
@@
-77,7
+77,7
@@
Perl_cxinc(pTHX)
dVAR;
const IV old_max = cxstack_max;
cxstack_max = GROW(cxstack_max);
dVAR;
const IV old_max = cxstack_max;
cxstack_max = GROW(cxstack_max);
- Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);
/* XXX should fix CXINC macro */
+ Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);
/* Without any kind of initialising deep enough recursion
* will end up reading uninitialised PERL_CONTEXTs. */
PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
/* Without any kind of initialising deep enough recursion
* will end up reading uninitialised PERL_CONTEXTs. */
PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
@@
-183,13
+183,11
@@
S_save_scalar_at(pTHX_ SV **sptr, const U32 flags)
if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
if (SvGMAGICAL(osv)) {
if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
if (SvGMAGICAL(osv)) {
- const bool oldtainted = PL_tainted;
SvFLAGS(osv) |= (SvFLAGS(osv) &
(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
SvFLAGS(osv) |= (SvFLAGS(osv) &
(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
- PL_tainted = oldtainted;
}
if (!(flags & SAVEf_KEEPOLDELEM))
}
if (!(flags & SAVEf_KEEPOLDELEM))
- mg_localize(osv, sv,
(flags & SAVEf_SETMAGIC) != 0
);
+ mg_localize(osv, sv,
cBOOL(flags & SAVEf_SETMAGIC)
);
}
return sv;
}
return sv;
@@
-202,7
+200,7
@@
Perl_save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type)
SSCHECK(3);
SSPUSHPTR(ptr1);
SSPUSHPTR(ptr2);
SSCHECK(3);
SSPUSHPTR(ptr1);
SSPUSHPTR(ptr2);
- SSPUSH
INT
(type);
+ SSPUSH
UV
(type);
}
SV *
}
SV *
@@
-271,7
+269,7
@@
Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val)
SSPUSHPTR(sv);
SSPUSHINT(mask);
SSPUSHINT(val);
SSPUSHPTR(sv);
SSPUSHINT(mask);
SSPUSHINT(val);
- SSPUSH
INT
(SAVEt_SET_SVFLAGS);
+ SSPUSH
UV
(SAVEt_SET_SVFLAGS);
}
void
}
void
@@
-300,7
+298,7
@@
Perl_save_gp(pTHX_ GV *gv, I32 empty)
gp->gp_sv = newSV(0);
}
#endif
gp->gp_sv = newSV(0);
}
#endif
- GvGP
(gv) = gp
;
+ GvGP
_set(gv,gp)
;
}
else {
gp_ref(GvGP(gv));
}
else {
gp_ref(GvGP(gv));
@@
-365,10
+363,9
@@
Perl_save_bool(pTHX_ bool *boolp)
PERL_ARGS_ASSERT_SAVE_BOOL;
PERL_ARGS_ASSERT_SAVE_BOOL;
- SSCHECK(3);
- SSPUSHBOOL(*boolp);
+ SSCHECK(2);
SSPUSHPTR(boolp);
SSPUSHPTR(boolp);
- SSPUSH
INT(SAVEt_BOOL
);
+ SSPUSH
UV(SAVEt_BOOL | (*boolp << 8)
);
}
void
}
void
@@
-378,17
+375,23
@@
Perl_save_pushi32ptr(pTHX_ const I32 i, void *const ptr, const int type)
SSCHECK(3);
SSPUSHINT(i);
SSPUSHPTR(ptr);
SSCHECK(3);
SSPUSHINT(i);
SSPUSHPTR(ptr);
- SSPUSH
INT
(type);
+ SSPUSH
UV
(type);
}
void
Perl_save_int(pTHX_ int *intp)
{
dVAR;
}
void
Perl_save_int(pTHX_ int *intp)
{
dVAR;
+ const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT;
PERL_ARGS_ASSERT_SAVE_INT;
PERL_ARGS_ASSERT_SAVE_INT;
- save_pushi32ptr(*intp, intp, SAVEt_INT);
+ if ((int)(shifted >> SAVE_TIGHT_SHIFT) == *intp) {
+ SSCHECK(2);
+ SSPUSHPTR(intp);
+ SSPUSHUV(SAVEt_INT_SMALL | shifted);
+ } else
+ save_pushi32ptr(*intp, intp, SAVEt_INT);
}
void
}
void
@@
-398,7
+401,9
@@
Perl_save_I8(pTHX_ I8 *bytep)
PERL_ARGS_ASSERT_SAVE_I8;
PERL_ARGS_ASSERT_SAVE_I8;
- save_pushi32ptr(*bytep, bytep, SAVEt_I8);
+ SSCHECK(2);
+ SSPUSHPTR(bytep);
+ SSPUSHUV(SAVEt_I8 | ((UV)*bytep << 8));
}
void
}
void
@@
-408,17
+413,25
@@
Perl_save_I16(pTHX_ I16 *intp)
PERL_ARGS_ASSERT_SAVE_I16;
PERL_ARGS_ASSERT_SAVE_I16;
- save_pushi32ptr(*intp, intp, SAVEt_I16);
+ SSCHECK(2);
+ SSPUSHPTR(intp);
+ SSPUSHUV(SAVEt_I16 | ((UV)*intp << 8));
}
void
Perl_save_I32(pTHX_ I32 *intp)
{
dVAR;
}
void
Perl_save_I32(pTHX_ I32 *intp)
{
dVAR;
+ const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT;
PERL_ARGS_ASSERT_SAVE_I32;
PERL_ARGS_ASSERT_SAVE_I32;
- save_pushi32ptr(*intp, intp, SAVEt_I32);
+ if ((I32)(shifted >> SAVE_TIGHT_SHIFT) == *intp) {
+ SSCHECK(2);
+ SSPUSHPTR(intp);
+ SSPUSHUV(SAVEt_I32_SMALL | shifted);
+ } else
+ save_pushi32ptr(*intp, intp, SAVEt_I32);
}
/* Cannot use save_sptr() to store a char* since the SV** cast will
}
/* Cannot use save_sptr() to store a char* since the SV** cast will
@@
-463,7
+476,7
@@
Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off)
SSPUSHPTR(SvREFCNT_inc_simple_NN(PL_curpad[off]));
SSPUSHPTR(PL_comppad);
SSPUSHLONG((long)off);
SSPUSHPTR(SvREFCNT_inc_simple_NN(PL_curpad[off]));
SSPUSHPTR(PL_comppad);
SSPUSHLONG((long)off);
- SSPUSH
INT
(SAVEt_PADSV_AND_MORTALIZE);
+ SSPUSH
UV
(SAVEt_PADSV_AND_MORTALIZE);
}
void
}
void
@@
-492,20
+505,25
@@
Perl_save_pushptr(pTHX_ void *const ptr, const int type)
dVAR;
SSCHECK(2);
SSPUSHPTR(ptr);
dVAR;
SSCHECK(2);
SSPUSHPTR(ptr);
- SSPUSH
INT
(type);
+ SSPUSH
UV
(type);
}
void
Perl_save_clearsv(pTHX_ SV **svp)
{
dVAR;
}
void
Perl_save_clearsv(pTHX_ SV **svp)
{
dVAR;
+ const UV offset = svp - PL_curpad;
+ const UV offset_shifted = offset << SAVE_TIGHT_SHIFT;
PERL_ARGS_ASSERT_SAVE_CLEARSV;
ASSERT_CURPAD_ACTIVE("save_clearsv");
PERL_ARGS_ASSERT_SAVE_CLEARSV;
ASSERT_CURPAD_ACTIVE("save_clearsv");
- SSCHECK(2);
- SSPUSHLONG((long)(svp-PL_curpad));
- SSPUSHINT(SAVEt_CLEARSV);
+ if ((offset_shifted >> SAVE_TIGHT_SHIFT) != offset)
+ Perl_croak(aTHX_ "panic: pad offset %"UVuf" out of range (%p-%p)",
+ offset, svp, PL_curpad);
+
+ SSCHECK(1);
+ SSPUSHUV(offset_shifted | SAVEt_CLEARSV);
SvPADSTALE_off(*svp); /* mark lexical as active */
}
SvPADSTALE_off(*svp); /* mark lexical as active */
}
@@
-555,7
+573,7
@@
Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
SSCHECK(3);
SSPUSHDPTR(f);
SSPUSHPTR(p);
SSCHECK(3);
SSPUSHDPTR(f);
SSPUSHPTR(p);
- SSPUSH
INT
(SAVEt_DESTRUCTOR);
+ SSPUSH
UV
(SAVEt_DESTRUCTOR);
}
void
}
void
@@
-565,24
+583,19
@@
Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
SSCHECK(3);
SSPUSHDXPTR(f);
SSPUSHPTR(p);
SSCHECK(3);
SSPUSHDXPTR(f);
SSPUSHPTR(p);
- SSPUSH
INT
(SAVEt_DESTRUCTOR_X);
+ SSPUSH
UV
(SAVEt_DESTRUCTOR_X);
}
void
Perl_save_hints(pTHX)
{
dVAR;
}
void
Perl_save_hints(pTHX)
{
dVAR;
- if (PL_compiling.cop_hints_hash) {
- HINTS_REFCNT_LOCK;
- PL_compiling.cop_hints_hash->refcounted_he_refcnt++;
- HINTS_REFCNT_UNLOCK;
- }
+ COPHH *save_cophh = cophh_copy(CopHINTHASH_get(&PL_compiling));
if (PL_hints & HINT_LOCALIZE_HH) {
if (PL_hints & HINT_LOCALIZE_HH) {
- save_pushptri32ptr(GvHV(PL_hintgv), PL_hints,
- PL_compiling.cop_hints_hash, SAVEt_HINTS);
- GvHV(PL_hintgv) = Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv));
+ save_pushptri32ptr(GvHV(PL_hintgv), PL_hints, save_cophh, SAVEt_HINTS);
+ GvHV(PL_hintgv) = hv_copy_hints_hv(GvHV(PL_hintgv));
} else {
} else {
- save_pushi32ptr(PL_hints,
PL_compiling.cop_hints_has
h, SAVEt_HINTS);
+ save_pushi32ptr(PL_hints,
save_coph
h, SAVEt_HINTS);
}
}
}
}
@@
-594,7
+607,7
@@
S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2,
SSPUSHPTR(ptr1);
SSPUSHINT(i);
SSPUSHPTR(ptr2);
SSPUSHPTR(ptr1);
SSPUSHINT(i);
SSPUSHPTR(ptr2);
- SSPUSH
INT
(type);
+ SSPUSH
UV
(type);
}
void
}
void
@@
-636,7
+649,7
@@
Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
SSPUSHPTR(SvREFCNT_inc_simple(hv));
SSPUSHPTR(newSVsv(key));
SSPUSHPTR(SvREFCNT_inc(*sptr));
SSPUSHPTR(SvREFCNT_inc_simple(hv));
SSPUSHPTR(newSVsv(key));
SSPUSHPTR(SvREFCNT_inc(*sptr));
- SSPUSH
INT
(SAVEt_HELEM);
+ SSPUSH
UV
(SAVEt_HELEM);
save_scalar_at(sptr, flags);
if (flags & SAVEf_KEEPOLDELEM)
return;
save_scalar_at(sptr, flags);
if (flags & SAVEf_KEEPOLDELEM)
return;
@@
-667,13
+680,17
@@
Perl_save_alloc(pTHX_ I32 size, I32 pad)
dVAR;
register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
- (char*)PL_savestack);
dVAR;
register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
- (char*)PL_savestack);
- register const I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
+ const UV elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
+ const UV elems_shifted = elems << SAVE_TIGHT_SHIFT;
- SSGROW(elems + 2);
+ if ((elems_shifted >> SAVE_TIGHT_SHIFT) != elems)
+ Perl_croak(aTHX_ "panic: save_alloc elems %"UVuf" out of range (%ld-%ld)",
+ elems, size, pad);
+
+ SSGROW(elems + 1);
PL_savestack_ix += elems;
PL_savestack_ix += elems;
- SSPUSHINT(elems);
- SSPUSHINT(SAVEt_ALLOC);
+ SSPUSHUV(SAVEt_ALLOC | elems_shifted);
return start;
}
return start;
}
@@
-697,9
+714,11
@@
Perl_leave_scope(pTHX_ I32 base)
DEBUG_l(Perl_deb(aTHX_ "savestack: releasing items %ld -> %ld\n",
(long)PL_savestack_ix, (long)base));
while (PL_savestack_ix > base) {
DEBUG_l(Perl_deb(aTHX_ "savestack: releasing items %ld -> %ld\n",
(long)PL_savestack_ix, (long)base));
while (PL_savestack_ix > base) {
+ UV uv = SSPOPUV;
+ const U8 type = (U8)uv & SAVE_MASK;
TAINT_NOT;
TAINT_NOT;
- switch (
SSPOPINT
) {
+ switch (
type
) {
case SAVEt_ITEM: /* normal string */
value = MUTABLE_SV(SSPOPPTR);
sv = MUTABLE_SV(SSPOPPTR);
case SAVEt_ITEM: /* normal string */
value = MUTABLE_SV(SSPOPPTR);
sv = MUTABLE_SV(SSPOPPTR);
@@
-744,9
+763,15
@@
Perl_leave_scope(pTHX_ I32 base)
*(char**)ptr = str;
}
break;
*(char**)ptr = str;
}
break;
+ case SAVEt_GVSV: /* scalar slot in GV */
+ value = MUTABLE_SV(SSPOPPTR);
+ gv = MUTABLE_GV(SSPOPPTR);
+ ptr = &GvSV(gv);
+ goto restore_svp;
case SAVEt_GENERIC_SVREF: /* generic sv */
value = MUTABLE_SV(SSPOPPTR);
ptr = SSPOPPTR;
case SAVEt_GENERIC_SVREF: /* generic sv */
value = MUTABLE_SV(SSPOPPTR);
ptr = SSPOPPTR;
+ restore_svp:
sv = *(SV**)ptr;
*(SV**)ptr = value;
SvREFCNT_dec(sv);
sv = *(SV**)ptr;
*(SV**)ptr = value;
SvREFCNT_dec(sv);
@@
-774,13
+799,21
@@
Perl_leave_scope(pTHX_ I32 base)
PL_localizing = 0;
}
break;
PL_localizing = 0;
}
break;
+ case SAVEt_INT_SMALL:
+ ptr = SSPOPPTR;
+ *(int*)ptr = (int)(uv >> SAVE_TIGHT_SHIFT);
+ break;
case SAVEt_INT: /* int reference */
ptr = SSPOPPTR;
*(int*)ptr = (int)SSPOPINT;
break;
case SAVEt_BOOL: /* bool reference */
ptr = SSPOPPTR;
case SAVEt_INT: /* int reference */
ptr = SSPOPPTR;
*(int*)ptr = (int)SSPOPINT;
break;
case SAVEt_BOOL: /* bool reference */
ptr = SSPOPPTR;
- *(bool*)ptr = cBOOL(SSPOPBOOL);
+ *(bool*)ptr = cBOOL(uv >> 8);
+ break;
+ case SAVEt_I32_SMALL:
+ ptr = SSPOPPTR;
+ *(I32*)ptr = (I32)(uv >> SAVE_TIGHT_SHIFT);
break;
case SAVEt_I32: /* I32 reference */
ptr = SSPOPPTR;
break;
case SAVEt_I32: /* I32 reference */
ptr = SSPOPPTR;
@@
-815,9
+848,9
@@
Perl_leave_scope(pTHX_ I32 base)
ptr = SSPOPPTR;
gv = MUTABLE_GV(SSPOPPTR);
gp_free(gv);
ptr = SSPOPPTR;
gv = MUTABLE_GV(SSPOPPTR);
gp_free(gv);
- GvGP
(gv) = (GP*)ptr
;
+ GvGP
_set(gv, (GP*)ptr)
;
/* putting a method back into circulation ("local")*/
/* putting a method back into circulation ("local")*/
- if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvNAME_get(hv))
+ if (GvCVu(gv) && (hv=GvSTASH(gv)) && Hv
E
NAME_get(hv))
mro_method_changed_in(hv);
SvREFCNT_dec(gv);
break;
mro_method_changed_in(hv);
SvREFCNT_dec(gv);
break;
@@
-825,6
+858,10
@@
Perl_leave_scope(pTHX_ I32 base)
ptr = SSPOPPTR;
SvREFCNT_dec(MUTABLE_SV(ptr));
break;
ptr = SSPOPPTR;
SvREFCNT_dec(MUTABLE_SV(ptr));
break;
+ case SAVEt_FREECOPHH:
+ ptr = SSPOPPTR;
+ cophh_free((COPHH *)ptr);
+ break;
case SAVEt_MORTALIZESV:
ptr = SSPOPPTR;
sv_2mortal(MUTABLE_SV(ptr));
case SAVEt_MORTALIZESV:
ptr = SSPOPPTR;
sv_2mortal(MUTABLE_SV(ptr));
@@
-839,7
+876,7
@@
Perl_leave_scope(pTHX_ I32 base)
Safefree(ptr);
break;
case SAVEt_CLEARSV:
Safefree(ptr);
break;
case SAVEt_CLEARSV:
- ptr = (void*)&PL_curpad[
SSPOPLONG
];
+ ptr = (void*)&PL_curpad[
uv >> SAVE_TIGHT_SHIFT
];
sv = *(SV**)ptr;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
sv = *(SV**)ptr;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
@@
-915,9
+952,9
@@
Perl_leave_scope(pTHX_ I32 base)
(*SSPOPDXPTR)(aTHX_ ptr);
break;
case SAVEt_REGCONTEXT:
(*SSPOPDXPTR)(aTHX_ ptr);
break;
case SAVEt_REGCONTEXT:
+ /* regexp must have croaked */
case SAVEt_ALLOC:
case SAVEt_ALLOC:
- i = SSPOPINT;
- PL_savestack_ix -= i; /* regexp must have croaked */
+ PL_savestack_ix -= uv >> SAVE_TIGHT_SHIFT;
break;
case SAVEt_STACK_POS: /* Position on Perl stack */
i = SSPOPINT;
break;
case SAVEt_STACK_POS: /* Position on Perl stack */
i = SSPOPINT;
@@
-972,8
+1009,8
@@
Perl_leave_scope(pTHX_ I32 base)
SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
GvHV(PL_hintgv) = NULL;
}
SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
GvHV(PL_hintgv) = NULL;
}
-
Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash
);
-
PL_compiling.cop_hints_hash = (struct refcounted_he *) SSPOPPTR
;
+
cophh_free(CopHINTHASH_get(&PL_compiling)
);
+
CopHINTHASH_set(&PL_compiling, (COPHH*)SSPOPPTR)
;
*(I32*)&PL_hints = (I32)SSPOPINT;
if (PL_hints & HINT_LOCALIZE_HH) {
SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
*(I32*)&PL_hints = (I32)SSPOPINT;
if (PL_hints & HINT_LOCALIZE_HH) {
SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
@@
-1065,11
+1102,11
@@
Perl_leave_scope(pTHX_ I32 base)
case SAVEt_I16: /* I16 reference */
ptr = SSPOPPTR;
case SAVEt_I16: /* I16 reference */
ptr = SSPOPPTR;
- *(I16*)ptr = (I16)
SSPOPINT
;
+ *(I16*)ptr = (I16)
(uv >> 8)
;
break;
case SAVEt_I8: /* I8 reference */
ptr = SSPOPPTR;
break;
case SAVEt_I8: /* I8 reference */
ptr = SSPOPPTR;
- *(I8*)ptr = (I8)
SSPOPINT
;
+ *(I8*)ptr = (I8)
(uv >> 8)
;
break;
case SAVEt_DESTRUCTOR:
ptr = SSPOPPTR;
break;
case SAVEt_DESTRUCTOR:
ptr = SSPOPPTR;
@@
-1189,8
+1226,6
@@
Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
(long)cx->blk_loop.resetsp);
PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
PTR2UV(cx->blk_loop.my_op));
(long)cx->blk_loop.resetsp);
PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
PTR2UV(cx->blk_loop.my_op));
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%"UVxf"\n",
- PTR2UV(CX_LOOP_NEXTOP_GET(cx)));
/* XXX: not accurate for LAZYSV/IV */
PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
PTR2UV(cx->blk_loop.state_u.ary.ary));
/* XXX: not accurate for LAZYSV/IV */
PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
PTR2UV(cx->blk_loop.state_u.ary.ary));