Fix up $@ (ERRSV now refers to GvSV(errgv) for non-threaded perl and

thr->errsv for threaded perl). Fix pp_tie and pp_dbmopen to use
GvCV(gv) instead of gv so AUTOLOAD stuff works. All tests now pass
again for non-threaded perl. Enhanced perl_get_sv to return
per-thread magicals where necessary for threaded perl.

p4raw-id: //depot/perl@228

diff --git a/embed.h b/embed.h
index 762ce18..0101ca8 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1264,8 +1264,7 @@
 #define e_tmpname              (curinterp->Ie_tmpname)
 #define endav                  (curinterp->Iendav)
 #define envgv                  (curinterp->Ienvgv)
-#define errhv                  (curinterp->Ierrhv)
-#define errsv                  (curinterp->Ierrsv)
+#define errgv                  (curinterp->Ierrgv)
 #define eval_root              (curinterp->Ieval_root)
 #define eval_start             (curinterp->Ieval_start)
 #define fdpid                  (curinterp->Ifdpid)
@@ -1417,8 +1416,7 @@
 #define Ie_tmpname             e_tmpname
 #define Iendav                 endav
 #define Ienvgv                 envgv
-#define Ierrhv                 errhv
-#define Ierrsv                 errsv
+#define Ierrgv                 errgv
 #define Ieval_root             eval_root
 #define Ieval_start            eval_start
 #define Ifdpid                 fdpid
@@ -1579,8 +1577,7 @@
 #define e_fp                   Perl_e_fp
 #define e_tmpname              Perl_e_tmpname
 #define endav                  Perl_endav
-#define errhv                  Perl_errhv
-#define errsv                  Perl_errsv
+#define errgv                  Perl_errgv
 #define eval_root              Perl_eval_root
 #define eval_start             Perl_eval_start
 #define fdpid                  Perl_fdpid

diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index 9c0325e..f5bb222 100644 (file)
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -147,6 +147,8 @@ void *arg;
     SvREFCNT_dec(thr->cvcache);
     SvREFCNT_dec(thr->magicals);
     SvREFCNT_dec(thr->specific);
+    SvREFCNT_dec(thr->errsv);
+    SvREFCNT_dec(thr->errhv);
     Safefree(markstack);
     Safefree(scopestack);
     Safefree(savestack);

diff --git a/interp.sym b/interp.sym
index ae064a8..1583ea2 100644 (file)
--- a/interp.sym
+++ b/interp.sym
@@ -47,8 +47,7 @@ e_fp
 e_tmpname
 endav
 envgv
-errhv
-errsv
+errgv
 eval_root
 eval_start
 fdpid

diff --git a/mg.c b/mg.c
index 47e05a1..15005e0 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -580,7 +580,7 @@ MAGIC *mg;
        break;
 #ifdef USE_THREADS
     case '@':
-       sv_setsv(sv, errsv);
+       sv_setsv(sv, thr->errsv);
        break;
 #endif /* USE_THREADS */
     }
@@ -1719,7 +1719,7 @@ MAGIC* mg;
        break;
 #ifdef USE_THREADS
     case '@':
-       sv_setsv(errsv, sv);
+       sv_setsv(thr->errsv, sv);
        break;
 #endif /* USE_THREADS */
     }

diff --git a/op.c b/op.c
index 3bd44fc..06f027c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3487,8 +3487,8 @@ OP *block;
                    croak(not_safe);
                else {
                    /* force display of errors found but not reported */
-                   sv_catpv(errsv, not_safe);
-                   croak("%s", SvPV(errsv, na));
+                   sv_catpv(ERRSV, not_safe);
+                   croak("%s", SvPVx(ERRSV, na));
                }
            }
        }

diff --git a/perl.c b/perl.c
index fff0450..dce37a4 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -470,8 +470,7 @@ register PerlInterpreter *sv_interp;
     envgv = Nullgv;
     siggv = Nullgv;
     incgv = Nullgv;
