/*
 *  Ikarus Scheme -- A compiler for R6RS Scheme.
 *  Copyright (C) 2006,2007,2008  Abdulaziz Ghuloum
 *  
 *  This program is free software: you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License version 3 as
 *  published by the Free Software Foundation.
 *  
 *  This program is distributed in the hope that it will be useful, but
 *  WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  General Public License for more details.
 *  
 *  You should have received a copy of the GNU General Public License
 *  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 */



#include "ikarus-data.h"
#include <strings.h>
#include <string.h>
#include <stdlib.h>

static ikptr
make_symbol_table(ikpcb* pcb){
  #define NUM_OF_BUCKETS 4096 /* power of 2 */
  int size = align_to_next_page(disp_vector_data + NUM_OF_BUCKETS * wordsize);
  ikptr st = ik_mmap_ptr(size, 0, pcb) + vector_tag;
  bzero((char*)(long)st-vector_tag, size);
  ref(st, off_vector_length) = fix(NUM_OF_BUCKETS);
  return st;
}


/* one-at-a-time from http://burtleburtle.net/bob/hash/doobs.html */
static long int 
compute_hash(ikptr str){
  long int len = unfix(ref(str, off_string_length));
  int* data = (int*)(str + off_string_data);
  int h = len;
  int* last = data + len;

  /* one-at-a-time */
  while(data < last){
    int c = (*data >> 8);
    h = h + c;
    h = h + (h << 10);
    h = h ^ (h >> 6);
    data++;
  }
  h = h + (h << 3);
  h = h ^ (h >> 11);
  h = h + (h << 15);
  return h;
}

ikptr 
ikrt_string_hash(ikptr str){
  return (ikptr)(compute_hash(str) & (~ fx_mask));
}

static int strings_eqp(ikptr str1, ikptr str2){
  ikptr len = ref(str1, off_string_length);
  if(len == ref(str2, off_string_length)){
    return
      (memcmp((char*)(long)str1+off_string_data, 
              (char*)(long)str2+off_string_data, 
              unfix(len) * string_char_size)
       == 0);
  }
  return 0;
}

static ikptr 
ik_make_symbol(ikptr str, ikptr ustr, ikpcb* pcb){
  ikptr sym = ik_unsafe_alloc(pcb, symbol_record_size) + record_tag;
  ref(sym, -record_tag) = symbol_record_tag;
  ref(sym, off_symbol_record_string)  = str;
  ref(sym, off_symbol_record_ustring) = ustr;
  ref(sym, off_symbol_record_value)   = unbound_object;
  ref(sym, off_symbol_record_proc)    = str;
  ref(sym, off_symbol_record_plist)   = null_object;
  return sym;
}

static ikptr
intern_string(ikptr str, ikptr st, ikpcb* pcb){
  int h = compute_hash(str);
  int idx = h & (unfix(ref(st, off_vector_length)) - 1);
  ikptr bckt = ref(st, off_vector_data + idx*wordsize);
  ikptr b = bckt;
  while(b){
    ikptr sym = ref(b, off_car);
    ikptr sym_str = ref(sym, off_symbol_record_string);
    if(strings_eqp(sym_str, str)){
      return sym;
    }
    b = ref(b, off_cdr);
  }
  ikptr sym = ik_make_symbol(str, false_object,  pcb);
  b = ik_unsafe_alloc(pcb, pair_size) + pair_tag;
  ref(b, off_car) = sym;
  ref(b, off_cdr) = bckt;
  ref(st, off_vector_data + idx*wordsize) = b;
  ((int*)(long)pcb->dirty_vector)[page_index(st+off_vector_data+idx*wordsize)] = -1;
  return sym;
}

