/*-----------------------------------------------------------------*-C-*---
 * File:    handc/runtime/scheme.h
 *
 *          Copyright (C)1997 Donovan Kolbly <d.kolbly@rscheme.org>
 *          as part of the RScheme project, licensed for free use.
 *          See <http://www.rscheme.org/> for the latest information.
 *
 * File version:     1.39
 * File mod date:    1997.11.29 23:10:48
 * System build:     v0.7.2, 97.12.21
 *
 * Purpose:          api interface functions and root vector
 *------------------------------------------------------------------------*/

/*
 *   Application interface to standard scheme data structures
 *   and RScheme extensions
 *
 *  
*/

#ifndef _H_RSCHEME_SCHEME
#define _H_RSCHEME_SCHEME

#include <rscheme/obj.h>
#include <stdio.h>

/*
 *  raise an exception
 */

_rs_volatile void scheme_error( const char *msg, unsigned num_args, ... );
_rs_volatile void raise_exception( int type, int argc, ... );
_rs_volatile void raise_error( obj err_object );
_rs_volatile void type_check_error( obj thing, 
				    const char *class_name, 
				    int fplace_code );

#define NUM_RSCHEME_GLOBALS (50)

extern obj rscheme_global[NUM_RSCHEME_GLOBALS];

/*  these are the "well-known" objects
 *  they are initialized from a vector in the
 *  boot image
 */

#define boot_image              rscheme_global[0]  /* *IS* the bootvec */
#define boot_args               rscheme_global[1]  /* boot arglist */
#define symbol_table 		rscheme_global[2]
#define interrupt_handlers	rscheme_global[3]
#define exception_handler_proc	rscheme_global[4]  /* scheme_error(), etc. */
#define dequeue_class	        rscheme_global[5]
#define continue_intr_tmpl	rscheme_global[6]

#define class_class 		rscheme_global[7]

#define pair_class 		rscheme_global[8]
#define vector_class 		rscheme_global[9]
#define string_class 		rscheme_global[10]
#define symbol_class 		rscheme_global[11]

#define closure_class 		rscheme_global[12]
#define template_class		rscheme_global[13]
#define partcont_class		rscheme_global[14]
#define binding_envt_class      rscheme_global[15]

#define tlv_class		rscheme_global[16]
#define byte_vector_class	rscheme_global[17]

#define boolean_class 		rscheme_global[18]
#define nil_class 		rscheme_global[19]
#define ascii_char_class 	rscheme_global[20]
#define unicode_char_class 	rscheme_global[21]
#define unique_obj_class 	rscheme_global[22]
#define fixnum_class 		rscheme_global[23]

#define double_float_class	rscheme_global[24]
#define function_class 		rscheme_global[25]

#define spare_1_class 	rscheme_global[26]
#define spare_2_class 	rscheme_global[27]
#define spare_3_class 	rscheme_global[28]

#define install_dir             rscheme_global[29] /* filled in at runtime */
#define allocation_area_class   rscheme_global[30]
#define default_alloc_area      rscheme_global[31] /* filled in at patchtime */
#define long_int_class          rscheme_global[32]
#define finalizing_list         rscheme_global[33]
#define unicode_string_class    rscheme_global[34]
#define os_error_class          rscheme_global[35]
#define condition_class         rscheme_global[36]
#define type_check_failed_class rscheme_global[37]
#define function_place_class    rscheme_global[38]
#define return_from_call_scheme_template rscheme_global[39]
#define c_signal_names          rscheme_global[40] /* filled in at runtime */
#define load_cache_and_call_proc rscheme_global[41]
#define gf_dispatch_template    rscheme_global[42]

#define mp_data_class           rscheme_global[43]
#define rect_complex_class      rscheme_global[44]
#define mp_rational_class       rscheme_global[45]
#define bignum_class            rscheme_global[46]

#define rscheme_global_ref(offset) rscheme_global[(offset)/sizeof(obj)]
#define rscheme_global_set(offset,expr) (rscheme_global[(offset)/sizeof(obj)]\
					 = (expr))

