/*-----------------------------------------------------------------------
  The Lazy Virtual Machine.

  Daan Leijen.

  Copyright 2001, Daan Leijen. All rights reserved. This file is
  distributed under the terms of the GNU Library General Public License.
-----------------------------------------------------------------------*/

/* $Id: fixed.c 177 2002-11-15 16:21:56Z cvs-3 $ */

/*---------------------------------------------------------------------
  Fixed memory blocks:
  tracked by gc but never moved.

  TODO: fixed blocks are allocated in the C heap [stat_alloc] pointed
  to by a Custom block. We track their contents without modifying
  the gc by using all contents of fixed blocks as roots. Unfortunately,
  this means that fixed blocks need at least two gc's before they (and
  their children!) are deallocated. This should be fixed someday.
----------------------------------------------------------------------*/
#include "mlvalues.h"
#include "custom.h"
#include "memory.h"
#include "fail.h"
#include "fixed.h"

#define Fixed_block_val(v)  (((struct fixed_block**)Data_custom_val(v))[0])

/* the global list of fixed blocks -- used as roots */
struct fixed_block* fixed_blocks = NULL;

/*----------------------------------------------------------------------
  fixed block custom operations
----------------------------------------------------------------------*/
static void fixed_block_finalize( value v )
{
  struct fixed_block* fixedb, *prev, *next;
  gc_message( 8,"finalise fixed_block\n", 0 );
  fixedb = Fixed_block_val(v);
  if (fixedb == NULL) return;

  /* unlink this block from the fixed_blocks list */
  for( prev = NULL, next = fixed_blocks;
       next != NULL && next != fixedb;
       prev = next, next = next->next ) {}
  if (next == fixedb && next != NULL) {
    if (prev == NULL) fixed_blocks = fixedb->next;
                 else prev->next = fixedb->next;
  }

  /* and free the block */
  stat_free(fixedb);
  return;
}

static int fixed_block_compare(value v1, value v2)
{
  raise_internal( "comparing abstract fixed_block" );
  return 0;
}

static long fixed_block_hash(value v)
{
  return (long)(Fixed_block_val(v));
}

static void fixed_block_serialize(value v, unsigned long * wsize_32,
                            unsigned long * wsize_64)
{
  raise_internal( "serializing fixed_block" );
}

static unsigned long fixed_block_deserialize(void * dst)
{
  raise_internal( "deserializing fixed_block" );
  return 0;
}


struct custom_operations fixed_block_ops = {
  "_fixed_block",
  fixed_block_finalize,
  fixed_block_compare,
  fixed_block_hash,
  fixed_block_serialize,
  fixed_block_deserialize
};

/*----------------------------------------------------------------------
  fixed block allocation
----------------------------------------------------------------------*/
value alloc_fixed( size_t size )
{
  CAMLparam0();
  CAMLlocal1(v);
  v = alloc_custom( &fixed_block_ops, sizeof(struct fixed_block*), 0, 1 );
  if (size == 0) {
    Fixed_block_val(v) = NULL;
  }
  else {
    size_t i;
    struct fixed_block* fixedb = stat_alloc( sizeof(struct fixed_block) + (size-1)*sizeof(value) );
    fixedb->size = size;
    for( i = 0; i < size; i++) { fixedb->data[i] = 0; }
    Fixed_block_val(v) = fixedb;
    fixedb->next = fixed_blocks;
    fixed_blocks = fixedb;
  }

  CAMLreturn(v);
}