#include "idst.h"

#if (VTBL_CACHE)
# include "array.h"
#endif

#include <stdlib.h>
#include <string.h>
#include <setjmp.h>
#include <gc.h>

#define DEBUG		0

#define METHOD_CACHE_PROBES 1

oop _nlAnswer= 0;

int    _argc= 0;
char **_argv= 0;

#if (STATISTICS)
unsigned long allocationCount= 0;
unsigned long allocationBytes= 0;
unsigned long messageSends= 0;
unsigned long cacheMisses= 0;
#endif

#define _do_selectors()					\
  _do(s__beNilType,		"_beNilType")		\
  _do(s__beTaggedType,		"_beTaggedType")	\
  _do(s__delegated,		"_delegated")		\
  _do(s__debugName,		"_debugName")		\
  _do(s__intern_,		"_intern:")		\
  _do(s__methodAt_put_,		"_methodAt:put:")	\
  _do(s__vtbl,			"_vtbl")		\
  _do(s__vtbl_,			"_vtbl:")		\
  _do(s_allocate_,		"allocate:")		\
  _do(s_at_put_,		"at:put:")		\
  _do(s_cannotReturn_,		"cannotReturn:")	\
  _do(s_delegate,		"delegate")		\
  _do(s_delegated,		"delegated")		\
  _do(s_flushCache,		"flushCache")		\
  _do(s_lookup_,		"lookup:")

#define _do(mangled, name)	static sel_t mangled= 0;
_do_selectors();
#undef _do

static vtbl_t vtbl_object	= 0;
static vtbl_t vtbl_sel		= 0;
static vtbl_t vtbl_assoc	= 0;
static vtbl_t vtbl_vtbl		= 0;

vtbl_t vtbl_Tagged	= 0;
vtbl_t vtbl_Nil		= 0;

oop v__object	= 0;
oop v__sel	= 0;
oop v__assoc	= 0;
oop v__vtbl	= 0;

/* ---------------------------------------------------------------- _SYSTEM */

#if 0

static void *xmalloc(int size)
{
#if (STATISTICS)
  ++allocationCount;
#endif
  return GC_MALLOC(size);
}

static void *xcalloc(int count, int size)
{
#if (STATISTICS)
  ++allocationCount;
#endif
  return GC_MALLOC(count * size);
}

static void *xrealloc(void *ptr, int size)
{
  return GC_REALLOC(ptr, size);
}

#if (VTBL_CACHE)
static void xfree(void *ptr)
{
  GC_free(ptr);
}
#endif

#endif

static oop alloc(vtbl_t vtbl, int size)
{
  vtbl_t *ptr= (vtbl_t *)_newPointers(sizeof(vtbl_t) + size);
  *ptr= vtbl;
  return (oop)(ptr + 1);
}

static char *xstrdup(char *string)
{
  int size= strlen(string) + 1;
  void *ptr= _newBytes(size);
  memcpy(ptr, string, size);
  return (char *)ptr;
}

/* ---------------------------------------------------------------- _OBJECT */

static oop object__debugName(oop self) { return (oop)"_object"; }

static vtbl_t object__vtbl(oop object)
{
#if (DEBUG)
  printf("object__vtbl(%p)\n", object);
#endif
#if (TAGGED_INTEGERS)
  if ((int)object & 1) return vtbl_Tagged;
#endif
  return object ? ((vtbl_t *)object)[-1] : vtbl_Nil;
}

static vtbl_t object__vtbl_(oop object, vtbl_t vtbl)
{
#if (DEBUG)
  printf("object__vtbl_(%p, %p)\n", object, vtbl);
#endif
#if (TAGGED_INTEGERS)
  if ((int)object & 1) return vtbl_Tagged= vtbl;
#endif
  if (!object) return vtbl_Nil= vtbl;
  return ((vtbl_t *)object)[-1]= vtbl;
}

static imp_t object__methodAt_put_(oop object, sel_t sel, imp_t imp)
{
  oop vt= _bind(object, s__vtbl)(object);
#if (DEBUG)
  printf("object__methodAt_put_(%p, %p, %p) -> vt_at_put_(%p, ...)\n", object, sel, imp, vt);
#endif
  return (imp_t)_bind(vt, s_at_put_)(vt, sel, imp);
}

static oop object__delegated(oop self)
{
  oop vt= _bind(self, s__vtbl)(self);
  vt=     _bind(vt, s_delegated)(vt);
  return  _bind(vt, s_allocate_)(vt, 0);
}

