#include <host.h>
#include <stdio.h>
#include <setjmp.h>

#define int8_ int56_		/* curl int8 */
#define int16_ int4954_		/* curl int16 */
#define array45type_ array_type_ 
#define static45array45type_ static_array_type_ 
#define proc45type_ proc_type_ 
#define numeric45type_ numeric_type_ 
#define base45class45entry_ base_class_entry_

typedef long word;
typedef (*curl_proc)();

#define CURL_ENV curl45env_
extern word CURL_ENV, keyword45marker45token_, para45sep45token_, no45method_closure;


#define WORD_AS_FLOAT(x) (*((float *)(&(x))))
#define FLOAT_AS_WORD(x) (*((word *)(&(x))))


#define CURL_ARRAY_INDEX(i) ((i)+1)
#define ARRAY_LENGTH(a) (*(word *)(a))
#define TEXT_DATA(a) (((char *)a)+sizeof(word))
#define TYPE_MTABLE(t) (((word **)((Type)t)->master)[-1])
#define word_deref(w) (*((word *)w))
#define word_assign(v,w) (*((word *)w)=v)

typedef unsigned char *bptr;
typedef word *wptr;

typedef void *KeywordType;


/*  The following structures all have the type as the first field, at least
    for debugging purposes.  This type is not necessary because anything that
    needs the type will be passed an <any> type object.  But this information
    may make things like pickling and GC easier.
*/



typedef enum {tk_type, tk_base, tk_class, tk_array, tk_proc} TypeKind;

typedef struct type {
  struct symbol *name;			/* name of type (debugging) */
  word immediate_size;		/* size of thing inside another object */
  word inst_size;		/* size of instance if new is allowed */
  struct binding *bindings;
  struct type **base_classes;
  struct base_class_entry *all_base_classes;
  word master;			/* new copies this */
  struct type *package;
  struct text *canonical_string;
  struct type *next;
  curl_proc gc_proc;
  word access;
  word flags;
} *Type;			

#define CLASSF_STERILE	1	/* Class is sterile (no descendents)	    */

#define hidden_type(obj) ( ((Type *) (((word *)obj)[-1])) [1])
#define hidden_narrowing_offset(obj) ( ((word *) (((word *)obj)[-1])) [2])
#define GET_METHOD(obj, bitoff, index) ((curl_proc) ((((word **)obj)[(bitoff-BPW)/BPW])[index]))

#define IS_NUMERIC_TYPE(t) (t && (hidden_type(t) == (Type)numeric_type_))
#define IS_CLASS_TYPE(t) (t && (hidden_type(t) == (Type)type_))
#define IS_ARRAY_TYPE(t) (t && (hidden_type(t) == (Type)array_type_))
#define IS_STATIC_ARRAY_TYPE(t) (t && (hidden_type(t) == (Type)static_array_type_))
#define IS_PROC_TYPE(t) (t && (hidden_type(t) == (Type)proc_type_))
#define IS_FLOAT_TYPE(t) ((t) == (Type)float_)

typedef struct numeric_type {
  struct type t;
  curl_proc add;
} *NumericType;


typedef struct array_type {
  struct type t;
  Type etype;
} *ArrayType;

typedef struct static_array_type {
  struct type t;
  Type etype;
  word length;
} *StaticArrayType;

typedef struct proc_type {
  struct type t;
  Type *ret_types;
  Type *arg_types;
  struct symbol **keyword_names;
  struct type **keyword_types;
  word flags;
} *ProcType;


typedef struct any {
  Type type;
  word value;
} Any, *pAny;

/* flags field of Binding */
#define BF_CONSTANT 1  /* Its a constant binding (no slot in instance) */
#define BF_METHOD   2  /* Its a method binding. */

/* access field of Binding */
#define BA_PUBLIC 1  
#define BA_PRIVATE 2
#define BA_PROTECTED 4
#define BA_PACKAGE 8		/* default */
#define BA_SYNCHRONIZED 16

