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

77 lines
2.8 KiB
C
Raw Normal View History

#include <unistd.h>
#include "scheme48.h"
2004-01-08 02:46:29 -05:00
/* 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");
2004-01-08 02:46:29 -05:00
#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)