1 #ifndef XEN_H 2 #define XEN_H 3 4 /* macros for extension language support 5 * 6 * Ruby: covers 1.8.0 to present 7 * Forth: covers 1.0 to present 8 * s7: all versions 9 * None: all versions 10 */ 11 12 #define XEN_MAJOR_VERSION 3 13 #define XEN_MINOR_VERSION 28 14 #define XEN_VERSION "3.28" 15 16 /* HISTORY: 17 * 18 * 14-May-20: g++ xen.h|c changes for Ruby 2.7 and gcc version 10. 19 * -------- 20 * 26-Apr-18: changed XEN_MAKE_OBJECT_TYPE in s7 again... 21 * -------- 22 * 2-Aug-17: changed XEN_MAKE_OBJECT_TYPE in s7. 23 * -------- 24 * 29-Jul-16: Xen_define_unsafe_typed_procedure. 25 * -------- 26 * 20-Aug-15: Xen_define_typed_procedure, Xen_define_typed_dilambda. 27 * -------- 28 * 27-Dec: Xen_arity in s7 now uses s7_arity. Xen_define_integer_procedure, Xen_define_dilambda. 29 * 21-Feb: Xen_is_number and friends. 30 * 7-Jan-14: in s7, C_TO_XEN_STRING and XEN_TO_C_STRING now treat a null string as a string (not #f). 31 * -------- 32 * 9-Nov: removed XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER. 33 * 11-Oct: removed XEN_EXACT_P. 34 * 23-Sep: removed *_OR_ELSE, XEN_ARG_*, and OFF_T* macros; added XEN_ARGIFY* to the Forth section. 35 * 7-Jul-13: removed int64 stuff (it was not used anywhere). Made various Ruby changes (NUM2ULL etc). 36 * -------- 37 * 5-Nov: minor s7-related changes. 38 * 9-July: XEN_VECTOR_ELEMENTS and XEN_VECTOR_COPY. 39 * 4-June: XEN_PROVIDE 40 * 8-May: added description arg to XEN_DEFINE_SIMPLE_HOOK and XEN_DEFINE_HOOK, only used in scheme. 41 * 12-Jan-12: added reverse argument to s7 version of XEN_MAKE_OBJECT_TYPE. 42 * -------- 43 * 20-Oct: XEN_LONG_LONG_P. 44 * 5-Jun-11: XEN_DEFINE_SAFE_PROCEDURE, an experiment with s7. 45 * -------- 46 * 25-Nov: updates for Ruby 1.9.*. 47 * 7-Nov: XEN_ADD_HOOK. 48 * 23-Oct: use s7_call_with_location, rather than s7_call, for better error reporting. 49 * 19-Mar: removed s7_define_set_function (removed encapsulation from s7, so it's not useful anymore). 50 * 17-Feb: various s7 changes. 51 * 5-Feb-10: XEN_ASSOC_REF and XEN_ASSOC_SET. XEN_ASSOC_REF returns the value, not the key/value pair. 52 * -------- 53 * 16-Dec: removed Guile support. removed xen_return_first (a guile-ism). 54 * 2-Nov: XEN_VECTOR_RANK. 55 * 5-Oct: use s7_c_pointer etc. 56 * 7-Aug: use s7_new_type_x in XEN_MAKE_OBJECT_TYPE. XEN_DEFINE_SET_PROCEDURE. 57 * 27-Jul: INT64_T cases paralleling OFF_T (the latter may go away someday). 58 * 14-Jul: s7_define_function_star via XEN_DEFINE_PROCEDURE_STAR. 59 * 6-Jul: cleaned up XEN_WRAP_C_POINTER et al (Mike Scholz). 60 * 29-Jun: some fth changes. 61 * 30-Mar: added a bunch of file-oriented functions for s7 (xen.c). 62 * 14-Mar: removed XEN_LOCAL_GC_PROTECT and XEN_LOCAL_GC_UNPROTECT. 63 * 14-Jan-09: s7_xen_initialize. 64 * -------- 65 * 17-Nov: use s7_define_constant in XEN_DEFINE_CONSTANT. 66 * 1-Nov: changed s7 and Guile C_TO_XEN_STRING slightly. 67 * 16-Oct: removed Gauche support. 68 * 10-Aug: S7, a TinyScheme derivative. 69 * changed XEN_NUMERATOR and XEN_DENOMINATOR to return off_t not XEN. 70 * 23-Jul: be more careful about wrapping POINTERs (they say 64-bit MS C void* == unsigned long long, but not unsigned long). 71 * 30-Jun: XEN_OFF_T_IF_BOUND_P. 72 * 19-May: more const char* arg declarations. 73 * 14-May: changed XEN_ARITY in Guile to use scm_procedure_property. 74 * 1-May: XEN_NAN_P and XEN_INF_P (Guile). 75 * 23-Apr: try to get old Gauche (8.7) to work again. 76 * 1-Mar-08: no ext case now checks arg consistency. 77 * -------- 78 * 12-Dec: Gauche uses COMPNUM, not COMPLEX (after 0.8.7?), NUMBERP for complex? 79 * 21-Nov: XEN_HAVE_COMPLEX_NUMBERS. 80 * 18-Jul: Gauche error handling changes. 81 * 28-Apr: Gauche API changes in versions 0.8.8, 0.8.10, and 0.9. 82 * 14-Feb: XEN_PUTS and friends for fth (Mike). 83 * 17-Jan-07: rb_errinfo changes (Mike Scholz). 84 * -------- 85 * 14-Nov: check for Scm_EvalRec (Gauche 0.8.8). 86 * 9-Sep: XEN_LOAD_PATH and XEN_ADD_TO_LOAD_PATH 87 * 1-Sep: string and array changes for Ruby (from Mike). 88 * 7-Aug: more careful list length handling in Ruby (from Mike). 89 * 23-May: added xen_rb_repl_set_prompt to set (no-gui) Ruby repl prompt. 90 * 12-May: changed HAVE_RATIOS to XEN_HAVE_RATIOS. 91 * 17-Apr: removed XEN_MAKE_OBJECT. 92 * 15-Apr: Gauche support. 93 * 28-Mar-06: Forth support thanks to Mike Scholz. 94 * -------- 95 * 7-Nov: xen_rb_defined_p (Mike Scholz). 96 * 16-Sep: removed some debugging extras that caused confusion on 64-bit machines. 97 * 12-Aug: include guile setter procedure names for better error reporting. 98 * 14-Jun: XEN_DEFINE (XEN value, not assumed to be int as in XEN_DEFINE_CONSTANT). 99 * XEN_ASSOC, XEN_MEMBER, and XEN_PROCEDURE_NAME for Scheme side. 100 * XEN_DEFINE_HOOK and XEN_DEFINE_SIMPLE_HOOK no longer take the "Var" arg. 101 * 18-May: deprecate XEN_NUMBER_OR_BOOLEAN_IF_BOUND_P and XEN_NUMBER_OR_BOOLEAN_P. 102 * 29-Mar: C_TO_XEN_STRINGN changes. 103 * 24-Mar: Ruby properties (Mike Scholz). 104 * 8-Mar: Ruby improvements in keywords and hooks (Mike Scholz). 105 * 7-Mar: C99 complex number changes (creal, _Complex_I) (Steve Bankowitz). 106 * 2-Mar: Ruby support for off_t (Mike Scholz). 107 * 4-Jan-05: more guile changes. 108 * -------- 109 * 31-Dec: removed "caller" arg from *_NO_CATCH. 110 * 10-Nov: scm_c_vector* (new Guile functions) 111 * 21-Oct: XEN_LIST_REVERSE, (using rb_ary_dup available in 1.8) 112 * 7-Oct: keyword changes for new Guile. 113 * 28-Sep: deprecated *_WITH_CALLER -- these no longer do anything useful in Guile. 114 * NaNs and Infs -> 0 or 0.0 in XEN_TO_C_INT|DOUBLE -- perhaps I should add another set of macros? 115 * 23-Aug: more Guile name changes. 116 * 12-Aug: more Guile name changes, C_TO_XEN_STRINGN (Guile) 117 * 3-Aug: xen_to_c_int bugfix thanks to Kjetil S. Matheussen. 118 * 29-Jul: deprecated XEN_TO_C_BOOLEAN_OR_TRUE. 119 * 21-Jul: deprecated XEN_TO_SMALL_C_INT and C_TO_SMALL_XEN_INT. 120 * use new Guile 1.7 numerical function names (under flag HAVE_SCM_TO_SIGNED_INTEGER). 121 * 28-Jun: XEN_REQUIRED_ARGS_OK to make it easier to turn off this check. 122 * 9-June: complex number conversions (Guile) -- Ruby complex numbers are an optional module? 123 * 21-May: plug some memory leaks in Ruby cases. 124 * 23-Feb: changed DEBUGGING to XEN_DEBUGGING, added redefinition checks under that switch. 125 * 2-Feb: C_TO_XEN_CHAR, ratio support (Guile), XEN_CONS_P, XEN_PAIR_P, etc 126 * 6-Jan: XEN_VARIABLE_REF in Guile changed to support 1.4 and older versions. 127 * 5-Jan-04: hook support in Ruby thanks to Michael Scholz. 128 * -------- 129 * 1-Nov: protect several macros from hidden double evaluations. 130 * 29-Sep: fixed incorrect assumption in xen_rb_cons (xen.c) that arg2 was list. 131 * 8-Sep: removed xen_malloc -- can't remember now why this existed. 132 * 19-Aug: xen_rb_str_new2 to avoid unwanted side-effects. 133 * 12-Aug: various changes for ISO C99. 134 * 30-Jul: use new SCM_VECTOR_REF/SET macros if they're defined. 135 * 7-Apr: changes to error handlers for more perspicuous error messages 136 * changed XEN_PROTECT_FROM_GC in Ruby to use rb_gc_register_address, added XEN_UNPROTECT_FROM_GC (rb_gc_unregister_address) 137 * 10-Mar: XEN_OUT_OF_RANGE_ERROR, XEN_BAD_ARITY_ERROR 138 * 17-Feb: XEN_HOOK_P 139 * 20-Jan-03: added Windows case for auto-import loader bugfix. 140 * -------- 141 * 19-Dec: proc arg checks for Ruby (to make sure XEN_[N|V]ARGIFY|DEFINE_PROCEDURE[etc] agree) 142 * 29-Jul: SCM_WRITABLE_VELTS for current CVS Guile 143 * 28-May: off_t equivalents in Ruby 1.7 144 * 6-May: off_t (long long) macros. 145 * 2-Jan-02: removed TIMING and MCHECK debugging stuff, VARIABLE_REF -> XEN_VARIABLE_REF 146 * -------- 147 * 22-Sep-01: removed (redundant) UNSIGNED_LONG macros -- use ULONG instead 148 */ 149 150 #ifndef __cplusplus 151 #include <sys/types.h> 152 #ifndef _MSC_VER 153 #include <stdbool.h> 154 #else 155 #ifndef true 156 #define bool unsigned char 157 #define true 1 158 #define false 0 159 #endif 160 #endif 161 #endif 162 163 164 #if ((!__NetBSD__) && ((_MSC_VER) || (!defined(__STC__)) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ < 199901L)))) 165 #define __func__ __FUNCTION__ 166 #endif 167 168 169 170 /* ------------------------------ RUBY ------------------------------ */ 171 172 /* other possibilities: 173 * XEN_DEFINE_METHOD, XEN_DEFINE_ALIAS, rb_ary_unsift = XEN_LIST_PREPEND?, 174 * various property macros -- in Scheme as well, rb_const_defined, rb_yield, XEN_INCLUDE_MODULE, 175 * rb_id2name (XEN_SYMBOL...), rb_raise. 176 */ 177 178 #if HAVE_RUBY 179 180 #ifdef _GNU_SOURCE 181 #undef _GNU_SOURCE 182 #endif 183 #include <ruby.h> 184 #if defined(__GNUC__) && (!(defined(__cplusplus))) 185 #ifndef _GNU_SOURCE 186 #define _GNU_SOURCE 187 #endif 188 #endif 189 190 #define XEN_OK 1 191 192 #define XEN VALUE 193 #define XEN_FILE_EXTENSION "rb" 194 #define XEN_COMMENT_STRING "#" 195 #define XEN_LANGUAGE_NAME "Ruby" 196 197 #define XEN_FALSE Qfalse 198 #define XEN_TRUE Qtrue 199 #define XEN_TRUE_P(a) ((a) == Qtrue) 200 #define XEN_FALSE_P(a) ((a) == Qfalse) 201 #define C_TO_XEN_BOOLEAN(a) ((a) ? Qtrue : Qfalse) 202 #define XEN_TO_C_BOOLEAN(a) (!(XEN_FALSE_P(a))) 203 204 /* #define XEN_UNDEFINED Qundef */ 205 #define XEN_UNDEFINED ID2SYM(rb_intern("undefined")) 206 207 #define XEN_BOUND_P(Arg) ((Arg) != XEN_UNDEFINED) 208 209 #if defined(__GNUC__) && (!(defined(__cplusplus))) 210 #define XEN_BOOLEAN_P(Arg) ({ XEN _xen_h_7_ = Arg; (XEN_TRUE_P(_xen_h_7_) || XEN_FALSE_P(_xen_h_7_)); }) 211 #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)); }) 212 #define XEN_INTEGER_P(Arg) ({ int _xen_h_9_ = TYPE(Arg); ((_xen_h_9_ == T_FIXNUM) || (_xen_h_9_ == T_BIGNUM)); }) 213 #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))); }) 214 #define XEN_KEYWORD_P(Obj) ({ XEN _xen_h_12_ = Obj; (XEN_BOUND_P(_xen_h_12_) && SYMBOL_P(_xen_h_12_)); }) 215 #else 216 #define XEN_BOOLEAN_P(Arg) (XEN_TRUE_P(Arg) || XEN_FALSE_P(Arg)) 217 #define XEN_NUMBER_P(Arg) ((TYPE(Arg) == T_FLOAT) || (TYPE(Arg) == T_FIXNUM) || (TYPE(Arg) == T_BIGNUM)) 218 #define XEN_INTEGER_P(Arg) ((TYPE(Arg) == T_FIXNUM) || (TYPE(Arg) == T_BIGNUM)) 219 #define XEN_PROCEDURE_P(Arg) (XEN_BOUND_P(Arg) && (rb_obj_is_kind_of(Arg, rb_cProc))) 220 #define XEN_KEYWORD_P(Obj) (XEN_BOUND_P(Obj) && SYMBOL_P(Obj)) 221 #endif 222 223 /* ---- lists ---- */ 224 #define XEN_EMPTY_LIST Qnil 225 #define XEN_NULL_P(a) (XEN_LIST_LENGTH(a) == 0) 226 227 #define XEN_CONS_P(Arg) (TYPE(Arg) == T_ARRAY) 228 #define XEN_PAIR_P(Arg) (TYPE(Arg) == T_ARRAY) 229 #define XEN_CONS(Arg1, Arg2) xen_rb_cons(Arg1, Arg2) 230 #define XEN_CONS_2(Arg1, Arg2, Arg3) xen_rb_cons2(Arg1, Arg2, Arg3) 231 #define XEN_CAR(a) xen_rb_list_ref(a, 0) 232 #define XEN_CADR(a) xen_rb_list_ref(a, 1) 233 #define XEN_CADDR(a) xen_rb_list_ref(a, 2) 234 #define XEN_CADDDR(a) xen_rb_list_ref(a, 3) 235 #define XEN_CDR(a) xen_rb_cdr(a) 236 #define XEN_CDDR(a) XEN_CDR(XEN_CDR(a)) 237 #define XEN_CDDDR(a) XEN_CDR(XEN_CDR(XEN_CDR(a))) 238 239 #define XEN_LIST_P(Arg) ((Arg) == XEN_EMPTY_LIST || XEN_CONS_P(Arg)) 240 #define XEN_LIST_P_WITH_LENGTH(Arg, Len) ((Len = XEN_LIST_LENGTH(Arg)) >= 0) 241 #define XEN_LIST_LENGTH(Arg) xen_rb_list_length(Arg) 242 #define XEN_EQ_P(a, b) ((a) == (b)) 243 #define XEN_LIST_1(a) rb_ary_new3(1, a) 244 #define XEN_LIST_2(a, b) rb_ary_new3(2, a, b) 245 #define XEN_LIST_3(a, b, c) rb_ary_new3(3, a, b, c) 246 #define XEN_LIST_4(a, b, c, d) rb_ary_new3(4, a, b, c, d) 247 #define XEN_LIST_5(a, b, c, d, e) rb_ary_new3(5, a, b, c, d, e) 248 #define XEN_LIST_6(a, b, c, d, e, f) rb_ary_new3(6, a, b, c, d, e, f) 249 #define XEN_LIST_7(a, b, c, d, e, f, g) rb_ary_new3(7, a, b, c, d, e, f, g) 250 #define XEN_LIST_8(a, b, c, d, e, f, g, h) rb_ary_new3(8, a, b, c, d, e, f, g, h) 251 #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) 252 #define XEN_COPY_ARG(Lst) xen_rb_copy_list(Lst) 253 #define XEN_LIST_REF(Lst, Num) xen_rb_list_ref(Lst, Num) 254 #define XEN_LIST_SET(Lst, Num, Val) xen_rb_list_set(Lst, Num, Val) 255 #define XEN_APPEND(X, Y) rb_ary_concat(X, Y) 256 #define XEN_LIST_REVERSE(Lst) ((Lst == XEN_EMPTY_LIST) ? XEN_EMPTY_LIST : rb_ary_reverse(XEN_COPY_ARG(Lst))) 257 258 /* ---- numbers ---- */ 259 #define XEN_ZERO INT2NUM(0) 260 #define XEN_DOUBLE_P(Arg) XEN_NUMBER_P(Arg) 261 #define XEN_TO_C_DOUBLE(a) NUM2DBL(a) 262 #define C_TO_XEN_DOUBLE(a) rb_float_new(a) 263 #define XEN_TO_C_INT(a) rb_num2long(a) 264 265 /* apparently no complex numbers (built-in) in Ruby? */ 266 #define XEN_COMPLEX_P(Arg) 1 267 #define C_TO_XEN_COMPLEX(a) XEN_ZERO 268 #define XEN_TO_C_COMPLEX(a) 0.0 269 270 #define XEN_ULONG_P(Arg1) XEN_INTEGER_P(Arg1) 271 #define XEN_WRAPPED_C_POINTER_P(Arg1) XEN_INTEGER_P(Arg1) 272 #define C_TO_XEN_INT(a) INT2NUM(a) 273 #define XEN_TO_C_ULONG(a) NUM2ULONG(a) 274 #ifdef ULONG2NUM 275 #define C_TO_XEN_ULONG(a) ULONG2NUM((unsigned long)a) 276 #else 277 #define C_TO_XEN_ULONG(a) UINT2NUM((unsigned long)a) 278 #endif 279 280 #ifdef NUM2ULL 281 /* ruby 1.9.3 */ 282 #define C_TO_XEN_LONG_LONG(a) LL2NUM(a) 283 #define XEN_TO_C_LONG_LONG(a) NUM2LL(a) 284 285 #define XEN_ULONG_LONG_P(Arg) XEN_INTEGER_P(Arg) 286 #define XEN_TO_C_ULONG_LONG(Arg) NUM2ULL(Arg) /* NUM2ULONG(Arg) */ 287 #define C_TO_XEN_ULONG_LONG(Arg) ULL2NUM(Arg) /* INT2NUM(Arg) */ 288 #else 289 /* older versions -- no dependable version number in ruby -- these macros may not work on a 64-bit machine */ 290 291 #ifndef OFFT2NUM 292 #define OFFT2NUM(a) INT2NUM(a) 293 #endif 294 #ifndef NUM2OFFT 295 #define NUM2OFFT(a) NUM2LONG(a) 296 #endif 297 #define C_TO_XEN_LONG_LONG(a) OFFT2NUM(a) 298 #define XEN_TO_C_LONG_LONG(a) NUM2OFFT(a) 299 300 #define XEN_ULONG_LONG_P(Arg) XEN_INTEGER_P(Arg) 301 #define XEN_TO_C_ULONG_LONG(Arg) NUM2OFFT(Arg) 302 #define C_TO_XEN_ULONG_LONG(Arg) OFFT2NUM(Arg) 303 #endif 304 305 /* ---- strings ---- */ 306 #define XEN_STRING_P(Arg) ((TYPE(Arg) == T_STRING) && (!SYMBOL_P(Arg))) 307 #define C_TO_XEN_STRING(a) xen_rb_str_new2((char *)a) 308 #define C_TO_XEN_STRINGN(a, len) rb_str_new((char *)a, len) 309 #ifndef RSTRING_PTR 310 #define XEN_TO_C_STRING(Str) RSTRING(Str)->ptr 311 #else 312 #define XEN_TO_C_STRING(Str) RSTRING_PTR(Str) 313 #endif 314 315 #define XEN_CHAR_P(Arg) XEN_STRING_P(Arg) 316 #define XEN_TO_C_CHAR(Arg) XEN_TO_C_STRING(Arg)[0] 317 #define C_TO_XEN_CHAR(Arg) rb_str_new((char *)(&(Arg)), 1) 318 319 #define XEN_NAME_AS_C_STRING_TO_VALUE(a) xen_rb_gv_get(a) 320 #define XEN_EVAL_C_STRING(Arg) xen_rb_eval_string_with_error(Arg) 321 #define XEN_TO_STRING(Obj) xen_rb_obj_as_string(Obj) 322 #define XEN_LOAD_FILE(a) xen_rb_load_file_with_error(a) 323 #define XEN_LOAD_PATH XEN_NAME_AS_C_STRING_TO_VALUE("$LOAD_PATH") 324 #define XEN_ADD_TO_LOAD_PATH(Path) xen_rb_add_to_load_path(Path) 325 326 /* ---- hooks ---- */ 327 #define XEN_HOOK_P(Arg) xen_rb_hook_p(Arg) 328 #define XEN_HOOK_PROCEDURES(a) xen_rb_hook_to_a(a) 329 #define XEN_CLEAR_HOOK(a) xen_rb_hook_reset_hook(a) 330 #define XEN_HOOKED(a) (!xen_rb_hook_empty_p(a)) 331 #define XEN_DEFINE_HOOK(Name, Descr, Arity, Help) xen_rb_create_hook((char *)(Name), Arity, (char *)Help) 332 #define XEN_DEFINE_SIMPLE_HOOK(Descr, Arity) xen_rb_create_simple_hook(Arity); 333 #define XEN_ADD_HOOK(Hook, Func, Name, Doc) xen_rb_add_hook(Hook, (XEN (*)(ANYARGS))Func, Name, Doc) 334 335 /* ---- vectors ---- */ 336 #define XEN_VECTOR_P(Arg) (TYPE(Arg) == T_ARRAY) 337 #define XEN_VECTOR_LENGTH(Arg) xen_rb_list_length(Arg) 338 #define XEN_VECTOR_REF(Vect, Num) xen_rb_list_ref(Vect, Num) 339 #define XEN_VECTOR_SET(Vect, Num, Val) xen_rb_list_set(Vect, Num, Val) 340 #define XEN_MAKE_VECTOR(Num, Fill) xen_rb_ary_new_with_initial_element(Num, Fill) 341 #define XEN_VECTOR_TO_LIST(a) a 342 #define XEN_VECTOR_COPY(Vect) rb_ary_dup(Vect) 343 344 #define XEN_ASSOC_REF(Item, Lst) xen_assoc(Item, Lst) 345 #define XEN_ASSOC_SET(Sym, Val, Lst) xen_set_assoc(Sym, Val, Lst) 346 347 348 /* ---- symbols ---- */ 349 #define XEN_SYMBOL_P(Arg) SYMBOL_P(Arg) 350 #define XEN_SYMBOL_TO_C_STRING(a) ((char *)rb_id2name(SYM2ID(a))) 351 #define C_STRING_TO_XEN_SYMBOL(a) ID2SYM(rb_intern(a)) 352 #define XEN_SYMBOL_TO_STRING(Sym) C_TO_XEN_STRING(XEN_SYMBOL_TO_C_STRING(Sym)) 353 #define XEN_DOCUMENTATION_SYMBOL C_STRING_TO_XEN_SYMBOL("documentation") 354 #define XEN_OBJECT_HELP(Name) rb_documentation(Name) 355 #define XEN_SET_OBJECT_HELP(Name, Help) rb_set_documentation(Name, Help) 356 #define C_SET_OBJECT_HELP(name, help) XEN_SET_OBJECT_HELP(C_TO_XEN_STRING(name), C_TO_XEN_STRING(help)) 357 358 #define XEN_VARIABLE_SET(a, b) xen_rb_gv_set(a, b) 359 #define XEN_VARIABLE_REF(a) xen_rb_gv_get(a) 360 #define XEN_DEFINE_CONSTANT(Name, Value, Help) \ 361 do { \ 362 char *temp; \ 363 temp = xen_scheme_constant_to_ruby(Name); \ 364 rb_define_global_const(temp, C_TO_XEN_INT(Value)); \ 365 if ((Name) && (Help)) C_SET_OBJECT_HELP(temp, Help); \ 366 if (temp) free(temp); \ 367 } while (0) 368 369 #define XEN_DEFINE_VARIABLE(Name, Var, Value) \ 370 { \ 371 char *temp; \ 372 Var = Value; \ 373 temp = xen_scheme_global_variable_to_ruby(Name); \ 374 rb_define_variable(temp, (VALUE *)(&Var)); \ 375 if (temp) free(temp); \ 376 } 377 #define XEN_DEFINE(Name, Value) xen_rb_define(Name, Value) 378 #define XEN_DEFINED_P(Name) xen_rb_defined_p(Name) 379 380 /* ---- C structs ---- */ 381 #define XEN_MARK_OBJECT_TYPE void * 382 #define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, Mark, Free) return(Data_Wrap_Struct(Tag, Mark, Free, Val)) 383 #define XEN_MAKE_OBJECT(Tag, Val, Mark, Free) Data_Wrap_Struct(Tag, Mark, Free, Val) 384 #define XEN_OBJECT_REF(a) DATA_PTR(a) 385 #define XEN_OBJECT_TYPE VALUE 386 #define XEN_OBJECT_TYPE_P(OBJ, TAG) (XEN_BOUND_P(OBJ) && (rb_obj_is_instance_of(OBJ, TAG))) 387 #define XEN_MAKE_OBJECT_TYPE(Typ, Siz) xen_rb_define_class(Typ) 388 389 #define XEN_MAKE_OBJECT_FREE_PROCEDURE(Type, Wrapped_Free, Original_Free) \ 390 static void *Wrapped_Free(XEN obj) \ 391 { \ 392 Original_Free((Type *)obj); \ 393 return(NULL); \ 394 } 395 396 #define XEN_MAKE_OBJECT_PRINT_PROCEDURE(Type, Wrapped_Print, Original_Print) \ 397 static XEN Wrapped_Print(XEN obj) \ 398 { \ 399 XEN val; \ 400 char *str; \ 401 str = Original_Print((Type *)XEN_OBJECT_REF(obj)); \ 402 val = C_TO_XEN_STRING(str); \ 403 free(str); \ 404 return(val); \ 405 } 406 407 /* ---- procedures ---- */ 408 #if defined(__cplusplus) || (defined(__GNUC__) && (__GNUC__ >= 10)) || (defined(__clang__) && (__clang_major__ >= 10)) 409 #ifdef ANYARGS 410 #define XEN_PROCEDURE_CAST (XEN (*)(ANYARGS)) 411 #define XEN_VALUE_ARG_PROCEDURE_CAST (XEN (*)(VALUE)) 412 #else 413 #define XEN_PROCEDURE_CAST (XEN (*)()) 414 #define XEN_VALUE_ARG_PROCEDURE_CAST (XEN (*)()) 415 #endif 416 #else 417 #define XEN_PROCEDURE_CAST 418 #define XEN_VALUE_ARG_PROCEDURE_CAST 419 #endif 420 421 #define XEN_ARITY(Func) rb_funcall(Func, rb_intern("arity"), 0) 422 #define XEN_REQUIRED_ARGS(Func) xen_rb_required_args(XEN_ARITY(Func)) 423 #define XEN_REQUIRED_ARGS_OK(Func, Args) (xen_rb_required_args(XEN_ARITY(Func)) == Args) 424 425 #define XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) \ 426 do { \ 427 char *temp; \ 428 temp = xen_scheme_procedure_to_ruby(Name); \ 429 rb_define_global_function(temp, XEN_PROCEDURE_CAST Func, ((RstArg > 0) ? -2 : (OptArg > 0) ? -1 : ReqArg)); \ 430 if ((Name) && (Doc)) C_SET_OBJECT_HELP(temp, Doc); \ 431 if (temp) free(temp); \ 432 } while (0) 433 434 #define XEN_DEFINE_PROCEDURE_WITH_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \ 435 do { \ 436 XEN_DEFINE_PROCEDURE(Get_Name, XEN_PROCEDURE_CAST Get_Func, Get_Req, Get_Opt, 0, Get_Help); \ 437 XEN_DEFINE_PROCEDURE(Set_Name, XEN_PROCEDURE_CAST Set_Func, Set_Req, Set_Opt, 0, Get_Help); \ 438 } while (0) 439 440 #define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) 441 442 #define XEN_CALL_0(Func, Caller) xen_rb_funcall_0(Func) 443 #define XEN_CALL_1(Func, Arg1, Caller) rb_funcall(Func, rb_intern("call"), 1, Arg1) 444 #define XEN_CALL_2(Func, Arg1, Arg2, Caller) rb_funcall(Func, rb_intern("call"), 2, Arg1, Arg2) 445 #define XEN_CALL_3(Func, Arg1, Arg2, Arg3, Caller) rb_funcall(Func, rb_intern("call"), 3, Arg1, Arg2, Arg3) 446 #define XEN_CALL_4(Func, Arg1, Arg2, Arg3, Arg4, Caller) rb_funcall(Func, rb_intern("call"), 4, Arg1, Arg2, Arg3, Arg4) 447 #define XEN_CALL_5(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Caller) rb_funcall(Func, rb_intern("call"), 5, Arg1, Arg2, Arg3, Arg4, Arg5) 448 #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) 449 #define XEN_APPLY(Func, Args, Caller) xen_rb_apply(Func, Args) 450 #define XEN_CALL_0_NO_CATCH(Func) xen_rb_funcall_0(Func) 451 #define XEN_CALL_1_NO_CATCH(Func, Arg1) rb_funcall(Func, rb_intern("call"), 1, Arg1) 452 #define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) rb_funcall(Func, rb_intern("call"), 2, Arg1, Arg2) 453 #define XEN_CALL_3_NO_CATCH(Func, Arg1, Arg2, Arg3) rb_funcall(Func, rb_intern("call"), 3, Arg1, Arg2, Arg3) 454 #define XEN_APPLY_NO_CATCH(Func, Args) xen_rb_apply(Func, Args) 455 456 /* ---- keywords, etc ---- */ 457 #define XEN_KEYWORD_EQ_P(k1, k2) ((k1) == (k2)) 458 #define XEN_MAKE_KEYWORD(Arg) xen_rb_make_keyword(Arg) 459 #define XEN_PROVIDE(a) rb_provide(xen_strdup(a)) 460 #define XEN_PROTECT_FROM_GC(Var) rb_gc_register_address(&(Var)) 461 #define XEN_UNPROTECT_FROM_GC(Var) rb_gc_unregister_address(&(Var)) 462 463 /* ---- errors ---- */ 464 #define XEN_ERROR_TYPE(Name) xen_rb_intern(Name) 465 466 467 #if USE_SND 468 469 #define XEN_ERROR(Type, Info) snd_rb_raise(Type, Info) 470 471 #define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) \ 472 snd_rb_raise(XEN_ERROR_TYPE("out-of-range"), \ 473 XEN_LIST_5(C_TO_XEN_STRING("~A: argument ~A, ~A, is out of range (~A)"), \ 474 C_TO_XEN_STRING(xen_scheme_procedure_to_ruby(Caller)), \ 475 C_TO_XEN_INT(ArgN), \ 476 Arg, \ 477 C_TO_XEN_STRING(Descr))) 478 479 #define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) \ 480 snd_rb_raise(XEN_ERROR_TYPE("wrong-type-arg"), \ 481 XEN_LIST_5(C_TO_XEN_STRING("~A: argument ~A, ~A, should be ~A"), \ 482 C_TO_XEN_STRING(xen_scheme_procedure_to_ruby(Caller)), \ 483 C_TO_XEN_INT(ArgN), \ 484 Arg, \ 485 C_TO_XEN_STRING(Descr))) 486 487 #else 488 489 #define XEN_ERROR(Type, Info) xen_rb_raise(Type, Info) 490 491 #define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) \ 492 rb_raise(rb_eRangeError, "%s: argument %d, %s, is out of range (%s)\n", \ 493 Caller, (int)ArgN, XEN_AS_STRING(Arg), Descr) 494 495 #define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) \ 496 rb_raise(rb_eTypeError, "%s: argument %d, %s, should be %s\n", \ 497 Caller, (int)ArgN, XEN_AS_STRING(Arg), Descr) 498 499 #endif 500 501 #define XEN_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) \ 502 if (!(Assertion)) \ 503 XEN_WRONG_TYPE_ARG_ERROR(Caller, Position, Arg, Correct_Type) 504 505 #define XEN_THROW(Type, Info) xen_rb_raise(Type, Info) 506 507 #define XEN_ARGIFY_1(OutName, InName) \ 508 static XEN OutName(int argc, XEN *argv, XEN self) \ 509 { \ 510 return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED)); \ 511 } 512 513 #define XEN_ARGIFY_2(OutName, InName) \ 514 static XEN OutName(int argc, XEN *argv, XEN self) \ 515 { \ 516 return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ 517 (argc > 1) ? argv[1] : XEN_UNDEFINED)); \ 518 } 519 520 #define XEN_ARGIFY_3(OutName, InName) \ 521 static XEN OutName(int argc, XEN *argv, XEN self) \ 522 { \ 523 return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ 524 (argc > 1) ? argv[1] : XEN_UNDEFINED, \ 525 (argc > 2) ? argv[2] : XEN_UNDEFINED)); \ 526 } 527 528 #define XEN_ARGIFY_4(OutName, InName) \ 529 static XEN OutName(int argc, XEN *argv, XEN self) \ 530 { \ 531 return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ 532 (argc > 1) ? argv[1] : XEN_UNDEFINED, \ 533 (argc > 2) ? argv[2] : XEN_UNDEFINED, \ 534 (argc > 3) ? argv[3] : XEN_UNDEFINED)); \ 535 } 536 537 #define XEN_ARGIFY_5(OutName, InName) \ 538 static XEN OutName(int argc, XEN *argv, XEN self) \ 539 { \ 540 return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ 541 (argc > 1) ? argv[1] : XEN_UNDEFINED, \ 542 (argc > 2) ? argv[2] : XEN_UNDEFINED, \ 543 (argc > 3) ? argv[3] : XEN_UNDEFINED, \ 544 (argc > 4) ? argv[4] : XEN_UNDEFINED)); \ 545 } 546 547 #define XEN_ARGIFY_6(OutName, InName) \ 548 static XEN OutName(int argc, XEN *argv, XEN self) \ 549 { \ 550 return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ 551 (argc > 1) ? argv[1] : XEN_UNDEFINED, \ 552 (argc > 2) ? argv[2] : XEN_UNDEFINED, \ 553 (argc > 3) ? argv[3] : XEN_UNDEFINED, \ 554 (argc > 4) ? argv[4] : XEN_UNDEFINED, \ 555 (argc > 5) ? argv[5] : XEN_UNDEFINED)); \ 556 } 557 558 #define XEN_ARGIFY_7(OutName, InName) \ 559 static XEN OutName(int argc, XEN *argv, XEN self) \ 560 { \ 561 return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ 562 (argc > 1) ? argv[1] : XEN_UNDEFINED, \ 563 (argc > 2) ? argv[2] : XEN_UNDEFINED, \ 564 (argc > 3) ? argv[3] : XEN_UNDEFINED, \ 565 (argc > 4) ? argv[4] : XEN_UNDEFINED, \ 566 (argc > 5) ? argv[5] : XEN_UNDEFINED, \ 567 (argc > 6) ? argv[6] : XEN_UNDEFINED)); \ 568 } 569 570 #define XEN_ARGIFY_8(OutName, InName) \ 571 static XEN OutName(int argc, XEN *argv, XEN self) \ 572 { \ 573 return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ 574 (argc > 1) ? argv[1] : XEN_UNDEFINED, \ 575 (argc > 2) ? argv[2] : XEN_UNDEFINED, \ 576 (argc > 3) ? argv[3] : XEN_UNDEFINED, \ 577 (argc > 4) ? argv[4] : XEN_UNDEFINED, \ 578 (argc > 5) ? argv[5] : XEN_UNDEFINED, \ 579 (argc > 6) ? argv[6] : XEN_UNDEFINED, \ 580 (argc > 7) ? argv[7] : XEN_UNDEFINED)); \ 581 } 582 583 #define XEN_ARGIFY_9(OutName, InName) \ 584 static XEN OutName(int argc, XEN *argv, XEN self) \ 585 { \ 586 return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \ 587 (argc > 1) ? argv[1] : XEN_UNDEFINED, \ 588 (argc > 2) ? argv[2] : XEN_UNDEFINED, \ 589 (argc > 3) ? argv[3] : XEN_UNDEFINED, \ 590 (argc > 4) ? argv[4] : XEN_UNDEFINED, \ 591 (argc > 5) ? argv[5] : XEN_UNDEFINED, \ 592 (argc > 6) ? argv[6] : XEN_UNDEFINED, \ 593 (argc > 7) ? argv[7] : XEN_UNDEFINED, \ 594 (argc > 8) ? argv[8] : XEN_UNDEFINED)); \ 595 } 596 597 #define XEN_NARGIFY_0(OutName, InName) \ 598 static XEN OutName(void) {return(InName());} 599 600 #define XEN_NARGIFY_1(OutName, InName) \ 601 static XEN OutName(XEN self, XEN Arg) {return(InName(Arg));} 602 603 #define XEN_NARGIFY_2(OutName, InName) \ 604 static XEN OutName(XEN self, XEN Arg1, XEN Arg2) {return(InName(Arg1, Arg2));} 605 606 #define XEN_NARGIFY_3(OutName, InName) \ 607 static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3) {return(InName(Arg1, Arg2, Arg3));} 608 609 #define XEN_NARGIFY_4(OutName, InName) \ 610 static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4) {return(InName(Arg1, Arg2, Arg3, Arg4));} 611 612 #define XEN_NARGIFY_5(OutName, InName) \ 613 static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5) {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5));} 614 615 #define XEN_NARGIFY_6(OutName, InName) \ 616 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));} 617 618 #define XEN_NARGIFY_7(OutName, InName) \ 619 static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5, XEN Arg6, XEN Arg7) \ 620 {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7));} 621 622 #define XEN_NARGIFY_8(OutName, InName) \ 623 static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5, XEN Arg6, XEN Arg7, XEN Arg8) \ 624 {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8));} 625 626 #define XEN_NARGIFY_9(OutName, InName) \ 627 static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5, XEN Arg6, XEN Arg7, XEN Arg8, XEN Arg9) \ 628 {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9));} 629 630 #define XEN_VARGIFY(OutName, InName) \ 631 static XEN OutName(XEN self, XEN Args) {return(InName(Args));} 632 633 #ifdef __cplusplus 634 extern "C" { 635 #endif 636 637 XEN xen_rb_gv_get(const char *name); 638 XEN xen_rb_gv_set(const char *name, XEN new_val); 639 XEN xen_rb_intern(const char *name); 640 XEN xen_rb_make_keyword(const char *name); 641 void xen_rb_define(const char *name, XEN value); 642 XEN xen_rb_cdr(XEN val); 643 XEN xen_rb_cons(XEN arg1, XEN arg2); 644 XEN xen_rb_cons2(XEN arg1, XEN arg2, XEN arg3); 645 char *xen_scheme_constant_to_ruby(const char *name); 646 char *xen_scheme_procedure_to_ruby(const char *name); 647 char *xen_scheme_global_variable_to_ruby(const char *name); 648 bool xen_rb_defined_p(const char *name); 649 XEN xen_rb_define_class(const char *name); 650 int xen_rb_list_length(XEN obj); 651 XEN xen_rb_list_ref(XEN obj, int index); 652 XEN xen_rb_list_set(XEN obj, int index, XEN value); 653 void xen_rb_raise(XEN type, XEN info); 654 XEN xen_rb_obj_as_string(XEN obj); 655 XEN xen_rb_eval_string_with_error(const char *str); 656 void xen_rb_load_file_with_error(const char *file); 657 XEN xen_rb_ary_new_with_initial_element(long num, XEN element); 658 XEN xen_rb_apply(XEN func, XEN args); 659 XEN xen_rb_funcall_0(XEN func); 660 int xen_rb_required_args(XEN val); 661 XEN xen_rb_copy_list(XEN val); 662 XEN xen_rb_str_new2(char *arg); 663 void xen_add_help(char *name, const char *help); 664 char *xen_help(char *name); 665 /* class Hook */ 666 bool xen_rb_hook_p(XEN hook); 667 bool xen_rb_hook_empty_p(XEN hook); 668 XEN xen_rb_hook_c_new(char *name, int arity, char *help); 669 XEN xen_rb_hook_reset_hook(XEN hook); 670 XEN xen_rb_hook_to_a(XEN hook); 671 void Init_Hook(void); 672 XEN xen_rb_create_hook(char *name, int arity, char *help); 673 XEN xen_rb_create_simple_hook(int arity); 674 XEN xen_rb_add_hook(XEN hook, VALUE (*func)(ANYARGS), const char *name, const char *doc); 675 typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data); 676 677 XEN rb_properties(void); 678 XEN rb_property(XEN obj, XEN prop); 679 XEN rb_set_property(XEN obj, XEN prop, XEN val); 680 XEN rb_documentation(XEN name); 681 XEN rb_set_documentation(XEN name, XEN help); 682 bool xen_rb_arity_ok(int rargs, int args); 683 void xen_rb_repl_set_prompt(const char *prompt); 684 XEN xen_rb_add_to_load_path(char *path); 685 XEN xen_set_assoc(XEN key, XEN val, XEN alist); 686 XEN xen_assoc(XEN key, XEN alist); 687 688 #ifdef __cplusplus 689 } 690 #endif 691 692 #endif 693 /* end HAVE_RUBY */ 694 695 696 697 /* ------------------------------ FORTH ------------------------------ */ 698 699 #if HAVE_FORTH 700 701 #include <fth.h> 702 703 #if USE_SND 704 # undef gettext_noop 705 # undef _ 706 # undef N_ 707 #endif 708 709 #define XEN_OK true 710 711 #define XEN FTH 712 #define XEN_FILE_EXTENSION FTH_FILE_EXTENSION 713 #define XEN_COMMENT_STRING "\\" 714 #define XEN_LANGUAGE_NAME "Forth" 715 716 #define XEN_FALSE FTH_FALSE 717 #define XEN_TRUE FTH_TRUE 718 #define XEN_EMPTY_LIST FTH_NIL 719 #define XEN_UNDEFINED FTH_UNDEF 720 #define XEN_DOCUMENTATION_SYMBOL FTH_DOCUMENTATION_SYMBOL 721 722 #define XEN_DEFINED_P(name) fth_defined_p((char *)name) 723 #define XEN_PROVIDE(feature) fth_add_feature(feature) 724 725 /* === Boolean, Bound, Equal === */ 726 #define XEN_BOOLEAN_P(Arg) FTH_BOOLEAN_P(Arg) 727 #define XEN_TRUE_P(a) FTH_TRUE_P(a) 728 #define XEN_FALSE_P(a) FTH_FALSE_P(a) 729 #define C_TO_XEN_BOOLEAN(a) BOOL_TO_FTH(a) 730 #define XEN_TO_C_BOOLEAN(a) FTH_TO_BOOL(a) 731 732 #define XEN_BOUND_P(Arg) FTH_BOUND_P(Arg) 733 #define XEN_EQ_P(a, b) ((a) == (b)) 734 735 /* === Number === */ 736 #define XEN_ZERO FTH_ZERO 737 #define XEN_NUMBER_P(Arg) FTH_NUMBER_P(Arg) 738 #define XEN_WRAPPED_C_POINTER_P(Arg) FTH_EXACT_P(Arg) 739 740 #define XEN_INTEGER_P(Arg) FTH_INTEGER_P(Arg) 741 #define C_TO_XEN_INT(a) fth_make_int(a) 742 #define XEN_TO_C_INT(a) fth_int_ref(a) 743 744 #define XEN_ULONG_P(Arg) FTH_UNSIGNED_P(Arg) 745 #define C_TO_XEN_ULONG(a) fth_make_unsigned((unsigned long)(a)) 746 #define XEN_TO_C_ULONG(a) fth_unsigned_ref(a) 747 748 #define XEN_ULONG_LONG_P(Arg) XEN_ULONG_P(Arg) 749 #define XEN_TO_C_ULONG_LONG(Arg) fth_ulong_long_ref(Arg) 750 #define C_TO_XEN_ULONG_LONG(Arg) fth_make_ulong_long((unsigned long long)Arg) 751 752 #define C_TO_XEN_LONG_LONG(a) fth_make_long_long(a) 753 #define XEN_TO_C_LONG_LONG(a) fth_long_long_ref(a) 754 755 #define XEN_DOUBLE_P(Arg) FTH_FLOAT_P(Arg) 756 #define C_TO_XEN_DOUBLE(a) fth_make_float(a) 757 #define XEN_TO_C_DOUBLE(a) fth_float_ref(a) 758 759 #if HAVE_COMPLEX_NUMBERS 760 # define XEN_COMPLEX_P(Arg) FTH_NUMBER_P(Arg) 761 # define C_TO_XEN_COMPLEX(a) fth_make_complex(a) 762 # define XEN_TO_C_COMPLEX(a) fth_complex_ref(a) 763 # define XEN_HAVE_COMPLEX_NUMBERS 1 764 #else 765 # define XEN_COMPLEX_P(Arg) false 766 # define C_TO_XEN_COMPLEX(a) XEN_ZERO 767 # define XEN_TO_C_COMPLEX(a) 0.0 768 #endif 769 770 #if HAVE_MAKE_RATIO 771 # define XEN_HAVE_RATIOS true 772 # define XEN_RATIO_P(Arg) FTH_RATIO_P(Arg) 773 # define XEN_MAKE_RATIO(Num, Den) fth_make_ratio(Num, Den) 774 # define XEN_NUMERATOR(Arg) XEN_TO_C_LONG_LONG(fth_numerator(Arg)) 775 # define XEN_DENOMINATOR(Arg) XEN_TO_C_LONG_LONG(fth_denominator(Arg)) 776 # define XEN_RATIONALIZE(Arg1, Arg2) fth_rationalize(Arg1, Arg2) 777 #endif 778 779 /* === String, Symbol, Keyword, Eval === */ 780 #define XEN_CHAR_P(Arg) FTH_CHAR_P(Arg) 781 #define C_TO_XEN_CHAR(Arg) CHAR_TO_FTH(Arg) 782 #define XEN_TO_C_CHAR(Arg) FTH_TO_CHAR(Arg) 783 784 #define XEN_STRING_P(Arg) FTH_STRING_P(Arg) 785 #define C_TO_XEN_STRING(str) fth_make_string(str) 786 #define C_TO_XEN_STRINGN(str, len) fth_make_string_len(str, len) 787 #define XEN_TO_C_STRING(Str) fth_string_ref(Str) 788 789 #if HAVE_FTH_PORT_PUTS 790 /* port = XEN_FALSE means default output handler (snd-print). */ 791 #define XEN_PUTS(Str, Port) fth_port_puts(Port, Str) 792 #define XEN_DISPLAY(Val, Port) fth_port_display(Port, Val) 793 #define XEN_FLUSH_PORT(Port) fth_port_flush(Port) 794 #define XEN_CLOSE_PORT(Port) fth_port_close(Port) 795 #define XEN_PORT_TO_STRING(Port) fth_port_to_string(Port) 796 #endif 797 798 #define XEN_TO_STRING(Obj) fth_object_to_string(Obj) 799 800 #define XEN_SYMBOL_P(Arg) FTH_SYMBOL_P(Arg) 801 #define C_STRING_TO_XEN_SYMBOL(a) fth_symbol(a) 802 #define XEN_SYMBOL_TO_C_STRING(Sym) fth_symbol_ref(Sym) 803 804 #define XEN_KEYWORD_P(Obj) FTH_KEYWORD_P(Obj) 805 #define XEN_MAKE_KEYWORD(arg) fth_keyword(arg) 806 #define XEN_KEYWORD_EQ_P(K1, K2) XEN_EQ_P(K1, K2) 807 808 #define XEN_EVAL_C_STRING(arg) fth_eval(arg) 809 #define XEN_LOAD_FILE(a) fth_load_file(a) 810 #define XEN_LOAD_PATH XEN_NAME_AS_C_STRING_TO_VALUE("*load-path*") 811 #define XEN_ADD_TO_LOAD_PATH(Path) fth_add_load_path(Path) 812 813 /* === Vector (Array) === */ 814 #define XEN_MAKE_VECTOR(Num, Fill) fth_make_array_with_init(Num, Fill) 815 #define XEN_VECTOR_P(Arg) FTH_ARRAY_P(Arg) 816 #define XEN_VECTOR_LENGTH(Arg) ((int)fth_array_length(Arg)) 817 #define XEN_VECTOR_TO_LIST(Vect) fth_array_to_list(Vect) 818 #define XEN_VECTOR_REF(Vect, Num) fth_array_ref(Vect, Num) 819 #define XEN_VECTOR_SET(Vect, Num, Val) fth_array_set(Vect, Num, Val) 820 #define XEN_VECTOR_COPY(Vect) fth_array_copy(Vect) 821 822 /* === List === */ 823 #define XEN_NULL_P(a) FTH_NIL_P(a) 824 #define XEN_LIST_P(Arg) FTH_LIST_P(Arg) 825 #define XEN_CONS_P(Arg) FTH_CONS_P(Arg) 826 #define XEN_PAIR_P(Arg) FTH_PAIR_P(Arg) 827 #define XEN_CONS(Arg1, Arg2) fth_cons(Arg1, Arg2) 828 #define XEN_CONS_2(Arg1, Arg2, Arg3) fth_cons_2(Arg1, Arg2, Arg3) 829 #define XEN_LIST_REF(Lst, Num) fth_list_ref(Lst, Num) 830 #define XEN_LIST_SET(Lst, Num, Val) fth_list_set(Lst, Num, Val) 831 #define XEN_LIST_REVERSE(Lst) fth_list_reverse(Lst) 832 #define XEN_LIST_P_WITH_LENGTH(Arg, Len) ((Len = XEN_LIST_LENGTH(Arg)) >= 0) 833 #define XEN_LIST_LENGTH(Arg) ((int)fth_list_length(Arg)) 834 #define XEN_LIST_1(a) FTH_LIST_1(a) 835 #define XEN_LIST_2(a, b) FTH_LIST_2(a, b) 836 #define XEN_LIST_3(a, b, c) FTH_LIST_3(a, b, c) 837 #define XEN_LIST_4(a, b, c, d) FTH_LIST_4(a, b, c, d) 838 #define XEN_LIST_5(a, b, c, d, e) FTH_LIST_5(a, b, c, d, e) 839 #define XEN_LIST_6(a, b, c, d, e, f) FTH_LIST_6(a, b, c, d, e, f) 840 #define XEN_LIST_7(a, b, c, d, e, f, g) FTH_LIST_7(a, b, c, d, e, f, g) 841 #define XEN_LIST_8(a, b, c, d, e, f, g, h) FTH_LIST_8(a, b, c, d, e, f, g, h) 842 #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) 843 #define XEN_CAR(a) fth_car(a) 844 #define XEN_CADR(a) FTH_CADR(a) 845 #define XEN_CADDR(a) FTH_CADDR(a) 846 #define XEN_CADDDR(a) FTH_CADDDR(a) 847 #define XEN_CDR(a) fth_cdr(a) 848 #define XEN_CDDR(a) FTH_CDDR(a) 849 #define XEN_CDDDR(a) FTH_CDDDR(a) 850 #define XEN_COPY_ARG(Lst) fth_list_copy(Lst) 851 #define XEN_APPEND(a, b) fth_list_append(XEN_LIST_2(a, b)) 852 #define XEN_ASSOC_REF(Item, Lst) fth_list_assoc_ref(Lst, Item) 853 #define XEN_ASSOC_SET(Sym, Val, Lst) fth_list_assoc_set(Lst, Sym, Val) 854 #define XEN_ASSOC(Item, Lst) fth_list_assoc_ref(Lst, Item) /* perhaps fth_list_assoc? */ 855 #define XEN_MEMBER(Item, Lst) fth_list_member_p(Lst, Item) 856 857 /* === Hook, Procedure === */ 858 #define XEN_HOOK_P(Arg) FTH_HOOK_P(Arg) 859 #define XEN_HOOKED(a) (!fth_hook_empty_p(a)) 860 #define XEN_DEFINE_HOOK(name, descr, arity, help) fth_make_hook(name, arity, help) 861 #define XEN_DEFINE_SIMPLE_HOOK(descr, arity) fth_make_simple_hook(arity) 862 #define XEN_CLEAR_HOOK(Arg) fth_hook_clear(Arg) 863 #define XEN_HOOK_PROCEDURES(Obj) fth_hook_procedure_list(Obj) 864 #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)) 865 866 #define XEN_PROCEDURE_P(Arg) FTH_PROC_P(Arg) 867 #define XEN_PROCEDURE_NAME(Func) C_TO_XEN_STRING(fth_proc_name(Func)) 868 #define XEN_PROCEDURE_HELP(Name) fth_documentation_ref(Name) 869 #define XEN_ARITY(Func) INT_TO_FIX(XEN_REQUIRED_ARGS(Func)) 870 #define XEN_REQUIRED_ARGS(Func) fth_proc_arity(Func) 871 #define XEN_REQUIRED_ARGS_OK(Func, args) (XEN_REQUIRED_ARGS(Func) == (args)) 872 873 #define XEN_CALL_0(Func, Caller) fth_proc_call(Func, Caller, 0) 874 #define XEN_CALL_1(Func, Arg1, Caller) fth_proc_call(Func, Caller, 1, Arg1) 875 #define XEN_CALL_2(Func, Arg1, Arg2, Caller) fth_proc_call(Func, Caller, 2, Arg1, Arg2) 876 #define XEN_CALL_3(Func, Arg1, Arg2, Arg3, Caller) fth_proc_call(Func, Caller, 3, Arg1, Arg2, Arg3) 877 #define XEN_CALL_4(Func, Arg1, Arg2, Arg3, Arg4, Caller) \ 878 fth_proc_call(Func, Caller, 4, Arg1, Arg2, Arg3, Arg4) 879 #define XEN_CALL_5(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Caller) \ 880 fth_proc_call(Func, Caller, 5, Arg1, Arg2, Arg3, Arg4, Arg5) 881 #define XEN_CALL_6(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Caller) \ 882 fth_proc_call(Func, Caller, 6, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6) 883 #define XEN_APPLY(Func, Args, Caller) fth_proc_apply(Func, Args, Caller) 884 #define XEN_CALL_0_NO_CATCH(Func) XEN_CALL_0(Func, NULL) 885 #define XEN_CALL_1_NO_CATCH(Func, Arg1) XEN_CALL_1(Func, Arg1, NULL) 886 #define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) XEN_CALL_2(Func, Arg1, Arg2, NULL) 887 #define XEN_CALL_3_NO_CATCH(Func, Arg1, Arg2, Arg3) XEN_CALL_3(Func, Arg1, Arg2, Arg3, NULL) 888 #define XEN_APPLY_NO_CATCH(Func, Args) XEN_APPLY(Func, Args, NULL) 889 890 /* === Define === */ 891 #define XEN_DEFINE(name, Value) fth_define(name, Value) 892 #define XEN_DEFINE_CONSTANT(name, Value, help) fth_define_constant(name, Value, help) 893 #define XEN_DEFINE_VARIABLE(name, Var, Value) (Var = fth_define_variable(name, Value, NULL)) 894 #define XEN_VARIABLE_SET(name, Value) fth_variable_set((char *)(name), Value) 895 #define XEN_VARIABLE_REF(name) fth_variable_ref((char *)(name)) 896 #define XEN_NAME_AS_C_STRING_TO_VARIABLE(name) fth_word_ref((char *)(name)) 897 #define XEN_NAME_AS_C_STRING_TO_VALUE(name) XEN_VARIABLE_REF(name) 898 899 #ifdef __cplusplus 900 # define XEN_PROCEDURE_CAST (XEN (*)()) 901 #else 902 # define XEN_PROCEDURE_CAST 903 #endif 904 905 #define XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) \ 906 fth_define_procedure(Name, XEN_PROCEDURE_CAST Func, ReqArg, OptArg, RstArg, Doc) 907 908 #define XEN_DEFINE_PROCEDURE_WITH_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \ 909 do { \ 910 XEN_DEFINE_PROCEDURE(Get_Name, XEN_PROCEDURE_CAST Get_Func, Get_Req, Get_Opt, 0, Get_Help); \ 911 XEN_DEFINE_PROCEDURE(Set_Name, XEN_PROCEDURE_CAST Set_Func, Set_Req, Set_Opt, 0, Get_Help); \ 912 } while (0) 913 914 #define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) 915 916 /* === Object === */ 917 #define XEN_OBJECT_TYPE FTH 918 #define XEN_MARK_OBJECT_TYPE void 919 920 #define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, Mark, Free) return(fth_make_instance(Tag, Val)) 921 #define XEN_MAKE_OBJECT(Tag, Val, Mark, Free) fth_make_instance(Tag, Val) 922 923 #define XEN_OBJECT_TYPE_P(Obj, Tag) fth_object_is_instance_of(Obj, Tag) 924 #define XEN_OBJECT_REF(Obj) fth_instance_ref_gen(Obj) 925 #define XEN_MAKE_OBJECT_TYPE(Typ, Siz) fth_make_object_type(Typ) 926 #define XEN_OBJECT_HELP(Name) fth_documentation_ref(Name) 927 928 #define XEN_PROTECT_FROM_GC(Obj) fth_gc_protect(Obj) 929 #define XEN_UNPROTECT_FROM_GC(Obj) fth_gc_unprotect(Obj) 930 931 #define XEN_MAKE_OBJECT_PRINT_PROCEDURE(Type, Wrapped_Print, Original_Print) \ 932 static XEN Wrapped_Print(XEN obj) \ 933 { \ 934 char * str = Original_Print((Type *)XEN_OBJECT_REF(obj)); \ 935 XEN val = C_TO_XEN_STRING(str); \ 936 free(str); \ 937 return val; \ 938 } 939 940 #define XEN_MAKE_OBJECT_FREE_PROCEDURE(Type, Wrapped_Free, Original_Free) \ 941 static void Wrapped_Free(XEN obj) \ 942 { \ 943 Original_Free((Type *)XEN_OBJECT_REF(obj)); \ 944 } 945 946 /* === Error === */ 947 #define XEN_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) \ 948 FTH_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) 949 #define XEN_ERROR_TYPE(Typ) fth_exception(Typ) 950 951 #define XEN_ERROR(Type, Info) fth_throw_list(Type, Info) 952 #define XEN_THROW(Type, Info) XEN_ERROR(Type, Info) 953 954 #define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) \ 955 FTH_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) 956 #define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) \ 957 FTH_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) 958 959 typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data); 960 961 #define XEN_NARGIFY_0(OutName, InName) static XEN (*OutName)(void) = InName; 962 #define XEN_NARGIFY_1(OutName, InName) static XEN (*OutName)(XEN a1) = InName; 963 #define XEN_NARGIFY_2(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2) = InName; 964 #define XEN_NARGIFY_3(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3) = InName; 965 #define XEN_NARGIFY_4(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4) = InName; 966 #define XEN_NARGIFY_5(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5) = InName; 967 #define XEN_NARGIFY_6(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6) = InName; 968 #define XEN_NARGIFY_7(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7) = InName; 969 #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; 970 #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; 971 #define XEN_ARGIFY_1(OutName, InName) static XEN (*OutName)(XEN a1) = InName; 972 #define XEN_ARGIFY_2(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2) = InName; 973 #define XEN_ARGIFY_3(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3) = InName; 974 #define XEN_ARGIFY_4(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4) = InName; 975 #define XEN_ARGIFY_5(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5) = InName; 976 #define XEN_ARGIFY_6(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6) = InName; 977 #define XEN_ARGIFY_7(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7) = InName; 978 #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; 979 #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; 980 #define XEN_VARGIFY(OutName, InName) static XEN (*OutName)(XEN a1) = InName; 981 982 #endif /* end HAVE_FORTH */ 983 984 985 /* ------------------------------ s7 ------------------------------ */ 986 987 #if HAVE_SCHEME 988 989 #define XEN_OK 1 990 991 #include "s7.h" 992 993 994 #ifdef __cplusplus 995 extern "C" { 996 #endif 997 extern s7_scheme *s7; /* s7 is a pointer to the current scheme */ 998 #ifdef __cplusplus 999 } 1000 #endif 1001 1002 1003 #define XEN s7_pointer 1004 #define XEN_FILE_EXTENSION "scm" 1005 #define XEN_LANGUAGE_NAME "s7" 1006 #define XEN_COMMENT_STRING ";" 1007 1008 extern XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero; 1009 extern size_t xen_s7_number_location, xen_s7_denominator_location; 1010 1011 #define XEN_FALSE xen_false 1012 #define XEN_TRUE xen_true 1013 #define XEN_TRUE_P(Arg) ((Arg) == XEN_TRUE) /* not scheme-wise, but Snd-wise (#t as special arg) */ 1014 #define XEN_FALSE_P(Arg) ((Arg) == XEN_FALSE) 1015 #define XEN_BOOLEAN_P(Arg) s7_is_boolean(Arg) 1016 #define C_TO_XEN_BOOLEAN(Arg) ((Arg) ? XEN_TRUE : XEN_FALSE) 1017 #define XEN_TO_C_BOOLEAN(Arg) ((XEN_TRUE_P(Arg)) ? true : false) 1018 1019 #define XEN_NULL_P(Arg) ((Arg) == xen_nil) 1020 #define XEN_BOUND_P(Arg) ((Arg) != xen_undefined) 1021 #define XEN_EMPTY_LIST xen_nil 1022 #define XEN_UNDEFINED xen_undefined 1023 #define XEN_EQ_P(Arg1, Arg2) ((Arg1) == (Arg2)) 1024 1025 #define XEN_CONS_P(Arg) s7_cons_p(Arg) 1026 #define XEN_CONS(Arg1, Arg2) s7_cons(s7, Arg1, Arg2) 1027 #define XEN_CONS_2(Arg1, Arg2, Arg3) s7_cons(s7, Arg1, s7_cons(s7, Arg2, Arg3)) 1028 #define XEN_PAIR_P(Arg) s7_is_pair(Arg) 1029 #define XEN_CAR(Arg) s7_car(Arg) 1030 #define XEN_CDR(Arg) s7_cdr(Arg) 1031 #define XEN_CADR(Arg) s7_cadr(Arg) 1032 #define XEN_CADDR(Arg) s7_caddr(Arg) 1033 #define XEN_CADDDR(Arg) s7_cadddr(Arg) 1034 #define XEN_CDDR(Arg) s7_cddr(Arg) 1035 #define XEN_CDDDR(Arg) s7_cdddr(Arg) 1036 #define XEN_LIST_P(Arg) s7_is_list(s7, Arg) /* not pair? because we want '() to return #t here */ 1037 #define XEN_LIST_LENGTH(Arg) s7_list_length(s7, Arg) 1038 #define XEN_LIST_P_WITH_LENGTH(Arg, Len) ((s7_is_list(s7, Arg)) && ((Len = XEN_LIST_LENGTH(Arg)) >= 0)) 1039 #define XEN_LIST_1(a) s7_list(s7, 1, a) 1040 #define XEN_LIST_2(a, b) s7_list(s7, 2, a, b) 1041 #define XEN_LIST_3(a, b, c) s7_list(s7, 3, a, b, c) 1042 #define XEN_LIST_4(a, b, c, d) s7_list(s7, 4, a, b, c, d) 1043 #define XEN_LIST_5(a, b, c, d, e) s7_list(s7, 5, a, b, c, d, e) 1044 #define XEN_LIST_6(a, b, c, d, e, f) s7_list(s7, 6, a, b, c, d, e, f) 1045 #define XEN_LIST_7(a, b, c, d, e, f, g) s7_list(s7, 7, a, b, c, d, e, f, g) 1046 #define XEN_LIST_8(a, b, c, d, e, f, g, h) s7_list(s7, 8, a, b, c, d, e, f, g, h) 1047 #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) 1048 #define XEN_LIST_REF(Lst, Num) s7_list_ref(s7, Lst, Num) 1049 #define XEN_LIST_SET(Lst, Num, Val) s7_list_set(s7, Lst, Num, Val) 1050 #define XEN_LIST_REVERSE(Lst) s7_reverse(s7, Lst) 1051 #define XEN_COPY_ARG(Lst) Lst 1052 #define XEN_APPEND(Arg1, Arg2) s7_append(s7, Arg1, Arg2) 1053 #define XEN_ASSOC_REF(Sym, Lst) xen_assoc(s7, Sym, Lst) 1054 #define XEN_ASSOC_SET(Sym, Val, Lst) xen_set_assoc(s7, Sym, Val, Lst) 1055 #define XEN_ASSOC(Sym, Lst) s7_assoc(s7, Sym, Lst) 1056 #define XEN_MEMBER(Sym, Lst) s7_member(s7, Sym, Lst) 1057 1058 #define XEN_STRING_P(Arg) s7_is_string(Arg) 1059 #define XEN_NAME_AS_C_STRING_TO_VALUE(Arg) s7_name_to_value(s7, Arg) 1060 #define XEN_TO_C_STRING(Str) s7_string(Str) 1061 #define C_TO_XEN_STRING(Str) s7_make_string(s7, Str) 1062 #define C_TO_XEN_STRINGN(Str, Len) s7_make_string_with_length(s7, Str, Len) 1063 1064 #define XEN_ZERO xen_zero 1065 #define XEN_INTEGER_P(Arg) s7_is_integer(Arg) 1066 #define C_TO_XEN_INT(Arg) s7_make_integer(s7, Arg) 1067 #define XEN_TO_C_INT(Arg) s7_integer(Arg) 1068 1069 #define XEN_ULONG_P(Arg) s7_is_integer(Arg) 1070 #define XEN_TO_C_ULONG(Arg) (uint64_t)s7_integer(Arg) 1071 #define C_TO_XEN_ULONG(Arg) s7_make_integer(s7, (s7_int)((intptr_t)Arg)) 1072 1073 #define XEN_ULONG_LONG_P(Arg) s7_is_c_pointer(Arg) 1074 #define XEN_TO_C_ULONG_LONG(Arg) (uint64_t)s7_c_pointer(Arg) 1075 #define C_TO_XEN_ULONG_LONG(Arg) s7_make_c_pointer(s7, (void *)Arg) 1076 1077 #define C_TO_XEN_LONG_LONG(Arg) s7_make_integer(s7, Arg) 1078 #define XEN_TO_C_LONG_LONG(Arg) s7_integer(Arg) 1079 1080 #define XEN_NUMBER_P(Arg) s7_is_real(Arg) 1081 #define XEN_WRAPPED_C_POINTER_P(Arg) s7_is_c_pointer(Arg) 1082 1083 #define XEN_DOUBLE_P(Arg) s7_is_real(Arg) 1084 #define XEN_TO_C_DOUBLE(Arg) ((double)s7_number_to_real(s7, Arg)) 1085 #define C_TO_XEN_DOUBLE(Arg) s7_make_real(s7, Arg) 1086 1087 #if HAVE_COMPLEX_NUMBERS 1088 #define XEN_HAVE_COMPLEX_NUMBERS 1 1089 #define XEN_COMPLEX_P(Arg) s7_is_complex(Arg) 1090 #define XEN_TO_C_COMPLEX(a) (s7_real_part(a) + s7_imag_part(a) * _Complex_I) 1091 #define C_TO_XEN_COMPLEX(a) s7_make_complex(s7, creal(a), cimag(a)) 1092 #else 1093 #define XEN_HAVE_COMPLEX_NUMBERS 0 1094 #define XEN_COMPLEX_P(Arg) false 1095 #define XEN_TO_C_COMPLEX(a) 0.0 1096 #define C_TO_XEN_COMPLEX(a) XEN_ZERO 1097 #endif 1098 1099 #define XEN_HAVE_RATIOS 1 1100 #define XEN_NUMERATOR(Arg) s7_numerator(Arg) 1101 #define XEN_DENOMINATOR(Arg) s7_denominator(Arg) 1102 #define XEN_RATIONALIZE(Arg1, Arg2) s7_rationalize(s7, XEN_TO_C_DOUBLE(Arg1), XEN_TO_C_DOUBLE(Arg2)) 1103 #define XEN_RATIO_P(Arg) s7_is_ratio(Arg) 1104 #define XEN_MAKE_RATIO(Num, Den) s7_make_ratio(s7, XEN_TO_C_INT(Num), XEN_TO_C_INT(Den)) 1105 1106 #define XEN_EVAL_C_STRING(Arg) s7_eval_c_string(s7, Arg) 1107 #define XEN_TO_STRING(Obj) s7_object_to_string(s7, Obj, false) 1108 1109 #define XEN_SYMBOL_TO_C_STRING(Arg) s7_symbol_name(Arg) 1110 #define XEN_SYMBOL_P(Arg) s7_is_symbol(Arg) 1111 #define C_STRING_TO_XEN_SYMBOL(Arg) s7_make_symbol(s7, Arg) 1112 #define XEN_DOCUMENTATION_SYMBOL C_STRING_TO_XEN_SYMBOL("documentation") 1113 #define XEN_SET_DOCUMENTATION(Var, Doc) 1114 1115 #define XEN_VECTOR_P(Arg) s7_is_vector(Arg) 1116 #define XEN_VECTOR_LENGTH(Arg) s7_vector_length(Arg) 1117 #define XEN_VECTOR_REF(Vect, Num) s7_vector_ref(s7, Vect, Num) 1118 #define XEN_VECTOR_SET(Vect, Num, Val) s7_vector_set(s7, Vect, Num, Val) 1119 #define XEN_MAKE_VECTOR(Num, Fill) s7_make_and_fill_vector(s7, Num, Fill) 1120 #define XEN_VECTOR_TO_LIST(Vect) s7_vector_to_list(s7, Vect) 1121 #define XEN_VECTOR_RANK(Vect) s7_vector_rank(Vect) 1122 #define XEN_VECTOR_COPY(Vect) s7_vector_copy(s7, Vect) 1123 #define XEN_VECTOR_ELEMENTS(Vect) s7_vector_elements(Vect) 1124 1125 #define XEN_CHAR_P(Arg) s7_is_character(Arg) 1126 #define XEN_TO_C_CHAR(Arg) s7_character(Arg) 1127 #define C_TO_XEN_CHAR(Arg) s7_make_character(s7, Arg) 1128 1129 #define XEN_KEYWORD_P(Obj) s7_is_keyword(Obj) 1130 #define XEN_KEYWORD_EQ_P(k1, k2) ((k1) == (k2)) 1131 #define XEN_MAKE_KEYWORD(Arg) s7_make_keyword(s7, Arg) 1132 1133 #define XEN_PROCEDURE_P(Arg) s7_is_procedure(Arg) 1134 1135 #define XEN_LOAD_FILE(File) s7_load(s7, File) 1136 #define XEN_LOAD_PATH s7_load_path(s7) 1137 #define XEN_ADD_TO_LOAD_PATH(Path) s7_add_to_load_path(s7, Path) 1138 1139 #define XEN_ERROR_TYPE(Typ) C_STRING_TO_XEN_SYMBOL(Typ) 1140 #define XEN_ERROR(Type, Info) s7_error(s7, Type, Info) 1141 #define XEN_THROW(Type, Info) s7_error(s7, Type, Info) 1142 1143 #define XEN_PROVIDE(Feature) s7_provide(s7, Feature) 1144 #define XEN_PROTECT_FROM_GC(Arg) s7_gc_protect(s7, Arg) 1145 1146 #define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) s7_wrong_type_arg_error(s7, Caller, ArgN, Arg, Descr) 1147 #define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) s7_out_of_range_error(s7, Caller, ArgN, Arg, Descr) 1148 1149 #define XEN_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) if (!(Assertion)) XEN_WRONG_TYPE_ARG_ERROR(Caller, Position, Arg, Correct_Type) 1150 1151 #define XEN_NARGIFY_0(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(InName());} 1152 #define XEN_NARGIFY_1(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(InName(XEN_CAR(args)));} 1153 #define XEN_NARGIFY_2(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_2(s7, args, InName));} 1154 #define XEN_NARGIFY_3(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_3(s7, args, InName));} 1155 #define XEN_NARGIFY_4(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_4(s7, args, InName));} 1156 #define XEN_NARGIFY_5(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_5(s7, args, InName));} 1157 #define XEN_NARGIFY_6(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_6(s7, args, InName));} 1158 #define XEN_NARGIFY_7(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_7(s7, args, InName));} 1159 #define XEN_NARGIFY_8(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_8(s7, args, InName));} 1160 #define XEN_NARGIFY_9(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_9(s7, args, InName));} 1161 1162 #define XEN_ARGIFY_1(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_1(s7, args, InName));} 1163 #define XEN_ARGIFY_2(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_2(s7, args, InName));} 1164 #define XEN_ARGIFY_3(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_3(s7, args, InName));} 1165 #define XEN_ARGIFY_4(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_4(s7, args, InName));} 1166 #define XEN_ARGIFY_5(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_5(s7, args, InName));} 1167 #define XEN_ARGIFY_6(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_6(s7, args, InName));} 1168 #define XEN_ARGIFY_7(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_7(s7, args, InName));} 1169 #define XEN_ARGIFY_8(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_8(s7, args, InName));} 1170 #define XEN_ARGIFY_9(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_9(s7, args, InName));} 1171 #define XEN_VARGIFY(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(InName(args));} 1172 1173 1174 #define XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) s7_define_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc) 1175 #define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) s7_define_safe_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc) 1176 #define XEN_DEFINE_PROCEDURE_STAR(Name, Func, Args, Doc) s7_define_function_star(s7, Name, Func, Args, Doc) 1177 1178 #define XEN_DEFINE_PROCEDURE_WITH_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \ 1179 s7_dilambda(s7, Get_Name, Get_Func, Get_Req, Get_Opt, Set_Func, Set_Req, Set_Opt, Get_Help) 1180 1181 #define XEN_ARITY(Func) s7_arity(s7, Func) 1182 #define XEN_REQUIRED_ARGS(Func) XEN_TO_C_INT(XEN_CAR(XEN_ARITY(Func))) 1183 #define XEN_REQUIRED_ARGS_OK(Func, Args) s7_is_aritable(s7, Func, Args) /* (XEN_REQUIRED_ARGS(Func) == Args) */ 1184 1185 #define XEN_CALL_0(Func, Caller) s7_call_with_location(s7, Func, XEN_EMPTY_LIST, Caller, __FILE__, __LINE__) /* these need a catch */ 1186 #define XEN_CALL_1(Func, Arg1, Caller) s7_call_with_location(s7, Func, XEN_LIST_1(Arg1), Caller, __FILE__, __LINE__) 1187 #define XEN_CALL_2(Func, Arg1, Arg2, Caller) s7_call_with_location(s7, Func, XEN_LIST_2(Arg1, Arg2), Caller, __FILE__, __LINE__) 1188 #define XEN_CALL_3(Func, Arg1, Arg2, Arg3, Caller) s7_call_with_location(s7, Func, XEN_LIST_3(Arg1, Arg2, Arg3), Caller, __FILE__, __LINE__) 1189 #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__) 1190 #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__) 1191 #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__) 1192 #define XEN_APPLY(Func, Args, Caller) s7_call_with_location(s7, Func, Args, Caller, __FILE__, __LINE__) 1193 1194 #define XEN_CALL_0_NO_CATCH(Func) s7_call_with_location(s7, Func, XEN_EMPTY_LIST, __func__, __FILE__, __LINE__) 1195 #define XEN_CALL_1_NO_CATCH(Func, Arg1) s7_call_with_location(s7, Func, XEN_LIST_1(Arg1), __func__, __FILE__, __LINE__) 1196 #define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) s7_call_with_location(s7, Func, XEN_LIST_2(Arg1, Arg2), __func__, __FILE__, __LINE__) 1197 #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__) 1198 #define XEN_APPLY_NO_CATCH(Func, Args) s7_call_with_location(s7, Func, Args, __func__, __FILE__, __LINE__) 1199 typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data); 1200 1201 #define XEN_DEFINE_CONSTANT(Name, Value, Help) s7_define_constant_with_documentation(s7, Name, s7_make_integer(s7, Value), Help) 1202 #define XEN_DEFINE(Name, Value) s7_define_variable(s7, Name, Value) 1203 #define XEN_DEFINED_P(Name) s7_is_defined(s7, Name) 1204 1205 #define XEN_DEFINE_VARIABLE(Name, Var, Value) Var = s7_define_variable(s7, Name, Value) 1206 #define XEN_VARIABLE_SET(Var, Val) s7_symbol_set_value(s7, Var, Val) 1207 #define XEN_VARIABLE_REF(Var) s7_symbol_value(s7, Var) 1208 #define XEN_NAME_AS_C_STRING_TO_VARIABLE(a) s7_make_symbol(s7, a) 1209 1210 #define XEN_MARK_OBJECT_TYPE void 1211 #define XEN_MAKE_OBJECT_TYPE(Name, Size) s7_make_c_type(s7, Name) 1212 1213 #define XEN_MAKE_OBJECT_FREE_PROCEDURE(Type, Wrapped_Free, Original_Free) static void Wrapped_Free(void *obj) {Original_Free((Type *)obj);} 1214 #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));} 1215 #define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, ig1, ig2) return(s7_make_c_object(s7, Tag, Val)) 1216 #define XEN_MAKE_OBJECT(Tag, Val, ig1, ig2) s7_make_c_object(s7, Tag, Val) 1217 #define XEN_OBJECT_REF(Arg) s7_c_object_value(Arg) 1218 #define XEN_OBJECT_TYPE s7_int /* tag type */ 1219 #define XEN_OBJECT_TYPE_P(Obj, Tag) (s7_c_object_type(Obj) == Tag) 1220 1221 #define XEN_HOOK_P(Arg) ((Arg) != XEN_FALSE) 1222 #define XEN_DEFINE_HOOK(Name, Descr, Arity, Help) s7_define_constant_with_documentation(s7, Name, s7_eval_c_string(s7, Descr), Help) 1223 /* "simple hooks are for channel-local hooks (unnamed, accessed through the channel) */ 1224 #define XEN_DEFINE_SIMPLE_HOOK(Descr, Arity) s7_eval_c_string(s7, Descr) 1225 #define XEN_HOOKED(Hook) s7_is_pair(s7_hook_functions(s7, Hook)) 1226 #define XEN_CLEAR_HOOK(Hook) s7_hook_set_functions(s7, Hook, s7_nil(s7)) 1227 #define XEN_HOOK_PROCEDURES(Hook) s7_hook_functions(s7, Hook) 1228 #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))) 1229 1230 #ifdef __cplusplus 1231 extern "C" { 1232 #endif 1233 1234 s7_scheme *s7_xen_initialize(s7_scheme *sc); 1235 void xen_s7_set_repl_prompt(const char *new_prompt); 1236 XEN xen_set_assoc(s7_scheme *sc, s7_pointer key, s7_pointer val, s7_pointer alist); 1237 XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist); 1238 1239 #ifdef __cplusplus 1240 } 1241 #endif 1242 1243 #endif 1244 /* end s7 */ 1245 1246 1247 1248 1249 1250 /* ------------------------------ NO EXTENSION LANGUAGE ------------------------------ */ 1251 1252 #ifndef XEN_OK 1253 1254 #define XEN int 1255 #define XEN_FILE_EXTENSION "txt" 1256 #define XEN_LANGUAGE_NAME "What Language?" 1257 #define XEN_COMMENT_STRING ";" 1258 #define XEN_FALSE 0 1259 #define XEN_TRUE 1 1260 #define XEN_TRUE_P(a) ((a) == XEN_TRUE) 1261 #define XEN_FALSE_P(a) ((a) == XEN_FALSE) 1262 #define XEN_BOOLEAN_P(Arg) 0 1263 #define C_TO_XEN_BOOLEAN(a) 0 1264 #define XEN_TO_C_BOOLEAN(a) 0 1265 #define XEN_NULL_P(a) ((a) == XEN_EMPTY_LIST) 1266 #define XEN_BOUND_P(Arg) 0 1267 #define XEN_EMPTY_LIST 0 1268 #define XEN_UNDEFINED 0 1269 #define XEN_EQ_P(a, b) 0 1270 #define XEN_CONS_P(Arg) 0 1271 #define XEN_CONS(Arg1, Arg2) 0 1272 #define XEN_CONS_2(Arg1, Arg2, Arg3) 0 1273 #define XEN_PAIR_P(Arg) 0 1274 #define XEN_CAR(a) 0 1275 #define XEN_CADR(a) 0 1276 #define XEN_CADDR(a) 0 1277 #define XEN_CADDDR(a) 0 1278 #define XEN_CDR(a) 0 1279 #define XEN_CDDR(a) 0 1280 #define XEN_CDDDR(a) 0 1281 #define XEN_LIST_P(Arg) 0 1282 #define XEN_LIST_P_WITH_LENGTH(Arg, Len) 0 1283 #define XEN_LIST_LENGTH(Arg) 0 1284 #define XEN_LIST_1(a) 0 1285 #define XEN_LIST_2(a, b) 0 1286 #define XEN_LIST_3(a, b, c) 0 1287 #define XEN_LIST_4(a, b, c, d) 0 1288 #define XEN_LIST_5(a, b, c, d, e) 0 1289 #define XEN_LIST_6(a, b, c, d, e, f) 0 1290 #define XEN_LIST_7(a, b, c, d, e, f, g) 0 1291 #define XEN_LIST_8(a, b, c, d, e, f, g, h) 0 1292 #define XEN_LIST_9(a, b, c, d, e, f, g, h, i) 0 1293 #define XEN_LIST_REF(Lst, Num) 0 1294 #define XEN_LIST_SET(Lst, Num, Val) 1295 #define XEN_LIST_REVERSE(Lst) 0 1296 #define XEN_COPY_ARG(Lst) Lst 1297 #define XEN_APPEND(X, Y) 0 1298 #define XEN_STRING_P(Arg) 0 1299 #define XEN_NAME_AS_C_STRING_TO_VALUE(a) 0 1300 #define XEN_TO_C_STRING(STR) "(not a string)" 1301 #define C_TO_XEN_STRING(a) 0 1302 #define C_TO_XEN_STRINGN(Str, Len) 0 1303 #define C_STRING_TO_XEN_SYMBOL(a) 0 1304 #define XEN_ZERO 0 1305 #define XEN_NUMBER_P(Arg) 0 1306 #define XEN_DOUBLE_P(Arg) 0 1307 #define XEN_TO_C_DOUBLE(a) 0.0 1308 #define C_TO_XEN_DOUBLE(a) 0 1309 #define XEN_INTEGER_P(Arg) 0 1310 #define C_TO_XEN_INT(a) a 1311 #define XEN_TO_C_INT(a) 0 1312 #define XEN_COMPLEX_P(Arg) 0 1313 #define XEN_TO_C_COMPLEX(a) 0.0 1314 #define C_TO_XEN_COMPLEX(a) a 1315 #define XEN_ULONG_P(Arg) 0 1316 #define XEN_TO_C_ULONG(a) 0 1317 #define C_TO_XEN_ULONG(a) 0 1318 #define C_TO_XEN_LONG_LONG(a) a 1319 #define XEN_TO_C_LONG_LONG(a) a 1320 #define XEN_ULONG_LONG_P(Arg) 0 1321 #define XEN_TO_C_ULONG_LONG(Arg) 0 1322 #define C_TO_XEN_ULONG_LONG(Arg) 0 1323 #define XEN_WRAPPED_C_POINTER_P(Arg) 0 1324 #define XEN_EVAL_C_STRING(Arg) 0 1325 #define XEN_SYMBOL_TO_C_STRING(a) "(not a symbol)" 1326 #define XEN_TO_STRING(Obj) "(unknown)" 1327 #define XEN_PROCEDURE_P(Arg) 0 1328 1329 #define XEN_ARGIFY_1(OutName, InName) static int OutName(void) {return(-1);} 1330 #define XEN_ARGIFY_2(OutName, InName) static int OutName(void) {return(-2);} 1331 #define XEN_ARGIFY_3(OutName, InName) static int OutName(void) {return(-3);} 1332 #define XEN_ARGIFY_4(OutName, InName) static int OutName(void) {return(-4);} 1333 #define XEN_ARGIFY_5(OutName, InName) static int OutName(void) {return(-5);} 1334 #define XEN_ARGIFY_6(OutName, InName) static int OutName(void) {return(-6);} 1335 #define XEN_ARGIFY_7(OutName, InName) static int OutName(void) {return(-7);} 1336 #define XEN_ARGIFY_8(OutName, InName) static int OutName(void) {return(-8);} 1337 #define XEN_ARGIFY_9(OutName, InName) static int OutName(void) {return(-9);} 1338 1339 #define XEN_NARGIFY_0(OutName, InName) static int OutName(void) {return(0);} 1340 #define XEN_NARGIFY_1(OutName, InName) static int OutName(void) {return(1);} 1341 #define XEN_NARGIFY_2(OutName, InName) static int OutName(void) {return(2);} 1342 #define XEN_NARGIFY_3(OutName, InName) static int OutName(void) {return(3);} 1343 #define XEN_NARGIFY_4(OutName, InName) static int OutName(void) {return(4);} 1344 #define XEN_NARGIFY_5(OutName, InName) static int OutName(void) {return(5);} 1345 #define XEN_NARGIFY_6(OutName, InName) static int OutName(void) {return(6);} 1346 #define XEN_NARGIFY_7(OutName, InName) static int OutName(void) {return(7);} 1347 #define XEN_NARGIFY_8(OutName, InName) static int OutName(void) {return(8);} 1348 #define XEN_NARGIFY_9(OutName, InName) static int OutName(void) {return(9);} 1349 1350 #define XEN_VARGIFY(OutName, InName) static int OutName(void) {return(-100);} 1351 1352 #define XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) \ 1353 xen_no_ext_lang_check_args(Name, Func(), ReqArg, OptArg, RstArg) 1354 1355 #define XEN_DEFINE_PROCEDURE_WITH_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \ 1356 {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);} 1357 1358 #define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) 1359 1360 #define XEN_ARITY(Func) 0 1361 #define XEN_REQUIRED_ARGS(Func) 0 1362 #define XEN_REQUIRED_ARGS_OK(Func, Args) false 1363 #define XEN_CALL_0(Func, Caller) 0 1364 #define XEN_CALL_1(Func, Arg1, Caller) 0 1365 #define XEN_CALL_2(Func, Arg1, Arg2, Caller) 0 1366 #define XEN_CALL_3(Func, Arg1, Arg2, Arg3, Caller) 0 1367 #define XEN_CALL_4(Func, Arg1, Arg2, Arg3, Arg4, Caller) 0 1368 #define XEN_CALL_5(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Caller) 0 1369 #define XEN_CALL_6(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Caller) 0 1370 #define XEN_APPLY(Func, Args, Caller) 0 1371 #define XEN_CALL_0_NO_CATCH(Func) 0 1372 #define XEN_CALL_1_NO_CATCH(Func, Arg1) 0 1373 #define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) 0 1374 #define XEN_CALL_3_NO_CATCH(Func, Arg1, Arg2, Arg3) 0 1375 #define XEN_APPLY_NO_CATCH(Func, Args) 0 1376 #define XEN_DEFINE_CONSTANT(a, b, c) 1377 #define XEN_DEFINE_VARIABLE(a, b, c) 1378 #define XEN_DEFINE(Name, Value) 1379 #define XEN_VARIABLE_SET(a, b) 1380 #define XEN_VARIABLE_REF(a) 0 1381 #define XEN_MARK_OBJECT_TYPE XEN 1382 #define XEN_MAKE_OBJECT_TYPE(Typ, Siz) 0 1383 #define XEN_MAKE_OBJECT_PRINT_PROCEDURE(Type, Wrapped_Print, Original_Print) 1384 #define XEN_MAKE_OBJECT_FREE_PROCEDURE(Type, Wrapped_Free, Original_Free) 1385 #define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, ig1, ig2) return(0) 1386 #define XEN_MAKE_OBJECT(Tag, Val, ig1, ig2) 0 1387 #define XEN_OBJECT_REF(a) 0 1388 #define XEN_OBJECT_TYPE int 1389 #define XEN_OBJECT_TYPE_P(OBJ, TAG) 0 1390 #define XEN_SYMBOL_P(Arg) 0 1391 #define XEN_HOOK_P(Arg) 0 1392 #define XEN_HOOKED(a) 0 1393 #define XEN_DEFINE_HOOK(Name, Descr, Arity, Help) 0 1394 #define XEN_DEFINE_SIMPLE_HOOK(Descr, Arity) 0 1395 #define XEN_CLEAR_HOOK(Arg) 1396 #define XEN_HOOK_PROCEDURES(a) 0 1397 #define XEN_ADD_HOOK(Hook, Func, Name, Doc) 1398 #define XEN_VECTOR_P(Arg) 0 1399 #define XEN_VECTOR_LENGTH(Arg) 0 1400 #define XEN_VECTOR_REF(Vect, Num) 0 1401 #define XEN_VECTOR_SET(a, b, c) 1402 #define XEN_MAKE_VECTOR(Num, Fill) 0 1403 #define XEN_VECTOR_TO_LIST(Vect) 0 1404 #define XEN_ASSOC_REF(Sym, Lst) 0 1405 #define XEN_ASSOC_SET(Sym, Val, Lst) 0 1406 #define XEN_CHAR_P(Arg) 0 1407 #define XEN_TO_C_CHAR(Arg) 0 1408 #define C_TO_XEN_CHAR(Arg) 0 1409 #define XEN_KEYWORD_P(Obj) 0 1410 #define XEN_KEYWORD_EQ_P(k1, k2) 0 1411 #define XEN_MAKE_KEYWORD(Arg) 0 1412 #define XEN_PROVIDE(Feature) 1413 #define XEN_DOCUMENTATION_SYMBOL 0 1414 #define XEN_OBJECT_HELP(Name) 0 1415 #define XEN_PROTECT_FROM_GC(a) 0 1416 #define XEN_LOAD_FILE(a) 0 1417 #define XEN_LOAD_PATH XEN_FALSE 1418 #define XEN_ADD_TO_LOAD_PATH(Path) XEN_FALSE 1419 #define XEN_ERROR_TYPE(Typ) XEN_FALSE 1420 #define XEN_ERROR(Type, Info) fprintf(stderr, "error") 1421 #define XEN_THROW(Type, Info) fprintf(stderr, "error") 1422 #define XEN_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) 1423 #define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) 1424 #define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) 1425 typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data); 1426 #define XEN_UNPROTECT_FROM_GC(Var) 0 1427 1428 #ifdef __cplusplus 1429 extern "C" { 1430 #endif 1431 1432 void xen_no_ext_lang_check_args(const char *name, int args, int req_args, int opt_args, int rst_args); 1433 1434 #ifdef __cplusplus 1435 } 1436 #endif 1437 1438 #endif 1439 /* end NO EXTENSION LANGUAGE */ 1440 1441 1442 1443 #define XEN_NOT_TRUE_P(a) (!(XEN_TRUE_P(a))) 1444 #define XEN_NOT_FALSE_P(a) (!(XEN_FALSE_P(a))) 1445 #define XEN_NOT_NULL_P(a) (!(XEN_NULL_P(a))) 1446 #define XEN_NOT_BOUND_P(Arg) (!(XEN_BOUND_P(Arg))) 1447 1448 #if defined(__GNUC__) && (!(defined(__cplusplus))) 1449 #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_))); }) 1450 #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_))); }) 1451 #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_))); }) 1452 #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_))); }) 1453 #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_))); }) 1454 #define XEN_INTEGER_OR_BOOLEAN_P(Arg) ({ XEN _xen_h_21_ = Arg; ((XEN_BOOLEAN_P(_xen_h_21_)) || (XEN_INTEGER_P(_xen_h_21_))); }) 1455 #else 1456 #define XEN_BOOLEAN_IF_BOUND_P(Arg) ((XEN_BOOLEAN_P(Arg)) || (XEN_NOT_BOUND_P(Arg))) 1457 #define XEN_INTEGER_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_INTEGER_P(Arg))) 1458 #define XEN_NUMBER_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_NUMBER_P(Arg))) 1459 #define XEN_STRING_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_STRING_P(Arg))) 1460 #define XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(Arg) ((XEN_BOOLEAN_P(Arg)) || (XEN_NOT_BOUND_P(Arg)) || (XEN_INTEGER_P(Arg))) 1461 #define XEN_INTEGER_OR_BOOLEAN_P(Arg) ((XEN_BOOLEAN_P(Arg)) || (XEN_INTEGER_P(Arg))) 1462 #endif 1463 1464 #if (!HAVE_FORTH) 1465 #define XEN_LONG_LONG_P(Arg) XEN_INTEGER_P(Arg) 1466 #else 1467 #define XEN_LONG_LONG_P(Arg) FTH_LONG_LONG_P(Arg) 1468 #endif 1469 #define XEN_LONG_LONG_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_LONG_LONG_P(Arg))) 1470 1471 #if (!HAVE_SCHEME) 1472 #define XEN_AS_STRING(form) XEN_TO_C_STRING(XEN_TO_STRING(form)) 1473 #define XEN_VECTOR_RANK(Vect) 1 1474 #else 1475 #define XEN_AS_STRING(form) s7_object_to_c_string(s7, form) 1476 #endif 1477 1478 1479 #define XEN_BAD_ARITY_ERROR(Caller, ArgN, Arg, Descr) \ 1480 XEN_ERROR(XEN_ERROR_TYPE("bad-arity"), \ 1481 XEN_LIST_3(C_TO_XEN_STRING(Caller), \ 1482 C_TO_XEN_STRING(Descr), \ 1483 Arg)) 1484 1485 #ifndef XEN_HAVE_RATIOS 1486 #define XEN_NUMERATOR(Arg) 0 1487 #define XEN_DENOMINATOR(Arg) 1 1488 #define XEN_RATIONALIZE(Arg1, Arg2) 1 1489 #define XEN_RATIO_P(Arg) false 1490 #define XEN_MAKE_RATIO(Num, Den) 1 1491 #endif 1492 #ifndef XEN_DEFINED_P 1493 #define XEN_DEFINED_P(Name) false 1494 #endif 1495 1496 /* (need a way to pass an uninterpreted pointer from C to XEN then back to C) */ 1497 #if HAVE_SCHEME 1498 #define XEN_WRAP_C_POINTER(a) s7_make_c_pointer(s7, (void *)(a)) 1499 #define XEN_UNWRAP_C_POINTER(a) s7_c_pointer(a) 1500 #else 1501 #if (SIZEOF_VOID_P == 4) 1502 #define XEN_WRAP_C_POINTER(a) ((XEN)(C_TO_XEN_ULONG((unsigned long)a))) 1503 #define XEN_UNWRAP_C_POINTER(a) XEN_TO_C_ULONG(a) 1504 #else 1505 #define XEN_WRAP_C_POINTER(a) C_TO_XEN_ULONG_LONG((uint64_t)(a)) 1506 #define XEN_UNWRAP_C_POINTER(a) XEN_TO_C_ULONG_LONG(a) 1507 #endif 1508 #endif 1509 1510 1511 /* Feb-14: the upper case macro names and the old-fashioned _p names are ugly and hard to read -- start replacing them 1512 */ 1513 1514 #define Xen_is_number(Arg) XEN_NUMBER_P(Arg) 1515 #define Xen_is_integer(Arg) XEN_INTEGER_P(Arg) 1516 #define Xen_is_llong(Arg) XEN_LONG_LONG_P(Arg) 1517 #define Xen_is_keyword(Arg) XEN_KEYWORD_P(Arg) 1518 #define Xen_is_true(Arg) XEN_TRUE_P(Arg) 1519 #define Xen_is_false(Arg) XEN_FALSE_P(Arg) 1520 #define Xen_is_bound(Arg) XEN_BOUND_P(Arg) 1521 #define Xen_is_boolean(Arg) XEN_BOOLEAN_P(Arg) 1522 #define Xen_is_null(Arg) XEN_NULL_P(Arg) 1523 #define Xen_is_eq(Arg1, Arg2) XEN_EQ_P(Arg1, Arg2) 1524 #define Xen_is_cons(Arg) XEN_CONS_P(Arg) 1525 #define Xen_is_pair(Arg) XEN_PAIR_P(Arg) 1526 #define Xen_is_list(Arg) XEN_LIST_P(Arg) 1527 #define Xen_is_string(Arg) XEN_STRING_P(Arg) 1528 #define Xen_is_double(Arg) XEN_DOUBLE_P(Arg) 1529 #define Xen_is_complex(Arg) XEN_COMPLEX_P(Arg) 1530 #define Xen_is_ulong(Arg) XEN_ULONG_P(Arg) 1531 #define Xen_is_ullong(Arg) XEN_ULONG_LONG_P(Arg) 1532 #define Xen_is_wrapped_c_pointer(Arg) XEN_WRAPPED_C_POINTER_P(Arg) 1533 #define Xen_is_procedure(Arg) XEN_PROCEDURE_P(Arg) 1534 #define Xen_c_object_is_type(Obj, Tag) XEN_OBJECT_TYPE_P(Obj, Tag) 1535 #define Xen_is_symbol(Arg) XEN_SYMBOL_P(Arg) 1536 #define Xen_is_hook(Arg) XEN_HOOK_P(Arg) 1537 #define Xen_is_vector(Arg) XEN_VECTOR_P(Arg) 1538 #define Xen_is_char(Arg) XEN_CHAR_P(Arg) 1539 #define Xen_keyword_is_eq(Arg1, Arg2) XEN_KEYWORD_EQ_P(Arg1, Arg2) 1540 #define Xen_is_defined(Arg) XEN_DEFINED_P(Arg) 1541 #define Xen_is_ratio(Arg) XEN_RATIO_P(Arg) 1542 1543 #define Xen_is_llong_or_unbound(Arg) XEN_LONG_LONG_IF_BOUND_P(Arg) 1544 #define Xen_is_boolean_or_unbound(Arg) XEN_BOOLEAN_IF_BOUND_P(Arg) 1545 #define Xen_is_integer_or_unbound(Arg) XEN_INTEGER_IF_BOUND_P(Arg) 1546 #define Xen_is_number_or_unbound(Arg) XEN_NUMBER_IF_BOUND_P(Arg) 1547 #define Xen_is_string_or_unbound(Arg) XEN_STRING_IF_BOUND_P(Arg) 1548 #define Xen_is_integer_boolean_or_unbound(Arg) XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(Arg) 1549 #define Xen_is_integer_or_boolean(Arg) XEN_INTEGER_OR_BOOLEAN_P(Arg) 1550 1551 #define Xen_append(a, b) XEN_APPEND(a, b) 1552 #define Xen_cadddr(a) XEN_CADDDR(a) 1553 #define Xen_caddr(a) XEN_CADDR(a) 1554 #define Xen_cadr(a) XEN_CADR(a) 1555 #define Xen_car(a) XEN_CAR(a) 1556 #define Xen_cddr(a) XEN_CDDR(a) 1557 #define Xen_cdddr(a) XEN_CDDDR(a) 1558 #define Xen_cdr(a) XEN_CDR(a) 1559 #define Xen_cons(a, b) XEN_CONS(a, b) 1560 #define Xen_cons_2(a, b, c) XEN_CONS_2(a, b, c) 1561 #define Xen_list_1(a) XEN_LIST_1(a) 1562 #define Xen_list_2(a, b) XEN_LIST_2(a, b) 1563 #define Xen_list_3(a, b, c) XEN_LIST_3(a, b, c) 1564 #define Xen_list_4(a, b, c, d) XEN_LIST_4(a, b, c, d) 1565 #define Xen_list_5(a, b, c, d, e) XEN_LIST_5(a, b, c, d, e) 1566 #define Xen_list_6(a, b, c, d, e, f) XEN_LIST_6(a, b, c, d, e, f) 1567 #define Xen_list_7(a, b, c, d, e, f, g) XEN_LIST_7(a, b, c, d, e, f, g) 1568 #define Xen_list_8(a, b, c, d, e, f, g, h) XEN_LIST_8(a, b, c, d, e, f, g, h) 1569 #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) 1570 #define Xen_list_length(a) XEN_LIST_LENGTH(a) 1571 #define Xen_list_ref(a, b) XEN_LIST_REF(a, b) 1572 #define Xen_list_reverse(a) XEN_LIST_REVERSE(a) 1573 #define Xen_list_set(a, b, c) XEN_LIST_SET(a, b, c) 1574 #define Xen_member(a, b) XEN_MEMBER(a, b) 1575 #define Xen_make_keyword(a) XEN_MAKE_KEYWORD(a) 1576 #define Xen_make_vector(a, b) XEN_MAKE_VECTOR(a, b) 1577 #define Xen_throw(a) XEN_THROW(a) 1578 #define Xen_vector_length(a) XEN_VECTOR_LENGTH(a) 1579 #define Xen_vector_ref(a, b) XEN_VECTOR_REF(a, b) 1580 #define Xen_vector_set(a, b, c) XEN_VECTOR_SET(a, b, c) 1581 #define Xen_vector_to_Xen_list(a) XEN_VECTOR_TO_LIST(a) 1582 #define C_bool_to_Xen_boolean(a) C_TO_XEN_BOOLEAN(a) 1583 #define C_char_to_Xen_char(a) C_TO_XEN_CHAR(a) 1584 #define C_complex_to_Xen_complex(a) C_TO_XEN_COMPLEX(a) 1585 #define C_double_to_Xen_real(a) C_TO_XEN_DOUBLE(a) 1586 #define C_int_to_Xen_integer(a) C_TO_XEN_INT(a) 1587 #define C_llong_to_Xen_llong(a) C_TO_XEN_LONG_LONG(a) 1588 #define C_string_to_Xen_string(a) C_TO_XEN_STRING(a) 1589 #define C_string_to_Xen_string_with_length(a, b) C_TO_XEN_STRINGN(a, b) 1590 #define C_string_to_Xen_symbol(a) C_STRING_TO_XEN_SYMBOL(a) 1591 #define C_ulong_to_Xen_ulong(a) C_TO_XEN_ULONG(a) 1592 #define C_ullong_to_Xen_ullong(a) C_TO_XEN_ULONG_LONG(a) 1593 #define Xen_boolean_to_C_bool(a) XEN_TO_C_BOOLEAN(a) 1594 #define Xen_char_to_C_char(a) XEN_TO_C_CHAR(a) 1595 #define Xen_complex_to_C_complex(a) XEN_TO_C_COMPLEX(a) 1596 #define Xen_real_to_C_double(a) XEN_TO_C_DOUBLE(a) 1597 #define Xen_integer_to_C_int(a) XEN_TO_C_INT(a) 1598 #define Xen_llong_to_C_llong(a) XEN_TO_C_LONG_LONG(a) 1599 #define Xen_string_to_C_string(a) XEN_TO_C_STRING(a) 1600 #define Xen_symbol_to_C_string(a) XEN_SYMBOL_TO_C_STRING(a) 1601 #define C_string_to_Xen_value(a) XEN_NAME_AS_C_STRING_TO_VALUE(a) 1602 #define Xen_ulong_to_C_ulong(a) XEN_TO_C_ULONG(a) 1603 #define Xen_ullong_to_C_ullong(a) XEN_TO_C_ULONG_LONG(a) 1604 #define Xen_wrap_C_pointer(a) XEN_WRAP_C_POINTER(a) 1605 #define Xen_unwrap_C_pointer(a) XEN_UNWRAP_C_POINTER(a) 1606 #define Xen_numerator(a) XEN_NUMERATOR(a) 1607 #define Xen_denominator(a) XEN_DENOMINATOR(a) 1608 #define Xen_rationalize(a, b) XEN_RATIONALIZE(a, b) 1609 #define Xen_make_ratio(a, b) XEN_MAKE_RATIO(a, b) 1610 #define Xen_load(a) XEN_LOAD_FILE(a) 1611 #define Xen_documentation(a) XEN_OBJECT_HELP(a) 1612 #define Xen_vector_rank(a) XEN_VECTOR_RANK(a) 1613 #define Xen_wrap_no_args(a, b) XEN_NARGIFY_0(a, b) 1614 #define Xen_wrap_1_arg(a, b) XEN_NARGIFY_1(a, b) 1615 #define Xen_wrap_2_args(a, b) XEN_NARGIFY_2(a, b) 1616 #define Xen_wrap_3_args(a, b) XEN_NARGIFY_3(a, b) 1617 #define Xen_wrap_4_args(a, b) XEN_NARGIFY_4(a, b) 1618 #define Xen_wrap_5_args(a, b) XEN_NARGIFY_5(a, b) 1619 #define Xen_wrap_6_args(a, b) XEN_NARGIFY_6(a, b) 1620 #define Xen_wrap_7_args(a, b) XEN_NARGIFY_7(a, b) 1621 #define Xen_wrap_8_args(a, b) XEN_NARGIFY_8(a, b) 1622 #define Xen_wrap_9_args(a, b) XEN_NARGIFY_9(a, b) 1623 #define Xen_wrap_1_optional_arg(a, b) XEN_ARGIFY_1(a, b) 1624 #define Xen_wrap_2_optional_args(a, b) XEN_ARGIFY_2(a, b) 1625 #define Xen_wrap_3_optional_args(a, b) XEN_ARGIFY_3(a, b) 1626 #define Xen_wrap_4_optional_args(a, b) XEN_ARGIFY_4(a, b) 1627 #define Xen_wrap_5_optional_args(a, b) XEN_ARGIFY_5(a, b) 1628 #define Xen_wrap_6_optional_args(a, b) XEN_ARGIFY_6(a, b) 1629 #define Xen_wrap_7_optional_args(a, b) XEN_ARGIFY_7(a, b) 1630 #define Xen_wrap_8_optional_args(a, b) XEN_ARGIFY_8(a, b) 1631 #define Xen_wrap_9_optional_args(a, b) XEN_ARGIFY_9(a, b) 1632 #define Xen_wrap_any_args(a, b) XEN_VARGIFY(a, b) 1633 #define Xen_apply(a, b, c) XEN_APPLY(a, b, c) 1634 #define Xen_unprotected_apply(a, b) XEN_APPLY_NO_CATCH(a, b) 1635 #define Xen_eval_C_string(a) XEN_EVAL_C_STRING(a) 1636 #define Xen_error(a, b) XEN_ERROR(a, b) 1637 #define Xen_call_with_no_args(a, b) XEN_CALL_0(a, b) 1638 #define Xen_call_with_1_arg(a, b, c) XEN_CALL_1(a, b, c) 1639 #define Xen_call_with_2_args(a, b, c, d) XEN_CALL_2(a, b, c, d) 1640 #define Xen_call_with_3_args(a, b, c, d, e) XEN_CALL_3(a, b, c, d, e) 1641 #define Xen_call_with_4_args(a, b, c, d, e, f) XEN_CALL_4(a, b, c, d, e, f) 1642 #define Xen_call_with_5_args(a, b, c, d, e, f, g) XEN_CALL_5(a, b, c, d, e, f, g) 1643 #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) 1644 #define Xen_unprotected_call_with_no_args(a) XEN_CALL_0_NO_CATCH(a) 1645 #define Xen_unprotected_call_with_1_arg(a, b) XEN_CALL_1_NO_CATCH(a, b) 1646 #define Xen_unprotected_call_with_2_args(a, b, c) XEN_CALL_2_NO_CATCH(a, b, c) 1647 #define Xen_unprotected_call_with_3_args(a, b, c, d) XEN_CALL_3_NO_CATCH(a, b, c, d) 1648 #define Xen_define(a, b) XEN_DEFINE(a, b) 1649 #define Xen_define_constant(a, b, c) XEN_DEFINE_CONSTANT(a, b, c) 1650 #define Xen_define_hook(a, b, c, d) XEN_DEFINE_HOOK(a, b, c, d) 1651 #define Xen_define_procedure(a, b, c, d, e, f) XEN_DEFINE_PROCEDURE(a, b, c, d, e, f) 1652 #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) 1653 #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) 1654 #define Xen_define_safe_procedure(a, b, c, d, e, f) XEN_DEFINE_SAFE_PROCEDURE(a, b, c, d, e, f) 1655 1656 #define Xen_define_integer_procedure(a, b, c, d, e, f) XEN_DEFINE_SAFE_PROCEDURE(a, b, c, d, e, f) /*obsolete */ 1657 1658 #define Xen_define_simple_hook(a, b) XEN_DEFINE_SIMPLE_HOOK(a, b) 1659 #define Xen_define_variable(a, b, c) XEN_DEFINE_VARIABLE(a, b, c) 1660 #define Xen_out_of_range_error(a, b, c, d) XEN_OUT_OF_RANGE_ERROR(a, b, c, d) 1661 #define Xen_wrong_type_arg_error(a, b, c, d) XEN_WRONG_TYPE_ARG_ERROR(a, b, c, d) 1662 #define Xen_bad_arity_error(a, b, c, d) XEN_BAD_ARITY_ERROR(a, b, c, d) 1663 #define Xen_clear_hook_list(a) XEN_CLEAR_HOOK(a) 1664 #define Xen_hook_has_list(a) XEN_HOOKED(a) 1665 #define Xen_hook_list(a) XEN_HOOK_PROCEDURES(a) 1666 #define Xen_add_to_hook_list(a, b, c, d) XEN_ADD_HOOK(a, b, c, d) 1667 #define Xen_GC_protect(a) XEN_PROTECT_FROM_GC(a) 1668 #define Xen_GC_unprotect(a) XEN_UNPROTECT_FROM_GC(a) 1669 #define Xen_provide_feature(a) XEN_PROVIDE(a) 1670 #define Xen_arity(a) XEN_ARITY(a) 1671 #define Xen_add_to_load_path(a) XEN_ADD_TO_LOAD_PATH(a) 1672 #define Xen_check_type(a, b, c, d, e) XEN_ASSERT_TYPE(a, b, c, d, e) 1673 #define Xen_make_object(a, b, c, d) XEN_MAKE_OBJECT(a, b, c, d) 1674 #define Xen_variable_ref(a) XEN_VARIABLE_REF(a) 1675 #define Xen_variable_set(a, b) XEN_VARIABLE_SET(a, b) 1676 #define Xen_object_ref(a) XEN_OBJECT_REF(a) 1677 #define Xen_copy_arg(a) XEN_COPY_ARG(a) 1678 #define Xen_assoc(a, b) XEN_ASSOC(a, b) 1679 #define Xen_assoc_ref(a, b) XEN_ASSOC_REF(a, b) 1680 #define Xen_assoc_set(a, b, c) XEN_ASSOC_SET(a, b, c) 1681 #define Xen_make_error_type(a) XEN_ERROR_TYPE(a) 1682 #define Xen_required_args(a) XEN_REQUIRED_ARGS(a) 1683 #define Xen_is_aritable(a, b) XEN_REQUIRED_ARGS_OK(a, b) 1684 #define Xen_object_to_C_string(a) XEN_AS_STRING(a) 1685 #define Xen_wrap_free(a, b, c) XEN_MAKE_OBJECT_FREE_PROCEDURE(a, b, c) 1686 #define Xen_wrap_print(a, b, c) XEN_MAKE_OBJECT_PRINT_PROCEDURE(a, b, c) 1687 #define Xen_make_object_type(a, b) XEN_MAKE_OBJECT_TYPE(a, b) 1688 #define Xen_object_mark_t XEN_MARK_OBJECT_TYPE 1689 #define Xen_object_type_t XEN_OBJECT_TYPE 1690 #define Xen_catch_t XEN_CATCH_BODY_TYPE 1691 #define Xen_comment_mark XEN_COMMENT_STRING 1692 #define Xen_documentation_symbol XEN_DOCUMENTATION_SYMBOL 1693 #define Xen_empty_list XEN_EMPTY_LIST 1694 #define Xen_false XEN_FALSE 1695 #define Xen_true XEN_TRUE 1696 #define Xen_undefined XEN_UNDEFINED 1697 #define Xen_integer_zero XEN_ZERO 1698 #define Xen_file_extension XEN_FILE_EXTENSION 1699 #define Xen_language XEN_LANGUAGE_NAME 1700 #define Xen_load_path XEN_LOAD_PATH 1701 #define Xen_procedure_cast XEN_PROCEDURE_CAST 1702 #define Xen XEN 1703 1704 #if HAVE_SCHEME 1705 #define Xen_define_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) s7_define_typed_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) 1706 #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) 1707 #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) \ 1708 s7_typed_dilambda(s7, Get_Name, Get_Func, Get_Req, Get_Opt, Set_Func, Set_Req, Set_Opt, Get_Help, Get_Sig, Set_Sig) 1709 #else 1710 #define Xen_define_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) Xen_define_safe_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc) 1711 #define Xen_define_unsafe_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) Xen_define_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc) 1712 #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) 1713 #endif 1714 1715 1716 #ifdef __cplusplus 1717 extern "C" { 1718 #endif 1719 1720 char *xen_strdup(const char *str); 1721 char *xen_version(void); 1722 void xen_repl(int argc, char **argv); 1723 void xen_initialize(void); 1724 void xen_gc_mark(XEN val); 1725 1726 #ifdef __cplusplus 1727 } 1728 #endif 1729 1730 #endif 1731