X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=scope.c;h=92e952360d3f56963afb24fb3a76855799693e2c;hb=af5050ac60ae083ebc5a0b2a1b4289c51c622f95;hp=b2c2ee0f64e46156d0fa5eccedf00aedb480114a;hpb=e0fa7e2be05466f132eb653ebe7b2f9664ffcb3b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/scope.c b/scope.c index b2c2ee0..92e9523 100644 --- a/scope.c +++ b/scope.c @@ -373,10 +373,9 @@ Perl_save_bool(pTHX_ bool *boolp) PERL_ARGS_ASSERT_SAVE_BOOL; - SSCHECK(3); - SSPUSHBOOL(*boolp); + SSCHECK(2); SSPUSHPTR(boolp); - SSPUSHUV(SAVEt_BOOL); + SSPUSHUV(SAVEt_BOOL | (*boolp << 8)); } void @@ -393,10 +392,16 @@ void Perl_save_int(pTHX_ int *intp) { dVAR; + const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT; 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 @@ -406,7 +411,9 @@ Perl_save_I8(pTHX_ I8 *bytep) PERL_ARGS_ASSERT_SAVE_I8; - save_pushi32ptr(*bytep, bytep, SAVEt_I8); + SSCHECK(2); + SSPUSHPTR(bytep); + SSPUSHUV(SAVEt_I8 | ((UV)*bytep << 8)); } void @@ -416,17 +423,25 @@ Perl_save_I16(pTHX_ I16 *intp) 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; + const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT; 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 @@ -680,13 +695,17 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad) 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; - SSPUSHINT(elems); - SSPUSHUV(SAVEt_ALLOC); + SSPUSHUV(SAVEt_ALLOC | elems_shifted); return start; } @@ -789,13 +808,21 @@ Perl_leave_scope(pTHX_ I32 base) 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; - *(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; @@ -932,11 +959,8 @@ Perl_leave_scope(pTHX_ I32 base) break; case SAVEt_REGCONTEXT: /* regexp must have croaked */ - PL_savestack_ix -= uv >> SAVE_TIGHT_SHIFT; - break; 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; @@ -1084,11 +1108,11 @@ Perl_leave_scope(pTHX_ I32 base) case SAVEt_I16: /* I16 reference */ ptr = SSPOPPTR; - *(I16*)ptr = (I16)SSPOPINT; + *(I16*)ptr = (I16)(uv >> 8); break; case SAVEt_I8: /* I8 reference */ ptr = SSPOPPTR; - *(I8*)ptr = (I8)SSPOPINT; + *(I8*)ptr = (I8)(uv >> 8); break; case SAVEt_DESTRUCTOR: ptr = SSPOPPTR;