#include #include "scheme48.h" /* kludges */ #define FIXED_S48_RECORD_TYPE(x) (s48_stob_ref((x), S48_STOBTYPE_RECORD, 0)) /* variables */ static s48_value scheme_list_length_function = S48_FALSE; static s48_value scheme_boolean_p_function = S48_FALSE; static s48_value scheme_integer_p_function = S48_FALSE; /* prototypes */ s48_value ffit_enter_string_array(char**); int length_scheme_list(s48_value); int call_scheme_boolean_p(s48_value); int call_scheme_integer_p(s48_value); char** ffit_extract_list_of_strings(s48_value); void ffit_init_hook(void); /* macros */ #define FFIT_MAKE_ENTER_RECORD(FUNNAME, SCM_RECTYPE, C_RECTYPE) \ s48_value FUNNAME(C_RECTYPE c_rec) { \ s48_value scm_rec = S48_FALSE; \ S48_DECLARE_GC_PROTECT(1); \ \ S48_GC_PROTECT_1(scm_rec); \ scm_rec = s48_make_record(SCM_RECTYPE); \ S48_RECORD_SET(scm_rec, 0, s48_enter_integer((long) c_rec)); \ S48_GC_UNPROTECT(); \ return scm_rec; \ } #define FFIT_MAKE_ENTER_RECORD_PROTOTYPE(FUNNAME, C_RECTYPE) \ s48_value FUNNAME(C_RECTYPE c_rec); #define FFIT_RECORD_TYPE_INIT(C_RECTYPE, SCM_NAME) \ S48_GC_PROTECT_GLOBAL(C_RECTYPE); \ C_RECTYPE = s48_get_imported_binding("SCM_NAME"); #define FFIT_CHECK_RECORD_TYPE(SCM_VAL, SCM_RECTYPE) \ if (!(S48_RECORD_P(SCM_VAL) && \ (FIXED_S48_RECORD_TYPE(SCM_VAL) == SCM_RECTYPE))) \ s48_raise_argument_type_error(SCM_VAL) #define FFIT_STRUCT_GET(FUNNAME, SCM_RECTYPE, C_RECTYPE, C_FIELD, FIELD_SCM_ENTER_FUN) \ s48_value FUNNAME(s48_value scm_rec) { \ s48_value res = S48_FALSE; \ C_RECTYPE c_rec; \ S48_DECLARE_GC_PROTECT(2); \ \ S48_GC_PROTECT_2(res, scm_rec); \ FFIT_CHECK_RECORD_TYPE(scm_rec, SCM_RECTYPE); \ c_rec = (C_RECTYPE) s48_extract_integer(S48_RECORD_REF(scm_rec, 0)); \ res = FIELD_SCM_ENTER_FUN(c_rec->C_FIELD); \ S48_GC_UNPROTECT(); \ return res; \ } #define FFIT_STRUCT_GET_INT(FUNNAME, SCM_RECTYPE, C_RECTYPE, C_FIELD) \ FFIT_STRUCT_GET(FUNNAME, SCM_RECTYPE, C_RECTYPE, C_FIELD, s48_enter_integer); #define FFIT_STRUCT_GET_CHAR(FUNNAME, SCM_RECTYPE, C_RECTYPE, C_FIELD) \ FFIT_STRUCT_GET(FUNNAMEm SCM_RECTYPE, C_RECTYPE, C_FIELD, s48_enter_char); #define FFIT_STRUCT_GET_STRING(FUNNAME, SCM_RECTYPE, C_RECTYPE, C_FIELD) \ FFIT_STRUCT_GET(FUNNAME, SCM_RECTYPE, C_RECTYPE, C_FIELD, s48_enter_string); /* predicates */ #define FFIT_LIST_P(x) (S48_PAIR_P(x) || (x == S48_NULL)) #define FFIT_CHECK_LIST(v) \ do { if (!FFIT_LIST_P(v)) s48_raise_argument_type_error(v); } while (0) #define FFIT_CHECK_INTEGER(v) \ do { if (!call_scheme_integer_p(v)) s48_raise_argument_type_error(v); } while (0) #define FFIT_CHECK_BOOLEAN(v) \ do { if (!call_scheme_boolean_p(v)) s48_raise_argument_type_error(v); } while (0)