/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */

/* boot.c - initializing ecl internal data */

/* -- imports --------------------------------------------------------------- */

#include <ecl/ecl.h>
#include <ecl/ecl-inl.h>
#include <ecl/internal.h>
#include <ecl/external.h>

#ifdef ECL_USE_MPROTECT
# include <sys/mman.h>
# ifndef MAP_FAILED
#  define MAP_FAILED -1
# endif
#endif
#include <limits.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#if defined(ECL_MS_WINDOWS_HOST)
# include <windows.h>
# include <shellapi.h>
# define MAXPATHLEN 512
#endif
#ifndef MAXPATHLEN
# ifdef PATH_MAX
#   define MAXPATHLEN PATH_MAX
# else
#   define MAXPATHLEN sysconf(_PC_PATH_MAX)
#   include <unistd.h>
# endif
#endif

/* -- constants ----------------------------------------------------- */

const cl_object ecl_ct_Jan1st1970UT = ecl_make_fixnum(39052800);

ecl_def_ct_base_string(ecl_ct_null_string,"",0,,const);

ecl_def_ct_single_float(ecl_ct_default_rehash_size,1.5f,,const);
ecl_def_ct_single_float(ecl_ct_default_rehash_threshold,0.75f,,const);

ecl_def_ct_single_float(ecl_ct_singlefloat_zero,0,,const);
ecl_def_ct_double_float(ecl_ct_doublefloat_zero,0,,const);
ecl_def_ct_long_float(ecl_ct_longfloat_zero,0,,const);

ecl_def_ct_single_float(ecl_ct_singlefloat_minus_zero,-0.0,,const);
ecl_def_ct_double_float(ecl_ct_doublefloat_minus_zero,-0.0,,const);
ecl_def_ct_long_float(ecl_ct_longfloat_minus_zero,-0.0l,,const);

ecl_def_ct_ratio(ecl_ct_plus_half,ecl_make_fixnum(1),ecl_make_fixnum(2),,const);
ecl_def_ct_ratio(ecl_ct_minus_half,ecl_make_fixnum(-1),ecl_make_fixnum(2),,const);

/* These two tags have a special meaning for the frame stack. */
ecl_def_constant(ecl_ct_protect_tag, ECL_NIL, "PROTECT-TAG", 11);
ecl_def_constant(ecl_ct_dummy_tag, ECL_NIL, "DUMMY-TAG", 9);

struct ecl_symbol
ecl_symbols[] = {
  /* This variable contains handlers for signals and exceptions. */
  ecl_constexpr_symbol(ecl_stp_special, "*SIGNAL-HANDLERS*", ECL_NIL),
  /* Restart clusters allow us to estabilish selectable correction actions. */
  ecl_constexpr_symbol(ecl_stp_special, "*RESTART-CLUSTERS*", ECL_NIL),
  /* This variable allows for interrupting sygnals from Lisp.. */
  ecl_constexpr_symbol(ecl_stp_special, "*INTERRUPTS-ENABLED*", ECL_T),
  /* OP_PUSHKEYS handles specially :ALLOW-OTHER-KEYS (per CL semantics). */
  ecl_constexpr_symbol(ecl_stp_constant, "ALLOW-OTHER-KEYS", ECL_ALLOW_OTHER_KEYS),
  /* The universal truth, the supertype of all, the class above classes. */
  ecl_constexpr_symbol(ecl_stp_constant, "T", ECL_T),
  /* The marker for unbound slots. This is more a tag than a symbol. */
  ecl_constexpr_symbol(ecl_stp_constant, "UNBOUND", ECL_UNBOUND),
};

/* -- implementation ------------------------------------------------ */

#if ECL_FIXNUM_BITS <= 32
/* 1GB */
#define ECL_DEFAULT_HEAP_SIZE 1073741824L
#else
/* 4GB */
#define ECL_DEFAULT_HEAP_SIZE 4294967296L
#endif

#ifndef ECL_DEFAULT_C_STACK_SIZE
#define ECL_DEFAULT_C_STACK_SIZE 0
#endif

#ifdef GBC_BOEHM_GENGC
#define ECL_INCREMENTAL_GC 1
#else
#define ECL_INCREMENTAL_GC 0
#endif

#if defined(ECL_THREADS) && defined(HAVE_SIGPROCMASK)
#define ECL_SIGNAL_HANDLING_THREAD 1
#else
#define ECL_SIGNAL_HANDLING_THREAD 0
#endif

/* INV: see ecl_option enum in external.h */
cl_fixnum ecl_option_values[ECL_OPT_LIMIT+1] = {
  /* ---------------------------------------------------------------- */
  ECL_INCREMENTAL_GC,           /* ECL_OPT_INCREMENTAL_GC             */
  1,                            /* ECL_OPT_TRAP_SIGSEGV               */
  1,                            /* ECL_OPT_TRAP_SIGFPE                */
  1,                            /* ECL_OPT_TRAP_SIGINT                */
  1,                            /* ECL_OPT_TRAP_SIGILL                */
  1,                            /* ECL_OPT_TRAP_SIGBUS                */
  1,                            /* ECL_OPT_TRAP_SIGPIPE               */
  1,                            /* ECL_OPT_TRAP_INTERRUPT_SIGNAL      */
  ECL_SIGNAL_HANDLING_THREAD,   /* ECL_OPT_SIGNAL_HANDLING_THREAD     */
  16,                           /* ECL_OPT_SIGNAL_QUEUE_SIZE          */
  0,                            /* ECL_OPT_BOOTED                     */
  /* ---------------------------------------------------------------- */
  8192,                         /* ECL_OPT_BIND_STACK_SIZE            */
  1024,                         /* ECL_OPT_BIND_STACK_SAFETY_AREA     */
  2048,                         /* ECL_OPT_FRAME_STACK_SIZE           */
  128,                          /* ECL_OPT_FRAME_STACK_SAFETY_AREA    */
  32768,                        /* ECL_OPT_LISP_STACK_SIZE            */
  128,                          /* ECL_OPT_LISP_STACK_SAFETY_AREA     */
  ECL_DEFAULT_C_STACK_SIZE,     /* ECL_OPT_C_STACK_SIZE               */
  4*sizeof(cl_index)*1024,      /* ECL_OPT_C_STACK_SAFETY_AREA        */
  ECL_DEFAULT_HEAP_SIZE,        /* ECL_OPT_HEAP_SIZE                  */
  1024*1024,                    /* ECL_OPT_HEAP_SAFETY_AREA           */
  0,                            /* ECL_OPT_THREAD_INTERRUPT_SIGNAL    */
  1,                            /* ECL_OPT_SET_GMP_MEMORY_FUNCTIONS   */
  1,                            /* ECL_OPT_USE_SETMODE_ON_FILES       */
  /* ---------------------------------------------------------------- */
  0};

cl_fixnum
ecl_get_option(int option)
{
  if (option >= ECL_OPT_LIMIT || option < 0) {
    return -1;
  }
  return ecl_option_values[option];
}

cl_fixnum
ecl_set_option(int option, cl_fixnum value)
{
  if (option > ECL_OPT_LIMIT || option < 0) {
    return -1;
  }
  if (option >= ECL_OPT_BOOTED || !ecl_option_values[ECL_OPT_BOOTED]) {
    ecl_option_values[option] = value;
  }
  return ecl_option_values[option];
}

/* -- environments ---------------------------------------------------------- */

#ifdef ECL_THREADS
static void
add_env(cl_env_ptr the_env)
{
  cl_object _env;
  ecl_mutex_lock(&ecl_core.processes_lock);
  _env = ecl_cast_ptr(cl_object,the_env);
  ecl_stack_push(ecl_core.threads, _env);
  ecl_mutex_unlock(&ecl_core.processes_lock);
}

static void
del_env(cl_env_ptr the_env)
{
  cl_object _env;
  ecl_mutex_lock(&ecl_core.processes_lock);
  _env = ecl_cast_ptr(cl_object,the_env);
  ecl_stack_del(ecl_core.threads, _env);
  ecl_mutex_unlock(&ecl_core.processes_lock);
}
#endif

