diff options
| -rw-r--r-- | dump.c | 4 | ||||
| -rw-r--r-- | embed.fnc | 3 | ||||
| -rw-r--r-- | embed.h | 1 | ||||
| -rw-r--r-- | intrpvar.h | 6 | ||||
| -rw-r--r-- | op.c | 2 | ||||
| -rw-r--r-- | proto.h | 7 | ||||
| -rw-r--r-- | scope.c | 21 | ||||
| -rw-r--r-- | scope.h | 5 | ||||
| -rw-r--r-- | sv.c | 1 |
9 files changed, 38 insertions, 12 deletions
@@ -504,7 +504,7 @@ Perl_sv_peek(pTHX_ SV *sv) } else if (DEBUG_R_TEST_) { int is_tmp = 0; - I32 ix; + SSize_t ix; /* is this SV on the tmps stack? */ for (ix=PL_tmps_ix; ix>=0; ix--) { if (PL_tmps_stack[ix] == sv) { @@ -2757,7 +2757,7 @@ Perl_sv_xmlpeek(pTHX_ SV *sv) } else if (DEBUG_R_TEST_) { int is_tmp = 0; - I32 ix; + SSize_t ix; /* is this SV on the tmps stack? */ for (ix=PL_tmps_ix; ix>=0; ix--) { if (PL_tmps_stack[ix] == sv) { @@ -1226,6 +1226,7 @@ Ap |void |save_vptr |NN void *ptr Ap |void |save_re_context Ap |void |save_padsv_and_mortalize|PADOFFSET off Ap |void |save_sptr |NN SV** sptr +Xp |void |save_strlen |NN STRLEN* ptr Ap |SV* |save_svref |NN SV** sptr Ap |void |save_pushptr |NULLOK void *const ptr|const int type Ap |void |save_pushi32ptr|const I32 i|NULLOK void *const ptr|const int type @@ -1692,7 +1693,7 @@ Apd |void |sv_utf8_encode |NN SV *const sv ApdM |bool |sv_utf8_decode |NN SV *const sv Apdmb |void |sv_force_normal|NN SV *sv Apd |void |sv_force_normal_flags|NN SV *const sv|const U32 flags -Ap |void |tmps_grow |I32 n +Ap |void |tmps_grow |SSize_t n Apd |SV* |sv_rvweaken |NN SV *const sv : This is indirectly referenced by globals.c. This is somewhat annoying. p |int |magic_killbackrefs|NN SV *sv|NN MAGIC *mg @@ -1217,6 +1217,7 @@ #define rsignal_restore(a,b) Perl_rsignal_restore(aTHX_ a,b) #define rsignal_save(a,b,c) Perl_rsignal_save(aTHX_ a,b,c) #define rxres_save(a,b) Perl_rxres_save(aTHX_ a,b) +#define save_strlen(a) Perl_save_strlen(aTHX_ a) #define sawparens(a) Perl_sawparens(aTHX_ a) #define scalar(a) Perl_scalar(aTHX_ a) #define scalarvoid(a) Perl_scalarvoid(aTHX_ a) diff --git a/intrpvar.h b/intrpvar.h index 80217289d0..c6ee593d0e 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -53,9 +53,9 @@ PERLVAR(I, scopestack_ix, I32) PERLVAR(I, scopestack_max, I32) PERLVAR(I, tmps_stack, SV **) /* mortals we've made */ -PERLVARI(I, tmps_ix, I32, -1) -PERLVARI(I, tmps_floor, I32, -1) -PERLVAR(I, tmps_max, I32) +PERLVARI(I, tmps_ix, SSize_t, -1) +PERLVARI(I, tmps_floor, SSize_t, -1) +PERLVAR(I, tmps_max, SSize_t) PERLVARI(I, sub_generation, U32, 1) /* incr to invalidate method cache */ @@ -3355,7 +3355,7 @@ S_gen_constant_list(pTHX_ OP *o) { dVAR; OP *curop; - const I32 oldtmps_floor = PL_tmps_floor; + const SSize_t oldtmps_floor = PL_tmps_floor; SV **svp; AV *av; @@ -3667,6 +3667,11 @@ PERL_CALLCONV void Perl_save_sptr(pTHX_ SV** sptr) #define PERL_ARGS_ASSERT_SAVE_SPTR \ assert(sptr) +PERL_CALLCONV void Perl_save_strlen(pTHX_ STRLEN* ptr) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_SAVE_STRLEN \ + assert(ptr) + PERL_CALLCONV SV* Perl_save_svref(pTHX_ SV** sptr) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_SAVE_SVREF \ @@ -4576,7 +4581,7 @@ PERL_CALLCONV OP * Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv, c #define PERL_ARGS_ASSERT_TIED_METHOD \ assert(methname); assert(sp); assert(sv); assert(mg) -PERL_CALLCONV void Perl_tmps_grow(pTHX_ I32 n); +PERL_CALLCONV void Perl_tmps_grow(pTHX_ SSize_t n); /* PERL_CALLCONV UV Perl_to_uni_fold(pTHX_ UV c, U8 *p, STRLEN *lenp) __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3); */ @@ -141,7 +141,7 @@ Perl_savestack_grow_cnt(pTHX_ I32 need) #undef GROW void -Perl_tmps_grow(pTHX_ I32 n) +Perl_tmps_grow(pTHX_ SSize_t n) { dVAR; #ifndef STRESS_REALLOC @@ -158,7 +158,7 @@ Perl_free_tmps(pTHX) { dVAR; /* XXX should tmps_floor live in cxstack? */ - const I32 myfloor = PL_tmps_floor; + const SSize_t myfloor = PL_tmps_floor; while (PL_tmps_ix > myfloor) { /* clean up after last statement */ SV* const sv = PL_tmps_stack[PL_tmps_ix--]; #ifdef PERL_POISON @@ -457,6 +457,20 @@ Perl_save_I32(pTHX_ I32 *intp) SS_ADD_END(size); } +void +Perl_save_strlen(pTHX_ STRLEN *ptr) +{ + dVAR; + dSS_ADD; + + PERL_ARGS_ASSERT_SAVE_STRLEN; + + SS_ADD_IV(*ptr); + SS_ADD_PTR(ptr); + SS_ADD_UV(SAVEt_STRLEN); + SS_ADD_END(3); +} + /* Cannot use save_sptr() to store a char* since the SV** cast will * force word-alignment and we'll miss the pointer. */ @@ -914,6 +928,9 @@ Perl_leave_scope(pTHX_ I32 base) case SAVEt_INT: /* int reference */ *(int*)ARG0_PTR = (int)ARG1_I32; break; + case SAVEt_STRLEN: /* STRLEN/size_t ref */ + *(STRLEN*)ARG0_PTR = (STRLEN)arg1.any_iv; + break; case SAVEt_BOOL: /* bool reference */ *(bool*)ARG0_PTR = cBOOL(uv >> 8); #ifdef NO_TAINT_SUPPORT @@ -64,7 +64,7 @@ #define SAVEt_SAVESWITCHSTACK 39 #define SAVEt_SHARED_PVREF 40 #define SAVEt_SPTR 41 -/* UNUSED 42 */ +#define SAVEt_STRLEN 42 #define SAVEt_SV 43 #define SAVEt_SVREF 44 #define SAVEt_VPTR 45 @@ -186,7 +186,8 @@ scope has the given name. Name must be a literal string. =cut */ -#define SAVETMPS save_int((int*)&PL_tmps_floor), PL_tmps_floor = PL_tmps_ix +#define SAVETMPS Perl_save_strlen(aTHX_ (STRLEN *)&PL_tmps_floor), \ + PL_tmps_floor = PL_tmps_ix #define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps() #ifdef DEBUGGING @@ -12891,6 +12891,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param) TOPINT(nss,ix) = i; break; case SAVEt_IV: /* IV reference */ + case SAVEt_STRLEN: /* STRLEN/size_t ref */ ptr = POPPTR(ss,ix); TOPPTR(nss,ix) = any_dup(ptr, proto_perl); iv = POPIV(ss,ix); |