typedef struct binding
 { struct symbol *name;		/* symbol: name being bound.		    */
   struct binding *next;	/* next binding in type.		    */
   struct type *value_type;	/* type of value */
   Any value;			/* default/constant value.	    */
   word offset;			/* Offset from base of object (bytes)	    */
   struct type *binder;		/* class that binds this */
   word access;			/* public, protected, etc. */
   word flags;			/* flag bits				    */
 } *Binding;

typedef struct base_class_entry {
  struct type *base_class;
  word offset;
  struct base_class_entry *next;
} *BaseClassEntry;

typedef struct ProcDebugInfo_ {
  struct text *fname;
  struct symbol *class_name;
  struct symbol *method_name;
  curl_proc address;
  struct ProcDebugInfo_ *next;
} *ProcDebugInfo;

typedef struct text {
  word len;
  unsigned char data[0];
} *Text;

typedef struct symbol
 { Text pname;			
   word hash;
   struct symbol *next;	/* next symbol in bucket		    */
 } *Symbol;

typedef struct list {
  Any first;
  struct list *rest;
} *List;
  
typedef struct closure {
  curl_proc code;
  word *env;
} *Closure;
  
#define bit_code 'B'
#define int8_code 'b'
#define int16_code 'h'
#define int_code 'i'
#define float_code 'f'
#define any_code 'a'
#define void_code 'v'
#define char_code 'c'
#define word_code 'w'
#define array_code '['		/* [,type */
#define static_array_code 's'	/* s, len-hi, len-lo, type */
#define proc_code 'p'		/* p, ret-type, nargs-hi, nargs-lo, args */
#define nary_proc_code 'n'	
#define keyword_proc_code 'k'	/* p, ret-type, nargs-hi, nargs-lo, args,
				   nkeys-hi, nkeys-lo, keywords
				   keywords: name-hi, name-lo, name, type */
#define nary_keyword_proc_code 'q'
#define class_code 't'		/* t, name-hi, name-lo, name */

extern word bit_, char_, int8_, int16_, int_, float_, any_, void_, text_, binding_, base_class_entry_, ProcDebugInfo_, word_, list_, closure_, symbol_, object_, Area_, typevec_, symbolvec_, wordv_, vector_;

extern word type_, proc_type_, array_type_, static_array_type_, numeric_type_;

extern Text current_filename;

#define LOAD1(base, offset) ((((unsigned long *)base)[offset >> BPWSHIFT] >> (offset & (BPW-1))) & 1)
			     
#define LOAD8(base, offset) *((bptr)base + (offset >> 3))
#define LOAD16(base, offset) *((INT16 *)((bptr)base + (offset >> 3)))
#define LOAD32(base, offset) *((INT32 *)((bptr)base + (offset >> 3)))
#define LOADANY(target, base, offset) (addr = (word *)((bptr)base + (offset >> 3)), target##type = addr[0], target##value = addr[1])
#define LOADP(base, offset) ((word)((bptr)base + (offset >> 3)))

#define STORE1(value, base, offset) (addr = ((word *)base)+(offset >> BPWSHIFT), *addr = (*addr & ~(1 << (offset & (BPW-1)))) | ((value & 1) << (offset & (BPW-1))))
#define STORE8(value, base, offset) *((bptr)base + (offset >> 3)) = value
#define STORE16(value, base, offset) *((INT16 *)((bptr)base + (offset >> 3))) = value
#define STORE32(value, base, offset) *((INT32 *)((bptr)base + (offset >> 3))) = (word)value
#define STOREANY(v, base, offset) (addr = (word *)((bptr)base + (offset >> 3)), addr[0] = v##type, addr[1] = v##value)

#define CAST_FROM_ANY_TO_STERILE(xt,xv,t) (xt == t ? xv : cast_from_any(xt,xv,t))

#define CURL_EQ_ANY(t1,v1,t2,v2) ((t1 == t2) && (v1 == v2))
  