-    errhv = Nullhv;
-    errsv = Nullsv;
+    errgv = Nullgv;
     argvgv = Nullgv;
     argvoutgv = Nullgv;
     stdingv = Nullgv;
@@ -1087,6 +1086,13 @@ perl_get_sv(name, create)
 char* name;
 I32 create;
 {
+#ifdef USE_THREADS
+    PADOFFSET tmp;
+    if (name[1] == '\0' && !isALPHA(name[0])
+       && (tmp = find_thread_magical(name)) != NOT_IN_PAD) {
+       return *av_fetch(thr->magicals, tmp, FALSE);
+    }
+#endif /* USE_THREADS */
     GV* gv = gv_fetchpv(name, create, SVt_PV);
     if (gv)
        return GvSV(gv);
@@ -1247,7 +1253,7 @@ I32 flags;                /* See G_* flags in cop.h */
            if (flags & G_KEEPERR)
                in_eval |= 4;
            else
-               sv_setpv(errsv,"");
+               sv_setpv(ERRSV,"");
        }
        markstack_ptr++;
 
@@ -1292,7 +1298,7 @@ I32 flags;                /* See G_* flags in cop.h */
        runops();
     retval = stack_sp - (stack_base + oldmark);
     if ((flags & G_EVAL) && !(flags & G_KEEPERR))
-       sv_setpv(errsv,"");
+       sv_setpv(ERRSV,"");
 
   cleanup:
     if (flags & G_EVAL) {
@@ -1401,7 +1407,7 @@ I32 flags;                /* See G_* flags in cop.h */
        runops();
     retval = stack_sp - (stack_base + oldmark);
     if (!(flags & G_KEEPERR))
-       sv_setpv(errsv,"");
+       sv_setpv(ERRSV,"");
 
   cleanup:
     JMPENV_POP;
@@ -1432,8 +1438,8 @@ I32 croak_on_error;
     sv = POPs;
     PUTBACK;
 
-    if (croak_on_error && SvTRUE(errsv))
-       croak(SvPV(errsv, na));
+    if (croak_on_error && SvTRUE(ERRSV))
+       croak(SvPVx(ERRSV, na));
 
     return sv;
 }
@@ -1804,11 +1810,11 @@ init_main_stash()
     incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(incgv);
     defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
-    errsv = newSVpv("", 0);
-    errhv = newHV();
+    errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+    GvMULTI_on(errgv);
     (void)form("%240s","");    /* Preallocate temp - for immediate signals. */
-    sv_grow(errsv, 240);       /* Preallocate - for immediate signals. */
-    sv_setpvn(errsv, "", 0);
+    sv_grow(ERRSV, 240);       /* Preallocate - for immediate signals. */
+    sv_setpvn(ERRSV, "", 0);
     curstash = defstash;
     compiling.cop_stash = defstash;
     debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
@@ -2840,6 +2846,8 @@ init_main_thread()
     thr->cvcache = newHV();
     thr->magicals = newAV();
     thr->specific = newAV();
+    thr->errsv = newSVpv("", 0);
+    thr->errhv = newHV();
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
     /* Handcraft thrsv similarly to mess_sv */
