77 lines
2.8 KiB
C
77 lines
2.8 KiB
C
|
#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)
|