#define integer_add(a1, a2) ((a1) + (a2))
#define integer_sub(a1, a2) ((a1) - (a2))
#define integer_mul(a1, a2) ((a1) * (a2))
#define integer_div(a1, a2) ((a1) / (a2))
#define integer_rem(a1, a2) ((a1) % (a2))
#define integer_or(a1, a2) ((a1) | (a2))
#define integer_and(a1, a2) ((a1) & (a2))
#define integer_xor(a1, a2) ((a1) ^ (a2))
#define integer_sll(a1, a2) ((a1) << (a2))
#define integer_srl(a1, a2) (((unsigned)(a1)) >> (a2))
#define integer_sra(a1, a2) (((signed)(a1)) >> (a2))
#define integer_eq(a1, a2) ((a1) == (a2))
#define integer_ne(a1, a2) ((a1) != (a2))
#define integer_lt(a1, a2) ((a1) < (a2))
#define integer_gt(a1, a2) ((a1) > (a2))
#define integer_ge(a1, a2) ((a1) >= (a2))
#define integer_le(a1, a2) ((a1) <= (a2))

extern word add45any_closure, sub45any_closure, mul45any_closure,
  div45any_closure, rem45any_closure, and45any_closure, or45any_closure,
  xor45any_closure, sll45any_closure, srl45any_closure, sra45any_closure,
  eq45any_closure, ne45any_closure, lt45any_closure, gt45any_closure,
  le45any_closure, ge45any_closure;

#define pointer_eq(a1, a2) ((a1) == (a2))
#define pointer_ne(a1, a2) ((a1) != (a2))

word curl_float(float);
int GetIndex(word class, char *method_name);
Symbol curl_symbol(char *str);
Text string_to_text(unsigned char *str, int len);
word no_method(word w);

#define STACK_ALLOC_INSTANCE(result,t) \
{\
  int psize;\
  word *master, *obj;\
  Type type = (Type)(t);\
  psize = type->inst_size / 8 + sizeof(word);\
  master = (word *)type->master;\
  obj = (word *)alloca(psize);\
  memcpy(obj, master-1, psize);\
  (result) = (word)(obj+1);\
}

#define STACK_ALLOC_ARRAY(result,t,nelts) \
{\
  ArrayType type = (ArrayType)(t);\
  int i, data_psize = ((nelts * type->etype->immediate_size) + 7) / 8;\
  wptr new = (wptr)alloca(data_psize + 2*sizeof(word));\
  new[0] = (word)t + 1;\
  new[1] = (word)nelts;\
  (result) = (word)(new+1);\
}

extern TSKEY default_area_key, try_stack_key, current_context_key, context_default_area_key;
extern word system_area;

#define default_area ((word)TS(default_area_key))
#define current_context ((word)TS(current_context_key))
#define try_stack ((TryFrame)TS(try_stack_key))
#define context_default_area ((word)TS(context_default_area_key))

#define set_default_area(val) SET_TS(default_area_key,((void *)val))
#define set_current_context(val) SET_TS(current_context_key,((void *)val))
#define set_try_stack(val) SET_TS(try_stack_key,((void *)val))
#define set_context_default_area(val) SET_TS(context_default_area_key,((void *)val))


typedef struct try_frame {
  struct try_frame *previous_frame;
  Type thrown_type;
  word thrown_value;
  int is_active;
  jmp_buf j;
} *TryFrame;

extern  word unknown45exception_;
extern word Exception_;
extern int debugger_flag;

/* extract stack pointer for gc */
#if defined (__i386__) || defined (WIN32)

extern word * (*fetch_esp_func) (void);
#define FETCH_ESP() ((*fetch_esp_func) ())

#elif defined (__sparc__)

extern int flush_register_windows (int);
extern word *get_sp (void);

#define FETCH_ESP() (flush_register_windows (0), get_sp ())

#endif
Text cons_message(const char *message);
extern word make_closure(curl_proc code, word *env);
extern void call_curl_error(char *message);
extern void call_curl_error_1(char *message, word type, word value);
extern void call_curl_error_2(char *message, word t1, word v1, word t2, word v2);