@@ -2904,20 +2912,21 @@ AV* list;
        JMPENV_PUSH(ret);
        switch (ret) {
        case 0: {
+               SV* atsv = ERRSV;
                PUSHMARK(stack_sp);
                perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
-               (void)SvPV(errsv, len);
+               (void)SvPV(atsv, len);
                if (len) {
                    JMPENV_POP;
                    curcop = &compiling;
                    curcop->cop_line = oldline;
                    if (list == beginav)
-                       sv_catpv(errsv, "BEGIN failed--compilation aborted");
+                       sv_catpv(atsv, "BEGIN failed--compilation aborted");
                    else
-                       sv_catpv(errsv, "END failed--cleanup aborted");
+                       sv_catpv(atsv, "END failed--cleanup aborted");
                    while (scopestack_ix > oldscope)
                        LEAVE;
-                   croak("%s", SvPVX(errsv));
+                   croak("%s", SvPVX(atsv));
                }
            }
            break;

diff --git a/perl.h b/perl.h
index 09cb1d6..c344105 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -461,6 +461,14 @@ typedef pthread_key_t perl_key;
 #   define SETERRNO(errcode,vmserrcode) errno = (errcode)
 #endif
 
+#ifdef USE_THREADS
+#  define ERRSV (thr->errsv)
+#  define ERRHV (thr->errhv)
+#else
+#  define ERRSV GvSV(errgv)
+#  define ERRHV GvHV(errgv)
+#endif /* USE_THREADS */
+
 #ifndef errno
        extern int errno;     /* ANSI allows errno to be an lvalue expr */
 #endif
@@ -1859,8 +1867,7 @@ IEXT I32  Imaxscream IINIT(-1);
 IEXT SV *      Ilastscream;
 
 /* shortcuts to misc objects */
-IEXT HV *      Ierrhv;
-IEXT SV *      Ierrsv;
+IEXT GV *      Ierrgv;
 
 /* shortcuts to debugging objects */
 IEXT GV *      IDBgv;

diff --git a/pp_ctl.c b/pp_ctl.c
index 915ee6c..7eb013c 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1040,21 +1040,21 @@ char *message;
            SV **svp;
            STRLEN klen = strlen(message);
            
-           svp = hv_fetch(errhv, message, klen, TRUE);
+           svp = hv_fetch(ERRHV, message, klen, TRUE);
            if (svp) {
                if (!SvIOK(*svp)) {
                    static char prefix[] = "\t(in cleanup) ";
                    sv_upgrade(*svp, SVt_IV);
                    (void)SvIOK_only(*svp);
-                   SvGROW(errsv, SvCUR(errsv)+sizeof(prefix)+klen);
-                   sv_catpvn(errsv, prefix, sizeof(prefix)-1);
-                   sv_catpvn(errsv, message, klen);
+                   SvGROW(ERRSV, SvCUR(ERRSV)+sizeof(prefix)+klen);
+                   sv_catpvn(ERRSV, prefix, sizeof(prefix)-1);
+                   sv_catpvn(ERRSV, message, klen);
                }
                sv_inc(*svp);
            }
        }
        else
-           sv_setpv(errsv, message);
+           sv_setpv(ERRSV, message);
        
        cxix = dopoptoeval(cxstack_ix);
        if (cxix >= 0) {
@@ -1077,7 +1077,7 @@ char *message;
            LEAVE;
 
            if (optype == OP_REQUIRE) {
-               char* msg = SvPV(errsv, na);
+               char* msg = SvPVx(ERRSV, na);
                DIE("%s", *msg ? msg : "Compilation failed in require");
            }
            return pop_return();
@@ -2197,7 +2197,7 @@ int gimme;
     if (saveop->op_flags & OPf_SPECIAL)
        in_eval |= 4;
     else
-       sv_setpv(errsv,"");
+       sv_setpv(ERRSV,"");
     if (yyparse() || error_count || !eval_root) {
        SV **newsp;
        I32 gimme;
@@ -2216,7 +2216,7 @@ int gimme;
        lex_end();
        LEAVE;
        if (optype == OP_REQUIRE) {
-           char* msg = SvPV(errsv, na);
+           char* msg = SvPVx(ERRSV, na);
            DIE("%s", *msg ? msg : "Compilation failed in require");
        }
        SvREFCNT_dec(rs);
@@ -2570,7 +2570,7 @@ PP(pp_leaveeval)
     LEAVE;
 
     if (!(save_flags & OPf_SPECIAL))
-       sv_setpv(errsv,"");
+       sv_setpv(ERRSV,"");
 
     RETURNOP(retop);
 }
@@ -2590,7 +2590,7 @@ PP(pp_entertry)
     eval_root = op;            /* Only needed so that goto works right. */
 
     in_eval = 1;
-    sv_setpv(errsv,"");
+    sv_setpv(ERRSV,"");
     PUTBACK;
     return DOCATCH(op->op_next);
 }