static ikptr
intern_unique_string(ikptr str, ikptr ustr, ikptr st, ikpcb* pcb){
  int h = compute_hash(ustr);
  int idx = h & (unfix(ref(st, off_vector_length)) - 1);
  ikptr bckt = ref(st, off_vector_data + idx*wordsize);
  ikptr b = bckt;
  while(b){
    ikptr sym = ref(b, off_car);
    ikptr sym_ustr = ref(sym, off_symbol_record_ustring);
    if(strings_eqp(sym_ustr, ustr)){
      return sym;
    }
    b = ref(b, off_cdr);
  }
  ikptr sym = ik_make_symbol(str, ustr, pcb);
  b = ik_unsafe_alloc(pcb, pair_size) + pair_tag;
  ref(b, off_car) = sym;
  ref(b, off_cdr) = bckt;
  ref(st, off_vector_data + idx*wordsize) = b;
  ((int*)(long)pcb->dirty_vector)[page_index(st+off_vector_data+idx*wordsize)] = -1;
  return sym;
}

ikptr
ikrt_intern_gensym(ikptr sym, ikpcb* pcb){
  ikptr st = pcb->gensym_table;
  if(st == 0){
    st = make_symbol_table(pcb);
    pcb->gensym_table = st;
  }
  ikptr ustr = ref(sym, off_symbol_record_ustring);
  int h = compute_hash(ustr);
  int idx = h & (unfix(ref(st, off_vector_length)) - 1);
  ikptr bckt = ref(st, off_vector_data + idx*wordsize);
  ikptr b = bckt;
  while(b){
    ikptr sym = ref(b, off_car);
    ikptr sym_ustr = ref(sym, off_symbol_record_ustring);
    if(strings_eqp(sym_ustr, ustr)){
      return false_object;
    }
    b = ref(b, off_cdr);
  }
  b = ik_unsafe_alloc(pcb, pair_size) + pair_tag;
  ref(b, off_car) = sym;
  ref(b, off_cdr) = bckt;
  ref(st, off_vector_data + idx*wordsize) = b;
  ((int*)(long)pcb->dirty_vector)[page_index(st+off_vector_data+idx*wordsize)] = -1;
  return true_object;
}


ikptr
ikrt_unintern_gensym(ikptr sym, ikpcb* pcb){
  ikptr st = pcb->gensym_table;
  if(st == 0){
    /* no symbol table */
    return false_object;
  }
  ikptr ustr = ref(sym, off_symbol_record_ustring);
  if (tagof(ustr) != string_tag) {
    return false_object;
  }
  int h = compute_hash(ustr);
  int idx = h & (unfix(ref(st, off_vector_length)) - 1);
  ikptr loc = (ikptr)(st+off_vector_data+idx*wordsize);
  ikptr bckt = ref(loc, 0);
  while(bckt){
    if (ref(bckt, off_car) == sym) {
      /* found it */
      ref(sym, off_symbol_record_ustring) = true_object;
      ref(loc, 0) = ref(bckt, off_cdr);
      return true_object;
    } else {
      loc = (ikptr)(bckt + off_cdr);
      bckt = ref(loc, 0);
    }
  }
  return false_object;
}

ikptr
ikrt_get_symbol_table(ikpcb* pcb){
  ikptr st = pcb->symbol_table;
  pcb->symbol_table = false_object;
  if(st == false_object) {
    fprintf(stderr, "bug in ikarus, attempt to access dead symbol table\n");
    exit(-1);
  }
  return st;
}


ikptr 
ikrt_string_to_symbol(ikptr str, ikpcb* pcb){
  ikptr st = pcb->symbol_table;
  if(st == false_object) {
    fprintf(stderr, "bug in ikarus, attempt to access dead symbol table\n");
    exit(-1);
  }
  if(st == 0){
    st = make_symbol_table(pcb);
    pcb->symbol_table = st;
  }
  return intern_string(str, st, pcb);
}

ikptr 
ik_intern_string(ikptr str, ikpcb* pcb){
  return ikrt_string_to_symbol(str, pcb);
}

ikptr 
ikrt_strings_to_gensym(ikptr str, ikptr ustr, ikpcb* pcb){
  ikptr st = pcb->gensym_table;
  if(st == 0){
    st = make_symbol_table(pcb);
    pcb->gensym_table = st;
  }
  return intern_unique_string(str, ustr, st, pcb);
}