oop object__beTaggedType(oop object)
{
  vtbl_Tagged= object__vtbl(object);
  return (oop)1;
}

oop object__beNilType(oop object)
{
  vtbl_Nil= object__vtbl(object);
  return object;
}

/* ---------------------------------------------------------------- _ASSOC */

static oop assoc__debugName(oop self) { return (oop)"_assoc"; }

static assoc_t assoc_key_value_(sel_t key, imp_t value)
{
  assoc_t assoc= (assoc_t)alloc(vtbl_assoc, sizeof(struct assoc));
  assoc->key= key;
  assoc->value= value;
  return assoc;
}

/* ---------------------------------------------------------------- _VTBL */

#if (VTBL_CACHE)
vtbl_t vtables= 0;
#endif

static oop vtbl__debugName(oop self) { return (oop)"_vtbl"; }

static vtbl_t vtbl_new(vtbl_t delegate)
{
  vtbl_t vtbl= (vtbl_t)alloc(vtbl_vtbl, sizeof(struct vtbl));
  vtbl->size=     _integerObject(0);
  vtbl->capacity= _integerObject(2);
  vtbl->bindings= (assoc_t *)_newPointers(sizeof(assoc_t) * _integerValue(vtbl->capacity));
  vtbl->delegate= delegate;
#if (VTBL_CACHE)
  vtbl->cache=    array_new(0);
  vtbl->next=     vtables;
#endif
  return vtbl;
}

static vtbl_t vtbl_delegate(vtbl_t self)
{
  return self->delegate;
}

static imp_t vtbl_at_put_(vtbl_t vtbl, sel_t sel, imp_t imp)
{
  int i, size= _integerValue(vtbl->size);
#if (DEBUG)
  printf("_vtbl_at_put_(%p, %p, %p)\n", vtbl, sel, imp);
#endif
  for (i= 0;  i < size;  ++i)
    if (sel == vtbl->bindings[i]->key)
      return vtbl->bindings[i]->value= imp;
  {
    int capacity= _integerValue(vtbl->capacity);
    if (size == capacity)
      {
	capacity *= 2;
	vtbl->capacity= _integerObject(capacity);
	vtbl->bindings= (assoc_t *)_realloc(vtbl->bindings, sizeof(assoc_t) * capacity);
      }
  }
  {
    assoc_t assoc= assoc_key_value_(sel, imp);
    vtbl->bindings[size++]= assoc;
    vtbl->size= _integerObject(size);
  }
  return imp;
}

static oop vtbl_allocate_(vtbl_t self, int size)
{
  vtbl_t *chunk= _newPointers(sizeof(vtbl_t) + size);
  *chunk++= self;
  return (oop)chunk;
}

static imp_t vtbl_lookup_(vtbl_t self, sel_t sel)
{
  while (self)
    {
      assoc_t *alist= self->bindings;
      int i, j= _integerValue(self->size);
      for (i= 0;  i < j;  ++i, ++alist)
	if (sel == (*alist)->key)
	  return (*alist)->value;
      self= self->delegate;
    }
  return 0;
}

/* ---------------------------------------------------------------- _SEL */

sel_t _sel_List= 0;

static oop sel__debugName(oop self) { return (oop)"_sel"; }

#if 0
static unsigned stringHash(char *string)
{
  unsigned hash= 0;
  while (*string)
    hash= hash * 31 + *string++;
  return hash;
}
#endif

static sel_t sel__intern_(sel_t self, char *name)
{
  sel_t sel;
  int intSize= strlen(name);
  oop oopSize= _integerObject(intSize);
  for (sel= _sel_List;  sel;  sel= sel->next)
    if ((sel->size == oopSize) && !memcmp(name, sel->name, intSize))
      return sel;

  sel= (sel_t)alloc(vtbl_sel, sizeof(struct sel));
  sel->size=  oopSize;
  sel->name=  xstrdup(name);
  sel->next=  _sel_List;
#if (VTBL_CACHE)
  sel->index= (_sel_List ? _sel_List->index : 0) + 1;
#endif

#if (DEBUG)
  printf("sel %p = %s\n", sel, name);
#endif
  return _sel_List= sel;
}

/* ---------------------------------------------------------------- */

#if 0

static oop _imp_ignore(oop self, ...)
{
  fprintf(stderr, "send to nil\n");
  return self;
}

#endif

static oop _imp_unknown(oop self, ...)
{
  return (oop)"(unknown)";
}

