custom allocator and custom abort

extlib/benz/codegen.c

@@ -984,6 +984,7 @@ emit_r(codegen_state *state, enum pic_opcode insn, int d, int i)
 static void
 create_activation(codegen_state *state)
 {
+  pic_state *pic = state->pic;
   codegen_context *cxt = state->cxt;
   size_t i, n;
   xhash regs;

extlib/benz/error.c

@@ -16,8 +16,14 @@ pic_panic(pic_state *pic, const char *msg)
 {
   PIC_UNUSED(pic);
 
+#if DEBUG
   fprintf(stderr, "abort: %s\n", msg);
-  abort();
+#else
+  PIC_UNUSED(msg);
+#endif
+  PIC_ABORT(pic);
+
+  PIC_UNREACHABLE();
 }
 
 void

extlib/benz/gc.c

@@ -112,8 +112,9 @@ add_heap_page(pic_state *pic)
   pic->heap->pages = page;
 }
 
-static void *
+#if PIC_ENABLE_LIBC
-alloc(void *ptr, size_t size)
+void *
+pic_default_allocf(void *ptr, size_t size)
 {
   if (size == 0) {
     if (ptr) {
@@ -127,13 +128,14 @@ alloc(void *ptr, size_t size)
     return malloc(size);
   }
 }
+#endif
 
 void *
 pic_alloc(pic_state *pic, size_t size)
 {
   void *ptr;
 
-  ptr = alloc(NULL, size);
+  ptr = pic->allocf(NULL, size);
   if (ptr == NULL && size > 0) {
     pic_panic(pic, "memory exhausted");
   }
@@ -143,7 +145,7 @@ pic_alloc(pic_state *pic, size_t size)
 void *
 pic_realloc(pic_state *pic, void *ptr, size_t size)
 {
-  ptr = alloc(ptr, size);
+  ptr = pic->allocf(ptr, size);
   if (ptr == NULL && size > 0) {
     pic_panic(pic, "memory exhausted");
   }
@@ -156,7 +158,7 @@ pic_calloc(pic_state *pic, size_t count, size_t size)
   void *ptr;
 
   size *= count;
-  ptr = alloc(NULL, size);
+  ptr = pic->allocf(NULL, size);
   if (ptr == NULL && size > 0) {
     pic_panic(pic, "memory exhausted");
   }
@@ -169,7 +171,7 @@ pic_free(pic_state *pic, void *ptr)
 {
   PIC_UNUSED(pic);
 
-  free(ptr);
+  pic->allocf(ptr, 0);
 }
 
 static void

extlib/benz/include/picrin.h

@@ -81,10 +81,14 @@ typedef struct {
   struct pic_env *up;
 } pic_callinfo;
 
+typedef void *(*pic_allocf)(void *, size_t);
+
 typedef struct {
   int argc;
   char **argv, **envp;
 
+  pic_allocf allocf;
+
   struct pic_winder *wind;
 
   pic_value *sp;
@@ -167,7 +171,8 @@ void pic_gc_arena_restore(pic_state *, size_t);
     pic_gc_arena_restore(pic, ai);              \
   } while (0)
 
-pic_state *pic_open(int argc, char *argv[], char **envp);
+pic_state *pic_open(int argc, char *argv[], char **envp, pic_allocf);
+void *pic_default_allocf(void *, size_t);
 void pic_close(pic_state *);
 
 void pic_add_feature(pic_state *, const char *);

extlib/benz/include/picrin/config.h

@@ -25,6 +25,9 @@
 /* #define PIC_SETJMP(pic, buf) setjmp(buf) */
 /* #define PIC_LONGJMP(pic, buf, val) longjmp((buf), (val)) */
 
+/** custom abort */
+/* #define PIC_ABORT(pic) abort() */
+
 /** initial memory size (to be dynamically extended if necessary) */
 /* #define PIC_ARENA_SIZE 1000 */
 
@@ -112,6 +115,10 @@
 # define PIC_LONGJMP(pic, buf, val) longjmp((buf), (val))
 #endif
 
+#ifndef PIC_ABORT
+# define PIC_ABORT(pic) abort()
+#endif
+
 #ifndef PIC_ARENA_SIZE
 # define PIC_ARENA_SIZE (8 * 1024)
 #endif

extlib/benz/include/picrin/xhash.h

@@ -9,10 +9,12 @@
 extern "C" {
 #endif
 
+#define XHASH_ALLOCATOR pic->allocf
+
 /* simple object to object hash table */
 
 #define XHASH_INIT_SIZE 11
-#define XHASH_RESIZE_RATIO 0.75
+#define XHASH_RESIZE_RATIO(x) ((x) * 3 / 4)
 
 #define XHASH_ALIGNMENT 3       /* quad word alignment */
 #define XHASH_MASK (~(size_t)((1 << XHASH_ALIGNMENT) - 1))
@@ -31,8 +33,10 @@ typedef struct xh_entry {
 
 typedef int (*xh_hashf)(const void *, void *);
 typedef int (*xh_equalf)(const void *, const void *, void *);
+typedef void *(*xh_allocf)(void *, size_t);
 
 typedef struct xhash {
+  xh_allocf allocf;
   xh_entry **buckets;
   size_t size, count, kwidth, vwidth;
   size_t koffset, voffset;
@@ -76,16 +80,17 @@ PIC_INLINE xh_entry *xh_next(xh_entry *e);
 
 
 PIC_INLINE void
-xh_bucket_realloc(xhash *x, size_t newsize)
+xh_bucket_alloc(xhash *x, size_t newsize)
 {
   x->size = newsize;
-  x->buckets = realloc(x->buckets, (x->size + 1) * sizeof(xh_entry *));
+  x->buckets = x->allocf(NULL, (x->size + 1) * sizeof(xh_entry *));
   memset(x->buckets, 0, (x->size + 1) * sizeof(xh_entry *));
 }
 
 PIC_INLINE void
-xh_init_(xhash *x, size_t kwidth, size_t vwidth, xh_hashf hashf, xh_equalf equalf, void *data)
+xh_init_(xhash *x, xh_allocf allocf, size_t kwidth, size_t vwidth, xh_hashf hashf, xh_equalf equalf, void *data)
 {
+  x->allocf = allocf;
   x->size = 0;
   x->buckets = NULL;
   x->count = 0;
@@ -99,7 +104,7 @@ xh_init_(xhash *x, size_t kwidth, size_t vwidth, xh_hashf hashf, xh_equalf equal
   x->tail = NULL;
   x->data = data;
 
-  xh_bucket_realloc(x, XHASH_INIT_SIZE);
+  xh_bucket_alloc(x, XHASH_INIT_SIZE);
 }
 
 PIC_INLINE xh_entry *
@@ -125,8 +130,8 @@ xh_resize_(xhash *x, size_t newsize)
   xh_entry *it;
   size_t idx;
 
-  xh_init_(&y, x->kwidth, x->vwidth, x->hashf, x->equalf, x->data);
+  xh_init_(&y, x->allocf, x->kwidth, x->vwidth, x->hashf, x->equalf, x->data);
-  xh_bucket_realloc(&y, newsize);
+  xh_bucket_alloc(&y, newsize);
 
   for (it = xh_begin(x); it != NULL; it = xh_next(it)) {
     idx = ((unsigned)it->hash) % y.size;
@@ -139,7 +144,7 @@ xh_resize_(xhash *x, size_t newsize)
   y.head = x->head;
   y.tail = x->tail;
 
-  free(x->buckets);
+  x->allocf(x->buckets, 0);
 
   /* copy all members from y to x */
   memcpy(x, &y, sizeof(xhash));
@@ -157,13 +162,13 @@ xh_put_(xhash *x, const void *key, void *val)
     return e;
   }
 
-  if (x->count + 1 > x->size * XHASH_RESIZE_RATIO) {
+  if (x->count + 1 > XHASH_RESIZE_RATIO(x->size)) {
     xh_resize_(x, x->size * 2 + 1);
   }
 
   hash = x->hashf(key, x->data);
   idx = ((unsigned)hash) % x->size;
-  e = malloc(x->voffset + x->vwidth);
+  e = x->allocf(NULL, x->voffset + x->vwidth);
   e->next = x->buckets[idx];
   e->hash = hash;
   e->key = ((char *)e) + x->koffset;
@@ -208,7 +213,7 @@ xh_del_(xhash *x, const void *key)
       q->bw->fw = q->fw;
     }
     r = q->next;
-    free(q);
+    x->allocf(q, 0);
     x->buckets[idx] = r;
   }
   else {
@@ -228,7 +233,7 @@ xh_del_(xhash *x, const void *key)
       q->bw->fw = q->fw;
     }
     r = q->next;
-    free(q);
+    x->allocf(q, 0);
     p->next = r;
   }
 
@@ -251,7 +256,7 @@ xh_clear(xhash *x)
     e = x->buckets[i];
     while (e) {
       d = e->next;
-      free(e);
+      x->allocf(e, 0);
       e = d;
     }
     x->buckets[i] = NULL;
@@ -265,7 +270,7 @@ PIC_INLINE void
 xh_destroy(xhash *x)
 {
   xh_clear(x);
-  free(x->buckets);
+  x->allocf(x->buckets, 0);
 }
 
 /* string map */
@@ -287,16 +292,15 @@ xh_str_hash(const void *key, void *data)
 PIC_INLINE int
 xh_str_equal(const void *key1, const void *key2, void *data)
 {
+  const char *s1 = *(const char **)key1, *s2 = *(const char **)key2;
+
   (void)data;
 
-  return strcmp(*(const char **)key1, *(const char **)key2) == 0;
+  return strcmp(s1, s2) == 0;
 }
 
-PIC_INLINE void
+#define xh_init_str(x, width)                                           \
-xh_init_str(xhash *x, size_t width)
+  xh_init_(x, XHASH_ALLOCATOR, sizeof(const char *), width, xh_str_hash, xh_str_equal, NULL);
-{
-  xh_init_(x, sizeof(const char *), width, xh_str_hash, xh_str_equal, NULL);
-}
 
 PIC_INLINE xh_entry *
 xh_get_str(xhash *x, const char *key)
@@ -334,11 +338,8 @@ xh_ptr_equal(const void *key1, const void *key2, void *data)
   return *(const void **)key1 == *(const void **)key2;
 }
 
-PIC_INLINE void
+#define xh_init_ptr(x, width)                   \
-xh_init_ptr(xhash *x, size_t width)
+  xh_init_(x, XHASH_ALLOCATOR, sizeof(const void *), width, xh_ptr_hash, xh_ptr_equal, NULL);
-{
-  xh_init_(x, sizeof(const void *), width, xh_ptr_hash, xh_ptr_equal, NULL);
-}
 
 PIC_INLINE xh_entry *
 xh_get_ptr(xhash *x, const void *key)
@@ -376,11 +377,8 @@ xh_int_equal(const void *key1, const void *key2, void *data)
   return *(int *)key1 == *(int *)key2;
 }
 
-PIC_INLINE void
+#define xh_init_int(x, width)                   \
-xh_init_int(xhash *x, size_t width)
+  xh_init_(x, XHASH_ALLOCATOR, sizeof(int), width, xh_int_hash, xh_int_equal, NULL);
-{
-  xh_init_(x, sizeof(int), width, xh_int_hash, xh_int_equal, NULL);
-}
 
 PIC_INLINE xh_entry *
 xh_get_int(xhash *x, int key)

extlib/benz/port.c

@@ -101,13 +101,13 @@ strfile_seek(void *cookie, long pos, int whence)
   struct strfile *m = cookie;
 
   switch (whence) {
-  case XF_SEEK_SET:
+  case SEEK_SET:
     m->pos = pos;
     break;
-  case XF_SEEK_CUR:
+  case SEEK_CUR:
     m->pos += pos;
     break;
-  case XF_SEEK_END:
+  case SEEK_END:
     m->pos = m->end + pos;
     break;
   }

extlib/benz/state.c

@@ -146,7 +146,7 @@ pic_init_core(pic_state *pic)
 }
 
 pic_state *
-pic_open(int argc, char *argv[], char **envp)
+pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
 {
   struct pic_port *pic_make_standard_port(pic_state *, xFILE *, short);
   char t;
@@ -154,12 +154,15 @@ pic_open(int argc, char *argv[], char **envp)
   pic_state *pic;
   size_t ai;
 
-  pic = malloc(sizeof(pic_state));
+  pic = allocf(NULL, sizeof(pic_state));
 
   if (! pic) {
     goto EXIT_PIC;
   }
 
+  /* allocator */
+  pic->allocf = allocf;
+
   /* turn off GC */
   pic->gc_enable = false;
 
@@ -172,7 +175,7 @@ pic_open(int argc, char *argv[], char **envp)
   pic->envp = envp;
 
   /* prepare VM stack */
-  pic->stbase = pic->sp = calloc(PIC_STACK_SIZE, sizeof(pic_value));
+  pic->stbase = pic->sp = allocf(NULL, PIC_STACK_SIZE * sizeof(pic_value));
   pic->stend = pic->stbase + PIC_STACK_SIZE;
 
   if (! pic->sp) {
@@ -180,7 +183,7 @@ pic_open(int argc, char *argv[], char **envp)
   }
 
   /* callinfo */
-  pic->cibase = pic->ci = calloc(PIC_STACK_SIZE, sizeof(pic_callinfo));
+  pic->cibase = pic->ci = allocf(NULL, PIC_STACK_SIZE * sizeof(pic_callinfo));
   pic->ciend = pic->cibase + PIC_STACK_SIZE;
 
   if (! pic->ci) {
@@ -188,7 +191,7 @@ pic_open(int argc, char *argv[], char **envp)
   }
 
   /* exception handler */
-  pic->xpbase = pic->xp = calloc(PIC_RESCUE_SIZE, sizeof(struct pic_proc *));
+  pic->xpbase = pic->xp = allocf(NULL, PIC_RESCUE_SIZE * sizeof(struct pic_proc *));
   pic->xpend = pic->xpbase + PIC_RESCUE_SIZE;
 
   if (! pic->xp) {
@@ -196,7 +199,7 @@ pic_open(int argc, char *argv[], char **envp)
   }
 
   /* GC arena */
-  pic->arena = calloc(PIC_ARENA_SIZE, sizeof(struct pic_object **));
+  pic->arena = allocf(NULL, PIC_ARENA_SIZE * sizeof(struct pic_object *));
   pic->arena_size = PIC_ARENA_SIZE;
   pic->arena_idx = 0;
 
@@ -346,13 +349,13 @@ pic_open(int argc, char *argv[], char **envp)
   return pic;
 
  EXIT_ARENA:
-  free(pic->xp);
+  allocf(pic->xp, 0);
  EXIT_XP:
-  free(pic->ci);
+  allocf(pic->ci, 0);
  EXIT_CI:
-  free(pic->sp);
+  allocf(pic->sp, 0);
  EXIT_SP:
-  free(pic);
+  allocf(pic, 0);
  EXIT_PIC:
   return NULL;
 }
@@ -361,6 +364,7 @@ void
 pic_close(pic_state *pic)
 {
   xh_entry *it;
+  pic_allocf allocf = pic->allocf;
 
   /* invoke exit handlers */
   while (pic->wind) {
@@ -372,7 +376,7 @@ pic_close(pic_state *pic)
 
   /* free symbol names */
   for (it = xh_begin(&pic->syms); it != NULL; it = xh_next(it)) {
-    free(xh_key(it, char *));
+    allocf(xh_key(it, char *), 0);
   }
 
   /* clear out root objects */
@@ -398,16 +402,16 @@ pic_close(pic_state *pic)
   pic_reader_close(pic, pic->reader);
 
   /* free runtime context */
-  free(pic->stbase);
+  allocf(pic->stbase, 0);
-  free(pic->cibase);
+  allocf(pic->cibase, 0);
-  free(pic->xpbase);
+  allocf(pic->xpbase, 0);
 
   /* free global stacks */
   xh_destroy(&pic->syms);
   xh_destroy(&pic->attrs);
 
   /* free GC arena */
-  free(pic->arena);
+  allocf(pic->arena, 0);
 
-  free(pic);
+  allocf(pic, 0);
 }

src/main.c

@@ -55,7 +55,7 @@ main(int argc, char *argv[], char **envp)
   struct pic_lib *PICRIN_MAIN;
   int status = 0;
 
-  pic = pic_open(argc, argv, envp);
+  pic = pic_open(argc, argv, envp, pic_default_allocf);
 
   pic_init_picrin(pic);