/*
    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
    Copyright (c) 1990, Giuseppe Attardi.
    Copyright (c) 2001, Juan Jose Garcia Ripoll.
    Copyright (c) 2010-2012, Jean-Claude Beaudoin.

    MKCL is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 3 of the License, or (at your option) any later version.

    See file './Copyright' for full details.
*/

#ifndef MKCL_EXTERNAL_H
#define MKCL_EXTERNAL_H

#define MKCL_STARTUP_SPECIALS_SIZE 256

#ifdef __cplusplus
extern "C" {
#endif

  /*
   * Per-thread data.
   */

  struct mkcl_env_struct {
    /* Flag for disabling interrupts while we call C library functions. */
    volatile int disable_interrupts;
    volatile mkcl_object sleeping_on;

    mkcl_index nvalues;

    /* Call stack management. */
    char * cs_limit; /* The line where an overflow is declared. */
    char * cs_org; /* The base of the memory region requested to be used as call stack for this thread. */
    mkcl_index cs_size; /* The allocated size of the call stack of this thread. */
    mkcl_index cs_overflow_size; /* The size of the call stack overflow area. */
    bool cs_overflowing;

    /* Array where values are returned by functions. */
    mkcl_object values[MKCL_MULTIPLE_VALUES_LIMIT];

    /* Environment for calling closures, CLOS generic functions, etc */
    mkcl_object function; /* Can be trusted only in the context of a call to a closure (or CLOS ?).
			     Otherwise, can be filled with leftover garbage! JCB */


    /* The three secondary stacks in MKCL. */

    /*
     * The lisp temporaries stack, which is used mainly for passing in the arguments during
     * function invocation (only if arguments count is above MKCL_C_ARGUMENTS_LIMIT),
     * and also by the bytecode compiler and by the
     * reader when they are building some data structure.
     */
    mkcl_index temp_stack_size;
    mkcl_index temp_stack_size_limit;
    mkcl_object *temp_stack;
    mkcl_object *temp_stack_top;
    mkcl_object *temp_stack_upper_bound;

    mkcl_index temp_stack_overflow_size;
    bool temp_stack_overflowing;

    /*
     * The BinDing Stack stores the bindings of special variables.
     */
    mkcl_index bds_size;
    mkcl_index bds_size_limit;
    struct mkcl_bds_bd *bds_org;
    struct mkcl_bds_bd *bds_top;
    struct mkcl_bds_bd *bds_upper_bound;

    mkcl_index bds_overflow_size;
    bool bds_overflowing;

    mkcl_object * specials;
    mkcl_index specials_size;

    /*
     * The FRames Stack (FRS) is a list of frames or jump points, and it
     * is used by different high-level constructs (BLOCK, TAGBODY, CATCH...)
     * to set return points.
     */
    mkcl_index frs_size;
    mkcl_index frs_size_limit;
    struct mkcl_frame *frs_org;
    struct mkcl_frame *frs_top;
    struct mkcl_frame *frs_upper_bound;

    mkcl_index frs_overflow_size;
    bool frs_overflowing;

    struct mkcl_frame *nlj_fr; /* The Non-Local Jump-to frame. */
    mkcl_index go_label_index;

    /*
     * The Invocation History Stack (IHS) keeps a list of the names of the
     * functions that are invoked, together with their lexical
     * environments.
     */
    struct mkcl_ihs_frame *ihs_top;

    /* Private variables used by different parts of MKCL: */
    /* ... the reader ... */
    mkcl_object string_pool;

    /* ... the compiler ... */
    struct mkcl_compiler_env *c_env;

    /* ... the formatter ... */
    mkcl_object fmt_aux_stream;

    /* ... the pretty printer ... */
    bool print_pretty;
    short *queue;
    short *indent_stack;
    int qh, qt, qc, isp, iisp;

    /* ... arithmetics ... */
    /* Note: if you change the size of these registers, change also
       MKCL_BIGNUM_REGISTER_SIZE in config.h */
    mkcl_object big_register[3];

    mkcl_object own_thread;

    /* The following is a hash table for caching invocations of
       generic functions. In a multithreaded environment we must
       queue operations in which the hash is cleared from updated
       generic functions. */
    volatile mkcl_object method_hash_clear_list; /* across thread communication! JCB */
    mkcl_object method_hash;
    mkcl_object method_spec_vector;
    mkcl_word method_generation;

    /* foreign function interface */
    struct mkcl_fficall * fficall;

    /* Alternative stack for processing signals */ /* Not used! Incompatible with Boehm's GC. JCB */
    void *altstack;
    mkcl_index altstack_size;

    /* Floating point interrupts which are trapped */
    int fpe_control_bits;

    /* to support MKCL_DEBUG_INTERRUPT_MASK */
    char * volatile interrupt_disabler_file;
    volatile size_t interrupt_disabler_lineno;

    volatile double fp_drone;
    struct mkcl_alloc_stats * alloc;

    /* Re-initialization parameters */
    char * cs_org_request;
    mkcl_index cs_size_request;
  };

#if 0
  typedef struct mkcl_env_struct *mkcl_env_ptr; /* Should disappear soon! use mkcl_env */
#endif

  typedef struct mkcl_env_struct * mkcl_env;

#define MKCL register const mkcl_env env
#define MKCL_ENV() mkcl_thread_env()

  extern MKCL_API const mkcl_env mkcl_thread_env(void);


  /*
   * process global data.
   */

  struct mkcl_core_struct {
    mkcl_object packages;
    mkcl_object lisp_package;
    mkcl_object user_package;
    mkcl_object keyword_package;
    mkcl_object system_package;
    mkcl_object mkcl_ext_package;
    mkcl_object clos_package;
    mkcl_object gray_package;
    mkcl_object mt_package;
    mkcl_object packages_to_be_created;

    mkcl_object pathname_translations;

    mkcl_object SYS_library_pathname;

    mkcl_object terminal_io;
    mkcl_object null_stream;
    mkcl_object standard_input;
    mkcl_object standard_output;
    mkcl_object error_output;
    mkcl_object standard_readtable;
    mkcl_object dispatch_reader;        /* a constant included here for GC purposes? JCB */
    mkcl_object default_dispatch_macro; /* unused? JCB */

    mkcl_object char_names;
    mkcl_object empty_string;
    mkcl_object dot_string;
    mkcl_object dot_dot_string;
    mkcl_object localhost_string;

    mkcl_object plus_half;
    mkcl_object minus_half;
    mkcl_object imag_unit;
    mkcl_object minus_imag_unit;
    mkcl_object imag_two;
    mkcl_object singlefloat_zero;
    mkcl_object doublefloat_zero;
    mkcl_object singlefloat_minus_zero;
    mkcl_object doublefloat_minus_zero;
    mkcl_object longfloat_zero;
    mkcl_object longfloat_minus_zero;

    mkcl_object gensym_prefix;
    mkcl_object gentemp_prefix;
    mkcl_object gentemp_counter;

    mkcl_object Jan1st1970UT;

    mkcl_object system_properties;

    mkcl_index top_special_index;  /* should this really be public? JCB */
#ifdef MKCL_WINDOWS
    CRITICAL_SECTION special_index_lock;  /* should this really be public? JCB */
#else
    pthread_mutex_t special_index_lock;  /* should this really be public? JCB */
#endif

    mkcl_object threads;
    mkcl_object initial_thread;
    mkcl_object shutdown_watchdog_thread;
    mkcl_object shutdown_watchdog_will_clean_up;
    mkcl_object shutdown_thread;
    mkcl_object shutdown_gate;
    mkcl_object imported_thread_pool;

#ifdef MKCL_WINDOWS
    CRITICAL_SECTION thread_list_lock;  /* should this really be public? JCB */
    CRITICAL_SECTION package_list_lock;  /* should this really be public? JCB */
#else
    pthread_mutex_t thread_list_lock;  /* should this really be public? JCB */
    pthread_mutex_t package_list_lock;  /* should this really be public? JCB */
#endif

    mkcl_object libraries; /* protected by the Load-Compile lock. */
    mkcl_object to_be_finalized;

    char *safety_region; /* protected by the Out-Of-Memory lock. */
    mkcl_index max_heap_size; /* protected by the Out-Of-Memory lock. */

    mkcl_object bytes_consed;
    mkcl_object gc_pinned;
    mkcl_object gc_counter;
    long gc_fast_counter;
    bool gc_stats;

    long path_max;
    long name_max;
    long arg_max;
    long pagesize;

    mkcl_object self;
    mkcl_object self_truename;

    mkcl_object empty_default_pathname_defaults;
    mkcl_object default_default_external_format;
    volatile mkcl_object children;
    volatile mkcl_object detached_children;

#if 0

    mkcl_object unicode_database;
    uint8_t *ucd_misc;
    uint8_t *ucd_pages;
    uint8_t *ucd_data;

    mkcl_object clear_compiler_properties;

#endif

#ifdef HASHTABLE_STATS /* JCB */
    mkcl_object hashtables[mkcl_htt_package + 1];
#endif
  };

  extern MKCL_API struct mkcl_core_struct mkcl_core;

  /* alloc.c / alloc_2.c */

  extern MKCL_API mkcl_object mkcl_alloc_cdisplay(MKCL, mkcl_index nb_levels);
  extern MKCL_API mkcl_object mkcl_alloc_clevel_block(MKCL, mkcl_object producer, const union mkcl_lispunion * const outer, const mkcl_index nb_vars);
  extern MKCL_API mkcl_object mkcl_alloc_raw_instance(MKCL, mkcl_index nb_slots);
  extern MKCL_API mkcl_object mkcl_alloc_raw_structure(MKCL, mkcl_object type,  mkcl_index nb_slots);
  extern MKCL_API mkcl_object mkcl_alloc_raw_base_string(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_string(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_symbol(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_bytecode(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_bclosure(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_cfun(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_cclosure(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_vector(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_bitvector(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_array(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_bignum(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_bignum_with_limbs(MKCL, int nb_limbs);
  extern MKCL_API mkcl_object mkcl_alloc_raw_ratio(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_singlefloat(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_doublefloat(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_longfloat(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_complex(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_hashtable(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_codeblock(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_random(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_package(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_pathname(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_readtable(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_thread(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_lock(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_rwlock(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_semaphore(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_condition_variable(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_foreign(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_stream(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_raw_process(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_utf_8(MKCL, mkcl_index length);
  extern MKCL_API mkcl_object mkcl_alloc_raw_utf_8(MKCL);
  extern MKCL_API mkcl_object mkcl_alloc_utf_16(MKCL, mkcl_index length);
  extern MKCL_API mkcl_object mkcl_alloc_raw_utf_16(MKCL);

  extern MKCL_API mkcl_object mkcl_cons(MKCL, mkcl_object a, mkcl_object d);
  extern MKCL_API mkcl_object mkcl_list1(MKCL, mkcl_object a);

  extern MKCL_API mkcl_object mk_si_scrub_values(MKCL);
  extern MKCL_API mkcl_object mk_si_gc(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_si_gc_dump(MKCL);
  extern MKCL_API mkcl_object mk_si_gc_off(MKCL);
  extern MKCL_API mkcl_object mk_si_gc_on(MKCL);
  extern MKCL_API mkcl_object mk_si_gc_stats(MKCL, mkcl_object enable);
  extern MKCL_API mkcl_object mk_si_mem_stats(MKCL);
  extern MKCL_API void *_mkcl_boot_alloc_unprotected(mkcl_index n);
  extern MKCL_API void *mkcl_alloc(MKCL, mkcl_index n);
  extern MKCL_API void *mkcl_alloc_atomic(MKCL, mkcl_index n);
  extern MKCL_API void *mkcl_alloc_uncollectable(MKCL, size_t size);
  extern MKCL_API void mkcl_free_uncollectable(MKCL, void *);
  extern MKCL_API void mkcl_dealloc(MKCL, void *);
#define mkcl_alloc_align(e,s,d) mkcl_alloc(e,s)
#define mkcl_alloc_atomic_align(e,s,d) mkcl_alloc_atomic(e,s)
#if 0
#define mkcl_register_static_root(e,x) mkcl_register_root(e,x)
#endif

  extern MKCL_API void * mkcl_foreign_malloc(MKCL, size_t size);
  extern MKCL_API void mkcl_foreign_free(MKCL, void *);

  extern MKCL_API size_t mkcl_GC_get_total_bytes(void);

  extern MKCL_API mkcl_object mkcl_alloc_pin_bag(MKCL);
  extern MKCL_API mkcl_object mkcl_pin(MKCL, mkcl_object bag, mkcl_object obj);
  extern MKCL_API mkcl_object mkcl_unpin(MKCL, mkcl_object pin);

  extern MKCL_API mkcl_object mk_si_sample_allocation_statistics(MKCL);
  extern MKCL_API mkcl_object mk_si_reset_allocation_statistics(MKCL);
  extern MKCL_API mkcl_object mk_si_room_report(MKCL, mkcl_object label);


  /* all_symbols */

  extern MKCL_API mkcl_object mk_si_mangle_string(MKCL, mkcl_object string);
  extern MKCL_API mkcl_object mk_si_mangle_symbol(MKCL, mkcl_object symbol);
  extern MKCL_API mkcl_object mk_si_mangle_name(MKCL, mkcl_object symbol);
  extern MKCL_API mkcl_object mk_si_mangle_function_name(MKCL, mkcl_object symbol);
  typedef union {
    struct {
      const char *name;
      int type;
      void *fun;
      short narg;
      mkcl_object value;
    } init;
    struct mkcl_symbol data;
  } mkcl_symbol_initializer;
  extern MKCL_API mkcl_symbol_initializer mkcl_root_symbols[];
  extern MKCL_API const mkcl_index mkcl_root_symbols_count;

#define MKCL_SYM(name,code) ((mkcl_object) (mkcl_root_symbols+(code)))

  /* apply.c */

  extern MKCL_API mkcl_object mkcl_APPLY_fixed(MKCL, mkcl_narg n, mkcl_object (*f)(), mkcl_object *x);
  extern MKCL_API mkcl_object mkcl_APPLY(MKCL, mkcl_narg n, mkcl_object fun, mkcl_object *x);

  /* array.c */

  extern MKCL_API mkcl_object mkcl_out_of_bounds_error(MKCL, mkcl_object fun, const char *place, mkcl_object value, mkcl_index min, mkcl_index max);
  extern MKCL_API mkcl_index mkcl_ensure_valid_array_index(MKCL, mkcl_object x, mkcl_index index);
  extern MKCL_API mkcl_object mkcl_ensure_valid_array_index_type(MKCL, mkcl_object x, mkcl_object index);
  extern MKCL_API mkcl_index mkcl_array_row_major_index_2_t(MKCL, mkcl_object a, mkcl_object i, mkcl_object j);
  extern MKCL_API mkcl_index mkcl_array_row_major_index_3_t(MKCL, mkcl_object a, mkcl_object i, mkcl_object j, mkcl_object k);
  extern MKCL_API mkcl_object mk_cl_array_row_major_index(MKCL, mkcl_narg narg, mkcl_object V1, ...);
  extern MKCL_API mkcl_object mk_cl_row_major_aref(MKCL, mkcl_object x, mkcl_object i);
  extern MKCL_API mkcl_object mk_si_row_major_aset(MKCL, mkcl_object x, mkcl_object i, mkcl_object v);
  extern MKCL_API mkcl_object mk_si_make_vector(MKCL, mkcl_object etype, mkcl_object dim, mkcl_object adj, mkcl_object fillp, mkcl_object displ, mkcl_object disploff);
  extern MKCL_API mkcl_object mkcl_alloc_simple_vector(MKCL, mkcl_index l, mkcl_elttype aet);
  extern MKCL_API mkcl_object mk_cl_array_element_type(MKCL, mkcl_object a);
  extern MKCL_API mkcl_object mk_cl_array_rank(MKCL, mkcl_object a);
  extern MKCL_API mkcl_object mk_cl_array_dimension(MKCL, mkcl_object a, mkcl_object index);
  extern MKCL_API mkcl_object mk_cl_array_total_size(MKCL, mkcl_object a);
  extern MKCL_API mkcl_object mk_cl_adjustable_array_p(MKCL, mkcl_object a);
  extern MKCL_API mkcl_object mk_cl_array_displacement(MKCL, mkcl_object a);
  extern MKCL_API mkcl_object mk_cl_svref(MKCL, mkcl_object x, mkcl_object index);
  extern MKCL_API mkcl_object mk_si_svset(MKCL, mkcl_object x, mkcl_object index, mkcl_object v);
  extern MKCL_API mkcl_object mk_cl_array_has_fill_pointer_p(MKCL, mkcl_object a);
  extern MKCL_API mkcl_object mk_cl_fill_pointer(MKCL, mkcl_object a);
  extern MKCL_API mkcl_object mk_si_fill_pointer_set(MKCL, mkcl_object a, mkcl_object fp);
  extern MKCL_API mkcl_object mk_si_replace_array(MKCL, mkcl_object old_obj, mkcl_object new_obj);
  extern MKCL_API mkcl_object mk_cl_aref(MKCL, mkcl_narg narg, mkcl_object x, ...);
  extern MKCL_API mkcl_object mk_si_aset(MKCL, mkcl_narg narg, mkcl_object v, mkcl_object x, ...);
  extern MKCL_API mkcl_object mk_si_make_pure_array(MKCL, mkcl_object etype, mkcl_object dims, mkcl_object adj, mkcl_object fillp, mkcl_object displ, mkcl_object disploff);
  extern MKCL_API mkcl_object mk_si_fill_array_with_elt(MKCL, mkcl_object array, mkcl_object elt, mkcl_object start, mkcl_object end);

  extern MKCL_API mkcl_index mkcl_to_array_index(MKCL, mkcl_object n);
  /* extern MKCL_API mkcl_object mkcl_aref_index(MKCL, mkcl_object x, mkcl_index index); */
  extern MKCL_API mkcl_object mkcl_aref(MKCL, mkcl_object x, mkcl_object index);
  /* extern MKCL_API mkcl_object mkcl_vref_index(MKCL, mkcl_object v, mkcl_index index); */
  extern MKCL_API mkcl_object mkcl_vref(MKCL, mkcl_object v, mkcl_object index);
  /* extern MKCL_API mkcl_object mkcl_aset_index(MKCL, mkcl_object x, mkcl_index index, mkcl_object value); */
  extern MKCL_API mkcl_object mkcl_aset(MKCL, mkcl_object x, mkcl_object index, mkcl_object value);
  /* extern MKCL_API mkcl_object mkcl_vset_index(MKCL, mkcl_object v, mkcl_index index, mkcl_object val); */
  extern MKCL_API mkcl_object mkcl_vset(MKCL, mkcl_object v, mkcl_object index, mkcl_object val);
  extern MKCL_API mkcl_object mkcl_bvref_index(MKCL, mkcl_object x, mkcl_index index);
  extern MKCL_API mkcl_object mkcl_bvref(MKCL, mkcl_object x, mkcl_object index);
  extern MKCL_API mkcl_object mkcl_bvset_index(MKCL, mkcl_object x, mkcl_index index, mkcl_word value);
  extern MKCL_API mkcl_object mkcl_bvset(MKCL, mkcl_object x, mkcl_object index, mkcl_object value);
  extern MKCL_API void mkcl_array_allocself(MKCL, mkcl_object x);
  extern MKCL_API mkcl_elttype mkcl_array_elttype(MKCL, mkcl_object x);
  extern MKCL_API mkcl_elttype mkcl_symbol_to_elttype(MKCL, mkcl_object x);
  extern MKCL_API mkcl_object mkcl_elttype_to_symbol(MKCL, mkcl_elttype aet);
  extern MKCL_API void mkcl_copy_subarray(MKCL, mkcl_object dest, mkcl_index i0, mkcl_object orig, mkcl_index i1, mkcl_index l);
  extern MKCL_API void mkcl_reverse_subarray(MKCL, mkcl_object dest, mkcl_index i0, mkcl_index i1);


  /* assignment.c */

  extern MKCL_API mkcl_object mk_cl_set(MKCL, mkcl_object var, mkcl_object val);
  extern MKCL_API mkcl_object mk_cl_makunbound(MKCL, mkcl_object sym);
  extern MKCL_API mkcl_object mk_cl_fmakunbound(MKCL, mkcl_object sym);
  extern MKCL_API mkcl_object mk_si_fset(MKCL, mkcl_narg narg, mkcl_object fun, mkcl_object def, ...);
  extern MKCL_API mkcl_object mk_si_get_sysprop(MKCL, mkcl_object sym, mkcl_object prop);
  extern MKCL_API mkcl_object mk_si_put_sysprop(MKCL, mkcl_object sym, mkcl_object prop, mkcl_object value);
  extern MKCL_API mkcl_object mk_si_rem_sysprop(MKCL, mkcl_object sym, mkcl_object prop);
  extern MKCL_API mkcl_object mk_si_system_properties(MKCL);

  extern MKCL_API void mkcl_clear_compiler_properties(MKCL, mkcl_object sym);

  /* big.c */

#define _mkcl_big_register0()	env->big_register[0]
#define _mkcl_big_register1()	env->big_register[1]
#define _mkcl_big_register2()	env->big_register[2]
  extern MKCL_API mkcl_object _mkcl_big_register_copy(MKCL, mkcl_object x);
  extern MKCL_API mkcl_object _mkcl_big_register_normalize(MKCL, mkcl_object x);
  extern MKCL_API void _mkcl_big_register_free(MKCL, mkcl_object x);
  extern MKCL_API mkcl_object bignum1(MKCL, mkcl_word val);


  /* cfun.c */

  extern MKCL_API mkcl_object mk_si_compiled_function_name(MKCL, mkcl_object fun);
  extern MKCL_API mkcl_object mk_si_set_compiled_function_name(MKCL, mkcl_object fun, mkcl_object name);
  extern MKCL_API mkcl_object mk_si_compiled_function_block(MKCL, mkcl_object fun);
  extern MKCL_API mkcl_object mk_cl_function_lambda_expression(MKCL, mkcl_object fun);
  extern MKCL_API mkcl_object mk_si_compiled_function_file(MKCL, mkcl_object fun);

  extern MKCL_API mkcl_object mkcl_make_cfun(MKCL, mkcl_objectfn_fixed c_function, mkcl_object name, mkcl_object block, int narg, mkcl_object * anchor);
  extern MKCL_API mkcl_object mkcl_make_cfun_va(MKCL, mkcl_objectfn c_function, mkcl_object name, mkcl_object block, mkcl_object * anchor);
  extern MKCL_API void mkcl_build_named_cfun_fun_ref_syms(MKCL, mkcl_object fun, mkcl_object * VV, mkcl_object * fun_ref_sym_locs, mkcl_index nb_fun_refs);
  extern MKCL_API mkcl_object mkcl_fix_lambda_fun_refs(MKCL, mkcl_object * VV, mkcl_object * fun_ref_syms_locs, mkcl_index nb_fun_refs, mkcl_object fun);
  extern MKCL_API mkcl_object mkcl_fix_lex_local_fun_refs(MKCL, mkcl_object producer, mkcl_object fun);

  extern MKCL_API mkcl_object mkcl_debug_make_cfun(MKCL, mkcl_objectfn_fixed c_function, mkcl_object name, mkcl_object cblock, int narg, mkcl_object * anchor, char * source, int position);
  extern MKCL_API mkcl_object mkcl_debug_make_cfun_va(MKCL, mkcl_objectfn c_function, mkcl_object name, mkcl_object cblock, mkcl_object * anchor, char * source, int position);
  extern MKCL_API mkcl_object mkcl_build_cdisplay(MKCL, mkcl_object producer, mkcl_object cenv, mkcl_index depth);

  extern MKCL_API mkcl_object mkcl_make_cclosure(MKCL, mkcl_object producer, mkcl_objectfn_fixed c_function, int narg, mkcl_index depth, mkcl_object syms_cenv, mkcl_object cenv, mkcl_object block, int position);
  extern MKCL_API mkcl_object mkcl_make_cclosure_va(MKCL, mkcl_object producer, mkcl_objectfn c_function, mkcl_index depth, mkcl_object syms_cenv, mkcl_object cenv, mkcl_object block, int position);

  extern MKCL_API mkcl_object mk_si_clone_closure(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_si_closure_depth(MKCL, mkcl_object clo);
  extern MKCL_API mkcl_object mk_si_closure_level(MKCL, mkcl_object clo, mkcl_object i);
  extern MKCL_API mkcl_object mk_si_closure_level_size(MKCL, mkcl_object level);
  extern MKCL_API mkcl_object mk_si_closure_level_var(MKCL, mkcl_object level, mkcl_object i);
  extern MKCL_API mkcl_object mk_si_closure_level_set_var(MKCL, mkcl_object level, mkcl_object i, mkcl_object val);
  extern MKCL_API mkcl_object mk_si_closure_level_outer_level(MKCL, mkcl_object level);

  extern MKCL_API void mkcl_def_c_function(MKCL, mkcl_object sym, mkcl_objectfn_fixed c_function, int narg);
  extern MKCL_API void mkcl_def_c_macro(MKCL, mkcl_object sym, mkcl_objectfn_fixed c_function, int narg);
  extern MKCL_API void mkcl_def_c_macro_va(MKCL, mkcl_object sym, mkcl_objectfn c_function);
  extern MKCL_API void mkcl_def_c_function_va(MKCL, mkcl_object sym, mkcl_objectfn c_function);
  extern MKCL_API void mkcl_set_function_source_file_info(MKCL, mkcl_object fun, mkcl_object source, mkcl_object position);
  extern MKCL_API void mkcl_cmp_defmacro(MKCL, mkcl_object data);
  extern MKCL_API void mkcl_cmp_defun(MKCL, mkcl_object data);

  extern MKCL_API mkcl_object mk_si_closurep(MKCL, mkcl_object fun);
  extern MKCL_API mkcl_object mk_si_closure_env(MKCL, mkcl_object fun);
  extern MKCL_API mkcl_object mk_si_closure_producer(MKCL, mkcl_object fun);
  extern MKCL_API mkcl_object mk_si_compiled_function_owner(MKCL, mkcl_object fun);
  extern MKCL_API mkcl_object mk_si_set_compiled_function_owner(MKCL, mkcl_object fun, mkcl_object owner);

  extern MKCL_API mkcl_object * mkcl_build_fun_ref_syms_from_locs(MKCL, mkcl_object * VV, mkcl_object * locs, mkcl_index size);
  extern MKCL_API mkcl_object * mkcl_build_fun_refs_from_syms(MKCL, mkcl_object fun_or_cblock, mkcl_object * syms, mkcl_index size);

  extern MKCL_API mkcl_object mk_si_patch_fun_ref(MKCL, mkcl_object fun, mkcl_object index, mkcl_object fun_ref);
  extern MKCL_API mkcl_object mk_si_get_fun_ref_sym(MKCL, mkcl_object fun, mkcl_object index);
  extern MKCL_API mkcl_object mkcl_fun_ref_fdefinition(MKCL, const mkcl_object * const fun_refs, mkcl_index i);
  extern MKCL_API int mkcl_fun_refs_trap(MKCL, mkcl_object fun, const mkcl_object * const fun_refs, mkcl_index i); /* debug JCB */
  extern MKCL_API mkcl_object mk_si_update_function_references(MKCL, mkcl_object fun);

  /* character.c */

  extern MKCL_API mkcl_object mk_cl_digit_char_p(MKCL, mkcl_narg narg, mkcl_object c, ...);
  extern MKCL_API mkcl_object mk_cl_charE(MKCL, mkcl_narg narg, mkcl_object c, ...);
  extern MKCL_API mkcl_object mk_cl_charNE(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_cl_charL(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_cl_charG(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_cl_charLE(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_cl_charGE(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_cl_char_equal(MKCL, mkcl_narg narg, mkcl_object c, ...);
  extern MKCL_API mkcl_object mk_cl_char_not_equal(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_cl_char_lessp(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_cl_char_greaterp(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_cl_char_not_greaterp(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_cl_char_not_lessp(MKCL, mkcl_narg narg, ...);
  extern MKCL_API mkcl_object mk_cl_digit_char(MKCL, mkcl_narg narg, mkcl_object w, ...);

  extern MKCL_API mkcl_object mk_cl_alpha_char_p(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_alphanumericp(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_both_case_p(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_char_code(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_char_downcase(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_char_int(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_char_name(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_char_upcase(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_character(MKCL, mkcl_object x);
  extern MKCL_API mkcl_object mk_cl_code_char(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_graphic_char_p(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_lower_case_p(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_name_char(MKCL, mkcl_object s);
  extern MKCL_API mkcl_object mk_cl_standard_char_p(MKCL, mkcl_object c);
  extern MKCL_API mkcl_object mk_cl_upper_case_p(MKCL, mkcl_object c);
  extern MKCL_API int mkcl_string_case(mkcl_object s);

  static inline bool mkcl_graphic_char_p(mkcl_character code) { return code > 159 || ((31 < code) && (code < 127)); } /* SBCL compatible */


#if 1
#include <mkcl/mkcl-unicode.h>

  static inline const struct mkcl_unichar_info * mkcl_unicode_character_information(mkcl_character code)
  {
    if (code >= MKCL_CHAR_CODE_LIMIT)
      return NULL;
    else
      {
	const mkcl_uint8_t page_index = _mkcl_unichar_info_pages[code >> 8];
	return &(_mkcl_unichar_info[page_index][code & 0xFF]);
      }
  }

  static inline enum mkcl_ucd_general_category  mkcl_unicode_character_general_category(mkcl_character code)
  {
    const struct mkcl_unichar_info * char_info = mkcl_unicode_character_information(code);
    if (char_info)
      return _mkcl_unichar_properties_signatures[char_info->properties_signature_index].general_category;
    else
      return (enum mkcl_ucd_general_category) -1;
  }

  static inline int mkcl_ucd_decimal_digit(mkcl_character code)
  {
    const struct mkcl_unichar_info * char_info = mkcl_unicode_character_information(code);
    if (char_info)
      return _mkcl_unichar_properties_signatures[char_info->properties_signature_index].decimal_digit;
    else
      return -1;
  }

  static inline bool mkcl_alpha_char_p(mkcl_character code)
  {
    const enum mkcl_ucd_general_category gc = mkcl_unicode_character_general_category(code);
    return mkcl_ucd_Uppercase_Letter <= gc && gc <= mkcl_ucd_Other_Letter;
  }

  static inline bool mkcl_upper_case_p(mkcl_character code)
  {
    const struct mkcl_unichar_info * char_info = mkcl_unicode_character_information(code);
    return (char_info && char_info->properties_signature_index == 0);
  }
  static inline bool mkcl_lower_case_p(mkcl_character code)
  {
    const struct mkcl_unichar_info * char_info = mkcl_unicode_character_information(code);
    return (char_info && char_info->properties_signature_index == 1);
  }
  static inline bool mkcl_both_case_p(mkcl_character code)
  {
    const struct mkcl_unichar_info * char_info = mkcl_unicode_character_information(code);
    return (char_info && char_info->properties_signature_index < 2);
  }
  
  static inline bool mkcl_alphanumericp(mkcl_character code)
  {
    const enum mkcl_ucd_general_category gc = mkcl_unicode_character_general_category(code);
    return ((mkcl_ucd_Uppercase_Letter <= gc && gc <= mkcl_ucd_Other_Letter)
	    || (mkcl_ucd_Decimal_Number <= gc && gc <= mkcl_ucd_Other_Number));
  }

  static inline mkcl_character mkcl_char_upcase(mkcl_character code)
  {
    const struct mkcl_unichar_info * char_info = mkcl_unicode_character_information(code);
    if (char_info && char_info->properties_signature_index == 1)
      return char_info->transform;
    else 
      return code;
  }

  static inline mkcl_character mkcl_char_downcase(mkcl_character code)
  {
    const struct mkcl_unichar_info * char_info = mkcl_unicode_character_information(code);
    if (char_info && char_info->properties_signature_index == 0)
      return char_info->transform;
    else 
      return code;
  }

#else

  static inline uint8_t * mkcl_ucd_char_data(mkcl_character code)
  {
    unsigned char page = mkcl_core.ucd_pages[code >> 8];
    return mkcl_core.ucd_data + ((mkcl_index)page << 10) + 4 * (code & 0xFF);
  }

  static inline mkcl_index mkcl_ucd_value_0(mkcl_character code) { return mkcl_ucd_char_data(code)[0]; }

  static inline mkcl_character mkcl_ucd_value_1(mkcl_character code)
  {
    uint8_t *c = mkcl_ucd_char_data(code);
    return(c[0] + (c[1] << 8) + (c[2] << 16));
  }

  static inline int mkcl_ucd_general_category(mkcl_character code) {return mkcl_core.ucd_misc[8 * mkcl_ucd_value_0(code)];}
  static inline int mkcl_ucd_decimal_digit(mkcl_character code) {return mkcl_core.ucd_misc[3 + 8 * mkcl_ucd_value_0(code)];}

  static inline bool mkcl_alpha_char_p(mkcl_character code) { return mkcl_ucd_general_category(code) < 5; }
  static inline bool mkcl_upper_case_p(mkcl_character code) { return mkcl_ucd_value_0(code) == 0; }
  static inline bool mkcl_lower_case_p(mkcl_character code) { return mkcl_ucd_value_0(code) == 1; }
  static inline bool mkcl_both_case_p(mkcl_character code) { return mkcl_ucd_value_0(code) < 2; }
  
  static inline bool mkcl_alphanumericp(mkcl_character i)
  {
    int gc = mkcl_ucd_general_category(i);
    return (gc < 5) || (gc == 12);
  }

  static inline mkcl_character mkcl_char_upcase(mkcl_character code)
  {
    uint8_t *c = mkcl_ucd_char_data(code);
    if (c[0] == 1) {
      c++;
      return(c[0] + (c[1] << 8) + (c[2] << 16));
    } else 
      return code;
  }

  static inline mkcl_character mkcl_char_downcase(mkcl_character code)
  {
    uint8_t *c = mkcl_ucd_char_data(code);
    if (c[0] == 0) {
      c++;
      return(c[0] + (c[1] << 8) + (c[2] << 16));
    } else 
      return code;
  }

#endif