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
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue