#define SO_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
+#ifndef GvCV_set
+# define GvCV_set(G, C) (GvCV(G) = (C))
+#endif
+
/* ... Thread safety and multiplicity ...................................... */
#ifndef SO_MULTIPLICITY
# define MY_CXT_CLONE NOOP
#endif
+#if defined(OP_CHECK_MUTEX_LOCK) && defined(OP_CHECK_MUTEX_UNLOCK)
+# define SO_CHECK_MUTEX_LOCK OP_CHECK_MUTEX_LOCK
+# define SO_CHECK_MUTEX_UNLOCK OP_CHECK_MUTEX_UNLOCK
+#else
+# define SO_CHECK_MUTEX_LOCK OP_REFCNT_LOCK
+# define SO_CHECK_MUTEX_UNLOCK OP_REFCNT_UNLOCK
+#endif
+
+typedef OP *(*so_ck_t)(pTHX_ OP *);
+
+#ifdef wrap_op_checker
+
+# define so_ck_replace(T, NC, OCP) wrap_op_checker((T), (NC), (OCP))
+
+#else
+
+STATIC void so_ck_replace(pTHX_ OPCODE type, so_ck_t new_ck, so_ck_t *old_ck_p){
+#define so_ck_replace(T, NC, OCP) so_ck_replace(aTHX_ (T), (NC), (OCP))
+ SO_CHECK_MUTEX_LOCK;
+ if (!*old_ck_p) {
+ *old_ck_p = PL_check[type];
+ PL_check[type] = new_ck;
+ }
+ SO_CHECK_MUTEX_UNLOCK;
+}
+
+#endif
+
+STATIC void so_ck_restore(pTHX_ OPCODE type, so_ck_t *old_ck_p) {
+#define so_ck_restore(T, OCP) so_ck_restore(aTHX_ (T), (OCP))
+ SO_CHECK_MUTEX_LOCK;
+ if (*old_ck_p) {
+ PL_check[type] = *old_ck_p;
+ *old_ck_p = 0;
+ }
+ SO_CHECK_MUTEX_UNLOCK;
+}
+
/* --- Global data --------------------------------------------------------- */
#define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION
(void) hv_store(MY_CXT.map, c->name, c->namelen, newSViv(PTR2IV(c)), 0);
}
+STATIC const char *so_strndup(pTHX_ const char *s, STRLEN len) {
+#define so_strndup(S, L) so_strndup(aTHX_ (S), (L))
+ const char *d;
+
+ if (!s)
+ return NULL;
+
+ d = PerlMemShared_malloc(len + 1);
+ Copy(s, d, len, char);
+ ((char *) d)[len] = '\0';
+
+ return d;
+}
+
sub_op_config_t *sub_op_dup(pTHX_ const sub_op_config_t *orig) {
- STRLEN len;
sub_op_config_t *dupe = PerlMemShared_malloc(sizeof *dupe);
- len = orig->namelen;
- if (orig->name) {
- dupe->name = PerlMemShared_malloc(len + 1);
- Copy(orig->name, dupe->name, len, char);
- ((char *) dupe->name)[len] = '\0';
- } else {
- dupe->name = NULL;
- }
- dupe->namelen = len;
-
- len = orig->protolen;
- if (orig->proto) {
- dupe->proto = PerlMemShared_malloc(len + 1);
- Copy(orig->proto, dupe->proto, len, char);
- ((char *) dupe->proto)[len] = '\0';
- } else {
- dupe->proto = NULL;
- }
- dupe->protolen = len;
+ dupe->name = so_strndup(orig->name, orig->namelen);
+ dupe->namelen = orig->namelen;
+
+ dupe->proto = so_strndup(orig->proto, orig->protolen);
+ dupe->protolen = orig->protolen;
dupe->call = orig->call;
dupe->ref = orig->ref;
if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) {
SvREFCNT_dec(cv);
- GvCV(gv) = NULL;
+ GvCV_set(gv, NULL);
}
if (c->call)
if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) {
SvREFCNT_dec(cv);
- GvCV(gv) = NULL;
+ GvCV_set(gv, NULL);
}
}
}
MY_CXT.owner = aTHX;
#endif /* SO_THREADSAFE */
- so_old_ck_entersub = PL_check[OP_ENTERSUB];
- PL_check[OP_ENTERSUB] = so_ck_entersub;
- so_old_ck_refgen = PL_check[OP_REFGEN];
- PL_check[OP_REFGEN] = so_ck_refgen;
- so_old_ck_gelem = PL_check[OP_GELEM];
- PL_check[OP_GELEM] = so_ck_gelem;
+ so_ck_replace(OP_ENTERSUB, so_ck_entersub, &so_old_ck_entersub);
+ so_ck_replace(OP_REFGEN, so_ck_refgen, &so_old_ck_refgen);
+ so_ck_replace(OP_GELEM, so_ck_gelem, &so_old_ck_gelem);
}
#if SO_THREADSAFE