@@ -2638,7 +2638,7 @@ PP(pp_leavetry)
     curpm = newpm;     /* Don't pop $1 et al till now */
 
     LEAVE;
-    sv_setpv(errsv,"");
+    sv_setpv(ERRSV,"");
     RETURN;
 }
 

diff --git a/pp_sys.c b/pp_sys.c
index 5eaa1e1..77dd618 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -278,10 +278,10 @@ PP(pp_warn)
        tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-       (void)SvUPGRADE(errsv, SVt_PV);
-       if (SvPOK(errsv) && SvCUR(errsv))
-           sv_catpv(errsv, "\t...caught");
-       tmps = SvPV(errsv, na);
+       (void)SvUPGRADE(ERRSV, SVt_PV);
+       if (SvPOK(ERRSV) && SvCUR(ERRSV))
+           sv_catpv(ERRSV, "\t...caught");
+       tmps = SvPV(ERRSV, na);
     }
     if (!tmps || !*tmps)
        tmps = "Warning: something's wrong";
@@ -303,10 +303,10 @@ PP(pp_die)
        tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-       (void)SvUPGRADE(errsv, SVt_PV);
-       if (SvPOK(errsv) && SvCUR(errsv))
-           sv_catpv(errsv, "\t...propagated");
-       tmps = SvPV(errsv, na);
+       (void)SvUPGRADE(ERRSV, SVt_PV);
+       if (SvPOK(ERRSV) && SvCUR(ERRSV))
+           sv_catpv(ERRSV, "\t...propagated");
+       tmps = SvPV(ERRSV, na);
     }
     if (!tmps || !*tmps)
        tmps = "Died";
@@ -550,7 +550,7 @@ PP(pp_tie)
     CATCH_SET(oldcatch);
 #else
     ENTER;
-    perl_call_sv((SV*)gv, G_SCALAR);
+    perl_call_sv((SV*)GvCV(gv), G_SCALAR);
     SPAGAIN;
 #endif 
     sv = TOPs;
@@ -680,7 +680,7 @@ PP(pp_dbmopen)
         runops();
 #else
     PUTBACK;
-    perl_call_sv((SV*)gv, G_SCALAR);
+    perl_call_sv((SV*)GvCV(gv), G_SCALAR);
 #endif 
     SPAGAIN;
 
@@ -707,7 +707,7 @@ PP(pp_dbmopen)
        if (op = pp_entersub(ARGS))
            runops();
 #else
-       perl_call_sv((SV*)gv, G_SCALAR);
+       perl_call_sv((SV*)GvCV(gv), G_SCALAR);
 #endif 
        SPAGAIN;
     }

diff --git a/thread.h b/thread.h
index 305155c..79064e4 100644 (file)
--- a/thread.h
+++ b/thread.h
@@ -219,6 +219,8 @@ struct thread {
     U32                flags;
     AV *       magicals;               /* Per-thread magicals */
     AV *       specific;               /* Thread-specific user data */
+    SV *       errsv;                  /* Backing SV for $@ */
+    HV *       errhv;                  /* HV for what was %@ in pp_ctl.c */
     perl_mutex mutex;                  /* For the fields others can change */
     U32                tid;
     struct thread *next, *prev;                /* Circular linked list of threads */

diff --git a/toke.c b/toke.c
index 6c53b99..5ba993c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5431,7 +5431,7 @@ char *s;
     if (in_eval & 2)
        warn("%_", msg);
     else if (in_eval)
-       sv_catsv(errsv, msg);
+       sv_catsv(ERRSV, msg);
     else
        PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
     if (++error_count >= 10)

diff --git a/util.c b/util.c
index 72c76a0..b6b27a6 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2530,6 +2530,8 @@ struct thread *t;
     thr->cvcache = newHV();
     thr->magicals = newAV();
     thr->specific = newAV();
+    thr->errsv = newSVpv("", 0);
+    thr->errhv = newHV();
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);