/***************** profiling *****************/
/*  functions for general-purpose (user) profiling */

void rsprof_start( const char *path, rs_bool append_q );
rs_bool rsprof_stop( void );
void rsprof_collect_objects( obj setup, obj otbl );
void rsprof_app_defn_rec( obj key, obj val );

/*
 *  functions and macros to support profiling the system
 *  intended for my personal research use
 */

#ifdef RS_PROFILE

void rs_profile_init( void );
void rs_profile_close( void );

void rs_profile2( const char *label, UINT_32 value_1, UINT_32 value_2 );
#else
#define rs_profile2(label,v1,v2) 0 /* do nothing */
#endif

#define rs_profile1(label,val) rs_profile2(label,val,0)
#define rs_profile0(label) rs_profile2(label,0,0)

/***************** arithmetic *****************/
/*
 *  these builtin operations handle arithmetic on
 *  the basic number system, which is only <fixnum> 
 *  and <double-float>
 */

obj basic_plus( obj a, obj b );
obj basic_minus( obj a, obj b );
obj basic_mul( obj a, obj b );
obj basic_div( obj a, obj b );

int basic_cmp( obj a, obj b );

#define basic_gt_q(a,b) ((basic_cmp(a,b)>0)?YES:NO)
#define basic_ge_q(a,b) ((basic_cmp(a,b)>=0)?YES:NO)
#define basic_lt_q(a,b) ((basic_cmp(a,b)<0)?YES:NO)
#define basic_le_q(a,b) ((basic_cmp(a,b)<=0)?YES:NO)
#define basic_eq_q(a,b) ((basic_cmp(a,b)==0)?YES:NO)
#define basic_ne_q(a,b) ((basic_cmp(a,b)!=0)?YES:NO)

/***************** miscellaneous *****************/

CIH_DECL rs_bool NULL_P( obj thing );
rs_bool TEMPLATE_P( obj thing );
rs_bool BYTE_VECTOR_P( obj thing );

CIH_DECL rs_bool LONGFLOAT_P( obj thing );
IEEE_64 extract_float( obj longfloat );
obj make_float( IEEE_64 longfloat );
IEEE_64 get_float( obj arg, const char *fn, const char *arg_name );

char *procedure_name( obj tmpl );
obj fluid_assq( obj key );
obj addr_to_name( obj tmpl, obj addr );
obj clone( obj thing );
obj clone2( obj thing, obj new_class );

obj all_instances( obj of_class );
obj all_pointers_to( obj an_instance );
void gc_now( void );

/***************** functions *****************/

CIH_DECL rs_bool FUNCTION_P( obj thing );
CIH_DECL obj make_closure( obj envt, obj tmpl );

/***************** partial continuations *****************/

/***************** pairs *****************/

CIH_DECL rs_bool PAIR_P( obj thing );
CIH_DECL obj cons( obj car, obj cdr );
CIH_DECL obj pair_car( obj pair );
CIH_DECL obj pair_cdr( obj pair );

#define pair_set_car(pair,item) gvec_write(pair,SLOT(0),item)
#define pair_set_cdr(pair,item) gvec_write(pair,SLOT(1),item)

/***************** vectors *****************/

rs_bool VECTOR_P( obj thing );
obj make_empty_vector( UINT_32 length );
obj vector_ref( obj vector, obj index );
obj vector_set( obj vector, obj index, obj value );
obj subvector( obj vector, obj index, obj limit );

/***************** strings *****************/

CIH_DECL rs_bool STRING_P( obj thing );

CIH_DECL char *string_text( obj str );
CIH_DECL UINT_32 string_length( obj str );

rs_bool string_eq( obj str1, obj str2 );
rs_bool string_ci_eq( obj str1, obj str2 );
int string_cmp( obj str1, obj str2 );
int string_ci_cmp( obj str1, obj str2 );
obj make_string( const char *text );
obj string_ref( obj str, UINT_32 index );
void string_set( obj str, UINT_32 index, obj ch );

