/*
 * ici.h - ICI exports for extension module compilation.
 *
 * This file is automatically generated from internal ICI include files.
 */

#ifndef ICI_ICI_H
#define ICI_ICI_H

#ifdef __cplusplus
extern "C" {
#endif


/* From fwd.h */

/*
 * In general CONFIG_FILE is defined by the external build environment,
 * but for some common cases we have standard setting that can be used
 * directly. Windows in particular, because it is such a pain to handle
 * setting like this in Visual C.
 */
#if defined(_WIN32) && !defined(CONFIG_FILE)
#define CONFIG_FILE "conf-w32.h"
#elif defined(__MACH__) && defined(__APPLE__) && !defined(CONFIG_FILE)
#define CONFIG_FILE "conf-osx.h"
#endif

#ifndef CONFIG_FILE
/*
 * CONFIG_FILE is supposed to be set from some makefile with some compile
 * line option to something like "conf-sun.h" (including the quotes).
 */
#error "The preprocessor define CONFIG_FILE has not been set."
#endif

#ifndef ICI_CONF_H
#include CONFIG_FILE
#endif

/*
 * Define SMALL to reduce the use of macros and thus reduce code size.
 * But it causes considerable speed degradation.
 */

#include <stddef.h>
#include <stdlib.h>
#include <stdarg.h>
#include <stdio.h>
#include <string.h>
#include <assert.h>
#ifdef SUNOS5
# include <signal.h>
#endif

/*
 * DLI is defined in some configurations (Windows, in the conf include file)
 * to be a declaration modifyer which must be applied to data objects being
 * referenced from a dynamically loaded DLL.
 *
 * If it hasn't been defined yet, define it to be null. Most system don't
 * need it.
 */
#ifndef DLI
#define DLI
#endif

/*
 * The character which seperates directories in a path list on this
 * architecture. This is the default value, it may have been set in
 * the config file.
 */
#ifndef ICI_PATH_SEP
#define ICI_PATH_SEP    ':'
#endif

/*
 * The string which is the extension of a dynamicly loaded library on this
 * architecture. This is the default value, it may have been set in
 * the config file.
 */
#ifndef ICI_DLL_EXT
#define ICI_DLL_EXT     ".so"
#endif

/*
 * A 'random' value for Windows event handling functions to return
 * to give a better indication that an ICI style error has occured which
 * should be propagated back. See events.c
 */
#define ICI_EVENT_ERROR 0x7A41B291

#define nels(a)         (sizeof a / sizeof a[0])
#define talloc(t)       ((t *)ici_alloc(sizeof(t)))

typedef struct array    array_t;
typedef struct catchs   catch_t;
typedef struct slot     slot_t;
typedef struct sets     set_t;
typedef struct structs  struct_t;
typedef struct exec     exec_t;
typedef struct floats   floats_t;
typedef struct file     file_t;
typedef struct func     func_t;
typedef struct cfunc    cfunc_t;
typedef struct method   method_t;
typedef struct ints     int_t;
typedef struct marks    mark_t;
typedef struct null     null_t;
typedef struct object   object_t;
typedef struct op       op_t;
typedef struct pc       pc_t;
typedef struct ptr      ptr_t;
typedef struct regexpo  regexp_t;
typedef struct src      src_t;
typedef struct string   string_t;
typedef struct type     type_t;
typedef struct wrap     wrap_t;
typedef struct ftype    ftype_t;
typedef struct forall   forall_t;
typedef struct parse    parse_t;
typedef struct mem      mem_t;
typedef struct expr     expr_t;
typedef union  ostemp   ostemp_t;
#ifndef NOSKT
typedef struct skt      skt_t;
#endif
#ifndef NODEBUGGING
typedef struct debug    debug_t;
#endif

extern DLI object_t     **objs;
extern DLI object_t     **objs_top;
extern DLI object_t     **objs_limit;
extern DLI object_t     **atoms;
extern DLI int          atomsz;
extern DLI int_t        *o_zero;
extern DLI int_t        *o_one;
extern DLI char         *error;

#define NEXT_VSVER      (++vsver)
extern DLI long         vsver;

#define NSUBEXP         (10)
extern DLI int  re_bra[(NSUBEXP + 1) * 3];
extern DLI int  re_nbra;

extern DLI volatile int ici_aborted;            /* See exec.c */

extern DLI int  ici_dont_record_line_nums;      /* See lex.c */
extern DLI char *ici_buf;                       /* See buf.h */
extern DLI int  ici_bufz;                       /* See buf.h */

extern DLI type_t       ici_array_type;
extern DLI type_t       ici_catch_type;
extern DLI type_t       set_type;
extern DLI type_t       struct_type;
extern DLI type_t       floats_type;
extern DLI type_t       file_type;
extern DLI type_t       ici_func_type;
extern DLI type_t       ici_cfunc_type;
extern DLI type_t       ici_method_type;
extern DLI type_t       forall_type;
extern DLI type_t       int_type;
extern DLI type_t       mark_type;
extern DLI type_t       null_type;
extern DLI type_t       op_type;
extern DLI type_t       pc_type;
extern DLI type_t       ptr_type;
extern DLI type_t       regexp_type;
extern DLI type_t       src_type;
extern DLI type_t       string_type;
extern DLI type_t       parse_type;
extern DLI type_t       ostemp_type;
#ifndef NOSKT
extern DLI type_t       socket_type;
#endif
extern DLI type_t       mem_type;

extern DLI ftype_t      stdio_ftype;

extern DLI op_t o_quote;
extern DLI op_t o_looper;
extern DLI op_t o_loop;
extern DLI op_t o_break;
extern DLI op_t o_continue;
extern DLI op_t o_offsq;
extern DLI op_t o_exec;
extern DLI op_t o_mkfunc;
extern DLI op_t o_return;
extern DLI op_t o_if;
extern DLI op_t o_ifnot;
extern DLI op_t o_ifnotbreak;
extern DLI op_t o_ifelse;
extern DLI op_t o_pop;
extern DLI op_t o_colon;
extern DLI op_t o_coloncaret;
extern DLI op_t o_dot;
extern DLI op_t o_dotkeep;
extern DLI op_t o_dotrkeep;
extern DLI op_t o_mkptr;
extern DLI op_t o_openptr;
extern DLI op_t o_fetch;
extern DLI op_t o_for;
extern DLI op_t o_mklvalue;
extern DLI op_t o_rematch;
extern DLI op_t o_renotmatch;
extern DLI op_t o_reextract;
extern DLI op_t o_onerror;
extern DLI op_t o_andand;
extern DLI op_t o_barbar;
extern DLI op_t o_namelvalue;
extern DLI op_t o_switch;
extern DLI op_t o_switcher;
extern DLI null_t       o_null;
extern DLI mark_t       o_mark;
#ifndef NODEBUGGING
extern DLI debug_t *ici_debug;
#endif

extern char     ici_version_string[];

#define null_ret() ici_ret_no_decref(objof(&o_null))

extern int      ici_faultarray(array_t *, ptrdiff_t);
extern char     **smash(char *, int);
extern char     **ssmash(char *, char *);
extern char     *ici_binop_name(int);
extern object_t *ici_evaluate(object_t *, catch_t *);
extern object_t *copy_simple(object_t *);
extern object_t *fetch_simple(object_t *, object_t *);
extern slot_t   *find_slot(struct_t **, object_t *);
extern slot_t   *find_raw_slot(struct_t *, object_t *);
extern object_t *get_token(file_t *);
extern object_t *get_value(struct_t *, object_t *);
extern object_t *atom(object_t *, int);
extern object_t *atom_probe(object_t *);
extern int_t    *atom_int(long);
extern int      parse_exec(void);
extern int      parse_module(file_t *, struct_t *);
extern int      parse_file(char *, char *, ftype_t *);
extern parse_t  *new_parse(file_t *);
extern array_t  *new_array(void);
extern mem_t    *new_mem(void *, size_t, int, void (*)());
extern catch_t  *new_catch(object_t *, int, int);
extern string_t *new_cname(char *);
extern string_t *get_cname(char *);
extern int      need_string(string_t **, char *);
extern unsigned long    ici_hash_string(object_t *);
extern set_t    *new_set(void);
extern struct_t *new_struct(void);
extern exec_t   *new_exec(void);
extern floats_t  *new_float(double);
extern file_t   *new_file(char *, ftype_t *, string_t *);
extern func_t   *new_func(void);
extern int_t    *new_int(long);
extern string_t *new_string(int);
extern string_t *new_name(char *, int);
extern op_t     *new_op(int (*)(), int, int);
extern pc_t     *new_pc(array_t *, int);
extern ptr_t    *new_ptr(object_t *, object_t *);
extern src_t    *new_src(int, string_t *);
extern regexp_t *new_regexp(string_t *, int);
extern int      assign_simple(object_t *, object_t *, object_t *);
extern file_t   *ici_sopen(char *, int);
extern catch_t  *ici_unwind(void);
extern void     collect(void);
extern unsigned long hash_unique(object_t *);
extern int      cmp_unique(object_t *, object_t *);
extern int      exec_simple(void);
extern void     free_simple(object_t *);
extern int      ici_growarray(array_t *, ptrdiff_t);
extern int      ici_op_binop(void);
extern int      ici_op_offsq(void);
extern int      ici_op_mklvalue(void);
extern int      ici_op_onerror(void);
extern int      ici_op_for(void);
extern int      ici_op_looper(void);
extern int      ici_op_continue(void);
extern int      ici_op_andand(void);
extern int      ici_op_if(void);
extern int      ici_op_ifelse(void);
extern int      ici_op_switcher(void);
extern int      ici_op_switch(void);
extern int      ici_op_pop(void);
extern int      ici_op_forall(void);
extern int      ici_op_return(void);
extern int      ici_op_call(void);
extern int      ici_op_mkptr(void);
extern int      ici_op_openptr(void);
extern int      ici_op_fetch(void);
extern int      ici_op_unary(void);
extern char     *syserr(void);
extern int      ici_argcount(int);
extern int      ici_argerror(int);
extern array_t  *mk_strarray(char **);
extern int      f_simple(void);
extern int      f_vsimple(void);
extern void     unassign_struct(struct_t *, object_t *);
extern int      unassign_set(set_t *, object_t *);
extern void     grow_objs(object_t *);
extern char     *objname(char *, object_t *);
extern void     expand_error(int, string_t *);
extern int      lex(parse_t *, array_t *);
extern struct_t *statics_struct(struct_t *, struct_t *);
extern void     wrapup(void);
extern int      f_close(file_t *f);
extern int      ici_ret_with_decref(object_t *);
extern int      int_ret(long);
extern int      ici_ret_no_decref(object_t *);
extern void     uninit_cfunc(void);
extern int      ici_typecheck(char *, ...);
extern int      ici_retcheck(char *, ...);
extern int      ici_op_call(void);
extern int      nptrs(char **);
extern int      ici_badindex(void);
extern int      mkstream(char *, FILE *);
extern int      ici_init(void);
extern void     ici_uninit(void);
extern int      exec_forall(void);
extern int      init_exec(struct_t *);
extern int      compile_expr(array_t *, expr_t *, int);
extern void     uninit_compile(void);
extern file_t   *need_stdin(void);
extern file_t   *need_stdout(void);
extern int      set_issubset(set_t *, set_t *);
extern int      set_ispropersubset(set_t *, set_t *);
extern void     ici_reclaim(void);
extern int      str_ret(char *);
extern int      float_ret(double);
extern char     *ici_func(object_t *, char *, ...);
extern char     *ici_funcv(object_t *, char *, va_list);
extern char     *ici_call(char *, char *, ...);
extern char     *ici_callv(char *, char *, va_list);
extern int      ici_cmkvar(struct_t *, char *, int, void *);
extern int      ici_set_val(struct_t *, string_t *, int, void *);
extern int      ici_fetch_num(object_t *, object_t *, double *);
extern int      ici_fetch_int(object_t *, object_t *, long *);
extern long     ici_strtol(char const *, char **, int);
extern int      ici_load(string_t *);
extern char	*ici_get_dll_path(void);
extern int      ici_find_on_path(char *, char [FILENAME_MAX], char *);
extern int      ici_assign_cfuncs(struct_t *, cfunc_t *);
extern int      def_cfuncs(cfunc_t *);
extern int      ici_main(int, char **);
extern int      ici_assign_struct_no_super(struct_t *, object_t *, object_t *);
extern int      ici_init_sstrings(void);
extern method_t *ici_new_method(object_t *, object_t *);

#ifndef NODEBUGGING
extern int      ici_maind(int, char **, int);
extern DLI int  ici_debug_enabled;
extern cfunc_t  ici_debug_cfuncs[];
#else
/*
 * We let the compiler use it's sense to remove a lot of debug
 * code base on a constant expression for ici_debug_enabled. Just
 * to save on lots of idefs.
 */
#define ici_debug_enabled 0
#endif

#ifndef	NOSIGNALS
# ifdef SUNOS5
extern volatile sigset_t ici_signasl_pending;
# else
extern volatile long	ici_signals_pending;
# endif
extern volatile long	ici_signals_count[];
extern void		ici_signals_init(void);
extern int		ici_signals_invoke_handlers(void);
extern int		ici_signals_blocking_syscall(int);
extern cfunc_t		ici_signals_cfuncs[];
#else
/*
 * Let compiler remove code without resorting to ifdefs as for debug.
 */
#define	ici_signals_pending 0
#define	ici_signals_blocking_syscall(x)
#define	ici_signals_invoke_handlers()
#endif

#ifndef NOSYSCALL
extern int      syscall_mkvars(struct_t *);
#endif
#ifndef NOSKT
extern int      skt_close(skt_t *);
#endif

#ifdef BSD
extern int      select();
#endif

#ifdef  sun
double strtod(const char *ptr, char **endptr);
#endif

#ifndef NOTRACE
extern void     trace_pcall(object_t *);
#endif


/* From object.h */

#define ICI_OBJNAMEZ    30

/*
 * Every object has a header, the o_type field of which is a pointer
 * to its type, which is an instance of the structure below. See below.
 */
struct type
{
    unsigned long (*t_mark)(object_t *);
    void        (*t_free)(object_t *);
    unsigned long (*t_hash)(object_t *);
    int         (*t_cmp)(object_t *, object_t *);
    object_t    *(*t_copy)(object_t *);
    int         (*t_assign)(object_t *, object_t *, object_t *);
    object_t    *(*t_fetch)(object_t *, object_t *);
    char        *t_name;
    void        (*t_objname)(object_t *, char [ICI_OBJNAMEZ]);
    int         (*t_call)(object_t *, object_t *, string_t *);
    string_t    *t_ici_name;
};
/*
 * t_mark(o)    Sets the O_MARK flag in o->o_flags of this object and
 *              all objects referenced by this one which don't already
 *              have O_MARK set. Returns the approximate memory cost
 *              of this and all other objects it sets the O_MARK of.
 *              Typically recurses on all referenced objects which
 *              don't already have O_MARK set (this recursion is a
 *              potential problem due to the uncontrolled stack depth
 *              it can create). This is used in the marking phase of
 *              garbage collection.
 *
 *              The macro mark() calls the t_mark function of the object
 *              (based on object type) if the O_MARK flag of the object
 *              is clear, else it returns 0. This is the usual interface
 *              to an object's mark function.
 *
 *              The mark function implemantation of objects can assume
 *              the O_MARK flag of the object they are being invoked
 *              on is clear.
 *
 * t_free(o)    Frees the object o and all associated data, but not
 *              other objects which are referenced from it. This is only
 *              called from garbage collection. Care should be taken
 *              to remember that errors can occur during object creation
 *              and that the free function might be asked to free a
 *              partially allocated object.
 *
 *              Simple object types which just have to free their data
 *              can use the existing function free_simple() as their
 *              implementation of this function.
 *
 * t_cmp(o1, o2) Compare o1 and o2 and return 0 if they are the same, else
 *              non zero. This similarity is the basis for merging objects
 *              into single atomic objects and the implementation of the ==
 *              operator.
 *
 *              Some objects are by nature both unique and intrinsically
 *              atomic (for example, objects which are one-to-one with
 *              some other allocated data which they alloc when the are
 *              created and free when they die). For these objects the
 *              existing function cmp_unique() can be used as their
 *              implementation of this function.
 *
 *              It is very important in implementing this function not to
 *              miss any fields which may otherwise distinguish two obejcts.
 *              The cmp, hash and copy operations of an object are all
 *              related. It is useful to check that they all regard the
 *              same data fields as significant in performing their
 *              operation.
 *
 * t_copy(o)    Returns a copy of the given object. This is the basis for
 *              the implementation of the copy() function. On failure, NULL
 *              is returned and error is set. The returned object has been
 *              incref'ed. The returned object should cmp() as being equal,
 *              but be a distinct object for object which are not
 *              intrinsically atomic.
 *
 *              Intrinsically atomic objects may use the existing function
 *              copy_simple() as their implemenation of this function.
 *
 * t_hash(o)    Return an unsigned long hash which is sensitive to the
 *              value of the object. Two objects which cmp() equal should
 *              return the same hash.
 *
 *              The returned hash is used in a hash table shared by objects
 *              of all types. So, somewhat problematically, it is desireable
 *              to generate hashes which have good spread and seperation
 *              across all objects.
 *
 *              Some objects are by nature both unique and intrinsically
 *              atomic (for example, objects which are one-to-one with
 *              some other allocated data which they alloc when the are
 *              created and free when they die). For these objects the
 *              existing function hash_unique() can be used as their
 *              implementation of this function.
 *
 * t_assign(o, k, v) Assign to key k of the object o the value v. Return
 *              1 on error, else 0.
 *
 *              The existing function assign_simple() may be used both as
 *              the implementation of this function for object types which
 *              do not support any assignment, and as a simple method of
 *              generating an error for particular assignments which break
 *              some rule of the object.
 *
 *              Not that it is not necessarilly wrong for an intrinsically
 *              atomic object to support some form of assignment. Only for
 *              the modified field to be significant in a cmp() operation.
 *              Objects which are intrinsically unique and atomic often
 *              support assignments.
 *
 * t_fetch(o, k) Fetch the value of key k of the object o. Return NULL on
 *              error.
 *
 *              The existing function fetch_simple() may be used both as
 *              the implementation of this function for object types which
 *              do not support any assignment, and as a simple method of
 *              generating an error for particular fetches which break
 *              some rule of the object.
 *
 * t_name       The name of this type. Use for the implementation of
 *              typeof() and in error messages. But apart from that, type
 *              names have no fundamental importance in the langauge and
 *              need not even be unique.
 *
 * t_objname(o, p) Place a short (30 chars or less) human readable
 *              representation of the object in the given buffer. This
 *              is not intended as a basis for re-parsing or serialisation.
 *              It is just for diagnostics and debug.
 *
 * t_call(o, s, m) Call the object o. If s is non-NULL, but m is NULL,
 *              this is a method call and s is a struct which is the
 *              subject object of the call. If m is also non-NULL, this
 *              is a method call with this object as the subject and
 *              m, a string, is the method being called.
 *              Return 1 on error, else 0.
 *
 * t_ici_name   A string_t copy of the name. This is just a cached version
 *              so that typeof() doesn't keep re-computing the string.
 *
 */

#ifndef SMALL
/*
 * Macros to perform the operation on the object.
 */
/*
 * mark()
 *
 * The recursive traversal of all objects performed by marking is particularly
 * expensive. So we take pains to cut short function calls wherever possible.
 * Thus the size of this macro. The o_leafz field of an object tells us it
 * doesn't reference any other objects and is of small (ie o_leafz) size.
 */
#if 1
#define mark(o)         ((objof(o)->o_flags & O_MARK) == 0 \
                            ? (objof(o)->o_leafz != 0 \
                                ? (objof(o)->o_flags |= O_MARK, objof(o)->o_leafz) \
                                : (*(objof(o))->o_type->t_mark)(objof(o))) \
                            : 0L)
