From: Gurusamy Sarathy Date: Thu, 14 Oct 1999 02:21:31 +0000 (+0000) Subject: avoid inefficiency in change#3386 (every longjmp() was followed X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=db36c5a16ec06ab929abf72b6174b106e97b8088;p=p5sagit%2Fp5-mst-13.2.git avoid inefficiency in change#3386 (every longjmp() was followed by an avoidable call to setjmp()) p4raw-link: @3386 on //depot/perl: 312caa8e97f1c7ee342a9895c2f0e749625b4929 p4raw-id: //depot/perl@4372 --- diff --git a/embed.h b/embed.h index 18953ae..bf2a0e8 100644 --- a/embed.h +++ b/embed.h @@ -2102,7 +2102,7 @@ #define do_pmop_dump(a,b,c) Perl_do_pmop_dump(aTHX_ a,b,c) #define do_sv_dump(a,b,c,d,e,f,g) Perl_do_sv_dump(aTHX_ a,b,c,d,e,f,g) #define magic_dump(a) Perl_magic_dump(aTHX_ a) -#define vdefault_protect(a,b,c) Perl_vdefault_protect(aTHX_ a,b,c) +#define vdefault_protect(a,b,c,d) Perl_vdefault_protect(aTHX_ a,b,c,d) #define reginitcolors() Perl_reginitcolors(aTHX) #define sv_2pv_nolen(a) Perl_sv_2pv_nolen(aTHX_ a) #define sv_pv(a) Perl_sv_pv(aTHX_ a) diff --git a/embed.pl b/embed.pl index e44ba23..7c05ab7 100755 --- a/embed.pl +++ b/embed.pl @@ -1756,8 +1756,10 @@ p |void |do_pmop_dump |I32 level|PerlIO *file|PMOP *pm p |void |do_sv_dump |I32 level|PerlIO *file|SV *sv|I32 nest \ |I32 maxnest|bool dumpops|STRLEN pvlim p |void |magic_dump |MAGIC *mg -p |void* |default_protect|int *excpt|protect_body_t body|... -p |void* |vdefault_protect|int *excpt|protect_body_t body|va_list *args +p |void* |default_protect|volatile JMPENV *je|int *excpt \ + |protect_body_t body|... +p |void* |vdefault_protect|volatile JMPENV *je|int *excpt \ + |protect_body_t body|va_list *args p |void |reginitcolors p |char* |sv_2pv_nolen |SV* sv p |char* |sv_pv |SV *sv diff --git a/perl.c b/perl.c index 74884b2..0bb828f 100644 --- a/perl.c +++ b/perl.c @@ -590,6 +590,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) dTHR; I32 oldscope; int ret; + dJMPENV; #ifdef USE_THREADS dTHX; #endif @@ -638,7 +639,8 @@ setuid perl scripts securely.\n"); oldscope = PL_scopestack_ix; PL_dowarn = G_WARN_OFF; - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_parse_body), env, xsinit); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_parse_body), + env, xsinit); switch (ret) { case 0: return 0; @@ -1005,6 +1007,7 @@ perl_run(pTHXx) dTHR; I32 oldscope; int ret; + dJMPENV; #ifdef USE_THREADS dTHX; #endif @@ -1012,7 +1015,7 @@ perl_run(pTHXx) oldscope = PL_scopestack_ix; redo_body: - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_run_body), oldscope); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_run_body), oldscope); switch (ret) { case 1: cxstack_ix = -1; /* start context stack again */ @@ -1206,6 +1209,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) bool oldcatch = CATCH_GET; int ret; OP* oldop = PL_op; + dJMPENV; if (flags & G_DISCARD) { ENTER; @@ -1273,7 +1277,8 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) PL_markstack_ptr++; redo_body: - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, FALSE); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body), + (OP*)&myop, FALSE); switch (ret) { case 0: retval = PL_stack_sp - (PL_stack_base + oldmark); @@ -1371,6 +1376,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) I32 oldscope; int ret; OP* oldop = PL_op; + dJMPENV; if (flags & G_DISCARD) { ENTER; @@ -1395,7 +1401,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) myop.op_flags |= OPf_SPECIAL; redo_body: - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, TRUE); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body), + (OP*)&myop, TRUE); switch (ret) { case 0: retval = PL_stack_sp - (PL_stack_base + oldmark); @@ -2990,11 +2997,12 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) CV *cv; STRLEN len; int ret; + dJMPENV; while (AvFILL(paramList) >= 0) { cv = (CV*)av_shift(paramList); SAVEFREESV(cv); - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_list_body), cv); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_list_body), cv); switch (ret) { case 0: (void)SvPV(atsv, len); diff --git a/perlapi.c b/perlapi.c index ac38dff..99a549b 100644 --- a/perlapi.c +++ b/perlapi.c @@ -4754,12 +4754,12 @@ Perl_magic_dump(pTHXo_ MAGIC *mg) #undef Perl_default_protect void* -Perl_default_protect(pTHXo_ int *excpt, protect_body_t body, ...) +Perl_default_protect(pTHXo_ volatile JMPENV *je, int *excpt, protect_body_t body, ...) { void* retval; va_list args; va_start(args, body); - retval = ((CPerlObj*)pPerl)->Perl_vdefault_protect(excpt, body, &args); + retval = ((CPerlObj*)pPerl)->Perl_vdefault_protect(je, excpt, body, &args); va_end(args); return retval; @@ -4767,9 +4767,9 @@ Perl_default_protect(pTHXo_ int *excpt, protect_body_t body, ...) #undef Perl_vdefault_protect void* -Perl_vdefault_protect(pTHXo_ int *excpt, protect_body_t body, va_list *args) +Perl_vdefault_protect(pTHXo_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args) { - return ((CPerlObj*)pPerl)->Perl_vdefault_protect(excpt, body, args); + return ((CPerlObj*)pPerl)->Perl_vdefault_protect(je, excpt, body, args); } #undef Perl_reginitcolors diff --git a/pod/perldelta.pod b/pod/perldelta.pod index ed395be..9af933b 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -1012,7 +1012,7 @@ change#4052 =item Data::Dumper A C setting can be specified to avoid venturing -too deeply into depp data structures. See L. +too deeply into deep data structures. See L. Dumping C objects works correctly. diff --git a/pp_ctl.c b/pp_ctl.c index 3bf4f1d..5f3ca18 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2436,13 +2436,14 @@ S_docatch(pTHX_ OP *o) dTHR; int ret; OP *oldop = PL_op; + dJMPENV; #ifdef DEBUGGING assert(CATCH_GET == TRUE); #endif PL_op = o; redo_body: - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_docatch_body)); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body)); switch (ret) { case 0: break; diff --git a/proto.h b/proto.h index 6551c31..787ec13 100644 --- a/proto.h +++ b/proto.h @@ -724,8 +724,8 @@ VIRTUAL void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o); VIRTUAL void Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm); VIRTUAL void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim); VIRTUAL void Perl_magic_dump(pTHX_ MAGIC *mg); -VIRTUAL void* Perl_default_protect(pTHX_ int *excpt, protect_body_t body, ...); -VIRTUAL void* Perl_vdefault_protect(pTHX_ int *excpt, protect_body_t body, va_list *args); +VIRTUAL void* Perl_default_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, ...); +VIRTUAL void* Perl_vdefault_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args); VIRTUAL void Perl_reginitcolors(pTHX); VIRTUAL char* Perl_sv_2pv_nolen(pTHX_ SV* sv); VIRTUAL char* Perl_sv_pv(pTHX_ SV *sv); diff --git a/scope.c b/scope.c index 9ee0429..1597acc 100644 --- a/scope.c +++ b/scope.c @@ -17,26 +17,27 @@ #include "perl.h" void * -Perl_default_protect(pTHX_ int *excpt, protect_body_t body, ...) +Perl_default_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, + protect_body_t body, ...) { void *ret; va_list args; va_start(args, body); - ret = vdefault_protect(excpt, body, &args); + ret = vdefault_protect(pcur_env, excpt, body, &args); va_end(args); return ret; } void * -Perl_vdefault_protect(pTHX_ int *excpt, protect_body_t body, va_list *args) +Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, + protect_body_t body, va_list *args) { dTHR; - dJMPENV; int ex; void *ret; DEBUG_l(Perl_deb(aTHX_ "Setting up local jumplevel %p, was %p\n", - &cur_env, PL_top_env)); + pcur_env, PL_top_env)); JMPENV_PUSH(ex); if (ex) ret = NULL; diff --git a/scope.h b/scope.h index f481306..9a196e6 100644 --- a/scope.h +++ b/scope.h @@ -148,6 +148,7 @@ struct jmpenv { int je_ret; /* last exception thrown */ bool je_mustcatch; /* need to call longjmp()? */ void (*je_throw)(int v); /* last for bincompat */ + bool je_noset; /* no need for setjmp() */ }; typedef struct jmpenv JMPENV; @@ -157,7 +158,8 @@ typedef struct jmpenv JMPENV; * body of protected processing. */ typedef void *(CPERLscope(*protect_body_t)) (pTHX_ va_list); -typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...); +typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env, + int *, protect_body_t, ...); /* * How to build the first jmpenv. @@ -175,6 +177,7 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...); PL_start_env.je_throw = NULL; \ PL_start_env.je_ret = -1; \ PL_start_env.je_mustcatch = TRUE; \ + PL_start_env.je_noset = 0; \ PL_top_env = &PL_start_env; \ } STMT_END @@ -216,43 +219,49 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...); * JMPENV_POP; // don't forget this! */ -#define dJMPENV JMPENV cur_env +#define dJMPENV JMPENV cur_env; \ + volatile JMPENV *pcur_env = ((cur_env.je_noset = 0),&cur_env) -#define JMPENV_PUSH_INIT_ENV(cur_env,THROWFUNC) \ +#define JMPENV_PUSH_INIT_ENV(ce,THROWFUNC) \ STMT_START { \ - cur_env.je_throw = (THROWFUNC); \ - cur_env.je_ret = -1; \ - cur_env.je_mustcatch = FALSE; \ - cur_env.je_prev = PL_top_env; \ - PL_top_env = &cur_env; \ + (ce).je_throw = (THROWFUNC); \ + (ce).je_ret = -1; \ + (ce).je_mustcatch = FALSE; \ + (ce).je_prev = PL_top_env; \ + PL_top_env = &(ce); \ OP_REG_TO_MEM; \ } STMT_END -#define JMPENV_PUSH_INIT(THROWFUNC) JMPENV_PUSH_INIT_ENV(cur_env,THROWFUNC) +#define JMPENV_PUSH_INIT(THROWFUNC) JMPENV_PUSH_INIT_ENV(*(JMPENV*)pcur_env,THROWFUNC) -#define JMPENV_POST_CATCH_ENV(cur_env) \ +#define JMPENV_POST_CATCH_ENV(ce) \ STMT_START { \ OP_MEM_TO_REG; \ - PL_top_env = &cur_env; \ + PL_top_env = &(ce); \ } STMT_END -#define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(cur_env) +#define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(*(JMPENV*)pcur_env) -#define JMPENV_PUSH_ENV(cur_env,v) \ - STMT_START { \ - JMPENV_PUSH_INIT_ENV(cur_env,NULL); \ - EXCEPT_SET_ENV(cur_env,PerlProc_setjmp(cur_env.je_buf, 1)); \ - JMPENV_POST_CATCH_ENV(cur_env); \ - (v) = EXCEPT_GET_ENV(cur_env); \ +#define JMPENV_PUSH_ENV(ce,v) \ + STMT_START { \ + if (!(ce).je_noset) { \ + JMPENV_PUSH_INIT_ENV(ce,NULL); \ + EXCEPT_SET_ENV(ce,PerlProc_setjmp((ce).je_buf, 1));\ + (ce).je_noset = 1; \ + } \ + else \ + EXCEPT_SET_ENV(ce,0); \ + JMPENV_POST_CATCH_ENV(ce); \ + (v) = EXCEPT_GET_ENV(ce); \ } STMT_END -#define JMPENV_PUSH(v) JMPENV_PUSH_ENV(cur_env,v) +#define JMPENV_PUSH(v) JMPENV_PUSH_ENV(*(JMPENV*)pcur_env,v) -#define JMPENV_POP_ENV(cur_env) \ - STMT_START { PL_top_env = cur_env.je_prev; } STMT_END +#define JMPENV_POP_ENV(ce) \ + STMT_START { PL_top_env = (ce).je_prev; } STMT_END -#define JMPENV_POP JMPENV_POP_ENV(cur_env) +#define JMPENV_POP JMPENV_POP_ENV(*(JMPENV*)pcur_env) #define JMPENV_JUMP(v) \ STMT_START { \ @@ -269,11 +278,10 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...); PerlProc_exit(1); \ } STMT_END -#define EXCEPT_GET_ENV(cur_env) (cur_env.je_ret) -#define EXCEPT_GET EXCEPT_GET_ENV(cur_env) -#define EXCEPT_SET_ENV(cur_env,v) (cur_env.je_ret = (v)) -#define EXCEPT_SET(v) EXCEPT_SET_ENV(cur_env,v) +#define EXCEPT_GET_ENV(ce) ((ce).je_ret) +#define EXCEPT_GET EXCEPT_GET_ENV(*(JMPENV*)pcur_env) +#define EXCEPT_SET_ENV(ce,v) ((ce).je_ret = (v)) +#define EXCEPT_SET(v) EXCEPT_SET_ENV(*(JMPENV*)pcur_env,v) -#define CATCH_GET (PL_top_env->je_mustcatch) -#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v)) - +#define CATCH_GET (PL_top_env->je_mustcatch) +#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v))