More fixups for thrperl integration.

p4raw-id: //depot/perl@27

diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index 2d5e744..e097046 100644 (file)
--- a/ext/DB_File/DB_File.pm
+++ b/ext/DB_File/DB_File.pm
@@ -1,8 +1,8 @@
 # DB_File.pm -- Perl 5 interface to Berkeley DB 
 #
 # written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
-# last modified 30th Apr 1997
-# version 1.14
+# last modified 31st May 1997
+# version 1.15
 #
 #     Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
@@ -146,7 +146,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO) ;
 use Carp;
 
 
-$VERSION = "1.14" ;
+$VERSION = "1.15" ;
 
 #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
 $DB_BTREE = new DB_File::BTREEINFO ;
@@ -1666,6 +1666,10 @@ Minor changes to DB_FIle.xs and DB_File.pm
 Made it illegal to tie an associative array to a RECNO database and an
 ordinary array to a HASH or BTREE database.
 
+=item 1.15
+
+Minor changes to DB_File.xs to support multithreaded perl.
+
 =back
 
 =head1 BUGS

diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index 8d01d91..cc70b5d 100644 (file)
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -3,8 +3,8 @@
  DB_File.xs -- Perl 5 interface to Berkeley DB 
 
  written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
- last modified 30th Apr 1997
- version 1.14
+ last modified 31st May 1997
+ version 1.15
 
  All comments/suggestions/problems are welcome
 
@@ -42,6 +42,7 @@
        1.13 -  Tidied up a few casts.
        1.14 -  Made it illegal to tie an associative array to a RECNO
                database and an ordinary array to a HASH or BTREE database.
+       1.15 -  Minor additions to DB_File.xs to support multithreaded perl.
 
 */
 