void bvec_copy(obj dst, INT_32 dst_offset,
	       obj src, INT_32 src_offset, INT_32 len );
obj bvec_hash( obj bvec, INT_32 offset, INT_32 len );
obj bvec_ci_hash( obj bvec, INT_32 offset, INT_32 len );
obj rs_string_search( obj str, obj seek, INT_32 skipn );

#define byte_string_length(s) (SIZEOF_PTR(s)-1)
#define byte_string_text(s)  ((UINT_8 *)PTR_TO_DATAPTR(s))

#define unicode_string_length(str) ((SIZEOF_PTR(str)/2)-1)
#define unicode_string_text(str) ((UINT_16*)(PTR_TO_DATAPTR(str)))

#define BYTE_STRING_P(s) STRING_P(s)
#define UNICODE_STRING_P(s) OBJ_ISA_PTR_OF_CLASS(s,unicode_string_class)

/***************** symbols *****************/

rs_bool SYMBOL_P( obj thing );
obj intern( obj str );
obj symbol_hash( obj symbol );
const char *symbol_text( obj symbol );
obj symbol_str( obj symbol );

obj lookup_symbol( const char *str );

/***************** top-level vars *****************/

CIH_DECL rs_bool TLV_P( obj thing );

CIH_DECL obj tlv_value( obj tlv );
obj tlv_name( obj tlv );  /* not necessarily available (returns #f if not) */

CIH_DECL void tlv_set_value( obj tlv, obj value );

/***************** classes *****************/

CIH_DECL obj object_class( obj thing );
CIH_DECL rs_bool CLASS_P( obj thing );
rs_bool class_is_gvec( obj a_class );
obj class_name( obj a_class );
CIH_DECL obj class_supers( obj a_class );
CIH_DECL obj class_category( obj a_class );
unsigned class_image_mode( obj a_class );

/* returns YES for indirect instances/subclasses as well */

CIH_DECL rs_bool instance_p( obj thing, obj a_class );
CIH_DECL rs_bool subclass_p( obj class1, obj class2 );
CIH_DECL rs_bool instance_cat_p( obj thing, obj a_category );
CIH_DECL rs_bool in_category_p( obj a_class, obj a_category );

#define FUNCTION_CATEGORY  (int2fx(1))
#define CLASS_CATEGORY     (int2fx(2))

/***************** dequeues *****************/

obj make_dequeue( void );
rs_bool dequeue_empty( obj deq );
obj dequeue_count( obj deq );
obj dequeue_state( obj deq );
void dequeue_push_back( obj deq, obj item );
void dequeue_push_front( obj deq, obj item );
obj dequeue_pop_back( obj deq );
obj dequeue_pop_front( obj deq );

/**************** type checking **************/

#include <rscheme/chektype.h>

/** INITIALIZATION **/

void init_runtim( void );
obj load_initial_heap( const char *path, obj *args, rs_bool verbose );
void init_math( void );

#ifdef INLINES
#include <rscheme/interim.ci>
#endif

#include <rscheme/hashmain.h>
#include <rscheme/hashfn.h>
#include <rscheme/stdiox.h>
#include <rscheme/allocns.h>
#include <rscheme/osglue.h>

/*  handy, but almost obsolete, low-level debugging fns.
 *
 *  (these functions print a subset of scheme data sensibly, but are
 *  very useful from, say, gdb, or when the scheme runtime is wedged)
 *
 *  !!!fprinto should NOT be considered a usual way to render things!!!
 *
 */

void fnprinto( FILE *dest, obj item, unsigned len );
void fprinto( FILE *dest, obj item );
void debug( obj item );
void debug_slots( obj item );  /* print the slots, too */
void fdebug_slots( FILE *dest, obj item );

/*  define this to provide a SIGUSR-based leak detection tool
    #define SIGUSR_HOOKS

*/
#endif /* _H_RSCHEME_SCHEME */