static imp_t methodLookupMethod= (imp_t)vtbl_lookup_;

#if (METHOD_CACHE)

enum { CacheSize= 1 << 10 };

//#define CacheHash(V, S)	(((unsigned)(V)) ^ ((S)->hash))

#define CacheHash(V, S)		(((unsigned)(V)) ^ (((unsigned)(S)) >> 4))
#define CacheMask(N)		((N) & (CacheSize - 1))

struct cache
{
  sel_t  selector;
  vtbl_t vtbl;
  imp_t  method;
} cache[CacheSize];

void flushCache(void)
{
  memset(cache, 0, sizeof(cache));
  if (!(methodLookupMethod= vtbl_lookup_(vtbl_vtbl, s_lookup_)))
    methodLookupMethod= (imp_t)vtbl_lookup_;
}

#endif

imp_t _rebind(oop receiver, sel_t sel)
{
#if 0
  if (!receiver) return imp_ignore;
#endif

#if (TAGGED_INTEGERS)
  register vtbl_t vtbl= ((int)receiver & 1) ? vtbl_Tagged : (receiver ? receiver->_vtbl[-1] : vtbl_Nil);
#else
  register vtbl_t vtbl=                                     (receiver ? receiver->_vtbl[-1] : vtbl_Nil);
#endif

#if (STATISTICS)
  ++messageSends;
#endif

#if (VTBL_CACHE)
  {
    imp_t method= array_at_(vtbl->cache, sel->index);
    if (method) return method;
  }
#endif

#if (METHOD_CACHE)
  {
    register unsigned const hash= CacheHash(vtbl, sel);
    register struct cache *line;
    line= cache + CacheMask(hash);
    if ((line->selector == sel) && (line->vtbl == vtbl)) return line->method;
#  if (METHOD_CACHE_PROBES >= 2)
    line= cache + CacheMask(hash >> 1);
    if (line->selector == sel && line->vtbl == vtbl) return line->method;
#  endif
#  if (METHOD_CACHE_PROBES >= 3)
    line= cache + CacheMask(hash >> 2);
    if (line->selector == sel && line->vtbl == vtbl) return line->method;
#  endif
#  if (NOSTATISTICS)
    if (line->selector)
      printf("cache eject: %s\n", line->selector->name);
#  endif
  }
#endif

#if (STATISTICS)
  ++cacheMisses;
#endif

  {
    static int recursionGuard= 0;
    imp_t method= recursionGuard++ ? vtbl_lookup_(vtbl, sel) : (imp_t)(methodLookupMethod((oop)vtbl, sel));
    --recursionGuard;
    if (method)
      {
#    if (METHOD_CACHE)
	register unsigned const hash= CacheHash(vtbl, sel);
	register struct cache *line= cache + CacheMask(hash);
#      if (METHOD_CACHE_PROBES >= 3)
	cache[CacheMask(hash >> 2)]= cache[CacheMask(hash >> 1)];
#      endif
#      if (METHOD_CACHE_PROBES >= 2)
	cache[CacheMask(hash >> 1)]= cache[CacheMask(hash)];
#      endif
	line->selector= sel;
	line->vtbl=     vtbl;
	line->method=   method;
#    endif
#    if (VTBL_CACHE)
	array_at_put_(vtbl->cache, sel->index, method);
#    endif
	return method;
      }
  }

  if (sel == s__debugName)
    {
      fprintf(stderr, "'%s' not understood\n", sel->name);
      return _imp_unknown;
    }
  else
    {
      char *name= (char *)_bind(receiver, s__debugName)(receiver);
      fprintf(stderr, "'%s' does not understand '%s'\n", name, sel->name);
      abort();
    }
  return 0;
}


#if (STATISTICS)
static void _idst_exit(void)
{
  size_t heapSize= GC_get_heap_size();
  unsigned long cacheHits= messageSends - cacheMisses;

  printf("\n");
  printf("%ld bytes allocated in %ld objects, %.1f bytes/object\n", (long)allocationBytes, (long)allocationCount, (double)allocationBytes / (double)allocationCount);
  printf("%ld bytes in heap, gc factor %.2f\n", (long)heapSize, (double)allocationBytes / (double)heapSize);
  printf("%ld message sends, %ld lookups, %2.1f%% cache hit rate\n", (long)messageSends, (long)cacheMisses, (double)cacheHits / (double)messageSends * 100.0);
  printf("\n");
}
#endif


