#ifndef XEN_H #define XEN_H /* macros for extension language support * * Ruby: covers 1.8.0 to present * Forth: covers 1.0 to present * s7: all versions * None: all versions */ #define XEN_MAJOR_VERSION 3 #define XEN_MINOR_VERSION 26 #define XEN_VERSION "3.26" /* HISTORY: * * 29-Jul-16: Xen_define_unsafe_typed_procedure. * -------- * 20-Aug-15: Xen_define_typed_procedure, Xen_define_typed_dilambda. * -------- * 27-Dec: Xen_arity in s7 now uses s7_arity. Xen_define_integer_procedure, Xen_define_dilambda. * 21-Feb: Xen_is_number and friends. * 7-Jan-14: in s7, C_TO_XEN_STRING and XEN_TO_C_STRING now treat a null string as a string (not #f). * -------- * 9-Nov: removed XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER. * 11-Oct: removed XEN_EXACT_P. * 23-Sep: removed *_OR_ELSE, XEN_ARG_*, and OFF_T* macros; added XEN_ARGIFY* to the Forth section. * 7-Jul-13: removed int64 stuff (it was not used anywhere). Made various Ruby changes (NUM2ULL etc). * -------- * 5-Nov: minor s7-related changes. * 9-July: XEN_VECTOR_ELEMENTS and XEN_VECTOR_COPY. * 4-June: XEN_PROVIDE * 8-May: added description arg to XEN_DEFINE_SIMPLE_HOOK and XEN_DEFINE_HOOK, only used in scheme. * 12-Jan-12: added reverse argument to s7 version of XEN_MAKE_OBJECT_TYPE. * -------- * 20-Oct: XEN_LONG_LONG_P. * 5-Jun-11: XEN_DEFINE_SAFE_PROCEDURE, an experiment with s7. * -------- * 25-Nov: updates for Ruby 1.9.*. * 7-Nov: XEN_ADD_HOOK. * 23-Oct: use s7_call_with_location, rather than s7_call, for better error reporting. * 19-Mar: removed s7_define_set_function (removed encapsulation from s7, so it's not useful anymore). * 17-Feb: various s7 changes. * 5-Feb-10: XEN_ASSOC_REF and XEN_ASSOC_SET. XEN_ASSOC_REF returns the value, not the key/value pair. * -------- * 16-Dec: removed Guile support. removed xen_return_first (a guile-ism). * 2-Nov: XEN_VECTOR_RANK. * 5-Oct: use s7_c_pointer etc. * 7-Aug: use s7_new_type_x in XEN_MAKE_OBJECT_TYPE. XEN_DEFINE_SET_PROCEDURE. * 27-Jul: INT64_T cases paralleling OFF_T (the latter may go away someday). * 14-Jul: s7_define_function_star via XEN_DEFINE_PROCEDURE_STAR. * 6-Jul: cleaned up XEN_WRAP_C_POINTER et al (Mike Scholz). * 29-Jun: some fth changes. * 30-Mar: added a bunch of file-oriented functions for s7 (xen.c). * 14-Mar: removed XEN_LOCAL_GC_PROTECT and XEN_LOCAL_GC_UNPROTECT. * 14-Jan-09: s7_xen_initialize. * -------- * 17-Nov: use s7_define_constant in XEN_DEFINE_CONSTANT. * 1-Nov: changed s7 and Guile C_TO_XEN_STRING slightly. * 16-Oct: removed Gauche support. * 10-Aug: S7, a TinyScheme derivative. * changed XEN_NUMERATOR and XEN_DENOMINATOR to return off_t not XEN. * 23-Jul: be more careful about wrapping POINTERs (they say 64-bit MS C void* == unsigned long long, but not unsigned long). * 30-Jun: XEN_OFF_T_IF_BOUND_P. * 19-May: more const char* arg declarations. * 14-May: changed XEN_ARITY in Guile to use scm_procedure_property. * 1-May: XEN_NAN_P and XEN_INF_P (Guile). * 23-Apr: try to get old Gauche (8.7) to work again. * 1-Mar-08: no ext case now checks arg consistency. * -------- * 12-Dec: Gauche uses COMPNUM, not COMPLEX (after 0.8.7?), NUMBERP for complex? * 21-Nov: XEN_HAVE_COMPLEX_NUMBERS. * 18-Jul: Gauche error handling changes. * 28-Apr: Gauche API changes in versions 0.8.8, 0.8.10, and 0.9. * 14-Feb: XEN_PUTS and friends for fth (Mike). * 17-Jan-07: rb_errinfo changes (Mike Scholz). * -------- * 14-Nov: check for Scm_EvalRec (Gauche 0.8.8). * 9-Sep: XEN_LOAD_PATH and XEN_ADD_TO_LOAD_PATH * 1-Sep: string and array changes for Ruby (from Mike). * 7-Aug: more careful list length handling in Ruby (from Mike). * 23-May: added xen_rb_repl_set_prompt to set (no-gui) Ruby repl prompt. * 12-May: changed HAVE_RATIOS to XEN_HAVE_RATIOS. * 17-Apr: removed XEN_MAKE_OBJECT. * 15-Apr: Gauche support. * 28-Mar-06: Forth support thanks to Mike Scholz. * -------- * 7-Nov: xen_rb_defined_p (Mike Scholz). * 16-Sep: removed some debugging extras that caused confusion on 64-bit machines. * 12-Aug: include guile setter procedure names for better error reporting. * 14-Jun: XEN_DEFINE (XEN value, not assumed to be int as in XEN_DEFINE_CONSTANT). * XEN_ASSOC, XEN_MEMBER, and XEN_PROCEDURE_NAME for Scheme side. * XEN_DEFINE_HOOK and XEN_DEFINE_SIMPLE_HOOK no longer take the "Var" arg. * 18-May: deprecate XEN_NUMBER_OR_BOOLEAN_IF_BOUND_P and XEN_NUMBER_OR_BOOLEAN_P. * 29-Mar: C_TO_XEN_STRINGN changes. * 24-Mar: Ruby properties (Mike Scholz). * 8-Mar: Ruby improvements in keywords and hooks (Mike Scholz). * 7-Mar: C99 complex number changes (creal, _Complex_I) (Steve Bankowitz). * 2-Mar: Ruby support for off_t (Mike Scholz). * 4-Jan-05: more guile changes. * -------- * 31-Dec: removed "caller" arg from *_NO_CATCH. * 10-Nov: scm_c_vector* (new Guile functions) * 21-Oct: XEN_LIST_REVERSE, (using rb_ary_dup available in 1.8) * 7-Oct: keyword changes for new Guile. * 28-Sep: deprecated *_WITH_CALLER -- these no longer do anything useful in Guile. * NaNs and Infs -> 0 or 0.0 in XEN_TO_C_INT|DOUBLE -- perhaps I should add another set of macros? * 23-Aug: more Guile name changes. * 12-Aug: more Guile name changes, C_TO_XEN_STRINGN (Guile) * 3-Aug: xen_to_c_int bugfix thanks to Kjetil S. Matheussen. * 29-Jul: deprecated XEN_TO_C_BOOLEAN_OR_TRUE. * 21-Jul: deprecated XEN_TO_SMALL_C_INT and C_TO_SMALL_XEN_INT. * use new Guile 1.7 numerical function names (under flag HAVE_SCM_TO_SIGNED_INTEGER). * 28-Jun: XEN_REQUIRED_ARGS_OK to make it easier to turn off this check. * 9-June: complex number conversions (Guile) -- Ruby complex numbers are an optional module? * 21-May: plug some memory leaks in Ruby cases. * 23-Feb: changed DEBUGGING to XEN_DEBUGGING, added redefinition checks under that switch. * 2-Feb: C_TO_XEN_CHAR, ratio support (Guile), XEN_CONS_P, XEN_PAIR_P, etc * 6-Jan: XEN_VARIABLE_REF in Guile changed to support 1.4 and older versions. * 5-Jan-04: hook support in Ruby thanks to Michael Scholz. * -------- * 1-Nov: protect several macros from hidden double evaluations. * 29-Sep: fixed incorrect assumption in xen_rb_cons (xen.c) that arg2 was list. * 8-Sep: removed xen_malloc -- can't remember now why this existed. * 19-Aug: xen_rb_str_new2 to avoid unwanted side-effects. * 12-Aug: various changes for ISO C99. * 30-Jul: use new SCM_VECTOR_REF/SET macros if they're defined. * 7-Apr: changes to error handlers for more perspicuous error messages * changed XEN_PROTECT_FROM_GC in Ruby to use rb_gc_register_address, added XEN_UNPROTECT_FROM_GC (rb_gc_unregister_address) * 10-Mar: XEN_OUT_OF_RANGE_ERROR, XEN_BAD_ARITY_ERROR * 17-Feb: XEN_HOOK_P * 20-Jan-03: added Windows case for auto-import loader bugfix. * -------- * 19-Dec: proc arg checks for Ruby (to make sure XEN_[N|V]ARGIFY|DEFINE_PROCEDURE[etc] agree) * 29-Jul: SCM_WRITABLE_VELTS for current CVS Guile * 28-May: off_t equivalents in Ruby 1.7 * 6-May: off_t (long long) macros. * 2-Jan-02: removed TIMING and MCHECK debugging stuff, VARIABLE_REF -> XEN_VARIABLE_REF * -------- * 22-Sep-01: removed (redundant) UNSIGNED_LONG macros -- use ULONG instead */ #ifndef __cplusplus #include #ifndef _MSC_VER #include #else #ifndef true #define bool unsigned char #define true 1 #define false 0 #endif #endif #endif #if ((!__NetBSD__) && ((_MSC_VER) || (!defined(__STC__)) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ < 199901L)))) #define __func__ __FUNCTION__ #endif /* ------------------------------ RUBY ------------------------------ */ /* other possibilities: * XEN_DEFINE_METHOD, XEN_DEFINE_ALIAS, rb_ary_unsift = XEN_LIST_PREPEND?, * various property macros -- in Scheme as well, rb_const_defined, rb_yield, XEN_INCLUDE_MODULE, * rb_id2name (XEN_SYMBOL...), rb_raise. */ #if HAVE_RUBY #ifdef _GNU_SOURCE #undef _GNU_SOURCE #endif #include #if defined(__GNUC__) && (!(defined(__cplusplus))) #ifndef _GNU_SOURCE #define _GNU_SOURCE #endif #endif #define XEN_OK 1 #define XEN VALUE #define XEN_FILE_EXTENSION "rb" #define XEN_COMMENT_STRING "#" #define XEN_LANGUAGE_NAME "Ruby" #define XEN_FALSE Qfalse #define XEN_TRUE Qtrue #define XEN_TRUE_P(a) ((a) == Qtrue) #define XEN_FALSE_P(a) ((a) == Qfalse) #define C_TO_XEN_BOOLEAN(a) ((a) ? Qtrue : Qfalse) #define XEN_TO_C_BOOLEAN(a) (!(XEN_FALSE_P(a))) /* #define XEN_UNDEFINED Qundef */ #define XEN_UNDEFINED ID2SYM(rb_intern("undefined")) #define XEN_BOUND_P(Arg) ((Arg) != XEN_UNDEFINED) #if defined(__GNUC__) && (!(defined(__cplusplus))) #define XEN_BOOLEAN_P(Arg) ({ XEN _xen_h_7_ = Arg; (XEN_TRUE_P(_xen_h_7_) || XEN_FALSE_P(_xen_h_7_)); }) #define XEN_NUMBER_P(Arg) ({ int _xen_h_8_ = TYPE(Arg); ((_xen_h_8_ == T_FLOAT) || (_xen_h_8_ == T_FIXNUM) || (_xen_h_8_ == T_BIGNUM)); }) #define XEN_INTEGER_P(Arg) ({ int _xen_h_9_ = TYPE(Arg); ((_xen_h_9_ == T_FIXNUM) || (_xen_h_9_ == T_BIGNUM)); }) #define XEN_PROCEDURE_P(Arg) ({ XEN _xen_h_10_ = Arg; (XEN_BOUND_P(_xen_h_10_) && (rb_obj_is_kind_of(_xen_h_10_, rb_cProc))); }) #define XEN_KEYWORD_P(Obj) ({ XEN _xen_h_12_ = Obj; (XEN_BOUND_P(_xen_h_12_) && SYMBOL_P(_xen_h_12_)); }) #else #define XEN_BOOLEAN_P(Arg) (XEN_TRUE_P(Arg) || XEN_FALSE_P(Arg)) #define XEN_NUMBER_P(Arg) ((TYPE(Arg) == T_FLOAT) || (TYPE(Arg) == T_FIXNUM) || (TYPE(Arg) == T_BIGNUM)) #define XEN_INTEGER_P(Arg) ((TYPE(Arg) == T_FIXNUM) || (TYPE(Arg) == T_BIGNUM)) #define XEN_PROCEDURE_P(Arg) (XEN_BOUND_P(Arg) && (rb_obj_is_kind_of(Arg, rb_cProc))) #define XEN_KEYWORD_P(Obj) (XEN_BOUND_P(Obj) && SYMBOL_P(Obj)) #endif /* ---- lists ---- */ #define XEN_EMPTY_LIST Qnil #define XEN_NULL_P(a) (XEN_LIST_LENGTH(a) == 0) #define XEN_CONS_P(Arg) (TYPE(Arg) == T_ARRAY) #define XEN_PAIR_P(Arg) (TYPE(Arg) == T_ARRAY) #define XEN_CONS(Arg1, Arg2) xen_rb_cons(Arg1, Arg2) #define XEN_CONS_2(Arg1, Arg2, Arg3) xen_rb_cons2(Arg1, Arg2, Arg3) #define XEN_CAR(a) xen_rb_list_ref(a, 0) #define XEN_CADR(a) xen_rb_list_ref(a, 1) #define XEN_CADDR(a) xen_rb_list_ref(a, 2) #define XEN_CADDDR(a) xen_rb_list_ref(a, 3) #define XEN_CDR(a) xen_rb_cdr(a) #define XEN_CDDR(a) XEN_CDR(XEN_CDR(a)) #define XEN_CDDDR(a) XEN_CDR(XEN_CDR(XEN_CDR(a))) #define XEN_LIST_P(Arg) ((Arg) == XEN_EMPTY_LIST || XEN_CONS_P(Arg)) #define XEN_LIST_P_WITH_LENGTH(Arg, Len) ((Len = XEN_LIST_LENGTH(Arg)) >= 0) #define XEN_LIST_LENGTH(Arg) xen_rb_list_length(Arg) #define XEN_EQ_P(a, b) ((a) == (b)) #define XEN_LIST_1(a) rb_ary_new3(1, a) #define XEN_LIST_2(a, b) rb_ary_new3(2, a, b) #define XEN_LIST_3(a, b, c) rb_ary_new3(3, a, b, c) #define XEN_LIST_4(a, b, c, d) rb_ary_new3(4, a, b, c, d) #define XEN_LIST_5(a, b, c, d, e) rb_ary_new3(5, a, b, c, d, e) #define XEN_LIST_6(a, b, c, d, e, f) rb_ary_new3(6, a, b, c, d, e, f) #define XEN_LIST_7(a, b, c, d, e, f, g) rb_ary_new3(7, a, b, c, d, e, f, g) #define XEN_LIST_8(a, b, c, d, e, f, g, h) rb_ary_new3(8, a, b, c, d, e, f, g, h) #define XEN_LIST_9(a, b, c, d, e, f, g, h, i) rb_ary_new3(9, a, b, c, d, e, f, g, h, i) #define XEN_COPY_ARG(Lst) xen_rb_copy_list(Lst) #define XEN_LIST_REF(Lst, Num) xen_rb_list_ref(Lst, Num) #define XEN_LIST_SET(Lst, Num, Val) xen_rb_list_set(Lst, Num, Val) #define XEN_APPEND(X, Y) rb_ary_concat(X, Y) #define XEN_LIST_REVERSE(Lst) ((Lst == XEN_EMPTY_LIST) ? XEN_EMPTY_LIST : rb_ary_reverse(XEN_COPY_ARG(Lst))) /* ---- numbers ---- */ #define XEN_ZERO INT2NUM(0) #define XEN_DOUBLE_P(Arg) XEN_NUMBER_P(Arg) #define XEN_TO_C_DOUBLE(a) NUM2DBL(a) #define C_TO_XEN_DOUBLE(a) rb_float_new(a) #define XEN_TO_C_INT(a) rb_num2long(a) /* apparently no complex numbers (built-in) in Ruby? */ #define XEN_COMPLEX_P(Arg) 1 #define C_TO_XEN_COMPLEX(a) XEN_ZERO #define XEN_TO_C_COMPLEX(a) 0.0 #define XEN_ULONG_P(Arg1) XEN_INTEGER_P(Arg1) #define XEN_WRAPPED_C_POINTER_P(Arg1) XEN_INTEGER_P(Arg1) #define C_TO_XEN_INT(a) INT2NUM(a) #define XEN_TO_C_ULONG(a) NUM2ULONG(a) #ifdef ULONG2NUM #define C_TO_XEN_ULONG(a) ULONG2NUM((unsigned long)a) #else #define C_TO_XEN_ULONG(a) UINT2NUM((unsigned long)a) #endif #ifdef NUM2ULL /* ruby 1.9.3 */ #define C_TO_XEN_LONG_LONG(a) LL2NUM(a) #define XEN_TO_C_LONG_LONG(a) NUM2LL(a) #define XEN_ULONG_LONG_P(Arg) XEN_INTEGER_P(Arg) #define XEN_TO_C_ULONG_LONG(Arg) NUM2ULL(Arg) /* NUM2ULONG(Arg) */ #define C_TO_XEN_ULONG_LONG(Arg) ULL2NUM(Arg) /* INT2NUM(Arg) */ #else /* older versions -- no dependable version number in ruby -- these macros may not work on a 64-bit machine */ #ifndef OFFT2NUM #define OFFT2NUM(a) INT2NUM(a) #endif #ifndef NUM2OFFT #define NUM2OFFT(a) NUM2LONG(a) #endif #define C_TO_XEN_LONG_LONG(a) OFFT2NUM(a) #define XEN_TO_C_LONG_LONG(a) NUM2OFFT(a) #define XEN_ULONG_LONG_P(Arg) XEN_INTEGER_P(Arg) #define XEN_TO_C_ULONG_LONG(Arg) NUM2OFFT(Arg) #define C_TO_XEN_ULONG_LONG(Arg) OFFT2NUM(Arg) #endif /* ---- strings ---- */ #define XEN_STRING_P(Arg) ((TYPE(Arg) == T_STRING) && (!SYMBOL_P(Arg))) #define C_TO_XEN_STRING(a) xen_rb_str_new2((char *)a) #define C_TO_XEN_STRINGN(a, len) rb_str_new((char *)a, len) #ifndef RSTRING_PTR #define XEN_TO_C_STRING(Str) RSTRING(Str)->ptr #else #define XEN_TO_C_STRING(Str) RSTRING_PTR(Str) #endif #define XEN_CHAR_P(Arg) XEN_STRING_P(Arg) #define XEN_TO_C_CHAR(Arg) XEN_TO_C_STRING(Arg)[0] #define C_TO_XEN_CHAR(Arg) rb_str_new((char *)(&(Arg)), 1) #define XEN_NAME_AS_C_STRING_TO_VALUE(a) xen_rb_gv_get(a) #define XEN_EVAL_C_STRING(Arg) xen_rb_eval_string_with_error(Arg) #define XEN_TO_STRING(Obj) xen_rb_obj_as_string(Obj) #define XEN_LOAD_FILE(a) xen_rb_load_file_with_error(C_TO_XEN_STRING(a)) #define XEN_LOAD_PATH XEN_NAME_AS_C_STRING_TO_VALUE("$LOAD_PATH") #define XEN_ADD_TO_LOAD_PATH(Path) xen_rb_add_to_load_path(Path) /* ---- hooks ---- */ #define XEN_HOOK_P(Arg) xen_rb_hook_p(Arg) #define XEN_HOOK_PROCEDURES(a) xen_rb_hook_to_a(a) #define XEN_CLEAR_HOOK(a) xen_rb_hook_reset_hook(a) #define XEN_HOOKED(a) (!xen_rb_hook_empty_p(a)) #define XEN_DEFINE_HOOK(Name, Descr, Arity, Help) xen_rb_create_hook((char *)(Name), Arity, (char *)Help) #define XEN_DEFINE_SIMPLE_HOOK(Descr, Arity) xen_rb_create_simple_hook(Arity); #define XEN_ADD_HOOK(Hook, Func, Name, Doc) xen_rb_add_hook(Hook, (XEN (*)())Func, Name, Doc) /* ---- vectors ---- */ #define XEN_VECTOR_P(Arg) (TYPE(Arg) == T_ARRAY) #define XEN_VECTOR_LENGTH(Arg) xen_rb_list_length(Arg) #define XEN_VECTOR_REF(Vect, Num) xen_rb_list_ref(Vect, Num) #define XEN_VECTOR_SET(Vect, Num, Val) xen_rb_list_set(Vect, Num, Val) #define XEN_MAKE_VECTOR(Num, Fill) xen_rb_ary_new_with_initial_element(Num, Fill) #define XEN_VECTOR_TO_LIST(a) a #define XEN_VECTOR_COPY(Vect) rb_ary_dup(Vect) #define XEN_ASSOC_REF(Item, Lst) xen_assoc(Item, Lst) #define XEN_ASSOC_SET(Sym, Val, Lst) xen_set_assoc(Sym, Val, Lst) /* ---- symbols ---- */ #define XEN_SYMBOL_P(Arg) SYMBOL_P(Arg) #define XEN_SYMBOL_TO_C_STRING(a) ((char *)rb_id2name(SYM2ID(a))) #define C_STRING_TO_XEN_SYMBOL(a) ID2SYM(rb_intern(a)) #define XEN_SYMBOL_TO_STRING(Sym) C_TO_XEN_STRING(XEN_SYMBOL_TO_C_STRING(Sym)) #define XEN_DOCUMENTATION_SYMBOL C_STRING_TO_XEN_SYMBOL("documentation") #define XEN_OBJECT_HELP(Name) rb_documentation(Name) #define XEN_SET_OBJECT_HELP(Name, Help) rb_set_documentation(Name, Help) #define C_SET_OBJECT_HELP(name, help) XEN_SET_OBJECT_HELP(C_TO_XEN_STRING(name), C_TO_XEN_STRING(help)) #define XEN_VARIABLE_SET(a, b) xen_rb_gv_set(a, b) #define XEN_VARIABLE_REF(a) xen_rb_gv_get(a) #define XEN_DEFINE_CONSTANT(Name, Value, Help) \ do { \ char *temp; \ temp = xen_scheme_constant_to_ruby(Name); \ rb_define_global_const(temp, C_TO_XEN_INT(Value)); \ if ((Name) && (Help)) C_SET_OBJECT_HELP(temp, Help); \ if (temp) free(temp); \ } while (0) #define XEN_DEFINE_VARIABLE(Name, Var, Value) \ { \ char *temp; \ Var = Value; \ temp = xen_scheme_global_variable_to_ruby(Name); \ rb_define_variable(temp, (VALUE *)(&Var)); \ if (temp) free(temp); \ } #define XEN_DEFINE(Name, Value) xen_rb_define(Name, Value) #define XEN_DEFINED_P(Name) xen_rb_defined_p(Name) /* ---- C structs ---- */ #define XEN_MARK_OBJECT_TYPE void * #define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, Mark, Free) return(Data_Wrap_Struct(Tag, Mark, Free, Val)) #define XEN_MAKE_OBJECT(Tag, Val, Mark, Free) Data_Wrap_Struct(Tag, Mark, Free, Val) #define XEN_OBJECT_REF(a) DATA_PTR(a) #define XEN_OBJECT_TYPE VALUE #define XEN_OBJECT_TYPE_P(OBJ, TAG) (XEN_BOUND_P(OBJ) && (rb_obj_is_instance_of(OBJ, TAG))) #define XEN_MAKE_OBJECT_TYPE(Typ, Siz) xen_rb_define_class(Typ) #define XEN_MAKE_OBJECT_FREE_PROCEDURE(Type, Wrapped_Free, Original_Free) \ static void *Wrapped_Free(XEN obj) \ { \ Original_Free((Type *)obj); \ return(NULL); \ } #define XEN_MAKE_OBJECT_PRINT_PROCEDURE(Type, Wrapped_Print, Original_Print) \ static XEN Wrapped_Print(XEN obj) \ { \ XEN val; \ char *str; \ str = Original_Print((Type *)XEN_OBJECT_REF(obj)); \ val = C_TO_XEN_STRING(str); \ free(str); \ return(val); \ } /* ---- procedures ---- */ #ifdef __cplusplus #ifdef ANYARGS #define XEN_PROCEDURE_CAST (XEN (*)(ANYARGS)) #define XEN_VALUE_ARG_PROCEDURE_CAST (XEN (*)(VALUE)) #else #define XEN_PROCEDURE_CAST (XEN (*)()) #define XEN_VALUE_ARG_PROCEDURE_CAST (XEN (*)()) #endif #else #define XEN_PROCEDURE_CAST #define XEN_VALUE_ARG_PROCEDURE_CAST #endif #define XEN_ARITY(Func) rb_funcall(Func, rb_intern("arity"), 0) #define XEN_REQUIRED_ARGS(Func) xen_rb_required_args(XEN_ARITY(Func)) #define XEN_REQUIRED_ARGS_OK(Func, Args) (xen_rb_required_args(XEN_ARITY(Func)) == Args) #define XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) \ do { \ char *temp; \ temp = xen_scheme_procedure_to_ruby(Name); \ rb_define_global_function(temp, XEN_PROCEDURE_CAST Func, ((RstArg > 0) ? -2 : (OptArg > 0) ? -1 : ReqArg)); \ if ((Name) && (Doc)) C_SET_OBJECT_HELP(temp, Doc); \ if (temp) free(temp); \ } while (0) #define XEN_DEFINE_PROCEDURE_WITH_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \ do { \ XEN_DEFINE_PROCEDURE(Get_Name, XEN_PROCEDURE_CAST Get_Func, Get_Req, Get_Opt, 0, Get_Help); \ XEN_DEFINE_PROCEDURE(Set_Name, XEN_PROCEDURE_CAST Set_Func, Set_Req, Set_Opt, 0, Get_Help); \ } while (0) #define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) #define XEN_CALL_0(Func, Caller) xen_rb_funcall_0(Func) #define XEN_CALL_1(Func, Arg1, Caller) rb_funcall(Func, rb_intern("call"), 1, Arg1) #define XEN_CALL_2(Func, Arg1, Arg2, Caller) rb_funcall(Func, rb_intern("call"), 2, Arg1, Arg2) #define XEN_CALL_3(Func, Arg1, Arg2, Arg3, Caller) rb_funcall(Func, rb_intern("call"), 3, Arg1, Arg2, Arg3) #define XEN_CALL_4(Func, Arg1, Arg2, Arg3, Arg4, Caller) rb_funcall(Func, rb_intern("call"), 4, Arg1, Arg2, Arg3, Arg4) #define XEN_CALL_5(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Caller) rb_funcall(Func, rb_intern("call"), 5, Arg1, Arg2, Arg3, Arg4, Arg5) #define XEN_CALL_6(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Caller) rb_funcall(Func, rb_intern("call"), 6, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6) #define XEN_APPLY(Func, Args, Caller) xen_rb_apply(Func, Args) #define XEN_CALL_0_NO_CATCH(Func) xen_rb_funcall_0(Func) #define XEN_CALL_1_NO_CATCH(Func, Arg1) rb_funcall(Func, rb_intern("call"), 1, Arg1) #define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) rb_funcall(Func, rb_intern("call"), 2, Arg1, Arg2) #define XEN_CALL_3_NO_CATCH(Func, Arg1, Arg2, Arg3) rb_funcall(Func, rb_intern("call"), 3, Arg1, Arg2, Arg3) #define XEN_APPLY_NO_CATCH(Func, Args) xen_rb_apply(Func, Args) /* ---- keywords, etc ---- */ #define XEN_KEYWORD_EQ_P(k1, k2) ((k1) == (k2)) #define XEN_MAKE_KEYWORD(Arg) xen_rb_make_keyword(Arg) #define XEN_PROVIDE(a) rb_provide(a) #define XEN_PROTECT_FROM_GC(Var) rb_gc_register_address(&(Var)) #define XEN_UNPROTECT_FROM_GC(Var) rb_gc_unregister_address(&(Var)) /* ---- errors ---- */ #define XEN_ERROR_TYPE(Name) xen_rb_intern(Name) #if USE_SND #define XEN_ERROR(Type, Info) snd_rb_raise(Type, Info) #define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) \ snd_rb_raise(XEN_ERROR_TYPE("out-of-range"), \ XEN_LIST_5(C_TO_XEN_STRING("~A: argument ~A, ~A, is out of range (~A)"), \ C_TO_XEN_STRING(xen_scheme_procedure_to_ruby(Caller)), \ C_TO_XEN_INT(ArgN), \ Arg, \ C_TO_XEN_STRING(Descr))) #define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) \ snd_rb_raise(XEN_ERROR_TYPE("wrong-type-arg"), \ XEN_LIST_5(C_TO_XEN_STRING("~A: argument ~A, ~A, should be ~A"), \ C_TO_XEN_STRING(xen_scheme_procedure_to_ruby(Caller)), \ C_TO_XEN_INT(ArgN), \ Arg, \ C_TO_XEN_STRING(Descr))) #else #define XEN_ERROR(Type, Info) xen_rb_raise(Type, Info) #define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) \ rb_raise(rb_eRangeError, "%s: argument %d, %s, is out of range (%s)\n", \ Caller, (int)ArgN, XEN_AS_STRING(Arg), Descr) #define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) \ rb_raise(rb_eTypeError, "%s: argument %d, %s, should be %s\n", \ Caller, (int)ArgN, XEN_AS_STRING(Arg), Descr) #endif #define XEN_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) \ if (!(Assertion)) \ XEN_WRONG_TYPE_ARG_ERROR(Caller, Position, Arg, Correct_Type) #define XEN_THROW(Type, Info) xen_rb_raise(Type, Info) #define XEN_ARGIFY_1(OutName, InName) \ static XEN OutName(int argc, XEN *argv, XEN self) \ { \ return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED)); \ } #define XEN_ARGIFY_2(OutName, InName) \ static XEN OutName(int argc, XEN *argv, XEN self) \ { \ return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ (argc > 1) ? argv[1] : XEN_UNDEFINED)); \ } #define XEN_ARGIFY_3(OutName, InName) \ static XEN OutName(int argc, XEN *argv, XEN self) \ { \ return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ (argc > 1) ? argv[1] : XEN_UNDEFINED, \ (argc > 2) ? argv[2] : XEN_UNDEFINED)); \ } #define XEN_ARGIFY_4(OutName, InName) \ static XEN OutName(int argc, XEN *argv, XEN self) \ { \ return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ (argc > 1) ? argv[1] : XEN_UNDEFINED, \ (argc > 2) ? argv[2] : XEN_UNDEFINED, \ (argc > 3) ? argv[3] : XEN_UNDEFINED)); \ } #define XEN_ARGIFY_5(OutName, InName) \ static XEN OutName(int argc, XEN *argv, XEN self) \ { \ return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ (argc > 1) ? argv[1] : XEN_UNDEFINED, \ (argc > 2) ? argv[2] : XEN_UNDEFINED, \ (argc > 3) ? argv[3] : XEN_UNDEFINED, \ (argc > 4) ? argv[4] : XEN_UNDEFINED)); \ } #define XEN_ARGIFY_6(OutName, InName) \ static XEN OutName(int argc, XEN *argv, XEN self) \ { \ return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ (argc > 1) ? argv[1] : XEN_UNDEFINED, \ (argc > 2) ? argv[2] : XEN_UNDEFINED, \ (argc > 3) ? argv[3] : XEN_UNDEFINED, \ (argc > 4) ? argv[4] : XEN_UNDEFINED, \ (argc > 5) ? argv[5] : XEN_UNDEFINED)); \ } #define XEN_ARGIFY_7(OutName, InName) \ static XEN OutName(int argc, XEN *argv, XEN self) \ { \ return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ (argc > 1) ? argv[1] : XEN_UNDEFINED, \ (argc > 2) ? argv[2] : XEN_UNDEFINED, \ (argc > 3) ? argv[3] : XEN_UNDEFINED, \ (argc > 4) ? argv[4] : XEN_UNDEFINED, \ (argc > 5) ? argv[5] : XEN_UNDEFINED, \ (argc > 6) ? argv[6] : XEN_UNDEFINED)); \ } #define XEN_ARGIFY_8(OutName, InName) \ static XEN OutName(int argc, XEN *argv, XEN self) \ { \ return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ (argc > 1) ? argv[1] : XEN_UNDEFINED, \ (argc > 2) ? argv[2] : XEN_UNDEFINED, \ (argc > 3) ? argv[3] : XEN_UNDEFINED, \ (argc > 4) ? argv[4] : XEN_UNDEFINED, \ (argc > 5) ? argv[5] : XEN_UNDEFINED, \ (argc > 6) ? argv[6] : XEN_UNDEFINED, \ (argc > 7) ? argv[7] : XEN_UNDEFINED)); \ } #define XEN_ARGIFY_9(OutName, InName) \ static XEN OutName(int argc, XEN *argv, XEN self) \ { \ return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ (argc > 1) ? argv[1] : XEN_UNDEFINED, \ (argc > 2) ? argv[2] : XEN_UNDEFINED, \ (argc > 3) ? argv[3] : XEN_UNDEFINED, \ (argc > 4) ? argv[4] : XEN_UNDEFINED, \ (argc > 5) ? argv[5] : XEN_UNDEFINED, \ (argc > 6) ? argv[6] : XEN_UNDEFINED, \ (argc > 7) ? argv[7] : XEN_UNDEFINED, \ (argc > 8) ? argv[8] : XEN_UNDEFINED)); \ } #define XEN_NARGIFY_0(OutName, InName) \ static XEN OutName(void) {return(InName());} #define XEN_NARGIFY_1(OutName, InName) \ static XEN OutName(XEN self, XEN Arg) {return(InName(Arg));} #define XEN_NARGIFY_2(OutName, InName) \ static XEN OutName(XEN self, XEN Arg1, XEN Arg2) {return(InName(Arg1, Arg2));} #define XEN_NARGIFY_3(OutName, InName) \ static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3) {return(InName(Arg1, Arg2, Arg3));} #define XEN_NARGIFY_4(OutName, InName) \ static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4) {return(InName(Arg1, Arg2, Arg3, Arg4));} #define XEN_NARGIFY_5(OutName, InName) \ static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5) {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5));} #define XEN_NARGIFY_6(OutName, InName) \ static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5, XEN Arg6) {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6));} #define XEN_NARGIFY_7(OutName, InName) \ static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5, XEN Arg6, XEN Arg7) \ {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7));} #define XEN_NARGIFY_8(OutName, InName) \ static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5, XEN Arg6, XEN Arg7, XEN Arg8) \ {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8));} #define XEN_NARGIFY_9(OutName, InName) \ static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5, XEN Arg6, XEN Arg7, XEN Arg8, XEN Arg9) \ {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9));} #define XEN_VARGIFY(OutName, InName) \ static XEN OutName(XEN self, XEN Args) {return(InName(Args));} #ifdef __cplusplus extern "C" { #endif XEN xen_rb_gv_get(const char *name); XEN xen_rb_gv_set(const char *name, XEN new_val); XEN xen_rb_intern(const char *name); XEN xen_rb_make_keyword(const char *name); void xen_rb_define(const char *name, XEN value); XEN xen_rb_cdr(XEN val); XEN xen_rb_cons(XEN arg1, XEN arg2); XEN xen_rb_cons2(XEN arg1, XEN arg2, XEN arg3); char *xen_scheme_constant_to_ruby(const char *name); char *xen_scheme_procedure_to_ruby(const char *name); char *xen_scheme_global_variable_to_ruby(const char *name); bool xen_rb_defined_p(const char *name); XEN xen_rb_define_class(const char *name); int xen_rb_list_length(XEN obj); XEN xen_rb_list_ref(XEN obj, int index); XEN xen_rb_list_set(XEN obj, int index, XEN value); void xen_rb_raise(XEN type, XEN info); XEN xen_rb_obj_as_string(XEN obj); XEN xen_rb_eval_string_with_error(const char *str); XEN xen_rb_load_file_with_error(XEN file); XEN xen_rb_ary_new_with_initial_element(long num, XEN element); XEN xen_rb_apply(XEN func, XEN args); XEN xen_rb_funcall_0(XEN func); int xen_rb_required_args(XEN val); XEN xen_rb_copy_list(XEN val); XEN xen_rb_str_new2(char *arg); void xen_add_help(char *name, const char *help); char *xen_help(char *name); /* class Hook */ bool xen_rb_hook_p(XEN hook); bool xen_rb_hook_empty_p(XEN hook); XEN xen_rb_hook_c_new(char *name, int arity, char *help); XEN xen_rb_hook_reset_hook(XEN hook); XEN xen_rb_hook_to_a(XEN hook); void Init_Hook(void); XEN xen_rb_create_hook(char *name, int arity, char *help); XEN xen_rb_create_simple_hook(int arity); XEN xen_rb_add_hook(XEN hook, VALUE (*func)(), const char *name, const char *doc); typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data); XEN rb_properties(void); XEN rb_property(XEN obj, XEN prop); XEN rb_set_property(XEN obj, XEN prop, XEN val); XEN rb_documentation(XEN name); XEN rb_set_documentation(XEN name, XEN help); bool xen_rb_arity_ok(int rargs, int args); void xen_rb_repl_set_prompt(const char *prompt); XEN xen_rb_add_to_load_path(char *path); XEN xen_set_assoc(XEN key, XEN val, XEN alist); XEN xen_assoc(XEN key, XEN alist); #ifdef __cplusplus } #endif #endif /* end HAVE_RUBY */ /* ------------------------------ FORTH ------------------------------ */ #if HAVE_FORTH #include #if USE_SND # undef gettext_noop # undef _ # undef N_ #endif #define XEN_OK true #define XEN FTH #define XEN_FILE_EXTENSION FTH_FILE_EXTENSION #define XEN_COMMENT_STRING "\\" #define XEN_LANGUAGE_NAME "Forth" #define XEN_FALSE FTH_FALSE #define XEN_TRUE FTH_TRUE #define XEN_EMPTY_LIST FTH_NIL #define XEN_UNDEFINED FTH_UNDEF #define XEN_DOCUMENTATION_SYMBOL FTH_DOCUMENTATION_SYMBOL #define XEN_DEFINED_P(name) fth_defined_p((char *)name) #define XEN_PROVIDE(feature) fth_add_feature(feature) /* === Boolean, Bound, Equal === */ #define XEN_BOOLEAN_P(Arg) FTH_BOOLEAN_P(Arg) #define XEN_TRUE_P(a) FTH_TRUE_P(a) #define XEN_FALSE_P(a) FTH_FALSE_P(a) #define C_TO_XEN_BOOLEAN(a) BOOL_TO_FTH(a) #define XEN_TO_C_BOOLEAN(a) FTH_TO_BOOL(a) #define XEN_BOUND_P(Arg) FTH_BOUND_P(Arg) #define XEN_EQ_P(a, b) ((a) == (b)) /* === Number === */ #define XEN_ZERO FTH_ZERO #define XEN_NUMBER_P(Arg) FTH_NUMBER_P(Arg) #define XEN_WRAPPED_C_POINTER_P(Arg) FTH_EXACT_P(Arg) #define XEN_INTEGER_P(Arg) FTH_INTEGER_P(Arg) #define C_TO_XEN_INT(a) fth_make_int(a) #define XEN_TO_C_INT(a) fth_int_ref(a) #define XEN_ULONG_P(Arg) FTH_UNSIGNED_P(Arg) #define C_TO_XEN_ULONG(a) fth_make_unsigned((unsigned long)(a)) #define XEN_TO_C_ULONG(a) fth_unsigned_ref(a) #define XEN_ULONG_LONG_P(Arg) XEN_ULONG_P(Arg) #define XEN_TO_C_ULONG_LONG(Arg) fth_ulong_long_ref(Arg) #define C_TO_XEN_ULONG_LONG(Arg) fth_make_ulong_long((unsigned long long)Arg) #define C_TO_XEN_LONG_LONG(a) fth_make_long_long(a) #define XEN_TO_C_LONG_LONG(a) fth_long_long_ref(a) #define XEN_DOUBLE_P(Arg) FTH_FLOAT_P(Arg) #define C_TO_XEN_DOUBLE(a) fth_make_float(a) #define XEN_TO_C_DOUBLE(a) fth_float_ref(a) #if HAVE_COMPLEX_NUMBERS # define XEN_COMPLEX_P(Arg) FTH_NUMBER_P(Arg) # define C_TO_XEN_COMPLEX(a) fth_make_complex(a) # define XEN_TO_C_COMPLEX(a) fth_complex_ref(a) # define XEN_HAVE_COMPLEX_NUMBERS 1 #else # define XEN_COMPLEX_P(Arg) false # define C_TO_XEN_COMPLEX(a) XEN_ZERO # define XEN_TO_C_COMPLEX(a) 0.0 #endif #if HAVE_MAKE_RATIO # define XEN_HAVE_RATIOS true # define XEN_RATIO_P(Arg) FTH_RATIO_P(Arg) # define XEN_MAKE_RATIO(Num, Den) fth_make_ratio(Num, Den) # define XEN_NUMERATOR(Arg) XEN_TO_C_LONG_LONG(fth_numerator(Arg)) # define XEN_DENOMINATOR(Arg) XEN_TO_C_LONG_LONG(fth_denominator(Arg)) # define XEN_RATIONALIZE(Arg1, Arg2) fth_rationalize(Arg1, Arg2) #endif /* === String, Symbol, Keyword, Eval === */ #define XEN_CHAR_P(Arg) FTH_CHAR_P(Arg) #define C_TO_XEN_CHAR(Arg) CHAR_TO_FTH(Arg) #define XEN_TO_C_CHAR(Arg) FTH_TO_CHAR(Arg) #define XEN_STRING_P(Arg) FTH_STRING_P(Arg) #define C_TO_XEN_STRING(str) fth_make_string(str) #define C_TO_XEN_STRINGN(str, len) fth_make_string_len(str, len) #define XEN_TO_C_STRING(Str) fth_string_ref(Str) #if HAVE_FTH_PORT_PUTS /* port = XEN_FALSE means default output handler (snd-print). */ #define XEN_PUTS(Str, Port) fth_port_puts(Port, Str) #define XEN_DISPLAY(Val, Port) fth_port_display(Port, Val) #define XEN_FLUSH_PORT(Port) fth_port_flush(Port) #define XEN_CLOSE_PORT(Port) fth_port_close(Port) #define XEN_PORT_TO_STRING(Port) fth_port_to_string(Port) #endif #define XEN_TO_STRING(Obj) fth_object_to_string(Obj) #define XEN_SYMBOL_P(Arg) FTH_SYMBOL_P(Arg) #define C_STRING_TO_XEN_SYMBOL(a) fth_symbol(a) #define XEN_SYMBOL_TO_C_STRING(Sym) fth_symbol_ref(Sym) #define XEN_KEYWORD_P(Obj) FTH_KEYWORD_P(Obj) #define XEN_MAKE_KEYWORD(arg) fth_keyword(arg) #define XEN_KEYWORD_EQ_P(K1, K2) XEN_EQ_P(K1, K2) #define XEN_EVAL_C_STRING(arg) fth_eval(arg) #define XEN_LOAD_FILE(a) fth_load_file(a) #define XEN_LOAD_PATH XEN_NAME_AS_C_STRING_TO_VALUE("*load-path*") #define XEN_ADD_TO_LOAD_PATH(Path) fth_add_load_path(Path) /* === Vector (Array) === */ #define XEN_MAKE_VECTOR(Num, Fill) fth_make_array_with_init(Num, Fill) #define XEN_VECTOR_P(Arg) FTH_ARRAY_P(Arg) #define XEN_VECTOR_LENGTH(Arg) ((int)fth_array_length(Arg)) #define XEN_VECTOR_TO_LIST(Vect) fth_array_to_list(Vect) #define XEN_VECTOR_REF(Vect, Num) fth_array_ref(Vect, Num) #define XEN_VECTOR_SET(Vect, Num, Val) fth_array_set(Vect, Num, Val) #define XEN_VECTOR_COPY(Vect) fth_array_copy(Vect) /* === List === */ #define XEN_NULL_P(a) FTH_NIL_P(a) #define XEN_LIST_P(Arg) FTH_LIST_P(Arg) #define XEN_CONS_P(Arg) FTH_CONS_P(Arg) #define XEN_PAIR_P(Arg) FTH_PAIR_P(Arg) #define XEN_CONS(Arg1, Arg2) fth_cons(Arg1, Arg2) #define XEN_CONS_2(Arg1, Arg2, Arg3) fth_cons_2(Arg1, Arg2, Arg3) #define XEN_LIST_REF(Lst, Num) fth_list_ref(Lst, Num) #define XEN_LIST_SET(Lst, Num, Val) fth_list_set(Lst, Num, Val) #define XEN_LIST_REVERSE(Lst) fth_list_reverse(Lst) #define XEN_LIST_P_WITH_LENGTH(Arg, Len) ((Len = XEN_LIST_LENGTH(Arg)) >= 0) #define XEN_LIST_LENGTH(Arg) ((int)fth_list_length(Arg)) #define XEN_LIST_1(a) FTH_LIST_1(a) #define XEN_LIST_2(a, b) FTH_LIST_2(a, b) #define XEN_LIST_3(a, b, c) FTH_LIST_3(a, b, c) #define XEN_LIST_4(a, b, c, d) FTH_LIST_4(a, b, c, d) #define XEN_LIST_5(a, b, c, d, e) FTH_LIST_5(a, b, c, d, e) #define XEN_LIST_6(a, b, c, d, e, f) FTH_LIST_6(a, b, c, d, e, f) #define XEN_LIST_7(a, b, c, d, e, f, g) FTH_LIST_7(a, b, c, d, e, f, g) #define XEN_LIST_8(a, b, c, d, e, f, g, h) FTH_LIST_8(a, b, c, d, e, f, g, h) #define XEN_LIST_9(a, b, c, d, e, f, g, h, i) FTH_LIST_9(a, b, c, d, e, f, g, h, i) #define XEN_CAR(a) fth_car(a) #define XEN_CADR(a) FTH_CADR(a) #define XEN_CADDR(a) FTH_CADDR(a) #define XEN_CADDDR(a) FTH_CADDDR(a) #define XEN_CDR(a) fth_cdr(a) #define XEN_CDDR(a) FTH_CDDR(a) #define XEN_CDDDR(a) FTH_CDDDR(a) #define XEN_COPY_ARG(Lst) fth_list_copy(Lst) #define XEN_APPEND(a, b) fth_list_append(XEN_LIST_2(a, b)) #define XEN_ASSOC_REF(Item, Lst) fth_list_assoc_ref(Lst, Item) #define XEN_ASSOC_SET(Sym, Val, Lst) fth_list_assoc_set(Lst, Sym, Val) #define XEN_ASSOC(Item, Lst) fth_list_assoc_ref(Lst, Item) /* perhaps fth_list_assoc? */ #define XEN_MEMBER(Item, Lst) fth_list_member_p(Lst, Item) /* === Hook, Procedure === */ #define XEN_HOOK_P(Arg) FTH_HOOK_P(Arg) #define XEN_HOOKED(a) (!fth_hook_empty_p(a)) #define XEN_DEFINE_HOOK(name, descr, arity, help) fth_make_hook(name, arity, help) #define XEN_DEFINE_SIMPLE_HOOK(descr, arity) fth_make_simple_hook(arity) #define XEN_CLEAR_HOOK(Arg) fth_hook_clear(Arg) #define XEN_HOOK_PROCEDURES(Obj) fth_hook_procedure_list(Obj) #define XEN_ADD_HOOK(Hook, Func, Name, Doc) fth_add_hook(Hook, (FTH)fth_define_procedure(Name, Func, fth_hook_arity(Hook), 0, false, Doc)) #define XEN_PROCEDURE_P(Arg) FTH_PROC_P(Arg) #define XEN_PROCEDURE_NAME(Func) C_TO_XEN_STRING(fth_proc_name(Func)) #define XEN_PROCEDURE_HELP(Name) fth_documentation_ref(Name) #define XEN_ARITY(Func) INT_TO_FIX(XEN_REQUIRED_ARGS(Func)) #define XEN_REQUIRED_ARGS(Func) fth_proc_arity(Func) #define XEN_REQUIRED_ARGS_OK(Func, args) (XEN_REQUIRED_ARGS(Func) == (args)) #define XEN_CALL_0(Func, Caller) fth_proc_call(Func, Caller, 0) #define XEN_CALL_1(Func, Arg1, Caller) fth_proc_call(Func, Caller, 1, Arg1) #define XEN_CALL_2(Func, Arg1, Arg2, Caller) fth_proc_call(Func, Caller, 2, Arg1, Arg2) #define XEN_CALL_3(Func, Arg1, Arg2, Arg3, Caller) fth_proc_call(Func, Caller, 3, Arg1, Arg2, Arg3) #define XEN_CALL_4(Func, Arg1, Arg2, Arg3, Arg4, Caller) \ fth_proc_call(Func, Caller, 4, Arg1, Arg2, Arg3, Arg4) #define XEN_CALL_5(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Caller) \ fth_proc_call(Func, Caller, 5, Arg1, Arg2, Arg3, Arg4, Arg5) #define XEN_CALL_6(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Caller) \ fth_proc_call(Func, Caller, 6, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6) #define XEN_APPLY(Func, Args, Caller) fth_proc_apply(Func, Args, Caller) #define XEN_CALL_0_NO_CATCH(Func) XEN_CALL_0(Func, NULL) #define XEN_CALL_1_NO_CATCH(Func, Arg1) XEN_CALL_1(Func, Arg1, NULL) #define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) XEN_CALL_2(Func, Arg1, Arg2, NULL) #define XEN_CALL_3_NO_CATCH(Func, Arg1, Arg2, Arg3) XEN_CALL_3(Func, Arg1, Arg2, Arg3, NULL) #define XEN_APPLY_NO_CATCH(Func, Args) XEN_APPLY(Func, Args, NULL) /* === Define === */ #define XEN_DEFINE(name, Value) fth_define(name, Value) #define XEN_DEFINE_CONSTANT(name, Value, help) fth_define_constant(name, Value, help) #define XEN_DEFINE_VARIABLE(name, Var, Value) (Var = fth_define_variable(name, Value, NULL)) #define XEN_VARIABLE_SET(name, Value) fth_variable_set((char *)(name), Value) #define XEN_VARIABLE_REF(name) fth_variable_ref((char *)(name)) #define XEN_NAME_AS_C_STRING_TO_VARIABLE(name) fth_word_ref((char *)(name)) #define XEN_NAME_AS_C_STRING_TO_VALUE(name) XEN_VARIABLE_REF(name) #ifdef __cplusplus # define XEN_PROCEDURE_CAST (XEN (*)()) #else # define XEN_PROCEDURE_CAST #endif #define XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) \ fth_define_procedure(Name, XEN_PROCEDURE_CAST Func, ReqArg, OptArg, RstArg, Doc) #define XEN_DEFINE_PROCEDURE_WITH_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \ do { \ XEN_DEFINE_PROCEDURE(Get_Name, XEN_PROCEDURE_CAST Get_Func, Get_Req, Get_Opt, 0, Get_Help); \ XEN_DEFINE_PROCEDURE(Set_Name, XEN_PROCEDURE_CAST Set_Func, Set_Req, Set_Opt, 0, Get_Help); \ } while (0) #define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) /* === Object === */ #define XEN_OBJECT_TYPE FTH #define XEN_MARK_OBJECT_TYPE void #define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, Mark, Free) return(fth_make_instance(Tag, Val)) #define XEN_MAKE_OBJECT(Tag, Val, Mark, Free) fth_make_instance(Tag, Val) #define XEN_OBJECT_TYPE_P(Obj, Tag) fth_object_is_instance_of(Obj, Tag) #define XEN_OBJECT_REF(Obj) fth_instance_ref_gen(Obj) #define XEN_MAKE_OBJECT_TYPE(Typ, Siz) fth_make_object_type(Typ) #define XEN_OBJECT_HELP(Name) fth_documentation_ref(Name) #define XEN_PROTECT_FROM_GC(Obj) fth_gc_protect(Obj) #define XEN_UNPROTECT_FROM_GC(Obj) fth_gc_unprotect(Obj) #define XEN_MAKE_OBJECT_PRINT_PROCEDURE(Type, Wrapped_Print, Original_Print) \ static XEN Wrapped_Print(XEN obj) \ { \ char * str = Original_Print((Type *)XEN_OBJECT_REF(obj)); \ XEN val = C_TO_XEN_STRING(str); \ free(str); \ return val; \ } #define XEN_MAKE_OBJECT_FREE_PROCEDURE(Type, Wrapped_Free, Original_Free) \ static void Wrapped_Free(XEN obj) \ { \ Original_Free((Type *)XEN_OBJECT_REF(obj)); \ } /* === Error === */ #define XEN_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) \ FTH_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) #define XEN_ERROR_TYPE(Typ) fth_exception(Typ) #define XEN_ERROR(Type, Info) fth_throw_list(Type, Info) #define XEN_THROW(Type, Info) XEN_ERROR(Type, Info) #define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) \ FTH_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) #define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) \ FTH_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data); #define XEN_NARGIFY_0(OutName, InName) static XEN (*OutName)(void) = InName; #define XEN_NARGIFY_1(OutName, InName) static XEN (*OutName)(XEN a1) = InName; #define XEN_NARGIFY_2(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2) = InName; #define XEN_NARGIFY_3(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3) = InName; #define XEN_NARGIFY_4(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4) = InName; #define XEN_NARGIFY_5(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5) = InName; #define XEN_NARGIFY_6(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6) = InName; #define XEN_NARGIFY_7(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7) = InName; #define XEN_NARGIFY_8(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7, XEN a8) = InName; #define XEN_NARGIFY_9(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7, XEN a8, XEN a9) = InName; #define XEN_ARGIFY_1(OutName, InName) static XEN (*OutName)(XEN a1) = InName; #define XEN_ARGIFY_2(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2) = InName; #define XEN_ARGIFY_3(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3) = InName; #define XEN_ARGIFY_4(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4) = InName; #define XEN_ARGIFY_5(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5) = InName; #define XEN_ARGIFY_6(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6) = InName; #define XEN_ARGIFY_7(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7) = InName; #define XEN_ARGIFY_8(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7, XEN a8) = InName; #define XEN_ARGIFY_9(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7, XEN a8, XEN a9) = InName; #define XEN_VARGIFY(OutName, InName) static XEN (*OutName)(XEN a1) = InName; #endif /* end HAVE_FORTH */ /* ------------------------------ s7 ------------------------------ */ #if HAVE_SCHEME #define XEN_OK 1 #include "s7.h" #ifdef __cplusplus extern "C" { #endif extern s7_scheme *s7; /* s7 is a pointer to the current scheme */ #ifdef __cplusplus } #endif #define XEN s7_pointer #define XEN_FILE_EXTENSION "scm" #define XEN_LANGUAGE_NAME "s7" #define XEN_COMMENT_STRING ";" extern XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero; extern size_t xen_s7_number_location, xen_s7_denominator_location; #define XEN_FALSE xen_false #define XEN_TRUE xen_true #define XEN_TRUE_P(Arg) ((Arg) == XEN_TRUE) /* not scheme-wise, but Snd-wise (#t as special arg) */ #define XEN_FALSE_P(Arg) ((Arg) == XEN_FALSE) #define XEN_BOOLEAN_P(Arg) s7_is_boolean(Arg) #define C_TO_XEN_BOOLEAN(Arg) ((Arg) ? XEN_TRUE : XEN_FALSE) #define XEN_TO_C_BOOLEAN(Arg) ((XEN_TRUE_P(Arg)) ? true : false) #define XEN_NULL_P(Arg) ((Arg) == xen_nil) #define XEN_BOUND_P(Arg) ((Arg) != xen_undefined) #define XEN_EMPTY_LIST xen_nil #define XEN_UNDEFINED xen_undefined #define XEN_EQ_P(Arg1, Arg2) ((Arg1) == (Arg2)) #define XEN_CONS_P(Arg) s7_cons_p(Arg) #define XEN_CONS(Arg1, Arg2) s7_cons(s7, Arg1, Arg2) #define XEN_CONS_2(Arg1, Arg2, Arg3) s7_cons(s7, Arg1, s7_cons(s7, Arg2, Arg3)) #define XEN_PAIR_P(Arg) s7_is_pair(Arg) #define XEN_CAR(Arg) s7_car(Arg) #define XEN_CDR(Arg) s7_cdr(Arg) #define XEN_CADR(Arg) s7_cadr(Arg) #define XEN_CADDR(Arg) s7_caddr(Arg) #define XEN_CADDDR(Arg) s7_cadddr(Arg) #define XEN_CDDR(Arg) s7_cddr(Arg) #define XEN_CDDDR(Arg) s7_cdddr(Arg) #define XEN_LIST_P(Arg) s7_is_list(s7, Arg) /* not pair? because we want '() to return #t here */ #define XEN_LIST_LENGTH(Arg) s7_list_length(s7, Arg) #define XEN_LIST_P_WITH_LENGTH(Arg, Len) ((s7_is_list(s7, Arg)) && ((Len = XEN_LIST_LENGTH(Arg)) >= 0)) #define XEN_LIST_1(a) s7_list(s7, 1, a) #define XEN_LIST_2(a, b) s7_list(s7, 2, a, b) #define XEN_LIST_3(a, b, c) s7_list(s7, 3, a, b, c) #define XEN_LIST_4(a, b, c, d) s7_list(s7, 4, a, b, c, d) #define XEN_LIST_5(a, b, c, d, e) s7_list(s7, 5, a, b, c, d, e) #define XEN_LIST_6(a, b, c, d, e, f) s7_list(s7, 6, a, b, c, d, e, f) #define XEN_LIST_7(a, b, c, d, e, f, g) s7_list(s7, 7, a, b, c, d, e, f, g) #define XEN_LIST_8(a, b, c, d, e, f, g, h) s7_list(s7, 8, a, b, c, d, e, f, g, h) #define XEN_LIST_9(a, b, c, d, e, f, g, h, i) s7_list(s7, 9, a, b, c, d, e, f, g, h, i) #define XEN_LIST_REF(Lst, Num) s7_list_ref(s7, Lst, Num) #define XEN_LIST_SET(Lst, Num, Val) s7_list_set(s7, Lst, Num, Val) #define XEN_LIST_REVERSE(Lst) s7_reverse(s7, Lst) #define XEN_COPY_ARG(Lst) Lst #define XEN_APPEND(Arg1, Arg2) s7_append(s7, Arg1, Arg2) #define XEN_ASSOC_REF(Sym, Lst) xen_assoc(s7, Sym, Lst) #define XEN_ASSOC_SET(Sym, Val, Lst) xen_set_assoc(s7, Sym, Val, Lst) #define XEN_ASSOC(Sym, Lst) s7_assoc(s7, Sym, Lst) #define XEN_MEMBER(Sym, Lst) s7_member(s7, Sym, Lst) #define XEN_STRING_P(Arg) s7_is_string(Arg) #define XEN_NAME_AS_C_STRING_TO_VALUE(Arg) s7_name_to_value(s7, Arg) #define XEN_TO_C_STRING(Str) s7_string(Str) #define C_TO_XEN_STRING(Str) s7_make_string(s7, Str) #define C_TO_XEN_STRINGN(Str, Len) s7_make_string_with_length(s7, Str, Len) #define XEN_ZERO xen_zero #define XEN_INTEGER_P(Arg) s7_is_integer(Arg) #define C_TO_XEN_INT(Arg) s7_make_integer(s7, Arg) #define XEN_TO_C_INT(Arg) s7_integer(Arg) #define XEN_ULONG_P(Arg) s7_is_ulong(Arg) #define XEN_TO_C_ULONG(Arg) s7_ulong(Arg) #define C_TO_XEN_ULONG(Arg) s7_make_ulong(s7, (unsigned long)Arg) #define XEN_ULONG_LONG_P(Arg) s7_is_ulong_long(Arg) #define XEN_TO_C_ULONG_LONG(Arg) s7_ulong_long(Arg) #define C_TO_XEN_ULONG_LONG(Arg) s7_make_ulong_long(s7, (unsigned long long)Arg) #define C_TO_XEN_LONG_LONG(Arg) s7_make_integer(s7, Arg) #define XEN_TO_C_LONG_LONG(Arg) s7_integer(Arg) #define XEN_NUMBER_P(Arg) s7_is_real(Arg) #define XEN_WRAPPED_C_POINTER_P(Arg) s7_is_c_pointer(Arg) #define XEN_DOUBLE_P(Arg) s7_is_real(Arg) #define XEN_TO_C_DOUBLE(Arg) ((double)s7_number_to_real(s7, Arg)) #define C_TO_XEN_DOUBLE(Arg) s7_make_real(s7, Arg) #if HAVE_COMPLEX_NUMBERS #define XEN_HAVE_COMPLEX_NUMBERS 1 #define XEN_COMPLEX_P(Arg) s7_is_complex(Arg) #define XEN_TO_C_COMPLEX(a) (s7_real_part(a) + s7_imag_part(a) * _Complex_I) #define C_TO_XEN_COMPLEX(a) s7_make_complex(s7, creal(a), cimag(a)) #else #define XEN_HAVE_COMPLEX_NUMBERS 0 #define XEN_COMPLEX_P(Arg) false #define XEN_TO_C_COMPLEX(a) 0.0 #define C_TO_XEN_COMPLEX(a) XEN_ZERO #endif #define XEN_HAVE_RATIOS 1 #define XEN_NUMERATOR(Arg) s7_numerator(Arg) #define XEN_DENOMINATOR(Arg) s7_denominator(Arg) #define XEN_RATIONALIZE(Arg1, Arg2) s7_rationalize(s7, XEN_TO_C_DOUBLE(Arg1), XEN_TO_C_DOUBLE(Arg2)) #define XEN_RATIO_P(Arg) s7_is_ratio(Arg) #define XEN_MAKE_RATIO(Num, Den) s7_make_ratio(s7, XEN_TO_C_INT(Num), XEN_TO_C_INT(Den)) #define XEN_EVAL_C_STRING(Arg) s7_eval_c_string(s7, Arg) #define XEN_TO_STRING(Obj) s7_object_to_string(s7, Obj, false) #define XEN_SYMBOL_TO_C_STRING(Arg) s7_symbol_name(Arg) #define XEN_SYMBOL_P(Arg) s7_is_symbol(Arg) #define C_STRING_TO_XEN_SYMBOL(Arg) s7_make_symbol(s7, Arg) #define XEN_DOCUMENTATION_SYMBOL C_STRING_TO_XEN_SYMBOL("documentation") #define XEN_SET_DOCUMENTATION(Var, Doc) #define XEN_VECTOR_P(Arg) s7_is_vector(Arg) #define XEN_VECTOR_LENGTH(Arg) s7_vector_length(Arg) #define XEN_VECTOR_REF(Vect, Num) s7_vector_ref(s7, Vect, Num) #define XEN_VECTOR_SET(Vect, Num, Val) s7_vector_set(s7, Vect, Num, Val) #define XEN_MAKE_VECTOR(Num, Fill) s7_make_and_fill_vector(s7, Num, Fill) #define XEN_VECTOR_TO_LIST(Vect) s7_vector_to_list(s7, Vect) #define XEN_VECTOR_RANK(Vect) s7_vector_rank(Vect) #define XEN_VECTOR_COPY(Vect) s7_vector_copy(s7, Vect) #define XEN_VECTOR_ELEMENTS(Vect) s7_vector_elements(Vect) #define XEN_CHAR_P(Arg) s7_is_character(Arg) #define XEN_TO_C_CHAR(Arg) s7_character(Arg) #define C_TO_XEN_CHAR(Arg) s7_make_character(s7, Arg) #define XEN_KEYWORD_P(Obj) s7_is_keyword(Obj) #define XEN_KEYWORD_EQ_P(k1, k2) ((k1) == (k2)) #define XEN_MAKE_KEYWORD(Arg) s7_make_keyword(s7, Arg) #define XEN_PROCEDURE_P(Arg) s7_is_procedure(Arg) #define XEN_LOAD_FILE(File) s7_load(s7, File) #define XEN_LOAD_PATH s7_load_path(s7) #define XEN_ADD_TO_LOAD_PATH(Path) s7_add_to_load_path(s7, Path) #define XEN_ERROR_TYPE(Typ) C_STRING_TO_XEN_SYMBOL(Typ) #define XEN_ERROR(Type, Info) s7_error(s7, Type, Info) #define XEN_THROW(Type, Info) s7_error(s7, Type, Info) #define XEN_PROVIDE(Feature) s7_provide(s7, Feature) #define XEN_PROTECT_FROM_GC(Arg) s7_gc_protect(s7, Arg) #define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) s7_wrong_type_arg_error(s7, Caller, ArgN, Arg, Descr) #define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) s7_out_of_range_error(s7, Caller, ArgN, Arg, Descr) #define XEN_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) if (!(Assertion)) XEN_WRONG_TYPE_ARG_ERROR(Caller, Position, Arg, Correct_Type) #define XEN_NARGIFY_0(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(InName());} #define XEN_NARGIFY_1(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(InName(XEN_CAR(args)));} #define XEN_NARGIFY_2(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_2(s7, args, InName));} #define XEN_NARGIFY_3(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_3(s7, args, InName));} #define XEN_NARGIFY_4(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_4(s7, args, InName));} #define XEN_NARGIFY_5(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_5(s7, args, InName));} #define XEN_NARGIFY_6(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_6(s7, args, InName));} #define XEN_NARGIFY_7(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_7(s7, args, InName));} #define XEN_NARGIFY_8(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_8(s7, args, InName));} #define XEN_NARGIFY_9(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_9(s7, args, InName));} #define XEN_ARGIFY_1(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_1(s7, args, InName));} #define XEN_ARGIFY_2(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_2(s7, args, InName));} #define XEN_ARGIFY_3(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_3(s7, args, InName));} #define XEN_ARGIFY_4(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_4(s7, args, InName));} #define XEN_ARGIFY_5(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_5(s7, args, InName));} #define XEN_ARGIFY_6(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_6(s7, args, InName));} #define XEN_ARGIFY_7(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_7(s7, args, InName));} #define XEN_ARGIFY_8(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_8(s7, args, InName));} #define XEN_ARGIFY_9(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_9(s7, args, InName));} #define XEN_VARGIFY(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(InName(args));} #define XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) s7_define_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc) #define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) s7_define_safe_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc) #define XEN_DEFINE_PROCEDURE_STAR(Name, Func, Args, Doc) s7_define_function_star(s7, Name, Func, Args, Doc) #define XEN_DEFINE_PROCEDURE_WITH_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \ s7_dilambda(s7, Get_Name, Get_Func, Get_Req, Get_Opt, Set_Func, Set_Req, Set_Opt, Get_Help) #define XEN_ARITY(Func) s7_arity(s7, Func) #define XEN_REQUIRED_ARGS(Func) XEN_TO_C_INT(XEN_CAR(XEN_ARITY(Func))) #define XEN_REQUIRED_ARGS_OK(Func, Args) s7_is_aritable(s7, Func, Args) /* (XEN_REQUIRED_ARGS(Func) == Args) */ #define XEN_CALL_0(Func, Caller) s7_call_with_location(s7, Func, XEN_EMPTY_LIST, Caller, __FILE__, __LINE__) /* these need a catch */ #define XEN_CALL_1(Func, Arg1, Caller) s7_call_with_location(s7, Func, XEN_LIST_1(Arg1), Caller, __FILE__, __LINE__) #define XEN_CALL_2(Func, Arg1, Arg2, Caller) s7_call_with_location(s7, Func, XEN_LIST_2(Arg1, Arg2), Caller, __FILE__, __LINE__) #define XEN_CALL_3(Func, Arg1, Arg2, Arg3, Caller) s7_call_with_location(s7, Func, XEN_LIST_3(Arg1, Arg2, Arg3), Caller, __FILE__, __LINE__) #define XEN_CALL_4(Func, Arg1, Arg2, Arg3, Arg4, Caller) s7_call_with_location(s7, Func, XEN_LIST_4(Arg1, Arg2, Arg3, Arg4), Caller, __FILE__, __LINE__) #define XEN_CALL_5(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Caller) s7_call_with_location(s7, Func, XEN_LIST_5(Arg1, Arg2, Arg3, Arg4, Arg5), Caller, __FILE__, __LINE__) #define XEN_CALL_6(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Caller) s7_call_with_location(s7, Func, XEN_LIST_6(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6), Caller, __FILE__, __LINE__) #define XEN_APPLY(Func, Args, Caller) s7_call_with_location(s7, Func, Args, Caller, __FILE__, __LINE__) #define XEN_CALL_0_NO_CATCH(Func) s7_call_with_location(s7, Func, XEN_EMPTY_LIST, __func__, __FILE__, __LINE__) #define XEN_CALL_1_NO_CATCH(Func, Arg1) s7_call_with_location(s7, Func, XEN_LIST_1(Arg1), __func__, __FILE__, __LINE__) #define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) s7_call_with_location(s7, Func, XEN_LIST_2(Arg1, Arg2), __func__, __FILE__, __LINE__) #define XEN_CALL_3_NO_CATCH(Func, Arg1, Arg2, Arg3) s7_call_with_location(s7, Func, XEN_LIST_3(Arg1, Arg2, Arg3), __func__, __FILE__, __LINE__) #define XEN_APPLY_NO_CATCH(Func, Args) s7_call_with_location(s7, Func, Args, __func__, __FILE__, __LINE__) typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data); #define XEN_DEFINE_CONSTANT(Name, Value, Help) s7_define_constant_with_documentation(s7, Name, s7_make_integer(s7, Value), Help) #define XEN_DEFINE(Name, Value) s7_define_variable(s7, Name, Value) #define XEN_DEFINED_P(Name) s7_is_defined(s7, Name) #define XEN_DEFINE_VARIABLE(Name, Var, Value) Var = s7_define_variable(s7, Name, Value) #define XEN_VARIABLE_SET(Var, Val) s7_symbol_set_value(s7, Var, Val) #define XEN_VARIABLE_REF(Var) s7_symbol_value(s7, Var) #define XEN_NAME_AS_C_STRING_TO_VARIABLE(a) s7_make_symbol(s7, a) #define XEN_MARK_OBJECT_TYPE void #define XEN_MAKE_OBJECT_TYPE(Name, Print, Free, Equal, Gc_Mark, Apply, Set, Length, Copy, Reverse, Fill) \ s7_new_type_x(Name, Print, Free, Equal, Gc_Mark, Apply, Set, Length, Copy, Reverse, Fill) #define XEN_MAKE_OBJECT_FREE_PROCEDURE(Type, Wrapped_Free, Original_Free) \ static void Wrapped_Free(void *obj) {Original_Free((Type *)obj);} #define XEN_MAKE_OBJECT_PRINT_PROCEDURE(Type, Wrapped_Print, Original_Print) \ static char *Wrapped_Print(s7_scheme *sc, void *obj) {return(Original_Print((Type *)obj));} #define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, ig1, ig2) return(s7_make_object(s7, Tag, Val)) #define XEN_MAKE_OBJECT(Tag, Val, ig1, ig2) s7_make_object(s7, Tag, Val) #define XEN_OBJECT_REF(Arg) s7_object_value(Arg) #define XEN_OBJECT_TYPE int /* tag type */ #define XEN_OBJECT_TYPE_P(Obj, Tag) (s7_object_type(Obj) == Tag) #define XEN_HOOK_P(Arg) ((Arg) != XEN_FALSE) #define XEN_DEFINE_HOOK(Name, Descr, Arity, Help) s7_define_constant_with_documentation(s7, Name, s7_eval_c_string(s7, Descr), Help) /* "simple hooks are for channel-local hooks (unnamed, accessed through the channel) */ #define XEN_DEFINE_SIMPLE_HOOK(Descr, Arity) s7_eval_c_string(s7, Descr) #define XEN_HOOKED(Hook) s7_is_pair(s7_hook_functions(s7, Hook)) #define XEN_CLEAR_HOOK(Hook) s7_hook_set_functions(s7, Hook, s7_nil(s7)) #define XEN_HOOK_PROCEDURES(Hook) s7_hook_functions(s7, Hook) #define XEN_ADD_HOOK(Hook, Func, Name, Doc) s7_hook_set_functions(s7, Hook, s7_cons(s7, s7_make_function(s7, Name, Func, 1, 0, false, Doc), s7_hook_functions(s7, Hook))) #ifdef __cplusplus extern "C" { #endif s7_scheme *s7_xen_initialize(s7_scheme *sc); void xen_s7_set_repl_prompt(const char *new_prompt); XEN xen_set_assoc(s7_scheme *sc, s7_pointer key, s7_pointer val, s7_pointer alist); XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist); #ifdef __cplusplus } #endif #endif /* end s7 */ /* ------------------------------ NO EXTENSION LANGUAGE ------------------------------ */ #ifndef XEN_OK #define XEN int #define XEN_FILE_EXTENSION "txt" #define XEN_LANGUAGE_NAME "What Language?" #define XEN_COMMENT_STRING ";" #define XEN_FALSE 0 #define XEN_TRUE 1 #define XEN_TRUE_P(a) ((a) == XEN_TRUE) #define XEN_FALSE_P(a) ((a) == XEN_FALSE) #define XEN_BOOLEAN_P(Arg) 0 #define C_TO_XEN_BOOLEAN(a) 0 #define XEN_TO_C_BOOLEAN(a) 0 #define XEN_NULL_P(a) ((a) == XEN_EMPTY_LIST) #define XEN_BOUND_P(Arg) 0 #define XEN_EMPTY_LIST 0 #define XEN_UNDEFINED 0 #define XEN_EQ_P(a, b) 0 #define XEN_CONS_P(Arg) 0 #define XEN_CONS(Arg1, Arg2) 0 #define XEN_CONS_2(Arg1, Arg2, Arg3) 0 #define XEN_PAIR_P(Arg) 0 #define XEN_CAR(a) 0 #define XEN_CADR(a) 0 #define XEN_CADDR(a) 0 #define XEN_CADDDR(a) 0 #define XEN_CDR(a) 0 #define XEN_CDDR(a) 0 #define XEN_CDDDR(a) 0 #define XEN_LIST_P(Arg) 0 #define XEN_LIST_P_WITH_LENGTH(Arg, Len) 0 #define XEN_LIST_LENGTH(Arg) 0 #define XEN_LIST_1(a) 0 #define XEN_LIST_2(a, b) 0 #define XEN_LIST_3(a, b, c) 0 #define XEN_LIST_4(a, b, c, d) 0 #define XEN_LIST_5(a, b, c, d, e) 0 #define XEN_LIST_6(a, b, c, d, e, f) 0 #define XEN_LIST_7(a, b, c, d, e, f, g) 0 #define XEN_LIST_8(a, b, c, d, e, f, g, h) 0 #define XEN_LIST_9(a, b, c, d, e, f, g, h, i) 0 #define XEN_LIST_REF(Lst, Num) 0 #define XEN_LIST_SET(Lst, Num, Val) #define XEN_LIST_REVERSE(Lst) 0 #define XEN_COPY_ARG(Lst) Lst #define XEN_APPEND(X, Y) 0 #define XEN_STRING_P(Arg) 0 #define XEN_NAME_AS_C_STRING_TO_VALUE(a) 0 #define XEN_TO_C_STRING(STR) "(not a string)" #define C_TO_XEN_STRING(a) 0 #define C_TO_XEN_STRINGN(Str, Len) 0 #define C_STRING_TO_XEN_SYMBOL(a) 0 #define XEN_ZERO 0 #define XEN_NUMBER_P(Arg) 0 #define XEN_DOUBLE_P(Arg) 0 #define XEN_TO_C_DOUBLE(a) 0.0 #define C_TO_XEN_DOUBLE(a) 0 #define XEN_INTEGER_P(Arg) 0 #define C_TO_XEN_INT(a) a #define XEN_TO_C_INT(a) 0 #define XEN_COMPLEX_P(Arg) 0 #define XEN_TO_C_COMPLEX(a) 0.0 #define C_TO_XEN_COMPLEX(a) a #define XEN_ULONG_P(Arg) 0 #define XEN_TO_C_ULONG(a) 0 #define C_TO_XEN_ULONG(a) 0 #define C_TO_XEN_LONG_LONG(a) a #define XEN_TO_C_LONG_LONG(a) a #define XEN_ULONG_LONG_P(Arg) 0 #define XEN_TO_C_ULONG_LONG(Arg) 0 #define C_TO_XEN_ULONG_LONG(Arg) 0 #define XEN_WRAPPED_C_POINTER_P(Arg) 0 #define XEN_EVAL_C_STRING(Arg) 0 #define XEN_SYMBOL_TO_C_STRING(a) "(not a symbol)" #define XEN_TO_STRING(Obj) "(unknown)" #define XEN_PROCEDURE_P(Arg) 0 #define XEN_ARGIFY_1(OutName, InName) static int OutName(void) {return(-1);} #define XEN_ARGIFY_2(OutName, InName) static int OutName(void) {return(-2);} #define XEN_ARGIFY_3(OutName, InName) static int OutName(void) {return(-3);} #define XEN_ARGIFY_4(OutName, InName) static int OutName(void) {return(-4);} #define XEN_ARGIFY_5(OutName, InName) static int OutName(void) {return(-5);} #define XEN_ARGIFY_6(OutName, InName) static int OutName(void) {return(-6);} #define XEN_ARGIFY_7(OutName, InName) static int OutName(void) {return(-7);} #define XEN_ARGIFY_8(OutName, InName) static int OutName(void) {return(-8);} #define XEN_ARGIFY_9(OutName, InName) static int OutName(void) {return(-9);} #define XEN_NARGIFY_0(OutName, InName) static int OutName(void) {return(0);} #define XEN_NARGIFY_1(OutName, InName) static int OutName(void) {return(1);} #define XEN_NARGIFY_2(OutName, InName) static int OutName(void) {return(2);} #define XEN_NARGIFY_3(OutName, InName) static int OutName(void) {return(3);} #define XEN_NARGIFY_4(OutName, InName) static int OutName(void) {return(4);} #define XEN_NARGIFY_5(OutName, InName) static int OutName(void) {return(5);} #define XEN_NARGIFY_6(OutName, InName) static int OutName(void) {return(6);} #define XEN_NARGIFY_7(OutName, InName) static int OutName(void) {return(7);} #define XEN_NARGIFY_8(OutName, InName) static int OutName(void) {return(8);} #define XEN_NARGIFY_9(OutName, InName) static int OutName(void) {return(9);} #define XEN_VARGIFY(OutName, InName) static int OutName(void) {return(-100);} #define XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) \ xen_no_ext_lang_check_args(Name, Func(), ReqArg, OptArg, RstArg) #define XEN_DEFINE_PROCEDURE_WITH_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \ {xen_no_ext_lang_check_args(Get_Name, Get_Func(), Get_Req, Get_Opt, 0); xen_no_ext_lang_check_args(Set_Name, Set_Func(), Set_Req, Set_Opt, 0);} #define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) #define XEN_ARITY(Func) 0 #define XEN_REQUIRED_ARGS(Func) 0 #define XEN_REQUIRED_ARGS_OK(Func, Args) false #define XEN_CALL_0(Func, Caller) 0 #define XEN_CALL_1(Func, Arg1, Caller) 0 #define XEN_CALL_2(Func, Arg1, Arg2, Caller) 0 #define XEN_CALL_3(Func, Arg1, Arg2, Arg3, Caller) 0 #define XEN_CALL_4(Func, Arg1, Arg2, Arg3, Arg4, Caller) 0 #define XEN_CALL_5(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Caller) 0 #define XEN_CALL_6(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Caller) 0 #define XEN_APPLY(Func, Args, Caller) 0 #define XEN_CALL_0_NO_CATCH(Func) 0 #define XEN_CALL_1_NO_CATCH(Func, Arg1) 0 #define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) 0 #define XEN_CALL_3_NO_CATCH(Func, Arg1, Arg2, Arg3) 0 #define XEN_APPLY_NO_CATCH(Func, Args) 0 #define XEN_DEFINE_CONSTANT(a, b, c) #define XEN_DEFINE_VARIABLE(a, b, c) #define XEN_DEFINE(Name, Value) #define XEN_VARIABLE_SET(a, b) #define XEN_VARIABLE_REF(a) 0 #define XEN_MARK_OBJECT_TYPE XEN #define XEN_MAKE_OBJECT_TYPE(Typ, Siz) 0 #define XEN_MAKE_OBJECT_PRINT_PROCEDURE(Type, Wrapped_Print, Original_Print) #define XEN_MAKE_OBJECT_FREE_PROCEDURE(Type, Wrapped_Free, Original_Free) #define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, ig1, ig2) return(0) #define XEN_MAKE_OBJECT(Tag, Val, ig1, ig2) 0 #define XEN_OBJECT_REF(a) 0 #define XEN_OBJECT_TYPE int #define XEN_OBJECT_TYPE_P(OBJ, TAG) 0 #define XEN_SYMBOL_P(Arg) 0 #define XEN_HOOK_P(Arg) 0 #define XEN_HOOKED(a) 0 #define XEN_DEFINE_HOOK(Name, Descr, Arity, Help) 0 #define XEN_DEFINE_SIMPLE_HOOK(Descr, Arity) 0 #define XEN_CLEAR_HOOK(Arg) #define XEN_HOOK_PROCEDURES(a) 0 #define XEN_ADD_HOOK(Hook, Func, Name, Doc) #define XEN_VECTOR_P(Arg) 0 #define XEN_VECTOR_LENGTH(Arg) 0 #define XEN_VECTOR_REF(Vect, Num) 0 #define XEN_VECTOR_SET(a, b, c) #define XEN_MAKE_VECTOR(Num, Fill) 0 #define XEN_VECTOR_TO_LIST(Vect) 0 #define XEN_ASSOC_REF(Sym, Lst) 0 #define XEN_ASSOC_SET(Sym, Val, Lst) 0 #define XEN_CHAR_P(Arg) 0 #define XEN_TO_C_CHAR(Arg) 0 #define C_TO_XEN_CHAR(Arg) 0 #define XEN_KEYWORD_P(Obj) 0 #define XEN_KEYWORD_EQ_P(k1, k2) 0 #define XEN_MAKE_KEYWORD(Arg) 0 #define XEN_PROVIDE(Feature) #define XEN_DOCUMENTATION_SYMBOL 0 #define XEN_OBJECT_HELP(Name) 0 #define XEN_PROTECT_FROM_GC(a) 0 #define XEN_LOAD_FILE(a) 0 #define XEN_LOAD_PATH XEN_FALSE #define XEN_ADD_TO_LOAD_PATH(Path) XEN_FALSE #define XEN_ERROR_TYPE(Typ) XEN_FALSE #define XEN_ERROR(Type, Info) fprintf(stderr, "error") #define XEN_THROW(Type, Info) fprintf(stderr, "error") #define XEN_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) #define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) #define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data); #define XEN_UNPROTECT_FROM_GC(Var) 0 #ifdef __cplusplus extern "C" { #endif void xen_no_ext_lang_check_args(const char *name, int args, int req_args, int opt_args, int rst_args); #ifdef __cplusplus } #endif #endif /* end NO EXTENSION LANGUAGE */ #define XEN_NOT_TRUE_P(a) (!(XEN_TRUE_P(a))) #define XEN_NOT_FALSE_P(a) (!(XEN_FALSE_P(a))) #define XEN_NOT_NULL_P(a) (!(XEN_NULL_P(a))) #define XEN_NOT_BOUND_P(Arg) (!(XEN_BOUND_P(Arg))) #if defined(__GNUC__) && (!(defined(__cplusplus))) #define XEN_BOOLEAN_IF_BOUND_P(Arg) ({ XEN _xen_h_14_ = Arg; ((XEN_BOOLEAN_P(_xen_h_14_)) || (XEN_NOT_BOUND_P(_xen_h_14_))); }) #define XEN_INTEGER_IF_BOUND_P(Arg) ({ XEN _xen_h_15_ = Arg; ((XEN_NOT_BOUND_P(_xen_h_15_)) || (XEN_INTEGER_P(_xen_h_15_))); }) #define XEN_NUMBER_IF_BOUND_P(Arg) ({ XEN _xen_h_16_ = Arg; ((XEN_NOT_BOUND_P(_xen_h_16_)) || (XEN_NUMBER_P(_xen_h_16_))); }) #define XEN_STRING_IF_BOUND_P(Arg) ({ XEN _xen_h_17_ = Arg; ((XEN_NOT_BOUND_P(_xen_h_17_)) || (XEN_STRING_P(_xen_h_17_))); }) #define XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(Arg) ({ XEN _xen_h_18_ = Arg; ((XEN_BOOLEAN_P(_xen_h_18_)) || (XEN_NOT_BOUND_P(_xen_h_18_)) || (XEN_INTEGER_P(_xen_h_18_))); }) #define XEN_INTEGER_OR_BOOLEAN_P(Arg) ({ XEN _xen_h_21_ = Arg; ((XEN_BOOLEAN_P(_xen_h_21_)) || (XEN_INTEGER_P(_xen_h_21_))); }) #else #define XEN_BOOLEAN_IF_BOUND_P(Arg) ((XEN_BOOLEAN_P(Arg)) || (XEN_NOT_BOUND_P(Arg))) #define XEN_INTEGER_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_INTEGER_P(Arg))) #define XEN_NUMBER_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_NUMBER_P(Arg))) #define XEN_STRING_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_STRING_P(Arg))) #define XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(Arg) ((XEN_BOOLEAN_P(Arg)) || (XEN_NOT_BOUND_P(Arg)) || (XEN_INTEGER_P(Arg))) #define XEN_INTEGER_OR_BOOLEAN_P(Arg) ((XEN_BOOLEAN_P(Arg)) || (XEN_INTEGER_P(Arg))) #endif #if (!HAVE_FORTH) #define XEN_LONG_LONG_P(Arg) XEN_INTEGER_P(Arg) #else #define XEN_LONG_LONG_P(Arg) FTH_LONG_LONG_P(Arg) #endif #define XEN_LONG_LONG_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_LONG_LONG_P(Arg))) #if (!HAVE_SCHEME) #define XEN_AS_STRING(form) XEN_TO_C_STRING(XEN_TO_STRING(form)) #define XEN_VECTOR_RANK(Vect) 1 #else #define XEN_AS_STRING(form) s7_object_to_c_string(s7, form) #endif #define XEN_BAD_ARITY_ERROR(Caller, ArgN, Arg, Descr) \ XEN_ERROR(XEN_ERROR_TYPE("bad-arity"), \ XEN_LIST_3(C_TO_XEN_STRING(Caller), \ C_TO_XEN_STRING(Descr), \ Arg)) #ifndef XEN_HAVE_RATIOS #define XEN_NUMERATOR(Arg) 0 #define XEN_DENOMINATOR(Arg) 1 #define XEN_RATIONALIZE(Arg1, Arg2) 1 #define XEN_RATIO_P(Arg) false #define XEN_MAKE_RATIO(Num, Den) 1 #endif #ifndef XEN_DEFINED_P #define XEN_DEFINED_P(Name) false #endif /* (need a way to pass an uninterpreted pointer from C to XEN then back to C) */ #if HAVE_SCHEME #define XEN_WRAP_C_POINTER(a) s7_make_c_pointer(s7, (void *)(a)) #define XEN_UNWRAP_C_POINTER(a) s7_c_pointer(a) #else #if (SIZEOF_VOID_P == 4) #define XEN_WRAP_C_POINTER(a) ((XEN)(C_TO_XEN_ULONG((unsigned int)a))) #define XEN_UNWRAP_C_POINTER(a) XEN_TO_C_ULONG(a) #else #define XEN_WRAP_C_POINTER(a) C_TO_XEN_ULONG_LONG((unsigned long long int)(a)) #define XEN_UNWRAP_C_POINTER(a) XEN_TO_C_ULONG_LONG(a) #endif #endif /* Feb-14: the upper case macro names and the old-fashioned _p names are ugly and hard to read -- start replacing them */ #define Xen_is_number(Arg) XEN_NUMBER_P(Arg) #define Xen_is_integer(Arg) XEN_INTEGER_P(Arg) #define Xen_is_llong(Arg) XEN_LONG_LONG_P(Arg) #define Xen_is_keyword(Arg) XEN_KEYWORD_P(Arg) #define Xen_is_true(Arg) XEN_TRUE_P(Arg) #define Xen_is_false(Arg) XEN_FALSE_P(Arg) #define Xen_is_bound(Arg) XEN_BOUND_P(Arg) #define Xen_is_boolean(Arg) XEN_BOOLEAN_P(Arg) #define Xen_is_null(Arg) XEN_NULL_P(Arg) #define Xen_is_eq(Arg1, Arg2) XEN_EQ_P(Arg1, Arg2) #define Xen_is_cons(Arg) XEN_CONS_P(Arg) #define Xen_is_pair(Arg) XEN_PAIR_P(Arg) #define Xen_is_list(Arg) XEN_LIST_P(Arg) #define Xen_is_string(Arg) XEN_STRING_P(Arg) #define Xen_is_double(Arg) XEN_DOUBLE_P(Arg) #define Xen_is_complex(Arg) XEN_COMPLEX_P(Arg) #define Xen_is_ulong(Arg) XEN_ULONG_P(Arg) #define Xen_is_ullong(Arg) XEN_ULONG_LONG_P(Arg) #define Xen_is_wrapped_c_pointer(Arg) XEN_WRAPPED_C_POINTER_P(Arg) #define Xen_is_procedure(Arg) XEN_PROCEDURE_P(Arg) #define Xen_c_object_is_type(Obj, Tag) XEN_OBJECT_TYPE_P(Obj, Tag) #define Xen_is_symbol(Arg) XEN_SYMBOL_P(Arg) #define Xen_is_hook(Arg) XEN_HOOK_P(Arg) #define Xen_is_vector(Arg) XEN_VECTOR_P(Arg) #define Xen_is_char(Arg) XEN_CHAR_P(Arg) #define Xen_keyword_is_eq(Arg1, Arg2) XEN_KEYWORD_EQ_P(Arg1, Arg2) #define Xen_is_defined(Arg) XEN_DEFINED_P(Arg) #define Xen_is_ratio(Arg) XEN_RATIO_P(Arg) #define Xen_is_llong_or_unbound(Arg) XEN_LONG_LONG_IF_BOUND_P(Arg) #define Xen_is_boolean_or_unbound(Arg) XEN_BOOLEAN_IF_BOUND_P(Arg) #define Xen_is_integer_or_unbound(Arg) XEN_INTEGER_IF_BOUND_P(Arg) #define Xen_is_number_or_unbound(Arg) XEN_NUMBER_IF_BOUND_P(Arg) #define Xen_is_string_or_unbound(Arg) XEN_STRING_IF_BOUND_P(Arg) #define Xen_is_integer_boolean_or_unbound(Arg) XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(Arg) #define Xen_is_integer_or_boolean(Arg) XEN_INTEGER_OR_BOOLEAN_P(Arg) #define Xen_append(a, b) XEN_APPEND(a, b) #define Xen_cadddr(a) XEN_CADDDR(a) #define Xen_caddr(a) XEN_CADDR(a) #define Xen_cadr(a) XEN_CADR(a) #define Xen_car(a) XEN_CAR(a) #define Xen_cddr(a) XEN_CDDR(a) #define Xen_cdddr(a) XEN_CDDDR(a) #define Xen_cdr(a) XEN_CDR(a) #define Xen_cons(a, b) XEN_CONS(a, b) #define Xen_cons_2(a, b, c) XEN_CONS_2(a, b, c) #define Xen_list_1(a) XEN_LIST_1(a) #define Xen_list_2(a, b) XEN_LIST_2(a, b) #define Xen_list_3(a, b, c) XEN_LIST_3(a, b, c) #define Xen_list_4(a, b, c, d) XEN_LIST_4(a, b, c, d) #define Xen_list_5(a, b, c, d, e) XEN_LIST_5(a, b, c, d, e) #define Xen_list_6(a, b, c, d, e, f) XEN_LIST_6(a, b, c, d, e, f) #define Xen_list_7(a, b, c, d, e, f, g) XEN_LIST_7(a, b, c, d, e, f, g) #define Xen_list_8(a, b, c, d, e, f, g, h) XEN_LIST_8(a, b, c, d, e, f, g, h) #define Xen_list_9(a, b, c, d, e, f, g, h, i) XEN_LIST_9(a, b, c, d, e, f, g, h, i) #define Xen_list_length(a) XEN_LIST_LENGTH(a) #define Xen_list_ref(a, b) XEN_LIST_REF(a, b) #define Xen_list_reverse(a) XEN_LIST_REVERSE(a) #define Xen_list_set(a, b, c) XEN_LIST_SET(a, b, c) #define Xen_member(a, b) XEN_MEMBER(a, b) #define Xen_make_keyword(a) XEN_MAKE_KEYWORD(a) #define Xen_make_vector(a, b) XEN_MAKE_VECTOR(a, b) #define Xen_throw(a) XEN_THROW(a) #define Xen_vector_length(a) XEN_VECTOR_LENGTH(a) #define Xen_vector_ref(a, b) XEN_VECTOR_REF(a, b) #define Xen_vector_set(a, b, c) XEN_VECTOR_SET(a, b, c) #define Xen_vector_to_Xen_list(a) XEN_VECTOR_TO_LIST(a) #define C_bool_to_Xen_boolean(a) C_TO_XEN_BOOLEAN(a) #define C_char_to_Xen_char(a) C_TO_XEN_CHAR(a) #define C_complex_to_Xen_complex(a) C_TO_XEN_COMPLEX(a) #define C_double_to_Xen_real(a) C_TO_XEN_DOUBLE(a) #define C_int_to_Xen_integer(a) C_TO_XEN_INT(a) #define C_llong_to_Xen_llong(a) C_TO_XEN_LONG_LONG(a) #define C_string_to_Xen_string(a) C_TO_XEN_STRING(a) #define C_string_to_Xen_string_with_length(a, b) C_TO_XEN_STRINGN(a, b) #define C_string_to_Xen_symbol(a) C_STRING_TO_XEN_SYMBOL(a) #define C_ulong_to_Xen_ulong(a) C_TO_XEN_ULONG(a) #define C_ullong_to_Xen_ullong(a) C_TO_XEN_ULONG_LONG(a) #define Xen_boolean_to_C_bool(a) XEN_TO_C_BOOLEAN(a) #define Xen_char_to_C_char(a) XEN_TO_C_CHAR(a) #define Xen_complex_to_C_complex(a) XEN_TO_C_COMPLEX(a) #define Xen_real_to_C_double(a) XEN_TO_C_DOUBLE(a) #define Xen_integer_to_C_int(a) XEN_TO_C_INT(a) #define Xen_llong_to_C_llong(a) XEN_TO_C_LONG_LONG(a) #define Xen_string_to_C_string(a) XEN_TO_C_STRING(a) #define Xen_symbol_to_C_string(a) XEN_SYMBOL_TO_C_STRING(a) #define C_string_to_Xen_value(a) XEN_NAME_AS_C_STRING_TO_VALUE(a) #define Xen_ulong_to_C_ulong(a) XEN_TO_C_ULONG(a) #define Xen_ullong_to_C_ullong(a) XEN_TO_C_ULONG_LONG(a) #define Xen_wrap_C_pointer(a) XEN_WRAP_C_POINTER(a) #define Xen_unwrap_C_pointer(a) XEN_UNWRAP_C_POINTER(a) #define Xen_numerator(a) XEN_NUMERATOR(a) #define Xen_denominator(a) XEN_DENOMINATOR(a) #define Xen_rationalize(a, b) XEN_RATIONALIZE(a, b) #define Xen_make_ratio(a, b) XEN_MAKE_RATIO(a, b) #define Xen_load(a) XEN_LOAD_FILE(a) #define Xen_documentation(a) XEN_OBJECT_HELP(a) #define Xen_vector_rank(a) XEN_VECTOR_RANK(a) #define Xen_wrap_no_args(a, b) XEN_NARGIFY_0(a, b) #define Xen_wrap_1_arg(a, b) XEN_NARGIFY_1(a, b) #define Xen_wrap_2_args(a, b) XEN_NARGIFY_2(a, b) #define Xen_wrap_3_args(a, b) XEN_NARGIFY_3(a, b) #define Xen_wrap_4_args(a, b) XEN_NARGIFY_4(a, b) #define Xen_wrap_5_args(a, b) XEN_NARGIFY_5(a, b) #define Xen_wrap_6_args(a, b) XEN_NARGIFY_6(a, b) #define Xen_wrap_7_args(a, b) XEN_NARGIFY_7(a, b) #define Xen_wrap_8_args(a, b) XEN_NARGIFY_8(a, b) #define Xen_wrap_9_args(a, b) XEN_NARGIFY_9(a, b) #define Xen_wrap_1_optional_arg(a, b) XEN_ARGIFY_1(a, b) #define Xen_wrap_2_optional_args(a, b) XEN_ARGIFY_2(a, b) #define Xen_wrap_3_optional_args(a, b) XEN_ARGIFY_3(a, b) #define Xen_wrap_4_optional_args(a, b) XEN_ARGIFY_4(a, b) #define Xen_wrap_5_optional_args(a, b) XEN_ARGIFY_5(a, b) #define Xen_wrap_6_optional_args(a, b) XEN_ARGIFY_6(a, b) #define Xen_wrap_7_optional_args(a, b) XEN_ARGIFY_7(a, b) #define Xen_wrap_8_optional_args(a, b) XEN_ARGIFY_8(a, b) #define Xen_wrap_9_optional_args(a, b) XEN_ARGIFY_9(a, b) #define Xen_wrap_any_args(a, b) XEN_VARGIFY(a, b) #define Xen_apply(a, b, c) XEN_APPLY(a, b, c) #define Xen_unprotected_apply(a, b) XEN_APPLY_NO_CATCH(a, b) #define Xen_eval_C_string(a) XEN_EVAL_C_STRING(a) #define Xen_error(a, b) XEN_ERROR(a, b) #define Xen_call_with_no_args(a, b) XEN_CALL_0(a, b) #define Xen_call_with_1_arg(a, b, c) XEN_CALL_1(a, b, c) #define Xen_call_with_2_args(a, b, c, d) XEN_CALL_2(a, b, c, d) #define Xen_call_with_3_args(a, b, c, d, e) XEN_CALL_3(a, b, c, d, e) #define Xen_call_with_4_args(a, b, c, d, e, f) XEN_CALL_4(a, b, c, d, e, f) #define Xen_call_with_5_args(a, b, c, d, e, f, g) XEN_CALL_5(a, b, c, d, e, f, g) #define Xen_call_with_6_args(a, b, c, d, e, f, g, h) XEN_CALL_6(a, b, c, d, e, f, g, h) #define Xen_unprotected_call_with_no_args(a) XEN_CALL_0_NO_CATCH(a) #define Xen_unprotected_call_with_1_arg(a, b) XEN_CALL_1_NO_CATCH(a, b) #define Xen_unprotected_call_with_2_args(a, b, c) XEN_CALL_2_NO_CATCH(a, b, c) #define Xen_unprotected_call_with_3_args(a, b, c, d) XEN_CALL_3_NO_CATCH(a, b, c, d) #define Xen_define(a, b) XEN_DEFINE(a, b) #define Xen_define_constant(a, b, c) XEN_DEFINE_CONSTANT(a, b, c) #define Xen_define_hook(a, b, c, d) XEN_DEFINE_HOOK(a, b, c, d) #define Xen_define_procedure(a, b, c, d, e, f) XEN_DEFINE_PROCEDURE(a, b, c, d, e, f) #define Xen_define_procedure_with_setter(a, b, c, d, e, f, g, h, i) XEN_DEFINE_PROCEDURE_WITH_SETTER(a, b, c, d, e, f, g, h, i) #define Xen_define_dilambda(a, b, c, d, e, f, g, h, i) XEN_DEFINE_PROCEDURE_WITH_SETTER(a, b, c, d, e, f, g, h, i) #define Xen_define_safe_procedure(a, b, c, d, e, f) XEN_DEFINE_SAFE_PROCEDURE(a, b, c, d, e, f) #define Xen_define_integer_procedure(a, b, c, d, e, f) XEN_DEFINE_SAFE_PROCEDURE(a, b, c, d, e, f) /*obsolete */ #define Xen_define_simple_hook(a, b) XEN_DEFINE_SIMPLE_HOOK(a, b) #define Xen_define_variable(a, b, c) XEN_DEFINE_VARIABLE(a, b, c) #define Xen_out_of_range_error(a, b, c, d) XEN_OUT_OF_RANGE_ERROR(a, b, c, d) #define Xen_wrong_type_arg_error(a, b, c, d) XEN_WRONG_TYPE_ARG_ERROR(a, b, c, d) #define Xen_bad_arity_error(a, b, c, d) XEN_BAD_ARITY_ERROR(a, b, c, d) #define Xen_clear_hook_list(a) XEN_CLEAR_HOOK(a) #define Xen_hook_has_list(a) XEN_HOOKED(a) #define Xen_hook_list(a) XEN_HOOK_PROCEDURES(a) #define Xen_add_to_hook_list(a, b, c, d) XEN_ADD_HOOK(a, b, c, d) #define Xen_GC_protect(a) XEN_PROTECT_FROM_GC(a) #define Xen_GC_unprotect(a) XEN_UNPROTECT_FROM_GC(a) #define Xen_provide_feature(a) XEN_PROVIDE(a) #define Xen_arity(a) XEN_ARITY(a) #define Xen_add_to_load_path(a) XEN_ADD_TO_LOAD_PATH(a) #define Xen_check_type(a, b, c, d, e) XEN_ASSERT_TYPE(a, b, c, d, e) #define Xen_make_object(a, b, c, d) XEN_MAKE_OBJECT(a, b, c, d) #define Xen_variable_ref(a) XEN_VARIABLE_REF(a) #define Xen_variable_set(a, b) XEN_VARIABLE_SET(a, b) #define Xen_object_ref(a) XEN_OBJECT_REF(a) #define Xen_copy_arg(a) XEN_COPY_ARG(a) #define Xen_assoc(a, b) XEN_ASSOC(a, b) #define Xen_assoc_ref(a, b) XEN_ASSOC_REF(a, b) #define Xen_assoc_set(a, b, c) XEN_ASSOC_SET(a, b, c) #define Xen_make_error_type(a) XEN_ERROR_TYPE(a) #define Xen_required_args(a) XEN_REQUIRED_ARGS(a) #define Xen_is_aritable(a, b) XEN_REQUIRED_ARGS_OK(a, b) #define Xen_object_to_C_string(a) XEN_AS_STRING(a) #define Xen_wrap_free(a, b, c) XEN_MAKE_OBJECT_FREE_PROCEDURE(a, b, c) #define Xen_wrap_print(a, b, c) XEN_MAKE_OBJECT_PRINT_PROCEDURE(a, b, c) #define Xen_make_object_type(a, b) XEN_MAKE_OBJECT_TYPE(a, b) #define Xen_object_mark_t XEN_MARK_OBJECT_TYPE #define Xen_object_type_t XEN_OBJECT_TYPE #define Xen_catch_t XEN_CATCH_BODY_TYPE #define Xen_comment_mark XEN_COMMENT_STRING #define Xen_documentation_symbol XEN_DOCUMENTATION_SYMBOL #define Xen_empty_list XEN_EMPTY_LIST #define Xen_false XEN_FALSE #define Xen_true XEN_TRUE #define Xen_undefined XEN_UNDEFINED #define Xen_integer_zero XEN_ZERO #define Xen_file_extension XEN_FILE_EXTENSION #define Xen_language XEN_LANGUAGE_NAME #define Xen_load_path XEN_LOAD_PATH #define Xen_procedure_cast XEN_PROCEDURE_CAST #define Xen XEN #if HAVE_SCHEME #define Xen_define_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) s7_define_typed_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) #define Xen_define_unsafe_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) s7_define_unsafe_typed_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) #define Xen_define_typed_dilambda(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt, Get_Sig, Set_Sig) \ s7_typed_dilambda(s7, Get_Name, Get_Func, Get_Req, Get_Opt, Set_Func, Set_Req, Set_Opt, Get_Help, Get_Sig, Set_Sig) #else #define Xen_define_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) Xen_define_safe_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc) #define Xen_define_unsafe_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) Xen_define_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc) #define Xen_define_typed_dilambda(a, b, c, d, e, f, g, h, i, j, k) XEN_DEFINE_PROCEDURE_WITH_SETTER(a, b, c, d, e, f, g, h, i) #endif #ifdef __cplusplus extern "C" { #endif char *xen_strdup(const char *str); char *xen_version(void); void xen_repl(int argc, char **argv); void xen_initialize(void); void xen_gc_mark(XEN val); #ifdef __cplusplus } #endif #endif