#else
#define mark(o)         ((objof(o)->o_flags & O_MARK) == 0 \
                            ? (*(objof(o))->o_type->t_mark)(objof(o)) \
                            : 0L)
#endif
#define freeo(o)        ((*(objof(o))->o_type->t_free)(objof(o)))
#define hash(o)         ((*(objof(o))->o_type->t_hash)(objof(o)))
#define cmp(o1,o2)      ((*(objof(o1))->o_type->t_cmp)(objof(o1), objof(o2)))
#define fetch(o,k)      ((*(objof(o))->o_type->t_fetch)(objof(o), objof(k)))
#define copy(o)         ((*(objof(o))->o_type->t_copy)(objof(o)))
#define assign(o,k,v)   ((*(objof(o))->o_type->t_assign)(objof(o), objof(k), objof(v)))

/*
 * Link an object into the list of objects. We clear the o_leafz field
 * here because that is the safe thing to do and, as of the introduction
 * of this field, much code does not set this field to zero. Objects
 * that want to take advantage of o_leafz must set it after calling rego().
 */
#define rego(o)         (objof(o)->o_leafz = 0, \
                          (objs_top < objs_limit \
                            ? (void)(*objs_top++ = objof(o)) \
                            : grow_objs(objof(o))))
#else
/*
 * Functions to performs operations on the object.
 */