void _idst_initialise(int argc, char **argv)
{
  GC_INIT();

#if (METHOD_CACHE)
  flushCache();
#endif

  _argc= argc;
  _argv= argv;

  vtbl_vtbl	= vtbl_new(0);
  vtbl_object	= vtbl_new(0);
  vtbl_sel	= vtbl_new(vtbl_object);
  vtbl_assoc	= vtbl_new(vtbl_object);

  vtbl_vtbl->_vtbl[-1]= vtbl_vtbl;	/* vtbl is its own vtbl */
  vtbl_vtbl->delegate= vtbl_object;	/* vtbl delegates to object */

  (void)object__vtbl_;

#if (DEBUG)
  printf("vtbl_object %p[%p] -> %p[%p]\n", vtbl_object, vtbl_object->_vtbl[-1], vtbl_object->delegate, (void *)0);
  printf("vtbl_sel    %p[%p] -> %p[%p]\n", vtbl_sel   , vtbl_sel   ->_vtbl[-1], vtbl_sel   ->delegate, vtbl_sel   ->delegate->_vtbl[-1]);
  printf("vtbl_assoc  %p[%p] -> %p[%p]\n", vtbl_assoc , vtbl_assoc ->_vtbl[-1], vtbl_assoc ->delegate, vtbl_assoc ->delegate->_vtbl[-1]);
  printf("vtbl_vtbl   %p[%p] -> %p[%p]\n", vtbl_vtbl  , vtbl_vtbl  ->_vtbl[-1], vtbl_vtbl  ->delegate, vtbl_vtbl  ->delegate->_vtbl[-1]);
#endif

# define _do(mangled, name) mangled= sel__intern_(0, name);
  _do_selectors();
# undef _do

  vtbl_at_put_(vtbl_vtbl,   s_at_put_,	      (imp_t)vtbl_at_put_);
  vtbl_at_put_(vtbl_vtbl,   s_allocate_,      (imp_t)vtbl_allocate_);
  vtbl_at_put_(vtbl_object, s__vtbl,	      (imp_t)object__vtbl);
  vtbl_at_put_(vtbl_object, s__methodAt_put_, (imp_t)object__methodAt_put_);

  v__object	= vtbl_allocate_(vtbl_object, sizeof(struct object));
  v__sel	= vtbl_allocate_(vtbl_sel,    sizeof(struct sel));
  v__assoc	= vtbl_allocate_(vtbl_assoc,  sizeof(struct assoc));
  v__vtbl	= vtbl_allocate_(vtbl_vtbl,   sizeof(struct vtbl));

  _method(v__object, s__debugName,    (imp_t)object__debugName);
  _method(v__sel,    s__debugName,    (imp_t)sel__debugName);
  _method(v__assoc,  s__debugName,    (imp_t)assoc__debugName);
  _method(v__vtbl,   s__debugName,    (imp_t)vtbl__debugName);

  _method(v__sel,    s__intern_,      (imp_t)sel__intern_);
  _method(v__object, s__delegated,    (imp_t)object__delegated);
  _method(v__vtbl,   s_delegated,     (imp_t)vtbl_new);

  _method(v__object, s__vtbl_,        (imp_t)object__vtbl_);
  _method(v__vtbl,   s_delegate,      (imp_t)vtbl_delegate);
  _method(v__vtbl,   s_flushCache,    (imp_t)flushCache);

  _method(v__object, s__beTaggedType, (imp_t)object__beTaggedType);
  _method(v__object, s__beNilType,    (imp_t)object__beNilType);

#if (STATISTICS)
  atexit(_idst_exit);
#endif
}

/* ---------------------------------------------------------------- */

oop _proto(oop parent)
{
  parent= parent ? parent : v__object;
  return _bind(parent, s__delegated)(parent);
}

sel_t _selector(char *name)
{
  return (sel_t)_bind(v__sel, s__intern_)(v__sel, name);
}

void  _method(oop proto, sel_t sel, imp_t imp)
{
  _bind(proto, s__methodAt_put_)(proto, sel, imp);
}

oop _nlReturn(oop blockClosure, void *voidp, oop anObject)
{
  _nlAnswer= anObject;
  jmp_buf *envp= (jmp_buf *)voidp;
  if (envp) longjmp(*envp, 1);
  return _bind(blockClosure, s_cannotReturn_)(blockClosure, anObject);
}

#if (VTBL_CACHE)
# include "array.c"
#endif