jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Restored mzscheme

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@793 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Dave Beazley 2000-09-01 20:55:59 +00:00
commit 1117988e39
3 changed files with 253 additions and 233 deletions
Download patch file Download diff file Expand all files Collapse all files

5
SWIG/Source/Modules1.1/Makefile.in
View file

@ -13,8 +13,9 @@ AR = @AR@
RANLIB = @RANLIB@ RANLIB = @RANLIB@
TARGET = libmodules11.a TARGET = libmodules11.a
OBJS = swigmain.o tcl8.o python.o perl5.o guile.o ruby.o #java.o mzscheme.o OBJS = swigmain.o tcl8.o python.o perl5.o guile.o ruby.o mzscheme.o #java.o
SRCS = swigmain.cxx tcl8.cxx python.cxx perl5.cxx guile.cxx #java.cxx mzscheme.cxx ruby.cxx SRCS = swigmain.cxx tcl8.cxx python.cxx perl5.cxx guile.cxx ruby.cxx mzscheme.cxx #java.cxx
INCLUDE = -I$(srcdir)/../Include \ INCLUDE = -I$(srcdir)/../Include \
-I$(srcdir)/../SWIG1.1 \ -I$(srcdir)/../SWIG1.1 \
-I$(srcdir)/../DOH/Include \ -I$(srcdir)/../DOH/Include \

477
SWIG/Source/Modules1.1/mzscheme.cxx
View file