@@ -134,6 +135,7 @@ btree_compare(key1, key2)
 const DBT * key1 ;
 const DBT * key2 ;
 {
+    dTHR ;
     dSP ;
     void * data1, * data2 ;
     int retval ;
@@ -181,6 +183,7 @@ btree_prefix(key1, key2)
 const DBT * key1 ;
 const DBT * key2 ;
 {
+    dTHR ;
     dSP ;
     void * data1, * data2 ;
     int retval ;
@@ -228,6 +231,7 @@ hash_cb(data, size)
 const void * data ;
 size_t size ;
 {
+    dTHR ;
     dSP ;
     int retval ;
     int count ;

diff --git a/ext/Opcode/Makefile.PL b/ext/Opcode/Makefile.PL
index 7fdcdf6..48a6ed8 100644 (file)
--- a/ext/Opcode/Makefile.PL
+++ b/ext/Opcode/Makefile.PL
@@ -3,5 +3,5 @@ WriteMakefile(
     NAME => 'Opcode',
     MAN3PODS   => ' ',
     VERSION_FROM => 'Opcode.pm',
-    XS_VERSION => '1.02'
+    XS_VERSION => '1.03'
 );

diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index a35ad1b..2fe23f0 100644 (file)
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -5,7 +5,7 @@ require 5.002;
 use vars qw($VERSION $XS_VERSION @ISA @EXPORT_OK);
 
 $VERSION = "1.04";
-$XS_VERSION = "1.02";
+$XS_VERSION = "1.03";
 
 use strict;
 use Carp;

diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs
index 9d4b726..8307ade 100644 (file)
--- a/ext/Opcode/Opcode.xs
+++ b/ext/Opcode/Opcode.xs
@@ -33,9 +33,10 @@ op_names_init()
 
     op_named_bits = newHV();
     for(i=0; i < maxo; ++i) {
-       hv_store(op_named_bits, op_name[i],strlen(op_name[i]),
-               Sv=newSViv(i), 0);
-       SvREADONLY_on(Sv);
+       SV *sv;
+       sv = newSViv(i);
+       SvREADONLY_on(sv);
+       hv_store(op_named_bits, op_name[i], strlen(op_name[i]), sv, 0);
     }
 
     put_op_bitspec(":none",0, sv_2mortal(new_opset(Nullsv)));

diff --git a/gv.c b/gv.c
index c9f919c..50e9040 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -58,6 +58,7 @@ GV *
 gv_fetchfile(name)
 char *name;
 {
+    dTHR;
     char smallbuf[256];
     char *tmpbuf;
     STRLEN tmplen;
@@ -182,6 +183,7 @@ I32 level;
            basestash = gv_stashpvn(packname, packlen, TRUE);
            gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
            if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
+               dTHR;           /* just for SvREFCNT_dec */
                gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
                if (!gvp || !(gv = *gvp))
                    croak("Cannot create %s::ISA", HvNAME(stash));
@@ -231,6 +233,7 @@ I32 level;
                    (cv = GvCV(gv)) &&
                    (CvROOT(cv) || CvXSUB(cv)))
                {
+                   dTHR;       /* just for SvREFCNT_inc */
                    if (cv = GvCV(topgv))
                        SvREFCNT_dec(cv);
                    GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));

diff --git a/hv.c b/hv.c
index 77c3798..454ee23 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -557,6 +557,7 @@ U32 hash;
 
     if (SvRMAGICAL(hv)) {
        if (mg_find((SV*)hv,'P')) {
+           dTHR;               /* just for SvTRUE */
            sv = sv_newmortal();
            keysv = sv_2mortal(newSVsv(keysv));
            mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); 
@@ -924,6 +925,7 @@ HV *hv;
        }
        magic_nextpack((SV*) hv,mg,key);
         if (SvOK(key)) {
+           dTHR;               /* just for SvREFCNT_inc */
            /* force key to stay around until next time */
            HeSVKEY_set(entry, SvREFCNT_inc(key));
            return entry;               /* beware, hent_val is not set */

diff --git a/mg.c b/mg.c
index cf2d71f..960e0c1 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -665,6 +665,7 @@ MAGIC* mg;
        if(psig_ptr[i])
            sv_setsv(sv,psig_ptr[i]);
        else {
+           dTHR;               /* just for SvREFCNT_inc */
            Sighandler_t sigstate = rsignal_state(i);
 
            /* cache state so we don't fetch it again */
@@ -1141,6 +1142,7 @@ MAGIC* mg;
                targ = AvARRAY(av)[LvTARGOFF(sv)];
        }
        if (targ && targ != &sv_undef) {
+           dTHR;               /* just for SvREFCNT_dec */
            /* somebody else defined it for us */
            SvREFCNT_dec(LvTARG(sv));
            LvTARG(sv) = SvREFCNT_inc(targ);
@@ -1183,6 +1185,7 @@ void
 vivify_defelem(sv)
 SV* sv;
 {
+    dTHR;                      /* just for SvREFCNT_inc and SvREFCNT_dec*/
     MAGIC* mg;
     SV* value;
 

diff --git a/op.c b/op.c
index 45b7400..3021154 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2991,11 +2991,15 @@ CV *cv;
 {
     dTHR;
 #ifdef USE_THREADS
-    MUTEX_DESTROY(CvMUTEXP(cv));
-    Safefree(CvMUTEXP(cv));
+    if (CvMUTEXP(cv)) {
+       MUTEX_DESTROY(CvMUTEXP(cv));
+       Safefree(CvMUTEXP(cv));
+       CvMUTEXP(cv) = 0;
+    }
     if (CvCONDP(cv)) {
        COND_DESTROY(CvCONDP(cv));
        Safefree(CvCONDP(cv));
+       CvCONDP(cv) = 0;
     }
 #endif /* USE_THREADS */
 
@@ -3284,8 +3288,8 @@ CV* cv;
        if (type == OP_CONST)
            sv = cSVOPo->op_sv;
        else if (type == OP_PADSV) {
-           AV* pad = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
-           sv = pad ? AvARRAY(pad)[o->op_targ] : Nullsv;
+           AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
+           sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
            if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
                return Nullsv;
        }
@@ -4701,7 +4705,7 @@ OP *o;
                        o2 = newUNOP(OP_REFGEN, 0, kid);
                        o2->op_sibling = kid->op_sibling;
                        kid->op_sibling = 0;
-                       prev->op_sibling = o;
+                       prev->op_sibling = o2;
                    }
                    break;
                default: goto oops;
@@ -4824,7 +4828,7 @@ register OP* o;
                OP* pop = o->op_next->op_next;
                IV i;
                if (pop->op_type == OP_CONST &&
-                   (o = pop->op_next) &&
+                   (op = pop->op_next) &&
                    pop->op_next->op_type == OP_AELEM &&
                    !(pop->op_next->op_private &
                      (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF)) &&

diff --git a/perl.c b/perl.c
index 4f96f28..242535a 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -830,24 +830,23 @@ print \"  \\@INC:\\n    @INC\\n\";");
     main_cv = compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)compcv, SVt_PVCV);
     CvUNIQUE_on(compcv);
-#ifdef USE_THREADS
-    CvOWNER(compcv) = 0;
-    New(666, CvMUTEXP(compcv), 1, pthread_mutex_t);
-    MUTEX_INIT(CvMUTEXP(compcv));
-    New(666, CvCONDP(compcv), 1, pthread_cond_t);
-    COND_INIT(CvCONDP(compcv));
-#endif /* USE_THREADS */
 
     comppad = newAV();
     av_push(comppad, Nullsv);
     curpad = AvARRAY(comppad);
     comppad_name = newAV();
     comppad_name_fill = 0;
+    min_intro_pending = 0;
+    padix = 0;
 #ifdef USE_THREADS
     av_store(comppad_name, 0, newSVpv("@_", 2));
+    curpad[0] = (SV*)newAV();
+    CvOWNER(compcv) = 0;
+    New(666, CvMUTEXP(compcv), 1, pthread_mutex_t);
+    MUTEX_INIT(CvMUTEXP(compcv));
+    New(666, CvCONDP(compcv), 1, pthread_cond_t);
+    COND_INIT(CvCONDP(compcv));
 #endif /* USE_THREADS */
-    min_intro_pending = 0;
-    padix = 0;
 
     comppadlist = newAV();
     AvREAL_off(comppadlist);
@@ -1333,6 +1332,7 @@ perl_eval_pv(p, croak_on_error)
 char* p;
 I32 croak_on_error;
 {
+    dTHR;
     dSP;
     SV* sv = newSVpv(p, 0);
 
@@ -2323,6 +2323,7 @@ dARGS
 static void
 nuke_stacks()
 {
+    dTHR;
     Safefree(cxstack);
     Safefree(tmps_stack);
     DEBUG( {
@@ -2748,6 +2749,7 @@ my_failure_exit()
 static void
 my_exit_jump()
 {
+    dTHR;
     register CONTEXT *cx;
     I32 gimme;
     SV **newsp;

diff --git a/perly.c b/perly.c
index 6bc37ff..fd161fd 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -1763,8 +1763,9 @@ case 55:
 break;
 case 56:
 #line 291 "perly.y"
-{ char *name = SvPVx(((SVOP*)yyvsp[0].opval)->op_sv, na);
-                         if (strEQ(name, "BEGIN") || strEQ(name, "END"))
+{ char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, na);
+                         if (strEQ(name, "BEGIN") || strEQ(name, "END")
+                             || strEQ(name, "RESTART"))
                              CvUNIQUE_on(compcv);
                          yyval.opval = yyvsp[0].opval; }
 break;

diff --git a/perly.y b/perly.y
index be6fe98..be3d0c7 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -288,8 +288,9 @@ startformsub:       /* NULL */      /* start a format subroutine scope */
                        { $$ = start_subparse(TRUE, 0); }
        ;
 
-subname        :       WORD    { char *name = SvPVx(((SVOP*)$1)->op_sv, na);
-                         if (strEQ(name, "BEGIN") || strEQ(name, "END"))
+subname        :       WORD    { char *name = SvPV(((SVOP*)$1)->op_sv, na);
+                         if (strEQ(name, "BEGIN") || strEQ(name, "END")
+                             || strEQ(name, "RESTART"))
                              CvUNIQUE_on(compcv);
                          $$ = $1; }
        ;

diff --git a/pp.c b/pp.c
index af615c3..391133b 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -385,6 +385,7 @@ SV* sv;
     else if (SvPADTMP(sv))
        sv = newSVsv(sv);
     else {
+       dTHR;                   /* just for SvREFCNT_inc */
        SvTEMP_off(sv);
        (void)SvREFCNT_inc(sv);
     }
@@ -1448,6 +1449,7 @@ seed()
 #define   SEED_C3      269
 #define   SEED_C5      26107
 
+    dTHR;
     U32 u;
 #ifdef VMS
 #  include <starlet.h>

diff --git a/pp_ctl.c b/pp_ctl.c
index 82c59bf..2f3b2b7 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2111,6 +2111,7 @@ static OP *
 docatch(o)
 OP *o;
 {
+    dTHR;
     int ret;
     I32 oldrunlevel = runlevel;
     OP *oldop = op;

diff --git a/run.c b/run.c
index e416160..2f8d8fa 100644 (file)
--- a/run.c
+++ b/run.c
@@ -56,9 +56,6 @@ runops() {
            DEBUG_s(debstack());
            DEBUG_t(debop(op));
            DEBUG_P(debprof(op));
-#ifdef USE_THREADS
-           DEBUG_L(YIELD());   /* shake up scheduling a bit */
-#endif /* USE_THREADS */
        }
     } while ( op = (*op->op_ppaddr)(ARGS) );
 

diff --git a/scope.c b/scope.c
index cf58e24..50c843d 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -177,6 +177,7 @@ save_gp(gv, empty)
 GV *gv;
 I32 empty;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHPTR(SvREFCNT_inc(gv));
     SSPUSHPTR(GvGP(gv));
@@ -276,6 +277,7 @@ void
 save_I16(intp)
 I16 *intp;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHINT(*intp);
     SSPUSHPTR(intp);

diff --git a/sv.c b/sv.c
index 1331f89..a23ac14 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1270,6 +1270,7 @@ register SV *sv;
        if (SvPOKp(sv) && SvLEN(sv))
            return asIV(sv);
        if (!SvROK(sv)) {
+           dTHR;               /* just for localizing */
            if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
                warn(warn_uninit);
            return 0;
@@ -1346,6 +1347,7 @@ register SV *sv;
        if (SvPOKp(sv) && SvLEN(sv))
            return asUV(sv);
        if (!SvROK(sv)) {
+           dTHR;               /* just for localizing */
            if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
                warn(warn_uninit);
            return 0;
@@ -1391,6 +1393,7 @@ register SV *sv;
        SvUVX(sv) = asUV(sv);
     }
     else  {
+       dTHR;           /* just for localizing */
        if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
            warn(warn_uninit);
        return 0;
@@ -1419,6 +1422,7 @@ register SV *sv;
        if (SvIOKp(sv))
            return (double)SvIVX(sv);
         if (!SvROK(sv)) {
+           dTHR;               /* just for localizing */
            if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
                warn(warn_uninit);
             return 0;
@@ -1626,6 +1630,7 @@ STRLEN *lp;
            goto tokensave;
        }
         if (!SvROK(sv)) {
+           dTHR;               /* just for localizing */
            if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
                warn(warn_uninit);
             *lp = 0;
@@ -2410,8 +2415,10 @@ I32 namlen;
     if (name)
        if (namlen >= 0)
            mg->mg_ptr = savepvn(name, namlen);
-       else if (namlen == HEf_SVKEY)
+       else if (namlen == HEf_SVKEY) {
+           dTHR;               /* just for SvREFCNT_inc */
            mg->mg_ptr = (char*)SvREFCNT_inc((SV*)name);
+       }
     
     switch (how) {
     case 0:
@@ -2681,6 +2688,7 @@ register SV *sv;
     assert(SvREFCNT(sv) == 0);
 
     if (SvOBJECT(sv)) {
+       dTHR;
        if (defstash) {         /* Still have a symbol table? */
            dTHR;
            dSP;
@@ -4213,6 +4221,7 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
     I32 svmax;
     bool *used_locale;
 {
+    dTHR;
     char *p;
     char *q;
     char *patend;

diff --git a/sv.h b/sv.h
index f52c09d..d58aeb1 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -243,6 +243,11 @@ struct xpvfm {
     long       xcv_depth;              /* >= 2 indicates recursive call */
     AV *       xcv_padlist;
     CV *       xcv_outside;
+#ifdef USE_THREADS
+    pthread_mutex_t *  xcv_mutexp;
+    pthread_cond_t *   xcv_condp;      /* signalled when owner leaves CV */
+    struct thread *    xcv_owner;      /* current owner thread */
+#endif /* USE_THREADS */
     U8         xcv_flags;
 
     I32                xfm_lines;

diff --git a/thread.h b/thread.h
index 466dea5..ac4a44f 100644 (file)
--- a/thread.h
+++ b/thread.h
@@ -114,7 +114,7 @@ struct thread {
 
     AV *       Tstack;
     AV *       Tmainstack;
-    Sigjmp_buf Ttop_env;
+    JMPENV *   Ttop_env;
     I32                Trunlevel;
 
     /* XXX Sort stuff, firstgv, secongv and so on? */

diff --git a/toke.c b/toke.c
index 7fddc3c..a007fa4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -536,6 +536,7 @@ int kind;
        nextval[nexttoke].opval = o;
        force_next(WORD);
        if (kind) {
+           dTHR;               /* just for in_eval */
            o->op_private = OPpCONST_ENTERED;
            /* XXX see note in pp_entereval() for why we forgo typo
               warnings if the symbol must be introduced in an eval.

diff --git a/util.c b/util.c
index 5759e5a..14940ac 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1131,6 +1131,7 @@ mess(pat, args)
     sv = mess_sv;
     sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
     if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
+       dTHR;
        if (dirty)
            sv_catpv(sv, dgd);
        else {