scheme48/c/scheme48.h.in

/* Copyright (c) 1993-2007 by Richard Kelsey and Jonathan Rees.
   See file COPYING. */

#ifdef __cplusplus
extern "C"
{
#endif

/* 
 * For building and linking DLLs on Windows, we need to mark functions
 * the DLL calls in Scheme 48 and vice versa explicitly---and differently
 * depending on whether we're compiling the DLL or Scheme 48 itself.
 *
 * Therefore, on Windows, we assume that __COMPILING_SCHEME48_ITSELF__
 * is defined when Scheme 48 itself is being compiled, and not when
 * we're compiling something external against it.
 */

#ifdef _WIN32
#  ifdef __COMPILING_SCHEME48_ITSELF__
#    define S48_EXTERN_ADD_ONS __declspec(dllexport)
#  else
#    define S48_EXTERN_ADD_ONS __declspec(dllimport)
#  endif
#endif

#ifndef S48_EXTERN_ADD_ONS
#  define S48_EXTERN_ADD_ONS
#endif

#define S48_EXTERN extern S48_EXTERN_ADD_ONS

#include "scheme48write-barrier.h"

typedef long	s48_value;

#define NO_ERRORS 0    /* errno value */

/* Misc stuff */

#define S48_EQ_P(v1, v2) ((v1) == (v2))
/* Superceded name for the above definition, retained for compatibility. */
#define S48_EQ(v1, v2) ((v1) == (v2)) 

#define S48_MAX_FIXNUM_VALUE ((1 << 29) - 1)
#define S48_MIN_FIXNUM_VALUE (-1 << 29)

S48_EXTERN int		s48_stob_has_type(s48_value, int);
S48_EXTERN long		s48_stob_length(s48_value, int);
S48_EXTERN long		s48_stob_byte_length(s48_value, int);
S48_EXTERN s48_value	s48_stob_ref(s48_value, int, long);
S48_EXTERN void		s48_stob_set(s48_value, int, long, s48_value);
S48_EXTERN char		s48_stob_byte_ref(s48_value, int, long);
S48_EXTERN void		s48_stob_byte_set(s48_value, int, long, char);

S48_EXTERN char *	s48_register_gc_rootB(char *);
S48_EXTERN void		s48_unregister_gc_rootB(char *);
S48_EXTERN void		s48_push_gc_rootsB(char *, long);
S48_EXTERN char		s48_pop_gc_rootsB(void);
S48_EXTERN char		s48_pop_gc_roots_up_to_markerB(char *);

S48_EXTERN s48_value	s48_make_string(int, long);
S48_EXTERN void		s48_string_set(s48_value s, long i, long c);
S48_EXTERN long		s48_string_ref(s48_value s, long i);
S48_EXTERN long		s48_string_length(s48_value s);
S48_EXTERN s48_value	s48_enter_string_latin_1(char* s);
S48_EXTERN s48_value	s48_enter_string_latin_1_n(char* s, long count);
S48_EXTERN void		s48_copy_latin_1_to_string(char* s, s48_value sch_s);
S48_EXTERN void		s48_copy_latin_1_to_string_n(char* s, long len, s48_value sch_s);
S48_EXTERN void		s48_copy_string_to_latin_1(s48_value sch_s, char* s);
S48_EXTERN void		s48_copy_string_to_latin_1_n(s48_value sch_s, long start, long count, char* s);
S48_EXTERN s48_value	s48_enter_string_utf_8(char* s);
S48_EXTERN s48_value	s48_enter_string_utf_8_n(char* s, long count);
S48_EXTERN long		s48_string_utf_8_length(s48_value s);
S48_EXTERN long		s48_string_utf_8_length_n(s48_value s, long start, long count);
S48_EXTERN void		s48_copy_string_to_utf_8(s48_value sch_s, char* s);
S48_EXTERN void		s48_copy_string_to_utf_8_n(s48_value sch_s, long start, long count, char* s);

S48_EXTERN s48_value	s48_enter_char(long);
S48_EXTERN long 	s48_extract_char(s48_value);
S48_EXTERN s48_value	s48_enter_fixnum(long);
S48_EXTERN long		s48_extract_fixnum(s48_value);
S48_EXTERN s48_value	s48_enter_integer(long);
S48_EXTERN long		s48_extract_integer(s48_value);
S48_EXTERN s48_value	s48_enter_double(double);
S48_EXTERN double	s48_extract_double(s48_value);
S48_EXTERN s48_value	s48_cons(s48_value, s48_value);
S48_EXTERN s48_value	s48_enter_byte_vector(char *, long);
S48_EXTERN char *	s48_extract_byte_vector(s48_value);
S48_EXTERN s48_value	s48_make_vector(int, s48_value);
S48_EXTERN s48_value	s48_make_byte_vector(int);
S48_EXTERN s48_value	s48_enter_byte_string(char *);
S48_EXTERN s48_value	s48_enter_byte_substring(char *, long);
S48_EXTERN s48_value	s48_make_record(s48_value);
S48_EXTERN s48_value	s48_make_weak_pointer(s48_value);
S48_EXTERN void		s48_check_record_type(s48_value, s48_value);
S48_EXTERN long		s48_length(s48_value);
S48_EXTERN s48_value	s48_enter_pointer(void *);
S48_EXTERN s48_value	s48_get_imported_binding(char *);
S48_EXTERN void		s48_define_exported_binding(char *, s48_value);

S48_EXTERN s48_value	s48_set_channel_os_index(s48_value, long);
S48_EXTERN s48_value	s48_add_channel(s48_value, s48_value, long);
S48_EXTERN void		s48_close_channel(long);

S48_EXTERN void		s48_check_enum_set_type(s48_value, s48_value);
S48_EXTERN long		s48_enum_set2integer(s48_value);
S48_EXTERN s48_value	s48_integer2enum_set(s48_value, long);

S48_EXTERN s48_value	s48_call_scheme(s48_value proc, long nargs, ...);

#define S48_EXPORT_FUNCTION(p) (s48_define_exported_binding(#p, s48_enter_pointer((void*) p)))

#define S48_MAKE_VALUE(type) (s48_make_byte_vector(sizeof(type)))
S48_EXTERN void *	s48_value_pointer(s48_value);

#define S48_EXTRACT_VALUE_POINTER(x, type) ((type *) s48_value_pointer(x))
#define S48_EXTRACT_VALUE(x, type) (*(S48_EXTRACT_VALUE_POINTER((x), type)))
#define S48_SET_VALUE(x, type, v) (S48_EXTRACT_VALUE((x), type) = (v))

#define S48_UNSAFE_EXTRACT_VALUE_POINTER(x, type)		\
  (S48_ADDRESS_AFTER_HEADER((x), type))
#define S48_UNSAFE_EXTRACT_VALUE(x, type)			\
  (*(S48_UNSAFE_EXTRACT_VALUE_POINTER((x), type)))
#define S48_UNSAFE_SET_VALUE(x, type, v)			\
  (S48_UNSAFE_EXTRACT_VALUE((x), type) = (v))

#define S48_UNSAFE_EXTRACT_DOUBLE(x)				\
  (*(S48_ADDRESS_AFTER_HEADER((x), double)))

#define S48_DECLARE_GC_PROTECT(n) long ___gc_buffer[(n)+2]

#define S48_GC_PROTECT_1(v) \
  (___gc_buffer[2]=(long)&(v), \
   s48_push_gc_rootsB((char *) ___gc_buffer, 1))

#define S48_GC_PROTECT_2(v1, v2) \
  (___gc_buffer[2]=(long)&(v1), ___gc_buffer[3]=(long)&(v2), \
   s48_push_gc_rootsB((char *) ___gc_buffer, 2))

#define S48_GC_PROTECT_3(v1, v2, v3) \
  (___gc_buffer[2]=(long)&(v1), \
   ___gc_buffer[3]=(long)&(v2), \
   ___gc_buffer[4]=(long)&(v3), \
   s48_push_gc_rootsB((char *) ___gc_buffer, 3))

#define S48_GC_PROTECT_4(v1, v2, v3, v4) \
  (___gc_buffer[2]=(long)&(v1), \
   ___gc_buffer[3]=(long)&(v2), \
   ___gc_buffer[4]=(long)&(v3), \
   ___gc_buffer[5]=(long)&(v4), \
   s48_push_gc_rootsB((char *) ___gc_buffer, 4))

#define S48_GC_PROTECT_5(v1, v2, v3, v4, v5) \
  (___gc_buffer[2]=(long)&(v1), \
   ___gc_buffer[3]=(long)&(v2), \
   ___gc_buffer[4]=(long)&(v3), \
   ___gc_buffer[5]=(long)&(v4), \
   ___gc_buffer[6]=(long)&(v5), \
   s48_push_gc_rootsB((char *) ___gc_buffer, 5))

#define S48_GC_PROTECT_6(v1, v2, v3, v4, v5, v6) \
  (___gc_buffer[2]=(long)&(v1), \
   ___gc_buffer[3]=(long)&(v2), \
   ___gc_buffer[4]=(long)&(v3), \
   ___gc_buffer[5]=(long)&(v4), \
   ___gc_buffer[6]=(long)&(v5), \
   ___gc_buffer[7]=(long)&(v6), \
   s48_push_gc_rootsB((char *) ___gc_buffer, 6))

#define S48_GC_PROTECT_7(v1, v2, v3, v4, v5, v6, v7) \
  (___gc_buffer[2]=(long)&(v1), \
   ___gc_buffer[3]=(long)&(v2), \
   ___gc_buffer[4]=(long)&(v3), \
   ___gc_buffer[5]=(long)&(v4), \
   ___gc_buffer[6]=(long)&(v5), \
   ___gc_buffer[7]=(long)&(v6), \
   ___gc_buffer[8]=(long)&(v7), \
   s48_push_gc_rootsB((char *) ___gc_buffer, 7))

#define S48_GC_PROTECT_8(v1, v2, v3, v4, v5, v6, v7, v8) \
  (___gc_buffer[2]=(long)&(v1), \
   ___gc_buffer[3]=(long)&(v2), \
   ___gc_buffer[4]=(long)&(v3), \
   ___gc_buffer[5]=(long)&(v4), \
   ___gc_buffer[6]=(long)&(v5), \
   ___gc_buffer[7]=(long)&(v6), \
   ___gc_buffer[8]=(long)&(v7), \
   ___gc_buffer[9]=(long)&(v8), \
   s48_push_gc_rootsB((char *) ___gc_buffer, 8))

#define S48_GC_PROTECT_9(v1, v2, v3, v4, v5, v6, v7, v8, v9) \
  (___gc_buffer[2]=(long)&(v1), \
   ___gc_buffer[3]=(long)&(v2), \
   ___gc_buffer[4]=(long)&(v3), \
   ___gc_buffer[5]=(long)&(v4), \
   ___gc_buffer[6]=(long)&(v5), \
   ___gc_buffer[7]=(long)&(v6), \
   ___gc_buffer[8]=(long)&(v7), \
   ___gc_buffer[9]=(long)&(v8), \
   ___gc_buffer[10]=(long)&(v9), \
   s48_push_gc_rootsB((char *) ___gc_buffer, 9))

#define S48_GC_PROTECT_10(v1, v2, v3, v4, v5, v6, v7, v8, v9, v10) \
  (___gc_buffer[2]=(long)&(v1), \
   ___gc_buffer[3]=(long)&(v2), \
   ___gc_buffer[4]=(long)&(v3), \
   ___gc_buffer[5]=(long)&(v4), \
   ___gc_buffer[6]=(long)&(v5), \
   ___gc_buffer[7]=(long)&(v6), \
   ___gc_buffer[8]=(long)&(v7), \
   ___gc_buffer[9]=(long)&(v8), \
   ___gc_buffer[10]=(long)&(v9), \
   ___gc_buffer[11]=(long)&(v10), \
   s48_push_gc_rootsB((char *) ___gc_buffer, 10))

#define S48_GC_UNPROTECT()				\
   do { if (! s48_pop_gc_rootsB())			\
       	  s48_raise_scheme_exception( S48_EXCEPTION_GC_PROTECTION_MISMATCH, 0); \
      } while(0)

#define S48_GC_PROTECT_GLOBAL(v) ((void*)(s48_register_gc_rootB((char *)&(v))))
#define S48_GC_UNPROTECT_GLOBAL(f) (s48_unregister_gc_rootB((char *)(f)))

/* Exceptions */

S48_EXTERN void s48_raise_scheme_exception(long type, long nargs, ...);
S48_EXTERN void s48_raise_argument_type_error(s48_value value);
S48_EXTERN void s48_raise_argument_number_error(s48_value value,
						s48_value min,
						s48_value max);
S48_EXTERN void s48_raise_range_error(s48_value value,
				      s48_value min,
				      s48_value max);
S48_EXTERN void s48_raise_closed_channel_error();
S48_EXTERN void s48_raise_os_error(int the_errno);
S48_EXTERN void s48_raise_string_os_error(char *reason);
S48_EXTERN void s48_raise_out_of_memory_error();

/* Old names retained for compatibility; use the versions with 'ument_'
   after the '_arg'. */

S48_EXTERN void s48_raise_argument_type_error(s48_value value);
S48_EXTERN void s48_raise_argument_number_error(s48_value value,
						s48_value min,
						s48_value max);

/* Type checking */

#define S48_CHECK_PAIR(v) do { if (!S48_PAIR_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_FIXNUM(v) do { if (!S48_FIXNUM_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_STRING(v) do { if (!S48_STRING_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_BYTE_VECTOR(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_CHANNEL(v) do { if (!S48_CHANNEL_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_RECORD(v) do { if (!S48_RECORD_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_VALUE(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_EXPORT_BINDING(v) do { if (!S48_EXPORT_BINDING_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_BOOLEAN(v)					\
  do { s48_value s48_temp = (v);				\
       if (s48_temp != S48_TRUE && s48_temp != S48_FALSE)	\
           s48_raise_argument_type_error(v); } while (0)

#define S48_VALUE_P(v) (S48_BYTE_VECTOR_P(v))

#define S48_TRUE_P(v) ((v) == S48_TRUE)
#define S48_FALSE_P(v) ((v) == S48_FALSE)
#define S48_EXTRACT_BOOLEAN(v) ((v) != S48_FALSE)
#define S48_ENTER_BOOLEAN(v) ((v) ? S48_TRUE : S48_FALSE)

S48_EXTERN void s48_check_record_type(s48_value record, s48_value type_binding);

#define S48_SHARED_BINDING_CHECK(binding)					\
  do { if (S48_UNSPECIFIC == S48_SHARED_BINDING_REF(binding))		\
         s48_raise_scheme_exception(S48_EXCEPTION_UNBOUND_EXTERNAL_NAME, 1,	\
				    S48_SHARED_BINDING_NAME(binding));	\
  } while(0)

#ifdef __cplusplus
/* closing brace for extern "C" */
}
#endif