cl_env_ptr
_ecl_alloc_env(cl_env_ptr parent)
{
  /* Allocates the lisp environment for a thread. Depending on which mechanism
   * we use for detecting delayed signals, we may allocate the environment using
   * mmap or with malloc.
   *
   * Note that at this point we are not allocating any other memory which is
   * stored via a pointer in the environment. If we would do that, an unlucky
   * interrupt by the gc before the allocated environment is registered in
   * ecl_core.processes could lead to memory being freed because the gc is not
   * aware of the pointer to the allocated memory in the environment. */
  cl_env_ptr output;
#if defined(ECL_USE_MPROTECT)
  output = (cl_env_ptr) mmap(0, sizeof(*output), PROT_READ | PROT_WRITE,
                             MAP_ANON | MAP_PRIVATE, -1, 0);
  if (output == MAP_FAILED)
    ecl_internal_error("Unable to allocate environment structure.");
#else
# if defined(ECL_USE_GUARD_PAGE)
  output = VirtualAlloc(0, sizeof(*output), MEM_COMMIT, PAGE_READWRITE);
  if (output == NULL)
    ecl_internal_error("Unable to allocate environment structure.");
# else
  output = ecl_malloc(sizeof(*output));
  if (output == NULL)
    ecl_internal_error("Unable to allocate environment structure.");
# endif
#endif
  /* Initialize the structure with NULL data. */
  ecl_mset(output, 0, sizeof(*output));
#ifdef ECL_THREADS
  add_env(output);
#endif
  return output;
}

void
_ecl_dealloc_env(cl_env_ptr env)
{
#ifdef ECL_THREADS
  del_env(env);
#endif
#if defined(ECL_USE_MPROTECT)
  if (munmap(env, sizeof(*env)))
    ecl_internal_error("Unable to deallocate environment structure.");
#elif defined(ECL_USE_GUARD_PAGE)
  if (!VirtualFree(env, 0, MEM_RELEASE))
    ecl_internal_error("Unable to deallocate environment structure.");
#else
  ecl_free_unsafe(env);
#endif
}

/* -- core runtime ---------------------------------------------------------- */

/* The root environment is a default execution context. */
static struct cl_env_struct first_env;

struct ecl_core_struct ecl_core = {
  .first_env = &first_env,
  /* processes */
#ifdef ECL_THREADS
  .threads = ECL_NIL,
  .last_var_index = 0,
  .reused_indices = ECL_NIL,
#endif
  /* signals */
  .default_sigmask_bytes = 0,
  .known_signals = ECL_NIL,
  /* allocation */
  .allocator = NULL,
  .max_heap_size = 0,
  .bytes_consed = ECL_NIL,
  .gc_counter = ECL_NIL,
  .gc_stats = 0,
  .safety_region = NULL,
  /* pathnames */
  .path_max = 0,
  .pathname_translations = ECL_NIL,
  /* MODULES is a stack of plugins that may be loaded at boot time. */
  .modules = ECL_NIL,
  /* LIBRARIES is a list of objects. It behaves as a sequence of weak pointers
     thanks to the magic in the garbage collector. */
  .libraries = ECL_NIL,
  .library_pathname = ECL_NIL
};

/* note that this function does not create any environment */
int
ecl_boot(void)
{
  int i;

  i = ecl_option_values[ECL_OPT_BOOTED];
  if (i) {
    if (i < 0) {
      /* The runtime has been only suspended. Resume it.*/
      ecl_set_option(ECL_OPT_BOOTED, 1);
    }
    return 1;
  }
  init_memory();
  init_modules();
  ecl_core.path_max = MAXPATHLEN;
  return 0;
}

int
ecl_halt(void)
{
  int i = ecl_option_values[ECL_OPT_BOOTED];
  if (i > 0)
    free_modules();
  ecl_set_option(ECL_OPT_BOOTED, 0);
  return 0;
}
