Add support for guile 2.0: update swg and interface files
Note: only the scm interface is considered.
This commit is contained in:
Geert Janssens
parent
7dfe4a0653
commit
2c23a5d2cd
4 changed files with 186 additions and 17 deletions
|
|
@ -1,3 +1,5 @@
|
|||
#ifdef GUILE_VERSION_1_6
|
||||
|
||||
#define gh_append2(a, b) scm_append(scm_listify(a, b, SCM_UNDEFINED))
|
||||
#define gh_apply(a, b) scm_apply(a, b, SCM_EOL)
|
||||
#define gh_bool2scm SCM_BOOL
|
||||
|
|
@ -37,3 +39,47 @@
|
|||
#define gh_vector_ref scm_vector_ref
|
||||
#define gh_vector_set_x scm_vector_set_x
|
||||
#define gh_char2scm SCM_MAKE_CHAR
|
||||
|
||||
#else
|
||||
|
||||
#define gh_append2(a, b) scm_append(scm_listify(a, b, SCM_UNDEFINED))
|
||||
#define gh_apply(a, b) scm_apply(a, b, SCM_EOL)
|
||||
#define gh_bool2scm scm_from_bool
|
||||
#define gh_boolean_p scm_is_bool
|
||||
#define gh_car SCM_CAR
|
||||
#define gh_cdr SCM_CDR
|
||||
#define gh_cons scm_cons
|
||||
#define gh_double2scm scm_from_double
|
||||
#define gh_int2scm scm_from_long
|
||||
#define gh_length(lst) scm_to_ulong(scm_length(lst))
|
||||
#define gh_list scm_listify
|
||||
#define gh_list_to_vector scm_vector
|
||||
#define gh_make_vector scm_make_vector
|
||||
#define gh_null_p scm_is_null
|
||||
#define gh_number_p scm_is_number
|
||||
#define gh_pair_p scm_is_pair
|
||||
#define gh_scm2bool scm_is_true
|
||||
#define gh_scm2char SCM_CHAR
|
||||
#define gh_scm2double scm_to_double
|
||||
#define gh_scm2int scm_to_int
|
||||
#define gh_scm2long scm_to_long
|
||||
#define gh_scm2short scm_to_short
|
||||
#define gh_scm2newstr SWIG_Guile_scm2newstr
|
||||
#define gh_scm2ulong scm_to_ulong
|
||||
#define gh_scm2ushort scm_to_ushort
|
||||
#define gh_scm2uint scm_to_uint
|
||||
#define gh_ulong2scm scm_from_ulong
|
||||
#define gh_long2scm scm_from_long
|
||||
#define gh_str02scm(str) str ? scm_from_locale_string(str) : SCM_BOOL_F
|
||||
#define gh_long_long2scm scm_from_long_long
|
||||
#define gh_scm2long_long scm_to_long_long
|
||||
#define gh_ulong_long2scm scm_from_ulong_long
|
||||
#define gh_scm2ulong_long scm_to_ulong_long
|
||||
#define gh_string_p scm_is_string
|
||||
#define gh_vector_length scm_c_vector_length
|
||||
#define gh_vector_p scm_is_vector
|
||||
#define gh_vector_ref scm_vector_ref
|
||||
#define gh_vector_set_x scm_vector_set_x
|
||||
#define gh_char2scm SCM_MAKE_CHAR
|
||||
|
||||
#endif
|
||||
|
|
@ -15,6 +15,36 @@
|
|||
extern "C" {
|
||||
#endif
|
||||
|
||||
|
||||
/* In the code below, use guile 2.0 compatible functions where possible.
|
||||
Functions that don't exist in older versions will be mapped to
|
||||
a deprecated equivalent for those versions only */
|
||||
/* ... setup guile 2-like interface for guile 1.6 */
|
||||
#if (SCM_MAJOR_VERSION == 1) && (SCM_MINOR_VERSION <= 6)
|
||||
|
||||
# define scm_from_locale_keyword scm_c_make_keyword
|
||||
# define scm_from_locale_symbol scm_str2symbol
|
||||
# define scm_is_null SCM_NULLP
|
||||
# define scm_is_true SCM_NFALSEP
|
||||
# define scm_is_string SCM_STRINGP
|
||||
|
||||
/* Used later on to setup different code paths where it's
|
||||
not possible to use a guile 2-like interface */
|
||||
# define GUILE_VERSION_1_6
|
||||
|
||||
#endif
|
||||
|
||||
/* ... setup guile 2-like interface for guile 1.6 and 1.8 */
|
||||
#if defined (SCM_MAJOR_VERSION) && (SCM_MAJOR_VERSION < 2)
|
||||
|
||||
static SCM
|
||||
scm_module_variable (SCM module, SCM sym)
|
||||
{
|
||||
return scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
typedef SCM (*swig_guile_proc)();
|
||||
|
||||
#define SWIG_malloc(size) \
|
||||
|
|
@ -150,7 +180,7 @@ SWIG_Guile_ConvertPtr(swig_module_info *module, SCM s, void **result,
|
|||
{
|
||||
swig_cast_info *cast;
|
||||
swig_type_info *from;
|
||||
if (SCM_NULLP(s)) {
|
||||
if (scm_is_null(s)) {
|
||||
*result = NULL;
|
||||
return SWIG_OK;
|
||||
} else if (SCM_NIMP(s)) {
|
||||
|
|
@ -246,7 +276,7 @@ SWIG_Guile_GetArgs (SCM *dest, SCM rest,
|
|||
}
|
||||
for (; i<optargs; i++)
|
||||
*dest++ = SCM_UNDEFINED;
|
||||
if (!SCM_NULLP(rest))
|
||||
if (!scm_is_null(rest))
|
||||
scm_wrong_num_args(gh_str02scm((char *) procname));
|
||||
return num_args_passed;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -12,7 +12,44 @@
|
|||
extern "C" {
|
||||
#endif
|
||||
|
||||
|
||||
/* In the code below, use guile 2.0 compatible functions where possible.
|
||||
Functions that don't exist in older versions will be mapped to
|
||||
a deprecated equivalent for those versions only */
|
||||
/* ... setup guile 2-like interface for guile 1.6 */
|
||||
#if (SCM_MAJOR_VERSION == 1) && (SCM_MINOR_VERSION <= 6)
|
||||
|
||||
# define scm_from_locale_keyword scm_c_make_keyword
|
||||
# define scm_from_locale_symbol scm_str2symbol
|
||||
# define scm_is_null SCM_NULLP
|
||||
# define scm_is_true SCM_NFALSEP
|
||||
# define scm_is_string SCM_STRINGP
|
||||
|
||||
/* Used later on to setup different code paths where it's
|
||||
not possible to use a guile 2-like interface */
|
||||
# define GUILE_VERSION_1_6
|
||||
|
||||
#endif
|
||||
|
||||
/* ... setup guile 2-like interface for guile 1.6 and 1.8 */
|
||||
#if defined (SCM_MAJOR_VERSION) && (SCM_MAJOR_VERSION < 2)
|
||||
|
||||
static SCM
|
||||
scm_module_variable (SCM module, SCM sym)
|
||||
{
|
||||
return scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
#if SCM_MAJOR_VERSION >= 2
|
||||
// scm_c_define_gsubr takes a different parameter type
|
||||
// depending on the guile version
|
||||
|
||||
typedef scm_t_subr swig_guile_proc;
|
||||
#else
|
||||
typedef SCM (*swig_guile_proc)();
|
||||
#endif
|
||||
typedef SCM (*guile_destructor)(SCM);
|
||||
|
||||
typedef struct swig_guile_clientdata {
|
||||
|
|
@ -22,10 +59,17 @@ typedef struct swig_guile_clientdata {
|
|||
|
||||
#define SWIG_scm2str(s) \
|
||||
SWIG_Guile_scm2newstr(s, NULL)
|
||||
#define SWIG_malloc(size) \
|
||||
SCM_MUST_MALLOC(size)
|
||||
#define SWIG_free(mem) \
|
||||
scm_must_free(mem)
|
||||
#ifdef GUILE_VERSION_1_6
|
||||
# define SWIG_malloc(size) \
|
||||
SCM_MUST_MALLOC(size)
|
||||
# define SWIG_free(mem) \
|
||||
scm_must_free(mem)
|
||||
#else
|
||||
# define SWIG_malloc(size) \
|
||||
scm_malloc(size)
|
||||
# define SWIG_free(mem) \
|
||||
free(mem)
|
||||
#endif
|
||||
#define SWIG_ConvertPtr(s, result, type, flags) \
|
||||
SWIG_Guile_ConvertPtr(s, result, type, flags)
|
||||
#define SWIG_MustGetPtr(s, type, argnum, flags) \
|
||||
|
|
@ -42,7 +86,7 @@ typedef struct swig_guile_clientdata {
|
|||
SWIG_Guile_IsPointer(object)
|
||||
#define SWIG_contract_assert(expr, msg) \
|
||||
if (!(expr)) \
|
||||
scm_error(scm_str2symbol("swig-contract-assertion-failed"), \
|
||||
scm_error(scm_from_locale_symbol("swig-contract-assertion-failed"), \
|
||||
(char *) FUNC_NAME, (char *) msg, \
|
||||
SCM_EOL, SCM_BOOL_F); else
|
||||
|
||||
|
|
@ -61,15 +105,25 @@ SWIGINTERN char *
|
|||
SWIG_Guile_scm2newstr(SCM str, size_t *len) {
|
||||
#define FUNC_NAME "SWIG_Guile_scm2newstr"
|
||||
char *ret;
|
||||
# ifndef GUILE_VERSION_1_6
|
||||
char *tmp;
|
||||
# endif
|
||||
size_t l;
|
||||
|
||||
SCM_ASSERT (SCM_STRINGP(str), str, 1, FUNC_NAME);
|
||||
|
||||
l = SCM_STRING_LENGTH(str);
|
||||
SCM_ASSERT (scm_is_string(str), str, 1, FUNC_NAME);
|
||||
l = scm_c_string_length(str);
|
||||
|
||||
ret = (char *) SWIG_malloc( (l + 1) * sizeof(char));
|
||||
if (!ret) return NULL;
|
||||
|
||||
# ifdef GUILE_VERSION_1_6
|
||||
memcpy(ret, SCM_STRING_CHARS(str), l);
|
||||
# else
|
||||
tmp = scm_to_locale_string(str);
|
||||
memcpy(ret, tmp, l);
|
||||
free(tmp);
|
||||
# endif
|
||||
|
||||
ret[l] = '\0';
|
||||
if (len) *len = l;
|
||||
return ret;
|
||||
|
|
@ -86,7 +140,7 @@ static SCM swig_keyword = SCM_EOL;
|
|||
static SCM swig_symbol = SCM_EOL;
|
||||
|
||||
#define SWIG_Guile_GetSmob(x) \
|
||||
( SCM_NNULLP(x) && SCM_INSTANCEP(x) && SCM_NFALSEP(scm_slot_exists_p(x, swig_symbol)) \
|
||||
( !scm_is_null(x) && SCM_INSTANCEP(x) && scm_is_true(scm_slot_exists_p(x, swig_symbol)) \
|
||||
? scm_slot_ref(x, swig_symbol) : (x) )
|
||||
|
||||
SWIGINTERN SCM
|
||||
|
|
@ -361,6 +415,7 @@ ensure_smob_tag(SCM swig_module,
|
|||
const char *smob_name,
|
||||
const char *scheme_variable_name)
|
||||
{
|
||||
#ifdef GUILE_VERSION_1_6
|
||||
SCM variable = scm_sym2var(scm_str2symbol(scheme_variable_name),
|
||||
scm_module_lookup_closure(swig_module),
|
||||
SCM_BOOL_T);
|
||||
|
|
@ -375,6 +430,20 @@ ensure_smob_tag(SCM swig_module,
|
|||
"SWIG_Guile_Init");
|
||||
return 0;
|
||||
}
|
||||
#else
|
||||
SCM variable = scm_module_variable(swig_module,
|
||||
scm_from_locale_symbol(scheme_variable_name));
|
||||
if (scm_is_false(variable)) {
|
||||
*tag_variable = scm_make_smob_type((char*)scheme_variable_name, 0);
|
||||
scm_c_module_define(swig_module, scheme_variable_name,
|
||||
scm_from_ulong(*tag_variable));
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
*tag_variable = scm_to_ulong(SCM_VARIABLE_REF(variable));
|
||||
return 0;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
SWIGINTERN SCM
|
||||
|
|
@ -409,8 +478,8 @@ SWIG_Guile_Init ()
|
|||
}
|
||||
swig_make_func = scm_permanent_object(
|
||||
scm_variable_ref(scm_c_module_lookup(scm_c_resolve_module("oop goops"), "make")));
|
||||
swig_keyword = scm_permanent_object(scm_c_make_keyword((char*) "init-smob"));
|
||||
swig_symbol = scm_permanent_object(scm_str2symbol("swig-smob"));
|
||||
swig_keyword = scm_permanent_object(scm_from_locale_keyword((char*) "init-smob"));
|
||||
swig_symbol = scm_permanent_object(scm_from_locale_symbol("swig-smob"));
|
||||
#ifdef SWIG_INIT_RUNTIME_MODULE
|
||||
SWIG_INIT_RUNTIME_MODULE
|
||||
#endif
|
||||
|
|
@ -426,6 +495,7 @@ SWIG_Guile_GetModule(void *SWIGUNUSEDPARM(clientdata))
|
|||
|
||||
module = SWIG_Guile_Init();
|
||||
|
||||
#ifdef GUILE_VERSION_1_6
|
||||
variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
|
||||
scm_module_lookup_closure(module),
|
||||
SCM_BOOL_T);
|
||||
|
|
@ -434,6 +504,15 @@ SWIG_Guile_GetModule(void *SWIGUNUSEDPARM(clientdata))
|
|||
} else {
|
||||
return (swig_module_info *) scm_num2ulong(SCM_VARIABLE_REF(variable), 0, "SWIG_Guile_Init");
|
||||
}
|
||||
#else
|
||||
variable = scm_module_variable(module,
|
||||
scm_from_locale_symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME));
|
||||
if (scm_is_false(variable)) {
|
||||
return NULL;
|
||||
} else {
|
||||
return (swig_module_info *) scm_to_ulong(SCM_VARIABLE_REF(variable));
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
SWIGINTERN void
|
||||
|
|
@ -444,11 +523,17 @@ SWIG_Guile_SetModule(swig_module_info *swig_module)
|
|||
|
||||
module = SWIG_Guile_Init();
|
||||
|
||||
#ifdef GUILE_VERSION_1_6
|
||||
variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
|
||||
scm_module_lookup_closure(module),
|
||||
SCM_BOOL_T);
|
||||
|
||||
SCM_VARIABLE_SET(variable, scm_ulong2num((unsigned long) swig_module));
|
||||
#else
|
||||
scm_module_define(module,
|
||||
scm_from_locale_symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
|
||||
scm_from_ulong((unsigned long) swig_module));
|
||||
#endif
|
||||
}
|
||||
|
||||
SWIGINTERN int
|
||||
|
|
@ -460,7 +545,11 @@ SWIG_Guile_GetArgs (SCM *dest, SCM rest,
|
|||
int num_args_passed = 0;
|
||||
for (i = 0; i<reqargs; i++) {
|
||||
if (!SCM_CONSP(rest))
|
||||
#ifdef GUILE_VERSION_1_6
|
||||
scm_wrong_num_args(scm_makfrom0str((char *) procname));
|
||||
#else
|
||||
scm_wrong_num_args(scm_from_locale_string(procname ? (char *) procname : "unknown procedure"));
|
||||
#endif
|
||||
*dest++ = SCM_CAR(rest);
|
||||
rest = SCM_CDR(rest);
|
||||
num_args_passed++;
|
||||
|
|
@ -473,7 +562,11 @@ SWIG_Guile_GetArgs (SCM *dest, SCM rest,
|
|||
for (; i<optargs; i++)
|
||||
*dest++ = SCM_UNDEFINED;
|
||||
if (!SCM_NULLP(rest))
|
||||
scm_wrong_num_args(scm_makfrom0str((char *) procname));
|
||||
#ifdef GUILE_VERSION_1_6
|
||||
scm_wrong_num_args(scm_makfrom0str((char *) procname));
|
||||
#else
|
||||
scm_wrong_num_args(scm_from_locale_string(procname ? (char *) procname : "unknown procedure"));
|
||||
#endif
|
||||
return num_args_passed;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -406,7 +406,7 @@ typedef unsigned long SCM;
|
|||
const std::size_t &, const std::ptrdiff_t &,
|
||||
enum SWIGTYPE
|
||||
{
|
||||
$1 = SCM_NFALSEP(scm_integer_p($input)) && SCM_NFALSEP(scm_exact_p($input))? 1 : 0;
|
||||
$1 = scm_is_true(scm_integer_p($input)) && scm_is_true(scm_exact_p($input))? 1 : 0;
|
||||
}
|
||||
|
||||
%typecheck(SWIG_TYPECHECK_BOOL)
|
||||
|
|
@ -419,7 +419,7 @@ typedef unsigned long SCM;
|
|||
float, double,
|
||||
const float &, const double &
|
||||
{
|
||||
$1 = SCM_NFALSEP(scm_real_p($input)) ? 1 : 0;
|
||||
$1 = scm_is_true(scm_real_p($input)) ? 1 : 0;
|
||||
}
|
||||
|
||||
%typecheck(SWIG_TYPECHECK_CHAR) char {
|
||||
|
|
@ -427,7 +427,7 @@ typedef unsigned long SCM;
|
|||
}
|
||||
|
||||
%typecheck(SWIG_TYPECHECK_STRING) char * {
|
||||
$1 = SCM_STRINGP($input) ? 1 : 0;
|
||||
$1 = scm_is_string($input) ? 1 : 0;
|
||||
}
|
||||
|
||||
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue