summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ext/DB_File/DB_File.pm10
-rw-r--r--ext/DB_File/DB_File.xs8
-rw-r--r--ext/Opcode/Makefile.PL2
-rw-r--r--ext/Opcode/Opcode.pm2
-rw-r--r--ext/Opcode/Opcode.xs7
-rw-r--r--gv.c3
-rw-r--r--hv.c2
-rw-r--r--mg.c3
-rw-r--r--op.c16
-rw-r--r--perl.c20
-rw-r--r--perly.c5
-rw-r--r--perly.y5
-rw-r--r--pp.c2
-rw-r--r--pp_ctl.c1
-rw-r--r--run.c3
-rw-r--r--scope.c2
-rw-r--r--sv.c11
-rw-r--r--sv.h5
-rw-r--r--thread.h2
-rw-r--r--toke.c1
-rw-r--r--util.c1
21 files changed, 77 insertions, 34 deletions
diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index 2d5e744671..e097046718 100644
--- 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 8d01d91642..cc70b5d7b9 100644
--- 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 7fdcdf6ac1..48a6ed82b8 100644
--- 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 a35ad1b47b..2fe23f0711 100644
--- 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 9d4b726536..8307ade2ca 100644
--- 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 c9f919ccc2..50e90409c1 100644
--- 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 77c379884a..454ee231cb 100644
--- 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 cf2d71f22a..960e0c1cd4 100644
--- 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 45b74002e8..30211544e9 100644
--- 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 4f96f287f3..242535a8cb 100644
--- 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 6bc37ff7c9..fd161fd8b0 100644
--- 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 be6fe98f20..be3d0c7763 100644
--- 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 af615c3385..391133b72a 100644
--- 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 82c59bf8a7..2f3b2b7765 100644
--- 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 e41616019c..2f8d8fa971 100644
--- 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 cf58e24f0e..50c843d108 100644
--- 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 1331f89256..a23ac14c3f 100644
--- 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 f52c09d43d..d58aeb1d84 100644
--- 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 466dea5520..ac4a44f7a2 100644
--- 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 7fddc3c7ea..a007fa47d0 100644
--- 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 5759e5a014..14940ac267 100644
--- 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 {
View Lorry Controller Status