#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
#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 */
#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
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
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
--- /dev/null
+#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 */
/* 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 ------------------------------------------------------- */
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;
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];
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 */
ent = ptable_ent_detach(t, key);
if (ent) {
old_val = ent->val;
- PerlMemShared_free(ent);
+ XSH_SHARED_FREE(ent, 1, ptable_ent);
}
}
}
#endif
- PerlMemShared_free(ent);
+ XSH_SHARED_FREE(ent, 1, ptable_ent);
}
# if PTABLE_USE_DEFAULT
# define ptable_default_delete ptable_default_delete
#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;
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