<Dmitriy.Zavin@infineon.com> writes:
> I have hacked support to create native mzscheme structures from C > structures, which includes native structure support. git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@6102 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Matthias Köppe
parent
47b80a2945
commit
6e6317c9cf
2 changed files with 171 additions and 8 deletions
|
|
@ -27,6 +27,8 @@ extern "C" {
|
|||
|
||||
#define SWIG_malloc(size) SWIG_MzScheme_Malloc(size, FUNC_NAME)
|
||||
#define SWIG_free(mem) free(mem)
|
||||
#define SWIG_NewStructFromPtr(ptr,type) \
|
||||
_swig_convert_struct_##type##(ptr)
|
||||
|
||||
#define MAXVALUES 6
|
||||
#define swig_make_boolean(b) (b ? scheme_true : scheme_false)
|
||||
|
|
@ -43,6 +45,9 @@ SWIGIMPORT(void *) SWIG_MzScheme_MustGetPtr(Scheme_Object *s, swig_type_info *ty
|
|||
SWIGIMPORT(Scheme_Object *) SWIG_MzScheme_NewPointerObj(void *ptr, swig_type_info *type, int owner);
|
||||
SWIGIMPORT(void *) SWIG_MzScheme_Malloc(size_t size, const char *func_name);
|
||||
SWIGIMPORT(Scheme_Object *) SWIG_MzScheme_PackageValues(int num, Scheme_Object **values);
|
||||
SWIGIMPORT(Scheme_Object *)
|
||||
SWIG_MzScheme_new_scheme_struct (Scheme_Env* env, const char* basename,
|
||||
int num_fields, char** field_names);
|
||||
|
||||
#else
|
||||
|
||||
|
|
@ -141,6 +146,45 @@ SWIG_MzScheme_PackageValues(int num, Scheme_Object **values) {
|
|||
else return scheme_values(num, values);
|
||||
}
|
||||
|
||||
#ifndef scheme_make_inspector
|
||||
#define scheme_make_inspector(x,y) \
|
||||
_scheme_apply(scheme_builtin_value("make-inspector"), x, y)
|
||||
#endif
|
||||
|
||||
/* Function to create a new struct. */
|
||||
SWIGRUNTIME(Scheme_Object *)
|
||||
SWIG_MzScheme_new_scheme_struct (Scheme_Env* env, const char* basename,
|
||||
int num_fields, char** field_names)
|
||||
{
|
||||
Scheme_Object *new_type;
|
||||
int count_out, i;
|
||||
Scheme_Object **struct_names;
|
||||
Scheme_Object **vals;
|
||||
Scheme_Object **a = (Scheme_Object**) \
|
||||
scheme_malloc(num_fields*sizeof(Scheme_Object*));
|
||||
|
||||
for (i=0; i<num_fields; ++i) {
|
||||
a[i] = (Scheme_Object*) scheme_intern_symbol(field_names[i]);
|
||||
}
|
||||
|
||||
new_type = scheme_make_struct_type(scheme_intern_symbol(basename),
|
||||
NULL /*super_type*/,
|
||||
scheme_make_inspector(0, NULL),
|
||||
num_fields,
|
||||
0 /* auto_fields */,
|
||||
NULL /* auto_val */,
|
||||
NULL /* properties */);
|
||||
struct_names = scheme_make_struct_names(scheme_intern_symbol(basename),
|
||||
scheme_build_list(num_fields,a),
|
||||
0 /*flags*/, &count_out);
|
||||
vals = scheme_make_struct_values(new_type, struct_names, count_out, 0);
|
||||
|
||||
for (i = 0; i < count_out; i++)
|
||||
scheme_add_global_symbol(struct_names[i], vals[i],env);
|
||||
|
||||
return new_type;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
|
|
|
|||
|
|
@ -34,6 +34,12 @@ Mzscheme Options (available with -mzscheme)\n\
|
|||
-noinit - Do not emit scheme_initialize, scheme_reload,\n\
|
||||
scheme_module_name functions\n";
|
||||
|
||||
static String *fieldnames_tab = 0;
|
||||
static String *convert_tab = 0;
|
||||
static String *convert_proto_tab = 0;
|
||||
static String *struct_name = 0;
|
||||
static String *mangled_struct_name = 0;
|
||||
|
||||
static char *prefix=0;
|
||||
static bool declaremodule = false;
|
||||
static bool noinit = false;
|
||||
|
|
@ -49,6 +55,7 @@ static File *f_init = 0;
|
|||
// Used for garbage collection
|
||||
static int exporting_destructor = 0;
|
||||
static String *swigtype_ptr = 0;
|
||||
static String *cls_swigtype = 0;
|
||||
|
||||
class MZSCHEME : public Language {
|
||||
public:
|
||||
|
|
@ -270,7 +277,6 @@ public:
|
|||
numreq = emit_num_required(l);
|
||||
|
||||
// adds local variables
|
||||
Wrapper_add_local(f, "_len", "int _len");
|
||||
Wrapper_add_local(f, "lenv", "int lenv = 1");
|
||||
Wrapper_add_local(f, "values", "Scheme_Object *values[MAXVALUES]");
|
||||
|
||||
|
|
@ -645,15 +651,128 @@ public:
|
|||
return SWIG_OK;
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------
|
||||
* classHandler()
|
||||
* ------------------------------------------------------------ */
|
||||
virtual int classHandler(Node *n) {
|
||||
SwigType *t = NewStringf("p.%s", Getattr(n, "name"));
|
||||
swigtype_ptr = SwigType_manglestr(t);
|
||||
Delete(t);
|
||||
Language::classHandler(n);
|
||||
Delete(swigtype_ptr);
|
||||
swigtype_ptr = 0;
|
||||
return SWIG_OK;
|
||||
String *mangled_classname = 0;
|
||||
String *real_classname = 0;
|
||||
String *scm_structname = NewString("");
|
||||
SwigType *ctype_ptr = NewStringf("p.%s", Getattr(n, "classtype"));
|
||||
|
||||
SwigType *t = NewStringf("p.%s", Getattr(n, "name"));
|
||||
swigtype_ptr = SwigType_manglestr(t);
|
||||
Delete(t);
|
||||
|
||||
cls_swigtype = SwigType_manglestr(Getattr(n, "name"));
|
||||
|
||||
|
||||
fieldnames_tab = NewString("");
|
||||
convert_tab = NewString("");
|
||||
convert_proto_tab = NewString("");
|
||||
|
||||
struct_name = Getattr(n,"sym:name");
|
||||
mangled_struct_name = Swig_name_mangle(Getattr(n,"sym:name"));
|
||||
|
||||
Printv(scm_structname, struct_name, NIL);
|
||||
Replaceall(scm_structname, "_", "-");
|
||||
|
||||
real_classname = Getattr(n,"name");
|
||||
mangled_classname = Swig_name_mangle(real_classname);
|
||||
|
||||
Printv(fieldnames_tab, "static const char *_swig_struct_",
|
||||
cls_swigtype, "_field_names[] = { \n", NIL);
|
||||
|
||||
Printv(convert_proto_tab, "static Scheme_Object *_swig_convert_struct_",
|
||||
cls_swigtype, "(", SwigType_str(ctype_ptr, "ptr"), ");\n", NIL);
|
||||
|
||||
Printv(convert_tab, "static Scheme_Object *_swig_convert_struct_",
|
||||
cls_swigtype, "(", SwigType_str(ctype_ptr, "ptr"), ")\n {\n",
|
||||
NIL);
|
||||
|
||||
Printv(convert_tab,
|
||||
tab4, "Scheme_Object *obj;\n",
|
||||
tab4, "Scheme_Object *fields[_swig_struct_", cls_swigtype,
|
||||
"_field_names_cnt];\n",
|
||||
tab4, "int i = 0;\n\n", NIL);
|
||||
|
||||
/* Generate normal wrappers */
|
||||
Language::classHandler(n);
|
||||
|
||||
Printv(convert_tab, tab4, "obj = scheme_make_struct_instance(",
|
||||
"_swig_struct_type_", cls_swigtype, ", i, fields);\n", NIL);
|
||||
Printv(convert_tab, tab4, "return obj;\n}\n\n", NIL);
|
||||
|
||||
Printv(fieldnames_tab, "};\n", NIL);
|
||||
|
||||
Printv(f_header, "static Scheme_Object *_swig_struct_type_",
|
||||
cls_swigtype, ";\n", NIL);
|
||||
|
||||
Printv(f_header, fieldnames_tab, NIL);
|
||||
Printv(f_header, "#define _swig_struct_", cls_swigtype,
|
||||
"_field_names_cnt (sizeof(_swig_struct_", cls_swigtype,
|
||||
"_field_names)/sizeof(char*))\n", NIL);
|
||||
|
||||
Printv(f_header, convert_proto_tab, NIL);
|
||||
Printv(f_wrappers, convert_tab, NIL);
|
||||
|
||||
Printv(init_func_def, "_swig_struct_type_", cls_swigtype,
|
||||
" = SWIG_MzScheme_new_scheme_struct(menv, \"", scm_structname, "\", ",
|
||||
"_swig_struct_", cls_swigtype, "_field_names_cnt,",
|
||||
"(char**) _swig_struct_", cls_swigtype, "_field_names);\n",
|
||||
NIL);
|
||||
|
||||
Delete(mangled_classname);
|
||||
Delete(swigtype_ptr);
|
||||
swigtype_ptr = 0;
|
||||
Delete(fieldnames_tab);
|
||||
Delete(convert_tab);
|
||||
Delete(ctype_ptr);
|
||||
Delete(convert_proto_tab);
|
||||
struct_name = 0;
|
||||
mangled_struct_name = 0;
|
||||
Delete(cls_swigtype);
|
||||
cls_swigtype = 0;
|
||||
|
||||
return SWIG_OK;
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------
|
||||
* membervariableHandler()
|
||||
* ------------------------------------------------------------ */
|
||||
|
||||
virtual int membervariableHandler(Node *n) {
|
||||
Language::membervariableHandler(n);
|
||||
|
||||
if (!is_smart_pointer()) {
|
||||
String *symname = Getattr(n, "sym:name");
|
||||
String *name = Getattr(n, "name");
|
||||
SwigType *type = Getattr(n, "type");
|
||||
String *swigtype = SwigType_manglestr(Getattr(n, "type"));
|
||||
String *tm = 0;
|
||||
String *access_mem = NewString("");
|
||||
SwigType *ctype_ptr = NewStringf("p.%s", Getattr(n, "type"));
|
||||
|
||||
Printv(fieldnames_tab, tab4, "\"", symname, "\",\n", NIL);
|
||||
Printv(access_mem, "(ptr)->", name, NIL);
|
||||
if ((SwigType_type(type) == T_USER) && (!is_a_pointer(type))) {
|
||||
Printv(convert_tab, tab4, "fields[i++] = ", NIL);
|
||||
Printv(convert_tab, "_swig_convert_struct_", swigtype,
|
||||
"((", SwigType_str(ctype_ptr, ""), ")&((ptr)->",
|
||||
name, "));\n", NIL);
|
||||
} else if ((tm = Swig_typemap_lookup_new("varout",n,access_mem,0))) {
|
||||
Replaceall(tm,"$result","fields[i++]");
|
||||
Printv(convert_tab, tm, "\n", NIL);
|
||||
} else
|
||||
Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number,
|
||||
"Unsupported member variable type %s (ignored).\n",
|
||||
SwigType_str(type,0));
|
||||
|
||||
Delete(access_mem);
|
||||
}
|
||||
return SWIG_OK;
|
||||
}
|
||||
|
||||
|
||||
/* ------------------------------------------------------------
|
||||
* validIdentifer()
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue