Benchmark notes (from Barrie Slaymaker <barries@slaysys.com>)

[p5sagit/p5-mst-13.2.git] / scope.c

diff --git a/scope.c b/scope.c
index 58272e1..1597acc 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -17,24 +17,32 @@
 #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, ...)
 {
-    dTHR;
-    dJMPENV;
+    void *ret;
     va_list args;
+    va_start(args, body);
+    ret = vdefault_protect(pcur_env, excpt, body, &args);
+    va_end(args);
+    return ret;
+}
+
+void *
+Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
+                     protect_body_t body, va_list *args)
+{
+    dTHR;
     int ex;
     void *ret;
 
-    DEBUG_l(deb("Setting up local jumplevel %p, was %p\n",
-               &cur_env, PL_top_env));
+    DEBUG_l(Perl_deb(aTHX_ "Setting up local jumplevel %p, was %p\n",
+               pcur_env, PL_top_env));
     JMPENV_PUSH(ex);
     if (ex)
        ret = NULL;
-    else {
-       va_start(args, body);
-       ret = CALL_FPTR(body)(args);
-       va_end(args);
-    }
+    else
+       ret = CALL_FPTR(body)(aTHX_ *args);
     *excpt = ex;
     JMPENV_POP;
     return ret;
@@ -189,7 +197,7 @@ Perl_free_tmps(pTHX)
 }
 
 STATIC SV *
-save_scalar_at(pTHX_ SV **sptr)
+S_save_scalar_at(pTHX_ SV **sptr)
 {
     dTHR;
     register SV *sv;
@@ -430,12 +438,12 @@ Perl_save_threadsv(pTHX_ PADOFFSET i)
 #ifdef USE_THREADS
     dTHR;
     SV **svp = &THREADSV(i);   /* XXX Change to save by offset */
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n",
+    DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %u: %p %p:%s\n",
                          i, svp, *svp, SvPEEK(*svp)));
     save_svref(svp);
     return svp;
 #else
-    croak("panic: save_threadsv called in non-threaded perl");
+    Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl");
     return 0;
 #endif /* USE_THREADS */
 }
@@ -534,11 +542,7 @@ Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
 }
 
 void
-#ifdef PERL_OBJECT
-Perl_save_destructor(pTHX_ DESTRUCTORFUNC f, void* p)
-#else
-Perl_save_destructor(pTHX_ void (*f) (void *), void *p)
-#endif
+Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
 {
     dTHR;
     SSCHECK(3);
@@ -548,6 +552,16 @@ Perl_save_destructor(pTHX_ void (*f) (void *), void *p)
 }
 
 void
+Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
+{
+    dTHR;
+    SSCHECK(3);
+    SSPUSHDXPTR(f);
+    SSPUSHPTR(p);
+    SSPUSHINT(SAVEt_DESTRUCTOR_X);
+}
+
+void
 Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
 {
     dTHR;
@@ -611,7 +625,7 @@ Perl_leave_scope(pTHX_ I32 base)
     I32 i;
 
     if (base < -1)
-       croak("panic: corrupt saved stack index");
+       Perl_croak(aTHX_ "panic: corrupt saved stack index");
     while (PL_savestack_ix > base) {
        switch (SSPOPINT) {
        case SAVEt_ITEM:                        /* normal string */
@@ -643,7 +657,7 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
        restore_sv:
            sv = *(SV**)ptr;
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "restore svref: %p %p:%s -> %p:%s\n",
                                  ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
            if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
@@ -795,7 +809,7 @@ Perl_leave_scope(pTHX_ I32 base)
                    hv_clear((HV*)sv);
                    break;
                case SVt_PVCV:
-                   croak("panic: leave_scope pad code");
+                   Perl_croak(aTHX_ "panic: leave_scope pad code");
                case SVt_RV:
                case SVt_IV:
                case SVt_NV:
@@ -828,7 +842,11 @@ Perl_leave_scope(pTHX_ I32 base)
            break;
        case SAVEt_DESTRUCTOR:
            ptr = SSPOPPTR;
-           CALLDESTRUCTOR(ptr);
+           (*SSPOPDPTR)(ptr);
+           break;
+       case SAVEt_DESTRUCTOR_X:
+           ptr = SSPOPPTR;
+           (*SSPOPDXPTR)(aTHXo_ ptr);
            break;
        case SAVEt_REGCONTEXT:
        case SAVEt_ALLOC:
@@ -887,7 +905,7 @@ Perl_leave_scope(pTHX_ I32 base)
            *(I32*)&PL_hints = (I32)SSPOPINT;
            break;
        default:
-           croak("panic: leave_scope inconsistency");
+           Perl_croak(aTHX_ "panic: leave_scope inconsistency");
        }
     }
 }