extern unsigned long    mark(object_t *);
extern void             freeo(object_t *);
extern unsigned long    hash(object_t *);
extern int              cmp(object_t *, object_t *);
extern object_t         *copy(object_t *);
extern object_t         *fetch(object_t *, object_t *);
extern int              assign(object_t *, object_t *, object_t *);
extern void             rego(object_t *);
#endif

#define ici_atom_hash_index(h)  ((h) & (atomsz - 1))


/*
 * References from ordinary machine data objects (ie. variables and stuff,
 * not other objects) are invisible to the garbage collector.  These refs
 * must be accounted for if there is a possibility of garbage collection.
 * Note that most routines that make objects (new_*(), copy() etc...)
 * return objects with 1 ref.  The caller is expected to decref() it when
 * they attach it into wherever it is going.
 */
#ifndef BUGHUNT
#define incref(o)       (++objof(o)->o_nrefs)
#define decref(o)       (--objof(o)->o_nrefs)
#else
void bughunt_incref(object_t *o);
void bughunt_decref(object_t *o);
#define incref(o) bughunt_incref(objof(o))
#define decref(o) bughunt_decref(objof(o))
#endif

/*
 * This is the universal header of all objects.
 */
struct object
{
    char        o_tcode;        /* See TC_* below. */
    char        o_flags;        /* See O_* below. */
    char        o_nrefs;        /* No. of refs invisible to collect. */
    char        o_leafz;        /* Iff a leaf object, it's size, else 0. */
    type_t      *o_type;        /* See struct type above. */
    /*
     * Each object includes this as a header.  In the real structures
     * associated with each object type the type specific stuff follows...
     */
};
#define objof(x)        ((object_t *)(x))
/*
 * For static object initialisations...
 */
