Front page | perl.perl5.porters |
Postings from April 2000
[PATCH 5.6.0]Threadsafe fixup
Thread Next
From:
Dan Sugalski
Date:
April 18, 2000 11:40
Subject:
[PATCH 5.6.0]Threadsafe fixup
Message ID:
4.3.1.0.20000418143957.01d57280@24.8.96.48
It turns out that lock() isn't threadsafe. Um, oooops...
(For the curious, lock is implemented as a type of magic, so whenever
you lock a variable perl checks to see if it's been upgraded to
something magic-containing and upgrades it if it hasn't. If two
threads lock a variable simultaneously they can race on the upgrade
and potentially leak memory, mutexes, and not actually lock the silly
thing against each other)
This patch pulls the guts out of the lock opcode and sticks 'em in a
function called, oddly enough, Perl_lock. Call it with a SV * and it
gets a perl-level lock that gets released when it goes out of scope. I
expect I'll be using this in a bit for the sort and $AUTOLOAD fixes.
This patch also exports two macros, SvLOCK and SvUNLOCK, that take out
a mutex on the passed SV *. Each SV (and associated AV, HV, GV, et al)
struct now has a mutex attached to it for this purpose. Yes it bloats
things a bit, but it was the only way to be extra-safe. (Perl_lock may
take out locks on two separate SVs at once, so a global lock wouldn't
do it)
--- embed.pl;1 Sun Mar 19 07:38:38 2000
+++ embed.pl;2 Tue Apr 18 10:43:51 2000
@@ -2489,6 +2489,8 @@
# endif
#endif
+Ap |SV* |lock |SV *sv
+
#if defined(PERL_OBJECT)
};
#endif
--- global.sym;1 Sun Mar 19 17:18:33 2000
+++ global.sym;3 Tue Apr 18 11:12:15 2000
@@ -537,3 +537,4 @@
Perl_ptr_table_fetch
Perl_ptr_table_store
Perl_ptr_table_split
+Perl_lock
--- pp.c;1 Mon Mar 20 15:35:44 2000
+++ pp.c Tue Apr 18 11:18:17 2000
@@ -5247,24 +5247,7 @@
dTOPss;
SV *retsv = sv;
#ifdef USE_THREADS
- MAGIC *mg;
-
- if (SvROK(sv))
- sv = SvRV(sv);
-
- mg = condpair_magic(sv);
- MUTEX_LOCK(MgMUTEXP(mg));
- if (MgOWNER(mg) == thr)
- MUTEX_UNLOCK(MgMUTEXP(mg));
- else {
- while (MgOWNER(mg))
- COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
- MgOWNER(mg) = thr;
- DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(sv));)
- MUTEX_UNLOCK(MgMUTEXP(mg));
- SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
- }
+ Perl_lock(aTHX_ sv);
#endif /* USE_THREADS */
if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
|| SvTYPE(retsv) == SVt_PVCV) {
--- proto.h;1 Sun Mar 19 17:18:33 2000
+++ proto.h Tue Apr 18 11:12:15 2000
@@ -1254,6 +1254,8 @@
# endif
#endif
+PERL_CALLCONV SV* Perl_lock(pTHX_ SV *sv);
+
#if defined(PERL_OBJECT)
};
#endif
--- sv.c;1 Thu Mar 23 02:44:37 2000
+++ sv.c Tue Apr 18 11:20:53 2000
@@ -55,6 +55,7 @@
UNLOCK_SV_MUTEX; \
SvANY(p) = 0; \
SvREFCNT(p) = 1; \
+ MUTEX_INIT(&p->sv_mutex); \
SvFLAGS(p) = 0; \
} STMT_END
@@ -67,6 +68,7 @@
del_sv(p); \
else \
plant_SV(p); \
+ MUTEX_DESTROY(&p->sv_mutex); \
UNLOCK_SV_MUTEX; \
} STMT_END
--- sv.h;1 Thu Mar 9 17:40:40 2000
+++ sv.h Tue Apr 18 13:59:12 2000
@@ -59,42 +59,55 @@
SVt_PVIO /* 15 */
} svtype;
+/* Cleaner than a bunch of #ifdefs in the SV struct definitions */
+#ifdef USE_THREADS
+#define SVMUTEX perl_mutex sv_mutex;
+#else
+#define SVMUTEX
+#endif
+
/* Using C's structural equivalence to help emulate C++ inheritance here... */
struct sv {
void* sv_any; /* pointer to something */
U32 sv_refcnt; /* how many references to us */
U32 sv_flags; /* what we are */
+ SVMUTEX /* Internal lock to protect us */
};
struct gv {
XPVGV* sv_any; /* pointer to something */
U32 sv_refcnt; /* how many references to us */
U32 sv_flags; /* what we are */
+ SVMUTEX /* Internal lock to protect us */
};
struct cv {
XPVCV* sv_any; /* pointer to something */
U32 sv_refcnt; /* how many references to us */
U32 sv_flags; /* what we are */
+ SVMUTEX /* Internal lock to protect us */
};
struct av {
XPVAV* sv_any; /* pointer to something */
U32 sv_refcnt; /* how many references to us */
U32 sv_flags; /* what we are */
+ SVMUTEX /* Internal lock to protect us */
};
struct hv {
XPVHV* sv_any; /* pointer to something */
U32 sv_refcnt; /* how many references to us */
U32 sv_flags; /* what we are */
+ SVMUTEX /* Internal lock to protect us */
};
struct io {
XPVIO* sv_any; /* pointer to something */
U32 sv_refcnt; /* how many references to us */
U32 sv_flags; /* what we are */
+ SVMUTEX /* Internal lock to protect us */
};
/*
@@ -984,6 +997,13 @@
NUL character). Calls C<sv_grow> to perform the expansion if necessary.
Returns a pointer to the character buffer.
+=for apidoc Am|void|SvLOCK|SV* sv
+Aquires an internal mutex for a SV. Used to make sure multiple threads
+don't stomp on the guts of an SV at the same time
+
+=for apidoc Am|void|SvUNLOCK|SV* sv
+Release the internal mutex for an SV.
+
=cut
*/
@@ -1032,3 +1052,6 @@
#define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv))
#define Sv_Grow sv_grow
+
+#define SvLOCK(sv) MUTEX_LOCK(&(sv->sv_mutex))
+#define SvUNLOCK(sv) MUTEX_UNLOCK(&(sv->sv_mutex))
--- util.c;1 Wed Mar 22 15:19:01 2000
+++ util.c Tue Apr 18 10:46:18 2000
@@ -3449,6 +3449,38 @@
return mg;
}
+SV *
+Perl_lock(pTHX_ SV *osv)
+{
+#ifdef USE_THREADS
+ MAGIC *mg;
+ SV *sv = osv;
+
+ SvLOCK(osv);
+ if (SvROK(sv)) {
+ sv = SvRV(sv);
+ SvUNLOCK(osv);
+ SvLOCK(sv);
+ }
+
+ mg = condpair_magic(sv);
+ MUTEX_LOCK(MgMUTEXP(mg));
+ if (MgOWNER(mg) == thr)
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ else {
+ while (MgOWNER(mg))
+ COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
+ MgOWNER(mg) = thr;
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n",
+ PTR2UV(thr), PTR2UV(sv));)
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
+ }
+#endif
+ SvUNLOCK(sv);
+ return sv;
+}
+
/*
* Make a new perl thread structure using t as a prototype. Some of the
* fields for the new thread are copied from the prototype thread, t,
Thread Next
-
[PATCH 5.6.0]Threadsafe fixup
by Dan Sugalski