Update XS helpers to 18554226

diff --git a/MANIFEST b/MANIFEST
index 0390be2b09f4c5a94a7a472e4b02f3069a1b13dd..9c3bb7e6602a7d2b6bdd2b39a8abc6fa35cfb527 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -55,6 +55,7 @@ t/lib/indirect/TestRequiredGlobal.pm
 xsh/caps.h
 xsh/debug.h
 xsh/hints.h
+xsh/mem.h
 xsh/ops.h
 xsh/ptable.h
 xsh/threads.h

diff --git a/indirect.xs b/indirect.xs
index 0545e0149a56a33fa28e35cdfc382a3a1a1283f4..9e8dc99bdb995fd2979471cf13dadbb945cb04ab 100644 (file)
--- a/indirect.xs
+++ b/indirect.xs
@@ -12,6 +12,7 @@
 
 #include "xsh/caps.h"
 #include "xsh/util.h"
+#include "xsh/mem.h"
 #include "xsh/ops.h"
 
 /* ... op => source position map ........................................... */
@@ -25,13 +26,13 @@ typedef struct {
 } indirect_op_info_t;
 
 #define PTABLE_NAME        ptable
-#define PTABLE_VAL_FREE(V) if (V) { Safefree(((indirect_op_info_t *) (V))->buf); Safefree(V); }
+#define PTABLE_VAL_FREE(V) if (V) { indirect_op_info_t *oi = (V); XSH_LOCAL_FREE(oi->buf, oi->size, char); XSH_LOCAL_FREE(oi, 1, indirect_op_info_t); }
 #define PTABLE_NEED_DELETE 1
 #define PTABLE_NEED_WALK   0
 
 #include "xsh/ptable.h"
 
-/* Safefree() always need aTHX */
+/* XSH_LOCAL_FREE() always need aTHX */
 #define ptable_store(T, K, V) ptable_store(aTHX_ (T), (K), (V))
 #define ptable_delete(T, K)   ptable_delete(aTHX_ (T), (K))
 #define ptable_clear(T)       ptable_clear(aTHX_ (T))