#define OBJ(tc, type)    {(tc), 0, 1, 0, &type}

/*
 * Flags that may appear in o_flags. The upper nibble is considered available
 * for type specific use.
 */
#define O_MARK          0x01    /* Garbage collection mark. */
#define O_ATOM          0x02    /* Is a member of the atom pool. */
#define O_TEMP          0x04    /* Is a re-usable temp (flag for asserts). */

/*
 * The o_tcode field is a small int which allows bypassing the o_type
 * pointer for some types.  Any type not listed here will have a value
 * of 0.  The types listed will set a code here to allow some time
 * critical areas of code to make quicker decisions (typically a switch)
 * based on the type.  It also allows faster decisions based on type
 * combinations (see PAIR() and TRI() below).
 */
#define TC_OTHER        0
#define TC_PC           1
#define TC_SRC          2
#define TC_PARSE        3
#define TC_OP           4
#define TC_STRING       5
#define TC_CATCH        6
#define TC_FORALL       7
#define TC_INT          8
#define TC_FLOAT        9
#define TC_REGEXP       10
#define TC_PTR          11
#define TC_ARRAY        12
#define TC_STRUCT       13
#define TC_SET          14

#define TC_NCODES       15
/* Max value of 15 dictated by PAIR (below). */

#define PAIR(a,b)       (((a) << 4) + (b))
#define TRI(a,b,t)      (((((a) << 4) + b) << 6) + t_subtype(t))