@ -29,17 +29,16 @@ static char cvsroot[] = "$Header$";
static char *mzscheme_usage = (char*)"\ static char *mzscheme_usage = (char*)"\
\n\ \n\
Mzscheme Options (available with -mzscheme)\n\ Mzscheme Options (available with -mzscheme)\n\
-help - Print this help\n\ -help - Print this help\n\
-module name - Set base name of module (not implemented) \n\ -module name - Set base name of module (not implemented) \n\
-prefix name - Set a prefix to be appended to all name\n\ -prefix name - Set a prefix to be appended to all name\n\
\n" \n"
; ;
static char *mzscheme_path = (char*)"mzscheme"; static char *prefix=0;
static char *prefix = 0; static char *module=0;
static char *module = 0; static char *mzscheme_path=(char*)"mzscheme";
static String *init_func_def = 0;
static DOHString *init_func_def = 0;
// --------------------------------------------------------------------- // ---------------------------------------------------------------------
// MZSCHEME::parse_args(int argc, char *argv[]) // MZSCHEME::parse_args(int argc, char *argv[])
@ -59,7 +58,7 @@ MZSCHEME::parse_args (int argc, char *argv[])
if (argv[i]) { if (argv[i]) {
if (strcmp (argv[i], "-help") == 0) { if (strcmp (argv[i], "-help") == 0) {
fputs (mzscheme_usage, stderr); fputs (mzscheme_usage, stderr);
SWIG_exit (EXIT_SUCCESS); SWIG_exit (0);
} }
else if (strcmp (argv[i], "-prefix") == 0) { else if (strcmp (argv[i], "-prefix") == 0) {
if (argv[i + 1]) { if (argv[i + 1]) {
@ -74,7 +73,7 @@ MZSCHEME::parse_args (int argc, char *argv[])
} }
else if (strcmp (argv[i], "-module") == 0) { else if (strcmp (argv[i], "-module") == 0) {
if (argv[i + 1]) { if (argv[i + 1]) {
set_module (argv[i + 1], 0); set_module (argv[i + 1]);
Swig_mark_arg (i); Swig_mark_arg (i);
Swig_mark_arg (i + 1); Swig_mark_arg (i + 1);
++i; ++i;
@ -113,6 +112,7 @@ MZSCHEME::parse_args (int argc, char *argv[])
void void
MZSCHEME::parse () MZSCHEME::parse ()
{ {
init_func_def = NewString("");
printf ("Generating wrappers for Mzscheme\n"); printf ("Generating wrappers for Mzscheme\n");
init_func_def = NewString(""); init_func_def = NewString("");
@ -137,7 +137,7 @@ MZSCHEME::parse ()
//---------------------------------------------------------------------- //----------------------------------------------------------------------
void void
MZSCHEME::set_module (char *mod_name, char **) MZSCHEME::set_module (char *mod_name)
{ {
if (module) { if (module) {
printf ("module already set (%s), returning\n", module); printf ("module already set (%s), returning\n", module);
@ -160,7 +160,7 @@ void
MZSCHEME::set_init (char *iname) MZSCHEME::set_init (char *iname)
{ {
abort (); // for now -ttn abort (); // for now -ttn
set_module (iname, 0); set_module (iname);
} }
// --------------------------------------------------------------------- // ---------------------------------------------------------------------
@ -185,7 +185,7 @@ MZSCHEME::headers (void)
if (Swig_insert_file ("mzscheme.swg", f_header) == -1) { if (Swig_insert_file ("mzscheme.swg", f_header) == -1) {
Printf (stderr, "SWIG : Fatal error. "); Printf (stderr, "SWIG : Fatal error. ");
Printf (stderr, "Unable to locate 'mzscheme.swg' in SWIG library.\n"); Printf (stderr, "Unable to locate 'mzscheme.swg' in SWIG library.\n");
SWIG_exit (EXIT_FAILURE); SWIG_exit (1);
} }
} }
} }
@ -213,9 +213,8 @@ void
MZSCHEME::close (void) MZSCHEME::close (void)
{ {
Printf (f_init, "}\n\n"); Printf (f_init, "}\n\n");
Printf(f_init, "Scheme_Object *scheme_reload(Scheme_Env *env) {\n"); Printf(f_init, "Scheme_Object *scheme_reload(Scheme_Env *env) {\n");
Printf(f_init, "%s\n", init_func_def); Printf(f_init, "%s\n", Char(init_func_def));
Printf (f_init, "\treturn scheme_void;\n}\n"); Printf (f_init, "\treturn scheme_void;\n}\n");
Printf(f_init, "Scheme_Object *scheme_initialize(Scheme_Env *env) {\n"); Printf(f_init, "Scheme_Object *scheme_initialize(Scheme_Env *env) {\n");
Printf(f_init, "\treturn scheme_reload(env);\n"); Printf(f_init, "\treturn scheme_reload(env);\n");
@ -223,7 +222,7 @@ MZSCHEME::close (void)
} }
// ---------------------------------------------------------------------- // ----------------------------------------------------------------------
// MZSCHEME::get_pointer(int parm, DataType *t) // MZSCHEME::get_pointer(int parm, SwigType *t, Wrapper *f)
// //
// Emits code to get a pointer from a parameter and do type checking. // Emits code to get a pointer from a parameter and do type checking.
// parm is the parameter number. This function is only used // parm is the parameter number. This function is only used
@ -231,154 +230,154 @@ MZSCHEME::close (void)
// ---------------------------------------------------------------------- // ----------------------------------------------------------------------
void void
MZSCHEME::get_pointer (DOHString_or_char *name, int parm, DataType *t, MZSCHEME::get_pointer (String *name, int parm, SwigType *t, Wrapper *f)
Wrapper *f)
{ {
Printf(f->code," if (!swig_get_c_pointer(argv[%d],\"%s\", (void **) &_arg%d))\n", parm, DataType_manglestr(t), parm); char p[256];
Printf(f->code," scheme_wrong_type(\"%s\", \"%s\", %d, argc, argv);\n", name, DataType_manglestr(t), parm); sprintf(p, "%d", parm);
Printv(f->code, tab4, "if (!swig_get_c_pointer(argv[", p, "], \"", SwigType_manglestr(t),
"\", (void **) &arg", p, "))\n",0);
Printv(f->code, tab8, "scheme_wrong_type(\"", name,
"\", \"", SwigType_manglestr(t), "\", ", p, ", argc, argv);\n",0);
} }
// ---------------------------------------------------------------------- // ----------------------------------------------------------------------
// MZSCHEME::create_function(char *name, char *iname, DataType *d, // MZSCHEME::create_function(char *name, char *iname, SwigType *d,
// ParmList *l) // ParmList *l)
// //
// Create a function declaration and register it with the interpreter. // Create a function declaration and register it with the interpreter.
// ---------------------------------------------------------------------- // ----------------------------------------------------------------------
static void static void
mreplace (DOHString *s, DOHString_or_char *argnum, DOHString_or_char *arg, DOHString_or_char *proc_name) mreplace (String *s, String *argnum, String *arg, String *proc_name)
{ {
Replace(s,"$argnum", argnum, DOH_REPLACE_ANY); Replace(s, "$argnum", argnum, DOH_REPLACE_ANY);
Replace(s,"$arg", arg, DOH_REPLACE_ANY); Replace(s, "$arg", arg, DOH_REPLACE_ANY);
Replace(s,"$name", proc_name, DOH_REPLACE_ANY); Replace(s, "$name", proc_name, DOH_REPLACE_ANY);
} }
static void static void
throw_unhandled_mzscheme_type_error (DataType *d) throw_unhandled_mzscheme_type_error (SwigType *d)
{ {
fflush (stdout); fflush (stdout);
Printf (stderr, "ERROR: Unhandled MZSCHEME type error.\n"); fprintf (stderr, "ERROR: Unhandled MZSCHEME type error.\n");
Printf (stderr, " type %d\n", DataType_Gettypecode(d)); fprintf (stderr, "str: %s\n", Char(SwigType_str(d,0)));
Printf (stderr, " name %s\n", DataType_Getname(d)); fprintf (stderr, "lstr: %s\n", Char(SwigType_lstr(d,0)));
Printf (stderr, " is_pointer %d\n", DataType_is_pointer(d)); fprintf (stderr, "manglestr: %s\n", Char(SwigType_manglestr(d)));
/* Printf (stderr, "implicit_ptr %d\n", d->implicit_ptr); */
Printf (stderr, "is_reference %d\n", DataType_is_reference(d));
/* Printf (stderr, " status %d\n", d->status); */
/* Printf (stderr, " qualifier %s\n", (d->qualifier ? d->qualifier : ""));
Printf (stderr, " arraystr %s\n", (d->arraystr ? d->arraystr : "")); */
/* Printf (stderr, " id %d\n", d->id); */
Printf (stderr, "\n\nBAILING...\n"); // for now -ttn Printf (stderr, "\n\nBAILING...\n"); // for now -ttn
abort(); // for now -ttn abort(); // for now -ttn
} }
void void
MZSCHEME::create_function (char *name, char *iname, DataType *d, ParmList *l) MZSCHEME::create_function (char *name, char *iname, SwigType *d, ParmList *l)
{ {
char source[256], target[256], argnum[256], arg[256];
char *tm;
Wrapper *f;
DOHString *cleanup = 0;
DOHString *proc_name = 0;
Parm *p; Parm *p;
Wrapper *f = NewWrapper();
DOHString *outarg = 0; String *proc_name = NewString("");
String *source = NewString("");
String *target = NewString("");
String *argnum = NewString("");
String *arg = NewString("");
String *cleanup = NewString("");
String *outarg = NewString("");
String *build = NewString("");
SwigType *t;
char *tm;
int need_len = 0;
int need_tempc = 0;
int have_build = 0;
int argout_set = 0; int argout_set = 0;
int i = 0;
f = NewWrapper();
outarg = NewString("");
cleanup = NewString("");
// Make a wrapper name for this // Make a wrapper name for this
char * wname = Swig_name_wrapper (iname); char *wname = Char(Swig_name_wrapper(iname));
// Build the name for Scheme. // Build the name for Scheme.
proc_name = NewString(iname); Printv(proc_name, iname,0);
Replace(proc_name,"_","-",DOH_REPLACE_ANY); Replace(proc_name, "_", "-", DOH_REPLACE_ANY);
// writing the function wrapper function // writing the function wrapper function
Printv(f->def, Printv(f->def, "static Scheme_Object *", wname, " (", 0);
"static Scheme_Object *", wname, " (", Printv(f->def, "int argc, Scheme_Object **argv", 0);
"int argc, Scheme_Object **argv", Printv(f->def, ")\n{", 0);
")\n{",
0);
// Declare return variable and arguments // Declare return variable and arguments
// number of parameters // number of parameters
// they are called _arg0, _arg1, ... // they are called arg0, arg1, ...
// the return value is called _result // the return value is called result
int pcount = emit_args (d, l, f); int pcount = emit_args(d, l, f);
int numargs = 0; int numargs = 0;
int numopt = 0;
// adds local variables
// adds local variables : type name Wrapper_add_local(f, "_tempc", "char *_tempc");
Wrapper_add_local (f,"_tempc","char *_tempc"); Wrapper_add_local(f, "_len", "int _len");
Wrapper_add_local (f,"_len", "int _len"); Wrapper_add_local(f, "swig_result", "Scheme_Object *swig_result");
Wrapper_add_local (f,"swig_result", "Scheme_Object *swig_result");
// Now write code to extract the parameters (this is super ugly) // Now write code to extract the parameters (this is super ugly)
int i = 0; for(p = l; p; p = Getnext(p)) {
p = l;
for (i = 0; i < pcount; ++i, p = Getnext(p)) {
DataType *pt = Gettype(p);
char *pn = Getname(p);
// Produce names of source and target // Produce names of source and target
Clear(source);
sprintf(source,"argv[%d]",i); Clear(target);
sprintf(target,"%s", Getlname(p)); Clear(argnum);
sprintf(argnum,"%d",i); Clear(arg);
strcpy(arg,pn); Printf(source, "argv[%d]", i);
Printf(target, "arg%d", i);
Printf(argnum, "%d", i);
Printv(arg, Getname(p),0);
// Handle parameter types. // Handle parameter types.
if (Getignore(p)) if (Getignore(p))
Printv(f->code, "/* ", pn, " ignored... */\n", 0); Printv(f->code, "/* ", Char(Getname(p)), " ignored... */\n", 0);
else { else {
++numargs; ++numargs;
if ((tm = typemap_lookup ((char*)"in", typemap_lang, if ((tm = Swig_typemap_lookup ((char*)"in",
pt, pn, source, target, f))) { Gettype(p), Getname(p), source, target, f))) {
Printv(f->code, tm, "\n", 0); Printv(f->code, tm, "\n", 0);
mreplace (f->code, argnum, arg, proc_name); mreplace (f->code, argnum, arg, proc_name);
} }
// no typemap found // no typemap found
// assume it's a Scheme_Object containing the C pointer // check if typedef and resolve
else if (DataType_is_pointer(pt)) { else if (SwigType_istypedef(Gettype(p))) {
get_pointer (proc_name, i, pt, f); t = SwigType_typedef_resolve(Gettype(p));
// if a pointer then get it
if (SwigType_ispointer(t)) {
get_pointer (proc_name, i, t, f);
}
// not a pointer
else throw_unhandled_mzscheme_type_error (Gettype(p));
} }
// no typemap found and not a pointer
else throw_unhandled_mzscheme_type_error (pt);
} }
// Check if there are any constraints. // Check if there are any constraints.
if ((tm = typemap_lookup ((char*)"check", typemap_lang, if ((tm = Swig_typemap_lookup ((char*)"check",
pt, pn, source, target, f))) { Gettype(p), Getname(p), source, target, f))) {
// Yep. Use it instead of the default // Yep. Use it instead of the default
Printv(f->code,tm,"\n", 0); Printv(f->code, tm, "\n", 0);
mreplace (f->code, argnum, arg, proc_name); mreplace (f->code, argnum, arg, proc_name);
} }
// Pass output arguments back to the caller. // Pass output arguments back to the caller.
if ((tm = typemap_lookup ((char*)"argout", typemap_lang, if ((tm = Swig_typemap_lookup ((char*)"argout",
pt, pn, source, target, f))) { Gettype(p), Getname(p), source, target, f))) {
// Yep. Use it instead of the default // Yep. Use it instead of the default
Printv(outarg, tm, "\n", 0); Printv(outarg, tm, "\n",0);
mreplace (outarg, argnum, arg, proc_name); mreplace (outarg, argnum, arg, proc_name);
argout_set = 1; argout_set = 1;
} }
// Free up any memory allocated for the arguments. // Free up any memory allocated for the arguments.
if ((tm = typemap_lookup ((char*)"freearg", typemap_lang, if ((tm = Swig_typemap_lookup ((char*)"freearg",
pt, pn, source, target, f))) { Gettype(p), Getname(p), source, target, f))) {
// Yep. Use it instead of the default // Yep. Use it instead of the default
Printv(cleanup, tm, "\n", 0); Printv(cleanup, tm, "\n",0);
mreplace (cleanup, argnum, arg, proc_name); mreplace (cleanup, argnum, arg, proc_name);
} }
i++;
} }
// Now write code to make the function call // Now write code to make the function call
@ -387,97 +386,97 @@ MZSCHEME::create_function (char *name, char *iname, DataType *d, ParmList *l)
// Now have return value, figure out what to do with it. // Now have return value, figure out what to do with it.
if (DataType_type(d) == T_VOID) { if (SwigType_type(d) == T_VOID) {
if(!argout_set) if(!argout_set)
Printv(f->code, tab4, "swig_result = scheme_void;\n", 0); Printv(f->code, tab4, "swig_result = scheme_void;\n",0);
} }
else if ((tm = typemap_lookup ((char*)"out", typemap_lang, else if ((tm = Swig_typemap_lookup ((char*)"out",
d, name, (char*)"result", (char*)"swig_result", f))) { d, name, (char*)"result", (char*)"swig_result", f))) {
Printv(f->code, tm, "\n", 0); Printv(f->code, tm, "\n",0);
mreplace (f->code, argnum, arg, proc_name); mreplace (f->code, argnum, arg, proc_name);
} }
// no typemap found and not void then create a Scheme_Object holding // no typemap found and not void then create a Scheme_Object holding
// the C pointer and return it // the C pointer and return it
else if (DataType_is_pointer(d)) { else if (SwigType_ispointer(d)) {
Printv(f->code, Printv(f->code, tab4,
tab4,
"swig_result = swig_make_c_pointer(", "swig_result = swig_make_c_pointer(",
"result, \"", "result, \"",
DataType_manglestr(d), SwigType_manglestr(d),
"\");\n", "\");\n", 0);
0);
} }
else { else {
throw_unhandled_mzscheme_type_error (d); throw_unhandled_mzscheme_type_error (d);
} }
// Dump the argument output code // Dump the argument output code
Printv(f->code, outarg,0); Printv(f->code, Char(outarg),0);
// Dump the argument cleanup code // Dump the argument cleanup code
Printv(f->code, cleanup, 0); Printv(f->code, Char(cleanup),0);
// Look for any remaining cleanup // Look for any remaining cleanup
if (NewObject) { if (NewObject) {
if ((tm = typemap_lookup ((char*)"newfree", typemap_lang, if ((tm = Swig_typemap_lookup ((char*)"newfree",
d, iname, (char*)"result", (char*)"", f))) { d, iname, (char*)"result", (char*)"", f))) {
Printv(f->code,tm,"\n",0); Printv(f->code, tm, "\n",0);
mreplace (f->code, argnum, arg, proc_name); mreplace (f->code, argnum, arg, proc_name);
} }
} }
// Free any memory allocated by the function being wrapped.. // Free any memory allocated by the function being wrapped..
if ((tm = typemap_lookup ((char*)"ret", typemap_lang, if ((tm = Swig_typemap_lookup ((char*)"ret",
d, name, (char*)"result", (char*)"", f))) { d, name, (char*)"result", (char*)"", f))) {
// Yep. Use it instead of the default // Yep. Use it instead of the default
Printv(f->code,tm,"\n",0); Printv(f->code, tm, "\n",0);
mreplace (f->code, argnum, arg, proc_name); mreplace (f->code, argnum, arg, proc_name);
} }
// returning multiple values // returning multiple values
if(argout_set) { if(argout_set) {
if(DataType_type(d) == T_VOID) { if(SwigType_type(d) == T_VOID) {
Wrapper_add_local(f,"_lenv","int _lenv = 0"); Wrapper_add_local(f, "_lenv", "int _lenv = 0");
Wrapper_add_local(f,"_values", "Scheme_Object * _values[MAXVALUES]"); Wrapper_add_local(f, "values", "Scheme_Object *values[MAXVALUES]");
Printv(f->code, tab4, "swig_result = scheme_values(_lenv, _values);\n", 0); Printv(f->code, tab4, "swig_result = scheme_values(_lenv, _values);\n",0);
} }
else { else {
Wrapper_add_local(f,"_lenv","int _lenv = 1"); Wrapper_add_local(f, "_lenv", "int _lenv = 1");
Wrapper_add_local(f,"_values", "Scheme_Object * _values[MAXVALUES]"); Wrapper_add_local(f, "values", "Scheme_Object *values[MAXVALUES]");
Printv(f->code, tab4, "_values[0] = swig_result;\n", 0); Printv(f->code, tab4, "_values[0] = swig_result;\n",0);
Printv(f->code, tab4, "swig_result = scheme_values(_lenv, _values);\n", 0); Printv(f->code, tab4, "swig_result = scheme_values(_lenv, _values);\n",0);
} }
} }
// Wrap things up (in a manner of speaking) // Wrap things up (in a manner of speaking)
Printv(f->code, tab4, "return swig_result;\n", "}\n", 0); Printv(f->code, tab4, "return swig_result;\n",0);
Printv(f->code, "}\n",0);
Wrapper_print(f,f_wrappers); Wrapper_print(f, f_wrappers);
// Now register the function // Now register the function
/* Printv(init_func_def, char temp[256];
"scheme_add_global(\"", proc_name, sprintf(temp, "%d", numargs);
Printv(init_func_def, "scheme_add_global(\"", proc_name,
"\", scheme_make_prim_w_arity(", wname, "\", scheme_make_prim_w_arity(", wname,
", \"", proc_name, "\", ", numargs, ", ", numargs, ", \"", proc_name, "\", ", temp, ", ", temp,
"), env);\n", "), env);\n",0);
0);
*/
Printf(init_func_def,"scheme_add_global(\"%s\", scheme_make_prim_w_arity(%s, \"%s\", %d, %d), env);\n",
proc_name, wname, proc_name, numargs, numargs);
Delete(proc_name); Delete(proc_name);
Delete(source);
Delete(target);
Delete(argnum);
Delete(arg);
Delete(outarg); Delete(outarg);
Delete(cleanup); Delete(cleanup);
Delete(build);
DelWrapper(f); DelWrapper(f);
} }
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// MZSCHEME::link_variable(char *name, char *iname, DataType *d) // MZSCHEME::link_variable(char *name, char *iname, SwigType *d)
// //
// Create a link to a C variable. // Create a link to a C variable.
// This creates a single function _wrap_swig_var_varname(). // This creates a single function _wrap_swig_var_varname().
@ -488,27 +487,28 @@ MZSCHEME::create_function (char *name, char *iname, DataType *d, ParmList *l)
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
void void
MZSCHEME::link_variable (char *name, char *iname, DataType *t) MZSCHEME::link_variable (char *name, char *iname, SwigType *t)
{ {
DOHString *proc_name; String *proc_name = NewString("");
char var_name[256]; char var_name[256];
char *tm; char *tm;
char *argnum = "0"; String *tm2 = NewString("");;
char *arg = "argv[0]"; String *argnum = NewString("0");
String *arg = NewString("argv[0]");
// evaluation function names // evaluation function names
sprintf (var_name, "_wrap_%svar_%s", prefix, iname); sprintf (var_name, "_wrap_%svar_%s", prefix, iname);
// Build the name for scheme. // Build the name for scheme.
proc_name = NewString(iname); Printv(proc_name, iname,0);
Replace(proc_name,"_","-",DOH_REPLACE_ANY); Replace(proc_name, "_", "-", DOH_REPLACE_ANY);
if (DataType_type(t) != T_USER) { if ((SwigType_type(t) != T_USER) || (SwigType_ispointer(t))) {
Printf (f_wrappers, "static Scheme_Object *%s(int argc, Scheme_Object** argv) {\n", var_name); Printf (f_wrappers, "static Scheme_Object *%s(int argc, Scheme_Object** argv) {\n", var_name);
if ((DataType_type(t) == T_CHAR) || (DataType_type(t) == T_POINTER) || (DataType_type(t) == T_ARRAY) || (DataType_type(t) == T_REFERENCE)) { if ((SwigType_type(t) == T_CHAR) || (SwigType_ispointer(t))){
Printf (f_wrappers, "\t char *_temp, _ptemp[128];\n"); Printf (f_wrappers, "\t char *_temp, _ptemp[128];\n");
Printf (f_wrappers, "\t int _len;\n"); Printf (f_wrappers, "\t int _len;\n");
} }
@ -520,35 +520,34 @@ MZSCHEME::link_variable (char *name, char *iname, DataType *t)
// Yup. Extract the type from argv[0] and set variable value // Yup. Extract the type from argv[0] and set variable value
// if (Status & STAT_READONLY) { // if (Status & STAT_READONLY) {
// Printf (f_wrappers, "\t\t GSWIG_ASSERT(0,\"Unable to set %s. " // Printf (f_wrappers, "\t\t GSWIG_ASSERT(0,\"Unable to set %s. "
// "Variable is read only.\", argv[0]);\n", iname); // "Variable is read only.\", argv[0]);\n", iname);
// } // }
if (Status & STAT_READONLY) { if (Status & STAT_READONLY) {
Printf (f_wrappers, "\t\t scheme_signal_error(\"Unable to set %s. " Printf (f_wrappers, "\t\t scheme_signal_error(\"Unable to set %s. "
"Variable is read only.\");\n", iname); "Variable is read only.\");\n", iname);
} }
else if ((tm = typemap_lookup ((char*)"varin", typemap_lang, else if ((tm = Swig_typemap_lookup ((char*)"varin",
t, name, (char*)"argv[0]", name))) { t, name, (char*)"argv[0]", name,0))) {
DOHString *tm2 = NewString(tm); Printv(tm2, tm,0);
mreplace(tm2, argnum, arg, proc_name); mreplace(tm2, argnum, arg, proc_name);
Printf(f_wrappers, "%s\n", tm2); Printv(f_wrappers, tm2, "\n",0);
Delete(tm2);
} }
else if (DataType_is_pointer(t)) { else if (SwigType_ispointer(t)) {
if (DataType_type(t) == T_STRING) { if ((SwigType_type(t) == T_CHAR) && (SwigType_ispointer(t) == 1)) {
Printf (f_wrappers, "\t\t _temp = SCHEME_STR_VAL(argv[0]);\n"); Printf (f_wrappers, "\t\t _temp = SCHEME_STR_VAL(argv[0]);\n");
Printf (f_wrappers, "\t\t _len = SCHEME_STRLEN_VAL(argv[0]);\n"); Printf (f_wrappers, "\t\t _len = SCHEME_STRLEN_VAL(argv[0]);\n");
Printf (f_wrappers, "\t\t if (%s) { free(%s);}\n", name, name); Printf (f_wrappers, "\t\t if (%s) { free(%s);}\n", name, name);
Printf (f_wrappers, "\t\t %s = (char *) " Printf (f_wrappers, "\t\t %s = (char *) "
"malloc((_len+1)*sizeof(char));\n", name); "malloc((_len+1)*sizeof(char));\n", name);
Printf (f_wrappers, "\t\t strncpy(%s,_temp,_len);\n", name); Printf (f_wrappers, "\t\t strncpy(%s,_temp,_len);\n", name);
} else { } else {
// Set the value of a pointer // Set the value of a pointer
Printf(f_wrappers, "\t\tif (!swig_get_c_pointer(argv[0], \"%s\", (void **) &_arg0))\n", Printf(f_wrappers, "\t\tif (!swig_get_c_pointer(argv[0], \"%s\", (void **) &arg0))\n",
DataType_manglestr(t)); SwigType_manglestr(t));
Printf(f_wrappers, "\t\t\tscheme_wrong_type(\"%s\", %s, 0, argc, argv", \ Printf(f_wrappers, "\t\t\tscheme_wrong_type(\"%s\", %s, 0, argc, argv", \
var_name, DataType_manglestr(t)); var_name, SwigType_manglestr(t));
} }
} }
else { else {
@ -559,17 +558,17 @@ MZSCHEME::link_variable (char *name, char *iname, DataType *t)
// Now return the value of the variable (regardless // Now return the value of the variable (regardless
// of evaluating or setting) // of evaluating or setting)
if ((tm = typemap_lookup ((char*)"varout", typemap_lang, if ((tm = Swig_typemap_lookup ((char*)"varout",
t, name, name, (char*)"swig_result"))) { t, name, name, (char*)"swig_result",0))) {
Printf (f_wrappers, "%s\n", tm); Printf (f_wrappers, "%s\n", tm);
} }
else if (DataType_is_pointer(t)) { else if (SwigType_ispointer(t)) {
if (DataType_type(t) == T_STRING) { if ((SwigType_type(t) == T_CHAR) && (SwigType_ispointer(t) == 1)) {
Printf (f_wrappers, "\t swig_result = scheme_make_string(%s);\n", name); Printf (f_wrappers, "\t swig_result = scheme_make_string(%s);\n", name);
} else { } else {
// Is an ordinary pointer type. // Is an ordinary pointer type.
Printf(f_wrappers, "\tswig_result = swig_make_c_pointer(%s, \"%s\");\n", Printf(f_wrappers, "\tswig_result = swig_make_c_pointer(%s, \"%s\");\n",
name, DataType_manglestr(t)); name, SwigType_manglestr(t));
} }
} }
else { else {
@ -581,33 +580,44 @@ MZSCHEME::link_variable (char *name, char *iname, DataType *t)
// Now add symbol to the MzScheme interpreter // Now add symbol to the MzScheme interpreter
Printv(init_func_def, Printv(init_func_def,
"scheme_add_global(\"", proc_name, "scheme_add_global(\"",
"\", scheme_make_prim_w_arity(", var_name, proc_name,
", \"", proc_name, "\", 0, 1), env);\n", "\", scheme_make_prim_w_arity(",
0); var_name,
", \"",
proc_name,
"\", ",
"0",
", ",
"1",
"), env);\n",0);
} else { } else {
Printf (stderr, "%s : Line %d. ** Warning. Unable to link with " Printf (stderr, "%s : Line %d. ** Warning. Unable to link with "
" type %s (ignored).\n", " type %s (ignored).\n",
input_file, line_number, DataType_str(t,0)); input_file, line_number, SwigType_manglestr(t));
} }
Delete(proc_name); Delete(proc_name);
Delete(argnum);
Delete(arg);
Delete(tm2);
} }
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// MZSCHEME::declare_const(char *name, char *iname, DataType *type, char *value) // MZSCHEME::declare_const(char *name, char *iname, SwigType *type, char *value)
// //
// Makes a constant. Not sure how this is really supposed to work. // Makes a constant. Not sure how this is really supposed to work.
// I'm going to fake out SWIG and create a variable instead. // I'm going to fake out SWIG and create a variable instead.
// ------------------------------------------------------------------------ // ------------------------------------------------------------------------
void void
MZSCHEME::declare_const (char *name, char *, DataType *type, char *value) MZSCHEME::declare_const (char *name, char *, SwigType *type, char *value)
{ {
int OldStatus = Status; // Save old status flags int OldStatus = Status; // Save old status flags
DOHString *proc_name;
char var_name[256]; char var_name[256];
DOHString *rvalue; String *proc_name = NewString("");
String *rvalue = NewString("");
String *temp = NewString("");
char *tm; char *tm;
Status = STAT_READONLY; // Enable readonly mode. Status = STAT_READONLY; // Enable readonly mode.
@ -617,33 +627,38 @@ MZSCHEME::declare_const (char *name, char *, DataType *type, char *value)
sprintf (var_name, "_wrap_const_%s", name); sprintf (var_name, "_wrap_const_%s", name);
// Build the name for scheme. // Build the name for scheme.
proc_name = NewString(name); Printv(proc_name, name,0);
Replace(proc_name,"_","-",DOH_REPLACE_ANY); Replace(proc_name, "_", "-", DOH_REPLACE_ANY);
if (DataType_type(type) == T_USER) { if ((SwigType_type(type) == T_USER) && (!SwigType_ispointer(type))) {
Printf (stderr, "%s : Line %d. Unsupported constant value.\n", fprintf (stderr, "%s : Line %d. Unsupported constant value.\n",
input_file, line_number); input_file, line_number);
return; return;
} }
// See if there's a typemap // See if there's a typemap
rvalue = NewString(value);
if (DataType_type(type) == T_STRING) { Printv(rvalue, value,0);
rvalue = NewStringf("\"%s\"", value); if ((SwigType_type(type) == T_CHAR) && (SwigType_ispointer(type) == 1)) {
} else if (DataType_type(type) == T_CHAR) { temp = Copy(rvalue);
rvalue = NewStringf("\'%s\'", value); Clear(rvalue);
} else { Printv(rvalue, "\"", temp, "\"",0);
rvalue = NewString(value);
} }
if ((tm = typemap_lookup ((char*)"const", typemap_lang, type, name, if ((SwigType_type(type) == T_CHAR) && (SwigType_ispointer(type) == 0)) {
Char(rvalue), name))) { Delete(temp);
temp = Copy(rvalue);
Clear(rvalue);
Printv(rvalue, "'", temp, "'",0);
}
if ((tm = Swig_typemap_lookup ((char*)"const", type, name,
rvalue, name,0))) {
// Yep. Use it instead of the default // Yep. Use it instead of the default
Printf (f_init, "%s\n", tm); Printf (f_init, "%s\n", tm);
} else { } else {
// Create variable and assign it a value // Create variable and assign it a value
Printf (f_header, "static %s %s = ", DataType_lstr(type,0), var_name); Printf (f_header, "static %s %s = ", SwigType_str(type,0), var_name);
if ((DataType_type(type) == T_CHAR) || (DataType_type(type) == T_STRING)) { if ((SwigType_type(type) == T_CHAR) && (SwigType_ispointer(type) <= 1)) {
Printf (f_header, "\"%s\";\n", value); Printf (f_header, "\"%s\";\n", value);
} else { } else {
Printf (f_header, "%s;\n", value); Printf (f_header, "%s;\n", value);
@ -654,33 +669,37 @@ MZSCHEME::declare_const (char *name, char *, DataType *type, char *value)
link_variable (var_name, name, type); link_variable (var_name, name, type);
Status = OldStatus; Status = OldStatus;
} }
Delete(proc_name);
Delete(rvalue);
Delete(temp);
} }
// ---------------------------------------------------------------------- // ----------------------------------------------------------------------
// MZSCHEME::usage_var(char *iname, DataType *t, String &usage) // MZSCHEME::usage_var(char *iname, SwigType *t, String &usage)
// //
// Produces a usage string for a MzScheme variable. // Produces a usage string for a MzScheme variable.
// ---------------------------------------------------------------------- // ----------------------------------------------------------------------
void void
MZSCHEME::usage_var (char *iname, DataType *t, DOHString *usage) MZSCHEME::usage_var (char *iname, SwigType *t, String *usage)
{ {
Printv(usage, "(", iname, " [value])", 0); // char temp[1024], *c;
if (DataType_type(t) == T_USER) {
Printf(usage," - unsupported"); // usage << "(" << iname << " [value])";
} // if (!((t->type != T_USER) || (t->is_pointer))) {
// usage << " - unsupported";
// }
} }
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
// MZSCHEME::usage_func(char *iname, DataType *t, ParmList *l, String &usage) // MZSCHEME::usage_func(char *iname, SwigType *t, ParmList *l, String &usage)
// //
// Produces a usage string for a function in MzScheme // Produces a usage string for a function in MzScheme
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
void void
MZSCHEME::usage_func (char *iname, DataType *d, ParmList *l, DOHString *usage) MZSCHEME::usage_func (char *iname, SwigType *d, ParmList *l, DOHString *usage)
{ {
Parm *p; Parm *p;
// Print the function name. // Print the function name.
@ -690,44 +709,44 @@ MZSCHEME::usage_func (char *iname, DataType *d, ParmList *l, DOHString *usage)
// Now go through and print parameters // Now go through and print parameters
for (p = l; p != 0; p = Getnext(p)) { for (p = l; p != 0; p = Getnext(p)) {
DataType *pt = Gettype(p); SwigType *pt = Gettype(p);
char *pn = Getname(p); String *pn = Getname(p);
if (Getignore(p)) if (Getignore(p))
continue; continue;
// Print the type. If the parameter has been named, use that as well. // Print the type. If the parameter has been named, use that as well.
if (DataType_type(pt) != T_VOID) { if (SwigType_type(pt) != T_VOID) {
// Print the type. // Print the type.
Printv(usage," <", DataType_Getname(pt), 0); Printv(usage," <", Getname(pt), 0);
if (DataType_is_pointer(pt)) { if (SwigType_ispointer(pt)) {
/* for (int j = 0; j < (pt->is_pointer - pt->implicit_ptr); j++) { */ for (int j = 0; j < SwigType_ispointer(pt); j++) {
for (int j = 0; j < DataType_is_pointer(pt); j++) {
Putc('*', usage); Putc('*', usage);
} }
} }
Putc('>',usage); Putc('>',usage);
// Print the name if it exists. // Print the name if it exists.
if (strlen (pn) > 0) { if (strlen (Char(pn)) > 0) {
Printv(usage," ", pn, 0); Printv(usage," ", pn, 0);
} }
} }
Delete(pn);
} }
Putc(')',usage); Putc(')',usage);
} }
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
// MZSCHEME::usage_returns(char *iname, DataType *t, ParmList *l, String &usage) // MZSCHEME::usage_returns(char *iname, SwigType *t, ParmList *l, String &usage)
// //
// Produces a usage string for a function in MzScheme // Produces a usage string for a function in MzScheme
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
void void
MZSCHEME::usage_returns (char *iname, DataType *d, ParmList *l, DOHString *usage) MZSCHEME::usage_returns (char *iname, SwigType *d, ParmList *l, DOHString *usage)
{ {
Parm *p; Parm *p;
DOHString *param; DOHString *param;
@ -741,37 +760,37 @@ MZSCHEME::usage_returns (char *iname, DataType *d, ParmList *l, DOHString *usage
// go through and see if any are output. // go through and see if any are output.
for (p = l; p != 0; p = Getnext(p)) { for (p = l; p != 0; p = Getnext(p)) {
DataType *pt = Gettype(p); SwigType *pt = Gettype(p);
char *pn = Getname(p); String *pn = Getname(p);
if (strcmp (pn,"BOTH") && strcmp (pn,"OUTPUT")) if (strcmp (Char(pn),"BOTH") && strcmp (Char(pn),"OUTPUT"))
continue; continue;
// Print the type. If the parameter has been named, use that as well. // Print the type. If the parameter has been named, use that as well.
if (DataType_type(pt) != T_VOID) { if (SwigType_type(pt) != T_VOID) {
++have_param; ++have_param;
// Print the type. // Print the type.
Printv(param," $",DataType_Getname(pt), 0); Printv(param," $", Getname(pt), 0);
if (DataType_is_pointer(pt)) { if (SwigType_ispointer(pt)) {
/* for (j = 0; j < (pt->is_pointer - pt->implicit_ptr - 1); j++) {*/ for (j = 0; j < SwigType_ispointer(pt) - 1; j++) {
for (j = 0; j < DataType_is_pointer(pt) - 1; j++) {
Putc('*',param); Putc('*',param);
} }
} }
Printf(param,"# "); Printf(param,"# ");
} }
Delete(pn);
} }
// See if we stick on the function return type. // See if we stick on the function return type.
if (DataType_type(d) != T_VOID || have_param == 0) { if (SwigType_type(d) != T_VOID || have_param == 0) {
++have_param; ++have_param;
if (DataType_type(d) == T_VOID) if (SwigType_type(d) == T_VOID)
Insert(param,0," unspecified"); Insert(param,0," unspecified");
else { else {
Insert(param,0,"# "); Insert(param,0,"# ");
Insert(param,0,DataType_str(d,0)); Insert(param,0,SwigType_str(d,0));
Insert(param,0," $"); Insert(param,0," $");
} }
} }
@ -793,13 +812,13 @@ MZSCHEME::usage_returns (char *iname, DataType *d, ParmList *l, DOHString *usage
// ---------------------------------------------------------------------- // ----------------------------------------------------------------------
// MZSCHEME::usage_const(char *iname, DataType *type, char *value, String &usage) // MZSCHEME::usage_const(char *iname, SwigType *type, char *value, String &usage)
// //
// Produces a usage string for a MzScheme constant // Produces a usage string for a MzScheme constant
// ---------------------------------------------------------------------- // ----------------------------------------------------------------------
void void
MZSCHEME::usage_const (char *iname, DataType *, char *value, DOHString *usage) MZSCHEME::usage_const (char *iname, SwigType *, char *value, DOHString *usage)
{ {
Printv(usage,"(", iname, " ", value, ")", 0); Printv(usage,"(", iname, " ", value, ")", 0);
} }

4
SWIG/Source/Modules1.1/swigmain.cxx
View file

@ -34,8 +34,8 @@ static char cvsroot[] = "$Header$";
#include "guile.h" #include "guile.h"
#ifdef OLD #ifdef OLD
#include "java.h" #include "java.h"
#include "mzscheme.h"
#endif #endif
#include "mzscheme.h"
#include "ruby.h" #include "ruby.h"
#include <ctype.h> #include <ctype.h>
@ -92,10 +92,10 @@ int main(int argc, char **argv) {
} else if (strcmp(argv[i],"-java") == 0) { } else if (strcmp(argv[i],"-java") == 0) {
dl = new JAVA; dl = new JAVA;
Swig_mark_arg(i); Swig_mark_arg(i);
#endif
} else if (strcmp(argv[i],"-mzscheme") == 0) { } else if (strcmp(argv[i],"-mzscheme") == 0) {
dl = new MZSCHEME; dl = new MZSCHEME;
Swig_mark_arg(i); Swig_mark_arg(i);
#endif
} else if (strcmp(argv[i],"-ruby") == 0) { } else if (strcmp(argv[i],"-ruby") == 0) {
dl = new RUBY; dl = new RUBY;
Swig_mark_arg(i); Swig_mark_arg(i);