@@ -92,10 +93,6 @@ static SV *indirect_hint(pTHX) {
 
 /* --- Compatibility wrappers ---------------------------------------------- */
 
-#ifndef Newx
-# define Newx(v, n, c) New(0, v, n, c)
-#endif
-
 #ifndef SvPV_const
 # define SvPV_const SvPV
 #endif
@@ -241,7 +238,7 @@ static void indirect_map_store(pTHX_ const OP *o, STRLEN pos, SV *sv, line_t lin
   * guarded by indirect_hint(). */
 
  if (!(oi = ptable_fetch(XSH_CXT.map, o))) {
-  Newx(oi, 1, indirect_op_info_t);
+  XSH_LOCAL_ALLOC(oi, 1, indirect_op_info_t);
   ptable_store(XSH_CXT.map, o, oi);
   oi->buf  = NULL;
   oi->size = 0;
@@ -255,8 +252,7 @@ static void indirect_map_store(pTHX_ const OP *o, STRLEN pos, SV *sv, line_t lin
  }
 
  if (len > oi->size) {
-  Safefree(oi->buf);
-  Newx(oi->buf, len, char);
+  XSH_LOCAL_REALLOC(oi->buf, oi->size, len, char);
   oi->size = len;
  }
  Copy(s, oi->buf, len, char);

diff --git a/xsh/caps.h b/xsh/caps.h
index 4559524863696f5c51f32a9a99fd224a10818b90..6c0b9446e218f8f5f5ac40fddaef490faec09972 100644 (file)
--- a/xsh/caps.h
+++ b/xsh/caps.h
@@ -1,6 +1,10 @@
 #ifndef XSH_CAPS_H
 #define XSH_CAPS_H 1
 
+#ifdef __cplusplus
+# error C++ compilers are not supported
+#endif
+
 #define XSH_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
 
 #define XSH_HAS_PERL_BRANCH(R, V, S) (PERL_REVISION == (R) && PERL_VERSION == (V) && PERL_SUBVERSION >= (S))

diff --git a/xsh/hints.h b/xsh/hints.h
index 458b1170f06c9655bfcae6f58918ea01ea8c891a..18f674f2271414e5bf48cc27ca3f50a01ff93d4f 100644 (file)
--- a/xsh/hints.h
+++ b/xsh/hints.h
@@ -2,6 +2,7 @@
 #define XSH_HINTS_H 1
 
 #include "caps.h" /* XSH_HAS_PERL(), XSH_THREADSAFE, tTHX */
+#include "mem.h"  /* XSH_SHARED_*() */
 
 #ifdef XSH_THREADS_H
 # error threads.h must be loaded at the very end
@@ -160,10 +161,10 @@ typedef struct {
 
 #ifdef XSH_HINTS_VAL_DEINIT
 # define XSH_HINTS_FREE(H) \
-   if (H) XSH_HINTS_VAL_DEINIT(XSH_HINTS_VAL_GET(H)); \
-   PerlMemShared_free(H)
+   if (H) XSH_HINTS_VAL_DEINIT(XSH_HINTS_VAL_GET(((xsh_hints_t *) (H)))); \
+   XSH_SHARED_FREE((H), 1, xsh_hints_t)
 #else
-# define XSH_HINTS_FREE(H) PerlMemShared_free(H)
+# define XSH_HINTS_FREE(H) XSH_SHARED_FREE((H), 1, xsh_hints_t)
 #endif
 
 #else  /*  XSH_HINTS_NEED_STRUCT */
@@ -183,7 +184,7 @@ typedef XSH_HINTS_TYPE_COMPACT xsh_hints_t;
 
 #ifdef XSH_HINTS_FREE
 # define PTABLE_NAME        ptable_hints
-# define PTABLE_VAL_FREE(V) XSH_HINTS_FREE((xsh_hints_t *) (V))
+# define PTABLE_VAL_FREE(V) XSH_HINTS_FREE(V)
 #else
 # define PTABLE_USE_DEFAULT 1
 #endif
@@ -231,7 +232,7 @@ static void xsh_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
  xsh_hints_t         *h2;
 
 #if XSH_HINTS_NEED_STRUCT
- h2              = PerlMemShared_malloc(sizeof *h2);
+ XSH_SHARED_ALLOC(h2, 1, xsh_hints_t);
 # if XSH_WORKAROUND_REQUIRE_PROPAGATION
  h2->require_tag = PTR2UV(xsh_dup_inc(INT2PTR(SV *, h1->require_tag), ud->params));
 # endif
@@ -268,7 +269,7 @@ static SV *xsh_hints_tag(pTHX_ XSH_HINTS_TYPE_VAL val) {
   return newSVuv(0);
 
 #if XSH_HINTS_NEED_STRUCT
- h              = PerlMemShared_malloc(sizeof *h);
+ XSH_SHARED_ALLOC(h, 1, xsh_hints_t);
 # if XSH_WORKAROUND_REQUIRE_PROPAGATION
  h->require_tag = xsh_require_tag();
 # endif

diff --git a/xsh/mem.h b/xsh/mem.h
new file mode 100644 (file)
index 0000000..e1b90b3
--- /dev/null
+++ b/xsh/mem.h
@@ -0,0 +1,199 @@
+#ifndef XSH_MEM_H
+#define XSH_MEM_H 1
+
+#include "util.h" /* XSH_ASSERT() */
+
+#ifdef DEBUGGING
+# ifdef Poison
+#  define XSH_POISON(D, N, T)      Poison((D), (N), T)
+# endif
+# ifdef PoisonNew
+#  define XSH_POISON_NEW(D, N, T)  PoisonNew((D), (N), T)
+#  define XSH_HAS_POISON_NEW       1
+# endif
+# ifdef PoisonFree
+#  define XSH_POISON_FREE(D, N, T) PoisonFree((D), (N), T)
+#  define XSH_HAS_POISON_FREE      1
+# endif
+#endif
+
+#ifdef XSH_POISON
+# ifndef XSH_POISON_NEW
+#  define XSH_POISON_NEW(D, N, T)  XSH_POISON(D, N, T)
+#  define XSH_HAS_POISON_NEW       1
+# endif
+# ifndef XSH_POISON_FREE
+#  define XSH_POISON_FREE(D, N, T) XSH_POISON(D, N, T)
+#  define XSH_HAS_POISON_FREE      1
+# endif
+#endif
+
+#ifndef XSH_HAS_POISON_NEW
+# define XSH_HAS_POISON_NEW  0
+#endif
+#ifndef XSH_HAS_POISON_FREE
+# define XSH_HAS_POISON_FREE 0
+#endif
+
+/* --- Shared memory ------------------------------------------------------- */
+
+/* Context for PerlMemShared_*() functions */
+#ifdef PERL_IMPLICIT_SYS
+# define pPMS  pTHX
+# define pPMS_ pTHX_
+# define aPMS  aTHX
+# define aPMS_ aTHX_
+#else
+# define pPMS  void
+# define pPMS_
+# define aPMS
+# define aPMS_
+#endif
+
+/* ... xsh_shared_alloc() .................................................. */
+
+#if XSH_HAS_POISON_NEW
+
+static void *xsh_shared_alloc(pPMS_ size_t size) {
+#define xsh_shared_alloc(S) xsh_shared_alloc(aPMS_ (S))
+ void *p;
+
+ p = PerlMemShared_malloc(size);
+ XSH_ASSERT(p);
+
+ XSH_POISON_NEW(p, size, char);
+
+ return p;
+}
+
+#else  /*  XSH_HAS_POISON_NEW */
+
+#define xsh_shared_alloc(S) PerlMemShared_malloc(S)
+
+#endif /* !XSH_HAS_POISON_NEW */
+
+#define XSH_SHARED_ALLOC(D, N, T) ((D) = xsh_shared_alloc((N) * sizeof(T)))
+
+/* ... xsh_shared_calloc() ................................................. */
+
+#define xsh_shared_calloc(C, S) PerlMemShared_calloc((C), (S))
+
+#define XSH_SHARED_CALLOC(D, N, T) ((D) = xsh_shared_calloc((N), sizeof(T)))
+
+/* ... xsh_shared_free() ................................................... */
+
+#if XSH_HAS_POISON_FREE
+
+static void xsh_shared_free(pPMS_ void *p, size_t size) {
+#define xsh_shared_free(P, S) xsh_shared_free(aPMS_ (P), (S))
+ if (p)
+  XSH_POISON_FREE(p, size, char);
+
+ PerlMemShared_free(p);
+
+ return;
+}
+
+#else  /*  XSH_HAS_POISON_FREE */
+
+#define xsh_shared_free(P, S) PerlMemShared_free(P)
+
+#endif /* !XSH_HAS_POISON_FREE */
+
+#define XSH_SHARED_FREE(D, N, T) (xsh_shared_free((D), (N) * sizeof(T)), (D) = NULL)
+
+/* ... xsh_shared_realloc() ................................................ */
+
+#if XSH_HAS_POISON_NEW && XSH_HAS_POISON_FREE
+
+static void *xsh_shared_realloc(pPMS_ void *p, size_t old_size, size_t new_size) {
+#define xsh_shared_realloc(P, OS, NS) xsh_shared_realloc(aPMS_ (P), (OS), (NS))
+ void *q;
+
+ if (!p)
+  return xsh_shared_alloc(new_size);
+
+ if (!new_size) {
+  xsh_shared_free(p, old_size);
+  return xsh_shared_alloc(1);
+ }
+
+ if (new_size < old_size)
+  XSH_POISON_FREE(((char *) p) + new_size, old_size - new_size, char);
+
+ q = PerlMemShared_realloc(p, new_size);
+ XSH_ASSERT(q);
+
+ if (old_size < new_size)
+  XSH_POISON_NEW(((char *) q) + old_size, new_size - old_size, char);
+
+ return q;
+}
+
+#else  /*  XSH_HAS_POISON_NEW && XSH_HAS_POISON_FREE */
+
+#define xsh_shared_realloc(P, OS, NS) PerlMemShared_realloc((P), (NS))
+
+#endif /* !XSH_HAS_POISON_NEW || !XSH_HAS_POISON_FREE */
+
+#define XSH_SHARED_REALLOC(D, OL, NL, T) ((D) = xsh_shared_realloc((D), (OL) * sizeof(T), (NL) * sizeof(T)))
+
+/* ... xsh_shared_recalloc() ............................................... */
+
+static void *xsh_shared_recalloc(pPMS_ void *p, size_t old_size, size_t new_size) {
+#define xsh_shared_recalloc(P, OS, NS) xsh_shared_recalloc(aPMS_ (P), (OS), (NS))
+ void *q;
+
+#ifdef XSH_POISON_FREE
+ if (new_size < old_size)
+  XSH_POISON_FREE(((char *) p) + new_size, old_size - new_size, char);
+#endif /* XSH_POISON_FREE */
+
+ q = PerlMemShared_realloc(p, new_size);
+ XSH_ASSERT(q);
+
+ if (old_size < new_size)
+  Zero(((char *) q) + old_size, new_size - old_size, char);
+
+ return q;
+}
+
+#define XSH_SHARED_RECALLOC(D, OL, NL, T) ((D) = xsh_shared_recalloc((D), (OL) * sizeof(T), (NL) * sizeof(T)))
+
+/* --- Interpreter-local memory -------------------------------------------- */
+
+#ifndef Newx
+# define Newx(D, N, T) New(0, (D), (N), T)
+#endif
+
+#ifndef PERL_POISON
+
+#if XSH_HAS_POISON_NEW
+# define XSH_LOCAL_ALLOC(D, N, T)  (Newx((D), (N), T), XSH_POISON_NEW((D), (N), T))
+#endif
+
+#if XSH_HAS_POISON_FREE
+# define XSH_LOCAL_FREE(D, N, T) (XSH_POISON_FREE((D), (N), T), Safefree(D))
+#endif
+
+#if XSH_HAS_POISON_NEW && XSH_HAS_POISON_FREE
+# define XSH_LOCAL_REALLOC(D, OL, NL, T) ((((D) && ((NL) < (OL))) ? XSH_POISON_FREE(((T *) (D)) + (NL), (OL) - (NL), T) : NOOP), Renew((D), (NL), T), (((OL) < (NL)) ? XSH_POISON_NEW(((T *) (D)) + (OL), (NL) - (OL), T) : NOOP))
+#endif
+
+#endif /* !PERL_POISON */
+
+#ifndef XSH_LOCAL_ALLOC
+# define XSH_LOCAL_ALLOC(D, N, T) Newx((D), (N), T)
+#endif
+
+#define XSH_LOCAL_CALLOC(D, N, T) Newxz((D), (N), T)
+
+#ifndef XSH_LOCAL_FREE
+# define XSH_LOCAL_FREE(D, N, T)  Safefree(D)
+#endif
+
+#ifndef XSH_LOCAL_REALLOC
+# define XSH_LOCAL_REALLOC(D, OL, NL, T) Renew((D), (NL), T)
+#endif
+
+#endif /* XSH_MEM_H */

diff --git a/xsh/ptable.h b/xsh/ptable.h
index af2e168877aab46b5c976469b12524aff390ad72..89b3bbf5e86d744bf0d3ae7181ff6ff07f2b4e3e 100644 (file)
--- a/xsh/ptable.h
+++ b/xsh/ptable.h
@@ -6,7 +6,8 @@
 /* This header is designed to be included several times with different
  * definitions for PTABLE_NAME and PTABLE_VAL_ALLOC/FREE(). */
 
-#include "util.h" /* VOID2(), XSH_ASSERT(), xPMS */
+#include "util.h" /* XSH_ASSERT() */
+#include "mem.h"  /* xPMS, XSH_SHARED_*() */
 
 /* --- Configuration ------------------------------------------------------- */
 
@@ -160,9 +161,7 @@ static void ptable_split(pPMS_ ptable *t) {
  size_t       new_size = old_size * 2;
  size_t       i;
 
- ary = VOID2(ptable_ent **,
-             PerlMemShared_realloc(ary, new_size * sizeof *ary));
- Zero(ary + old_size, new_size - old_size, sizeof *ary);
+ XSH_SHARED_RECALLOC(ary, old_size, new_size, ptable_ent *);
  t->max = --new_size;
  t->ary = ary;
 
@@ -201,8 +200,7 @@ static ptable_ent *ptable_ent_vivify(pPMS_ ptable *t, const void *key) {
    return ent;
  }
 
- ent = VOID2(ptable_ent *, PerlMemShared_malloc(sizeof *ent));
-
+ XSH_SHARED_ALLOC(ent, 1, ptable_ent);
  ent->key    = key;
  ent->val    = NULL;
  ent->next   = t->ary[idx];
@@ -269,11 +267,11 @@ static ptable *ptable_new(pPMS_ size_t init_buckets) {
 
  XSH_ASSERT(init_buckets >= 4 && ((init_buckets & (init_buckets - 1)) == 0));
 
- t        = VOID2(ptable *, PerlMemShared_malloc(sizeof *t));
+ XSH_SHARED_ALLOC(t, 1, ptable);
  t->max   = init_buckets - 1;
  t->items = 0;
- t->ary   = VOID2(ptable_ent **,
-                              PerlMemShared_calloc(t->max + 1, sizeof *t->ary));
+ XSH_SHARED_CALLOC(t->ary, t->max + 1, ptable_ent *);
+
  return t;
 }
 #endif /* !ptable_new */
@@ -303,7 +301,7 @@ static void *ptable_splice(pPMS_ ptable *t, const void *key, void *new_val) {
   ent = ptable_ent_detach(t, key);
   if (ent) {
    old_val = ent->val;
-   PerlMemShared_free(ent);
+   XSH_SHARED_FREE(ent, 1, ptable_ent);
   }
  }
 
@@ -387,7 +385,7 @@ static void PTABLE_PREFIX(_delete)(pPTBL_ ptable *t, const void *key) {
  }
 #endif
 
- PerlMemShared_free(ent);
+ XSH_SHARED_FREE(ent, 1, ptable_ent);
 }
 # if PTABLE_USE_DEFAULT
 #  define ptable_default_delete ptable_default_delete
@@ -411,7 +409,7 @@ static void PTABLE_PREFIX(_clear)(pPTBL_ ptable *t) {
 #ifdef PTABLE_VAL_FREE
     PTABLE_VAL_FREE(entry->val);
 #endif
-    PerlMemShared_free(entry);
+    XSH_SHARED_FREE(entry, 1, ptable_ent);
     entry = nentry;
    }
    array[idx] = NULL;
@@ -432,8 +430,8 @@ static void PTABLE_PREFIX(_free)(pPTBL_ ptable *t) {
  if (!t)
   return;
  PTABLE_PREFIX(_clear)(aPTBL_ t);
- PerlMemShared_free(t->ary);
- PerlMemShared_free(t);
+ XSH_SHARED_FREE(t->ary, t->max + 1, ptable_ent *);
+ XSH_SHARED_FREE(t, 1, ptable);
 }
 # if PTABLE_USE_DEFAULT
 #  define ptable_default_free ptable_default_free

diff --git a/xsh/threads.h b/xsh/threads.h
index b72c63b0f6839115647050901c26aa50a98315cb..428844415087bbcb6a9f4d3435044298cd8ef529 100644 (file)
--- a/xsh/threads.h
+++ b/xsh/threads.h
@@ -3,6 +3,7 @@
 
 #include "caps.h" /* XSH_HAS_PERL(), XSH_THREADSAFE */
 #include "util.h" /* XSH_PACKAGE, dNOOP, NOOP */
+#include "mem.h"  /* XSH_SHARED_*() */
 
 #ifndef XSH_THREADS_COMPILE_TIME_PROTECTION
 # define XSH_THREADS_COMPILE_TIME_PROTECTION 0
@@ -307,7 +308,7 @@ static int xsh_teardown_late_arg_free(pTHX_ SV *sv, MAGIC *mg) {
   tok->cb(aTHX_ tok->ud);
  XSH_LOADED_UNLOCK;
 
- PerlMemShared_free(tok);
+ XSH_SHARED_FREE(tok, 1, xsh_teardown_late_token);
 
  return 0;
 }
@@ -338,7 +339,7 @@ static void xsh_teardown_late_register(pTHX_ xsh_teardown_late_cb cb, void *ud){
  } else {
   xsh_teardown_late_token *tok;
 
-  tok     = PerlMemShared_malloc(sizeof *tok);
+  XSH_SHARED_ALLOC(tok, 1, xsh_teardown_late_token);
   tok->cb = cb;
   tok->ud = ud;
 

diff --git a/xsh/util.h b/xsh/util.h
index dcc142c79066a5d532afbe31691d5cfc41d82279..500472364a3545615e9b38ecd5781d318a1ce177 100644 (file)
--- a/xsh/util.h
+++ b/xsh/util.h
@@ -13,7 +13,12 @@
 # if XSH_HAS_PERL(5, 8, 9) || XSH_HAS_PERL(5, 9, 3)
 #  define XSH_ASSERT(C) assert(C)
 # else
-#  define XSH_ASSERT(C) PERL_DEB( \
+#  ifdef PERL_DEB
+#   define XSH_DEB(X) PERL_DEB(X)
+#  else
+#   define XSH_DEB(X) (X)
+#  endif
+#  define XSH_ASSERT(C) XSH_DEB( \
    ((C) ? ((void) 0)           \
         : (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__  \
                                  "\", line %d", STRINGIFY(C), __LINE__), \
@@ -23,13 +28,6 @@
 # define XSH_ASSERT(C)
 #endif
 
-#undef VOID2
-#ifdef __cplusplus
-# define VOID2(T, P) static_cast<T>(P)
-#else
-# define VOID2(T, P) (P)
-#endif
-
 #ifndef STMT_START
 # define STMT_START do
 #endif
@@ -61,19 +59,6 @@
 #define xsh_dup(S, P)     sv_dup((S), (P))
 #define xsh_dup_inc(S, P) SvREFCNT_inc(xsh_dup((S), (P)))
 
-/* Context for PerlMemShared_*() functions */
-#ifdef PERL_IMPLICIT_SYS
-# define pPMS  pTHX
-# define pPMS_ pTHX_
-# define aPMS  aTHX
-# define aPMS_ aTHX_
-#else
-# define pPMS  void
-# define pPMS_
-# define aPMS
-# define aPMS_
-#endif
-
 #ifdef USE_ITHREADS
 # define XSH_LOCK(M)   MUTEX_LOCK(M)
 # define XSH_UNLOCK(M) MUTEX_UNLOCK(M)