/***********************************************************************/
/*                                                                     */
/*                           Objective Caml                            */
/*                                                                     */
/*           Xavier Leroy, projet Cristal, INRIA Rocquencourt          */
/*                                                                     */
/*  Copyright 2001 Institut National de Recherche en Informatique et   */
/*  en Automatique.  All rights reserved.  This file is distributed    */
/*  under the terms of the GNU Library General Public License, with    */
/*  the special exception on linking described in file ../LICENSE.     */
/*                                                                     */
/***********************************************************************/

/***---------------------------------------------------------------------
  Modified and adapted for the Lazy Virtual Machine by Daan Leijen.
  Modifications copyright 2001, Daan Leijen. This (modified) file is
  distributed under the terms of the GNU Library General Public License.
---------------------------------------------------------------------***/

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

/* Registration of global memory roots */

#include "memory.h"
#include "misc.h"
#include "mlvalues.h"
#include "globroots.h"

/* The set of global memory roots is represented as a skip list
   (see William Pugh, "Skip lists: a probabilistic alternative to
   balanced binary trees", Comm. ACM 33(6), 1990). */

/* Generate a random level for a new node: 0 with probability 3/4,
   1 with probability 3/16, 2 with probability 3/64, etc.
   We use a simple linear congruential PRNG (see Knuth vol 2) instead
   of random(), because we need exactly 32 bits of pseudo-random data
   (i.e. 2 * (MAX_LEVEL + 1)).  Moreover, the congruential PRNG
   is faster and guaranteed to be deterministic (to reproduce bugs). */

static uint32 random_seed = 0;

static int random_level(void)
{
  uint32 r;
  int level = 0;

  /* Linear congruence with modulus = 2^32, multiplier = 69069
     (Knuth vol 2 p. 106, line 15 of table 1), additive = 25173. */
  r = random_seed = random_seed * 69069 + 25173;
  /* Knuth (vol 2 p. 13) shows that the least significant bits are
     "less random" than the most significant bits with a modulus of 2^m,
     so consume most significant bits first */
  while ((r & 0xC0000000U) == 0xC0000000U) { level++; r = r << 2; }
  Assert(level <= MAX_LEVEL);
  return level;
}

/* The initial global root list */

struct global_root_list caml_global_roots = { NULL, { NULL, }, 0 };

/* Register a global C root */

void register_global_root(value *r)
{
  struct global_root * update[MAX_LEVEL];
  struct global_root * e, * f;
  int i, new_level;

  Assert (((long) r & 3) == 0);  /* compact.c demands this (for now) */

  /* Init "cursor" to list head */
  e = (struct global_root *) &caml_global_roots;
  /* Find place to insert new node */
  for (i = caml_global_roots.level; i >= 0; i--) {
    while (1) {
      f = e->forward[i];
      if (f == NULL || f->root >= r) break;
      e = f;
    }
    update[i] = e;
  }
  e = e->forward[0];
  /* If already present, don't do anything */
  if (e != NULL && e->root == r) return;
  /* Insert additional element, updating list level if necessary */
  new_level = random_level();
  if (new_level > caml_global_roots.level) {
    for (i = caml_global_roots.level + 1; i <= new_level; i++)
      update[i] = (struct global_root *) &caml_global_roots;
    caml_global_roots.level = new_level;
  }
  e = stat_alloc(sizeof(struct global_root) +
                 new_level * sizeof(struct global_root *));
  e->root = r;
  for (i = 0; i <= new_level; i++) {
    e->forward[i] = update[i]->forward[i];
    update[i]->forward[i] = e;
  }
}

/* Un-register a global C root */

void remove_global_root(value *r)
{
  struct global_root * update[MAX_LEVEL];
  struct global_root * e, * f;
  int i;

  /* Init "cursor" to list head */
  e = (struct global_root *) &caml_global_roots;
  /* Find element in list */
  for (i = caml_global_roots.level; i >= 0; i--) {
    while (1) {
      f = e->forward[i];
      if (f == NULL || f->root >= r) break;
      e = f;
    }
    update[i] = e;
  }
  e = e->forward[0];
  /* If not found, nothing to do */
  if (e == NULL || e->root != r) return;
  /* Rebuild list without node */
  for (i = 0; i <= caml_global_roots.level; i++) {
    if (update[i]->forward[i] == e)
      update[i]->forward[i] = e->forward[i];
  }
  /* Reclaim list element */
  stat_free(e);
  /* Down-correct list level */
  while (caml_global_roots.level > 0 &&
         caml_global_roots.forward[caml_global_roots.level] == NULL)
    caml_global_roots.level--;
}