#define isfalse(o)      ((o) == objof(o_zero) || (o) == objof(&o_null))


/* From alloc.h */


/*
 * If WHOALLOC is defined to be non-zero (i.e. 1), every allocation records
 * the C source file and line number it was made on and how much was allocated.
 * It is then possible to print a summary, after running for a while, of what
 * is still allocated. Mainly for finding leaks, but it can also be
 * used for other debugging. Changing this requires total recompilation.
 */
#define WHOALLOC    0   /* Define to 1 to track who is using memory. */
#if WHOALLOC
#define DBGMEM      0   /* Set this to track _every_ allocation/free */
#endif  /*WHOALLOC*/


/*
 * Most allocated things will fit within 24 bytes, many of the rest within
 * about 50.  We keep our own lists of things of these sizes, and use the
 * native system's mechanism for the remainder.  Each items on our lists
 * is also allocated directly from the system.  Clearly some time and space
 * advantage would be gained from allocating in larger chunks and then
 * splitting up ourselves, but there are disadvantages too.
 *
 * Raw malloc's will end up being done of the sizes given here plus
 * sizeof(int) plus futher alignment requirements.  We allow these to be
 * set from the configuration file so they can be fine tuned for a
 * particular malloc. (eg. 64 may be a non-optimal size form some mallocs).
 */

#ifndef LIST1Z
#define LIST1Z      24
#endif
#define FEW_OBJS    (LIST1Z / 4)

#ifndef LIST2Z
#define LIST2Z      56
#endif
#define FEW_MORE_OBJS   (LIST2Z / 4)

/*
 * To be sure that the area returned by ici_raw_alloc is properly aligned
 * we must add to the pointer originally returned by malloc a size
 * which will maintain the worst case alignment requirement.
 * Even though we only need one byte of space for our header.
 *
 * The following structure is used as an overlay to make sure we add
 * the right amount to start user data at a good alignment position.
 */
typedef struct
{
#if !WHOALLOC
    int         ga_list;    /* Which fast free list, 0 if none. */
#else
#if !DBGMEM
    short       ga_list;
    short       ga_who;
    int         ga_size;
#else   /* DBGMEM */
    int         ga_list;    /* which fast free list */
    int         ga_size;
#endif  /* DBGMEM */
#endif
    union
    {
        char    gau_data[1];    /* The first byte of user data when not free.*/
        char    *gau_next;      /* Next free block when on fast free list. */
        double  gau_align;      /* Only to force alignment. */
    }
    gau;
}
    gahead_t;

/*
 * The number of bytes between the prefix block header and the start
 * of the user data. This is the overhead. (offsetof() from stddef.h).
 */
#define GALLOC_HEADZ    offsetof(gahead_t, gau.gau_data)

/*
 * Return a pointer to the header, given the user pointer.
 */
#define gahead(p)   ((gahead_t *)((char *)p - GALLOC_HEADZ))
/*
 * Return the user pointer given a pointer to the header.
 */
#define gadata(p)   (((gahead_t *)p)->gau.gau_data)
/*
 * Given a size, which, if any, fast free list should it be on?
 * Note that this will be a constant expression if z is a constant.
 */
#define galist(z)   ((z) <= LIST1Z ? 1 : (z) <= LIST2Z ? 2 : 0)

/*
 * Allocate memory as if by ici_raw_alloc(). But if there is currently a block
 * of suitable size on one of the fast free lists, just use that. If there
 * isn't resort to the real ici_raw_alloc() function.
 *
 * Every block allocated by ici_raw_alloc() is prefixed by a header which
 * contains an int. This int is 0 in general, but if the block is of an
 * appropriate size for one of the fast free lists, it is a small integer
 * index of that free list.
 */
#define ici_alloc(z) \
        (ici_fflist[galist(z)] != NULL \
        ? ici_new_mem += (z), ici_fflist[galist(z)] \
            = *(char **)(ici_fftmp = ici_fflist[galist(z)]), ici_fftmp \
        : ici_raw_alloc(z))

/*
 * Free memory allocated with ici_raw_alloc/ici_alloc. If it belongs on one
 * of the fast free lists, just put it on that. Otherwise resort to the real
 * function.
 */
#define ici_free(p) \
    do\
        if (gahead(p)->ga_list != 0) \
        { \
            *(char **)(p) = ici_fflist[gahead(p)->ga_list]; \
            ici_fflist[gahead(p)->ga_list] = (char *)(p); \
        } \
        else \
            ici_raw_free(p);\
    while (0)

