scsh-ldap/ffi-tools/ffi-tools.h

#include <unistd.h>
#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)