extern DLI char *ici_fflist[3]; /* The array of free lists heads. */
extern DLI char *ici_fftmp;     /* Temporary used in ici_alloc() above. */
extern DLI long ici_old_mem;    /* Num bytes in use after last collect. */
extern DLI long ici_new_mem;    /* Num bytes alloced since last collect. */
extern void ici_raw_free(void *);
#if !WHOALLOC
extern void *ici_raw_alloc(int);
#else
extern void *ici_raw_alloc(int, char *, int);
#undef  ici_alloc
#undef  ici_free
#define ici_alloc(z)    ici_raw_alloc((z), __FILE__, __LINE__)
#define ici_free(p)     ici_raw_free(p)
#endif

#ifdef  SMALL
/*
 * If SMALL is defined we ignore all those macros and always use functions
 * for allocation. No fast free lists are used. The address returned by
 * malloc is the address of our objects. Incompatible with WHOALLOC.
 * If your malloc() is even slightly slow this will significantly degrade
 * performance.
 */
#undef  GALLOC_HEADZ
#undef  gahead
#undef  gadata
#undef  galist
#undef  ici_alloc
#undef  ici_free

#define GALLOC_HEADZ    0
#define gahead(p)       p
#define gadata(p)       p
#define galist(z)       0
#define ici_alloc(z)    ici_raw_alloc(z)
#define ici_free(p)     ici_raw_free(p)
#endif /* SMALL */

/* From buf.h */

/*
 * Ensure that buf points to enough memory to hold index n (plus room for
 * a '\0' at the end).
 */
#ifdef  SMALL
#define chkbuf(n)       ici_growbuf(n)
#else
#define chkbuf(n)       (ici_bufz > (int)(n) ? 0 : ici_growbuf(n))
#endif

#define buf     ici_buf

extern int      ici_growbuf(int);


/* From catch.h */

struct catchs
{
    object_t    o_head;
    object_t    *c_catcher;
    short       c_odepth;       /* Operand stack depth. */
    short       c_vdepth;       /* Variable stack depth. */
};
#define catchof(o)      ((catch_t *)(o))
#define iscatch(o)      ((o)->o_tcode == TC_CATCH)

/* From cfunc.h */


struct cfunc
{
    object_t    o_head;
    char        *cf_name;
    int         (*cf_cfunc)();
    int         (*cf_arg1)();
    char        *cf_arg2;
};
#define cfuncof(o)      ((cfunc_t *)(o))
#define iscfunc(o)      ((o)->o_type == &ici_cfunc_type)

/*
 * Convienience macro for use in static initialisations. Note that the
 * ici_cfunc_type pointer is patched in at run-time. This is only because
 * Windows has trouble making initialised address refs to data objects
 * across dynamic load boundaries.
 * ###Why is O_ATOM set?
 */
#define CF_OBJ          {0, O_ATOM, 1, 0, NULL}

/*
 * The n'th argument (first is 0) during execution of a function's C code.
 */
#define ARG(n)          (o_top[-2 - (n)])

/*
 * Count of actual arguments to this C function.
 */
#define NARGS()         (opof(x_top[-1])->op_code)

/*
 * A pointer to the first arg to this C function, decrement for next
 * and subsequent.
 */
#define ARGS()          (&o_top[-2])

/*
 * Return the cf_arg1 and cf_arg2 fields of the current C function.
 * The first is a function pointer, the second a char *.
 */
#define CF_ARG1()       (cfuncof(o_top[-1])->cf_arg1)
#define CF_ARG2()       (cfuncof(o_top[-1])->cf_arg2)


/* From array.h */

/*
 * The ICI array object. Array objects are implemented in a manner to
 * make them efficient to use as stacks. And they are used that way in the
 * execution engine. A single contiguous array of object pointers is
 * associated with the array. a_base points to its start, a_limit one
 * past its end and a_top somewhere in the middle. The stretch from a_base
 * to just less than a_top is the current contents of the array.
 */
struct array
{
    object_t    o_head;
    object_t    **a_top;    /* The next free slot. */
    object_t    **a_base;   /* The base of the array. */
    object_t    **a_limit;  /* Allocation limit, first one you can't use. */
};
#define arrayof(o)  ((array_t *)(o))
#define isarray(o)  ((o)->o_tcode == TC_ARRAY)

/*
 * Check that there are at least n elements on the end of array a. Sets error
 * on failure and return non-zero.
 */
#define popcheck(a, n)  ((a)->a_top - (a)->a_base < (n) ? ici_badindex() : 0)

/*
 * Check that there is room for n new elements on the end of a.  May reallocate
 * array memory to get more room. Return non-zero on failure, usual conventions.
 */
#define pushcheck(a, n) ((a)->a_limit-(a)->a_top < (n) ? ici_growarray((a),(n)) : 0)

/*
 * Ensure that the array a has i as a valid index.  Will grow and NULL fill
 * as necessary. Return non-zero on failure, usual conventions.
 */
#define arrayprobe(a, i) ((i) < 0 \
                || (a)->a_top-(a)->a_base <= (i) \
                || (objof(a)->o_flags & O_ATOM) \
                ? ici_faultarray((a), (i)) \
                : 0)


/* From int.h */

struct ints
{
    object_t    o_head;
    long        i_value;
};
#define intof(o)        ((int_t *)(o))
#define isint(o)        ((o)->o_tcode == TC_INT)

/* From float.h */

struct floats
{
    object_t    o_head;
    double      f_value;
};
#define floatof(o)      ((floats_t *)o)
#define isfloat(o)      ((o)->o_tcode == TC_FLOAT)

/* From exec.h */

union ostemp
{
    int_t       i;
    floats_t     f;
};

struct exec
{
    array_t     x_xs;
    array_t     x_os;
    array_t     x_vs;
    int         x_count;
    array_t     *x_xs_pc_cache;         /* See below. */
    array_t     *x_os_temp_cache;       /* See below. */
};
/*
 * x_xs_pc_cache        An array that shadows the execution stack. pc objects
 *                      exist only in a one-to-one relationship with a fixed
 *                      (for their life) position on the execution stack. This
 *                      cache holds pc objects that, if present at a
 *                      particular index equal to the corresponding execution
 *                      stack index, can be used to avoid a new allocation.
 *                      See new_pc() in pc.c.
 *
 * x_os_temp_cache      An array of pseudo int/float objects that shadows the
 *                      operand stack. The objects in this array (apart
 *                      from the NULLs) are unions of int and float objects
 *                      that can be used as intermediate results in specific
 *                      circumstances as flaged by the compiler. Specifically,
 *                      they are known to be immediately consumed by some operator
 *                      that is only sensitive to the value, not the address,
 *                      of the object. See binop.h.
 */

#ifdef MULTI

#include    "multi.h"

#define ici_ex  (PROC_VARS->v_ex)

#else

extern DLI exec_t ici_ex;

#endif

#define os      (&ici_ex.x_os)
#define xs      (&ici_ex.x_xs)
#define vs      (&ici_ex.x_vs)
#define o_top   ici_ex.x_os.a_top
#define x_top   ici_ex.x_xs.a_top
#define v_top   ici_ex.x_vs.a_top

#ifndef NODEBUGGING

/*
 * ICI debug interface.  exec() calls the functions in this interface
 * if debugging is enabled.  A default interface, with stubbed
 * implementations of these functions, is provided in the ICI core
 * (in idb2.c).  Debuggers will normally override the default with
 * a more useful set of functions.
 */
struct debug
{
    void    (*idbg_error)(char *, src_t *);
    void    (*idbg_fncall)(object_t *, object_t **, int);
    void    (*idbg_fnresult)(object_t *);
    void    (*idbg_src)(src_t *);
    void    (*idbg_watch)(object_t *, object_t *, object_t *);
};

#endif

/* From file.h */


struct ftype
{
    int         (*ft_getch)();
    int         (*ft_ungetch)();
    int         (*ft_putch)();
    int         (*ft_flush)();
    int         (*ft_close)();
    long        (*ft_seek)();
    int         (*ft_eof)();
    int         (*ft_write)();
};

struct file
{
    object_t    o_head;
    char        *f_file;
    ftype_t     *f_type;
    string_t    *f_name;    /* Reasonable name to call it by. */
};
#define fileof(o)   ((file_t *)(o))
#define isfile(o)   (objof(o)->o_type == &file_type)

#define F_CLOSED    0x10

/* From forall.h */

struct forall
{
    object_t    o_head;
    int         fa_index;
    object_t    *fa_objs[6];
};
#define fa_aggr         fa_objs[0]
#define fa_code         fa_objs[1]
#define fa_vaggr        fa_objs[2]
#define fa_vkey         fa_objs[3]
#define fa_kaggr        fa_objs[4]
#define fa_kkey         fa_objs[5]

#define forallof(o)     ((forall_t *)o)
#define isforall(o)     ((o)->o_tcode == TC_FORALL)

/* From func.h */

struct func
{
    object_t    o_head;
    array_t     *f_code;        /* The code of this function, atom. */
    array_t     *f_args;        /* Array of argument names. */
    struct_t    *f_autos;       /* Prototype struct of autos (incl. args). */
    string_t    *f_name;        /* Some name for the function (diagnostics). */
};

#define funcof(o)       ((func_t *)(o))
#define isfunc(o)       ((o)->o_type == &ici_func_type)


/* From mark.h */

struct marks
{
    object_t    o_head;
};
#define markof(o)       ((mark_t *)o)
#define ismark(o)       ((o) == objof(&o_mark))

/* From mem.h */

struct mem
{
    object_t            o_head;
    void                *m_base;
    size_t              m_length;       /* In m_accessz units. */
    int                 m_accessz;      /* Read/write size. */
    void                (*m_free)();
};

#define memof(o)        ((mem_t *)o)
#define ismem(o)        ((o)->o_type == &mem_type)

/* From method.h */

struct method
{
    object_t    o_head;
    object_t    *m_subject;
    object_t    *m_callable;
};
#define methodof(o)     ((method_t *)(o))
#define ismethod(o)     ((o)->o_type == &ici_method_type)


/* From null.h */

struct null
{
    object_t    o_head;
};
#define nullof(o)       ((null_t *)o)
#define isnull(o)       ((o) == objof(&o_null))


/* From op.h */

struct op
{
    object_t    o_head;
    int         (*op_func)();
    int         op_ecode;       /* See OP_* below. */
    int         op_code;
};
#define opof(o) ((op_t *)o)
#define isop(o) ((o)->o_tcode == TC_OP)

#define OP_OTHER        0       /* Use op_func. */
#define OP_CALL         1
#define OP_NAMELVALUE   2
#define OP_DOT          3
#define OP_DOTKEEP      4
#define OP_DOTRKEEP     5
#define OP_ASSIGN       6
#define OP_ASSIGNLOCAL  7
#define OP_EXEC         8
#define OP_LOOP         9
#define OP_IFNOTBREAK   10
#define OP_BREAK        11
#define OP_QUOTE        12
#define OP_BINOP        13
#define OP_AT           14
#define OP_SWAP         15
#define OP_BINOP_FOR_TEMP 16
#define OP_AGGR_KEY_CALL 17
#define OP_COLON        18
#define OP_COLONCARET   19
#define OP_METHOD_CALL  20
#define OP_SUPER_CALL   21
#define OP_ASSIGNLOCALVAR 22

/* From parse.h */

typedef struct
{
    int         t_what;         /* See TM_* and T_* below. */
    union
    {
        long    tu_int;
        double  tu_float;
        char    *tu_str;        /* Malloced string. */
        object_t *tu_obj;
    }
        tu;
}
    token_t;

#define t_int   tu.tu_int
#define t_float tu.tu_float
#define t_str   tu.tu_str
#define t_obj   tu.tu_obj

struct parse
{
    object_t    o_head;
    file_t      *p_file;
    int         p_lineno;       /* Diagnostic information. */
    short       p_sol;          /* At first char in line. */
    short       p_cr;           /* New-line cause by \r, not \n. */
    token_t     p_got;
    token_t     p_ungot;
    func_t      *p_func;        /* NULL when not within scope. */
    int         p_module_depth; /* Depth within module, 0 is file level. */
};
#define isparse(o)      ((o)->o_type == &parse_type)
#define parseof(o)      ((parse_t *)(o))

/* From pc.h */

struct pc
{
    object_t    o_head;
    array_t     *pc_code;
    object_t    **pc_next;
    object_t    **pc_limit;
};
#define pcof(o)         ((pc_t *)o)
#define ispc(o)         ((o)->o_tcode == TC_PC)

/* From ptr.h */

struct ptr
{
    object_t    o_head;
    object_t    *p_aggr;        /* The aggregate which contains the object. */
    object_t    *p_key;         /* The key which references it. */
};
#define ptrof(o)        ((ptr_t *)o)
#define isptr(o)        ((o)->o_tcode == TC_PTR)

/* From re.h */

#define regexpof(o)     ((regexp_t *)(o))
#define isregexp(o)     ((o)->o_tcode == TC_REGEXP)

/* From set.h */

struct sets
{
    object_t    o_head;
    int         s_nels;         /* How many slots used. */
    int         s_nslots;       /* How many slots allocated. */
    object_t    **s_slots;
};
#define setof(o)        ((set_t *)(o))
#define isset(o)        ((o)->o_tcode == TC_SET)

/* From skt.h */


#ifdef _WIN32
/*
 * Windows uses a special type to represent its SOCKET descriptors.
 * For correctness we include winsock.h here. Other platforms (i.e.,
 * BSD) are easier and use integers.
 */
#include <winsock.h>
#else
#define SOCKET  int
#endif

struct skt
{
    object_t    o_head;
    SOCKET      s_skt;
    int         s_closed;
};
#define sktof(o)        ((skt_t *)(o))
#define isskt(o)        ((o)->o_type == &socket_type)

/* From src.h */


struct src
{
    object_t    s_head;
    int         s_lineno;
    string_t    *s_filename;
};
#define srcof(o)        ((src_t *)o)
#define issrc(o)        ((o)->o_tcode == TC_SRC)

/* From str.h */


struct string
{
    object_t    o_head;
    struct_t    *s_struct;      /* Where we were last found on the vs. */
    slot_t      *s_slot;        /* And our slot. */
    long        s_vsver;        /* The vs version at that time. */
    unsigned long s_hash;       /* String hash code or 0 if not yet computed */
    int         s_nchars;
    char        s_chars[1];     /* And following bytes. */
};
#define stringof(o)     ((string_t *)o)
#define isstring(o)     ((o)->o_tcode == TC_STRING)

/*
 * Macros to assist external modules in getting ICI strings. To use, make
 * an include file (say icistr.h) with your strings, and what you want to
 * call them by, formatted like this:
 *
 *  ICI_STR(fred, "fred")
 *  ICI_STR(amp, "&")
 *
 * etc. Include that file in any files that access ICI strings.
 * Access them with either ICIS(fred) or ICISO(fred) which return
 * string_t* and object_t* pointers respectively. For example:
 *
 *  o = fetch(s, ICIS(fred));
 *
 * Next, in a source file, write:
 *
 *  #undef  ICI_STR
 *  #define ICI_STR ICI_STR_DECL
 *  #include "icistr.h"
 *
 *  int
 *  init_ici_str(void)
 *  {
 *  #undef  ICI_STR
 *  #define ICI_STR ICI_STR_MAKE
 *      return
 *  #include "icistr.h"
 *      0;
 *  }
 *  #undef  ICI_STR
 *  #define ICI_STR ICI_STR_NORM
 *
 * Finally, call init_ici_str() at startup. It returns 1 on error, usual
 * conventions.
 */
#define ICIS(name)              (ici_str_##name)
#define ICISO(name)             (objof(ICIS(name)))
#define ICI_STR_NORM(name, str) extern string_t *ici_str_##name;
#define ICI_STR_DECL(name, str) string_t *ici_str_##name;
#define ICI_STR_MAKE(name, str) (ICIS(name) = new_cname(str)) == NULL ||
#define ICI_STR_REL(name, str)  decref(ICIS(name));
#define ICI_STR                 ICI_STR_NORM

/* From struct.h */


struct slot
{
    object_t    *sl_key;
    object_t    *sl_value;
};

struct structs
{
    object_t    o_head;
    int         s_nels;         /* How many slots used. */
    int         s_nslots;       /* How many slots allocated. */
    struct_t    *s_super;       /* The super of this struct, may be NULL. */
    slot_t      *s_slots;
};
#define structof(o)     ((struct_t *)(o))
#define isstruct(o)     ((o)->o_tcode == TC_STRUCT)

/* From trace.h */


extern int trace_yes;
extern int trace_flags;

#define TRACE_LEXER         1
#define TRACE_EXPR          2
#define TRACE_INTRINSICS    4
#define TRACE_FUNCS         8
#define TRACE_MEM           16
#define TRACE_SRC           32
#define TRACE_GC            64

#define TRACE_ALL       (TRACE_EXPR|TRACE_FUNCS|TRACE_GC)

/* From wrap.h */


struct wrap
{
    wrap_t      *w_next;
    int         (*w_func)();
};

extern DLI wrap_t       *wraps;

#ifdef __cplusplus
}
#endif

#endif /* ICI_ICI_H */
