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

Major reworking of the Wrapper object. It is now a DOH object.

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@948 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Dave Beazley 2000-11-22 23:14:01 +00:00
commit 267beb814f
14 changed files with 717 additions and 653 deletions
Download patch file Download diff file Expand all files Collapse all files

77
SWIG/Source/Modules1.1/guile.cxx
View file

@ -363,18 +363,18 @@ get_pointer (char *iname, int parm, SwigType *t,
{
SwigType_remember(t);
/* Pointers are smobs */
Printf(f->code, " if (SWIG_Guile_GetPtr(s_%d,(void **) &arg%d", parm, parm);
Printf(f, " if (SWIG_Guile_GetPtr(s_%d,(void **) &arg%d", parm, parm);
if (SwigType_type(t) == T_VOID)
Printf(f->code, ", NULL)) {\n");
Printf(f, ", NULL)) {\n");
else
Printv(f->code, ", SWIGTYPE", SwigType_manglestr(t), ")) {\n", 0);
Printv(f, ", SWIGTYPE", SwigType_manglestr(t), ")) {\n", 0);
/* Raise exception */
Printv(f->code,
Printv(f,
tab8,
"scm_wrong_type_arg(\"",proc_name, "\", ",
0);
Printf(f->code,"%d, s_%d);\n", num_scheme_parm, parm);
Printv(f->code, tab4, "}\n", 0);
Printf(f,"%d, s_%d);\n", num_scheme_parm, parm);
Printv(f, tab4, "}\n", 0);
}
/* Return true iff T is a pointer type */
@ -497,7 +497,7 @@ GUILE::function (DOH *node) {
proc_name = NewString(iname);
Replace(proc_name,"_", "-", DOH_REPLACE_ANY);
/* Emit locals etc. into f->code; figure out which args to ignore */
/* Emit locals etc. into f; figure out which args to ignore */
emit_args (node, f);
/* Declare return variable */
@ -509,10 +509,23 @@ GUILE::function (DOH *node) {
0, proc_name, f);
/* Open prototype and signature */
/* <DB> The function prototype must be produced first */
Printv(f, "static SCM\n", wname," (", 0);
for (p = l, i = 0; p; p = Getnext(p), i++) {
if (i != 0) Printf(f,", ");
Printf(f,"SCM s_%d", i);
}
Printf(f,")\n{\n");
Printf(f,"$locals\n");
/* Define the scheme name in C. This define is used by several Guile
macros. */
Printv(f,"#define FUNC_NAME \"", proc_name, "\"\n", 0);
Printv(f->def, "static SCM\n", wname," (", 0);
Printv(signature, "(", proc_name, 0);
/* Now write code to extract the parameters */
for (p = l, i = 0; p; p=Getnext(p), i++) {
@ -528,16 +541,14 @@ GUILE::function (DOH *node) {
// Handle parameter types.
if (Getignore(p))
Printv(f->code, "/* ", pn, " ignored... */\n", 0);
Printv(f, "/* ", pn, " ignored... */\n", 0);
else {
if (numargs!=0) Printf(f->def,", ");
Printf(f->def,"SCM s_%d", i);
if (opt_p) {
numopt++;
Printf(f->code," if (s_%d != GH_NOT_PASSED) {\n", i);
Printf(f," if (s_%d != GH_NOT_PASSED) {\n", i);
}
++numargs;
if (guile_do_typemap(f->code, "in", pt, pn,
if (guile_do_typemap(f, "in", pt, pn,
source, target, numargs, proc_name, f, 0)) {
/* nothing to do */
}
@ -554,12 +565,12 @@ GUILE::function (DOH *node) {
numargs, proc_name, f);
}
if (opt_p)
Printf(f->code," }\n");
Printf(f," }\n");
}
/* Check if there are any constraints. */
guile_do_typemap(f->code, "check", pt, pn,
guile_do_typemap(f, "check", pt, pn,
source, target, numargs, proc_name, f, 0);
/* Pass output arguments back to the caller. */
@ -591,27 +602,23 @@ GUILE::function (DOH *node) {
/* Close prototype and signature */
Printv(signature, ")\n", 0);
Printf(f->def, ")\n{\n");
/* Define the scheme name in C. This define is used by several Guile
macros. */
Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"\n", 0);
// Now write code to make the function call
Printv(f->code, tab4, "gh_defer_ints();\n", 0);
Printv(f, tab4, "gh_defer_ints();\n", 0);
emit_func_call (node, f);
Printv(f->code, tab4, "gh_allow_ints();\n", 0);
Printv(f, tab4, "gh_allow_ints();\n", 0);
// Now have return value, figure out what to do with it.
if (guile_do_typemap(f->code, "out", d, name,
if (guile_do_typemap(f, "out", d, name,
(char*)"result", (char*)"gswig_result",
0, proc_name, f, 0)) {
/* nothing */
}
else if (is_a_pointer(d)) {
SwigType_remember(d);
Printv(f->code, tab4,
Printv(f, tab4,
"gswig_result = SWIG_Guile_MakePtr (",
"result, ",
"SWIGTYPE", SwigType_manglestr(d),
@ -623,33 +630,33 @@ GUILE::function (DOH *node) {
}
// Dump the argument output code
Printv(f->code,outarg,0);
Printv(f,outarg,0);
// Dump the argument cleanup code
Printv(f->code,cleanup,0);
Printv(f,cleanup,0);
// Look for any remaining cleanup
if (NewObject) {
guile_do_typemap(f->code, "newfree", d, iname,
guile_do_typemap(f, "newfree", d, iname,
(char*)"result", (char*)"", 0, proc_name, f, 0);
}
// Free any memory allocated by the function being wrapped..
guile_do_typemap(f->code, "ret", d, name,
guile_do_typemap(f, "ret", d, name,
(char*)"result", (char*)"", 0, proc_name, f, 0);
// Wrap things up (in a manner of speaking)
Printv(f->code, "return gswig_result;\n", 0);
Printv(f, "return gswig_result;\n", 0);
// Undefine the scheme name
Printf(f->code, "#undef FUNC_NAME\n");
Printf(f->code, "}\n");
Printf(f, "#undef FUNC_NAME\n");
Printf(f, "}\n");
Wrapper_print (f, f_wrappers);
Printf(f_wrappers,"%s", f);
if (numargs > 10) {
int i;
@ -722,7 +729,7 @@ GUILE::function (DOH *node) {
Delete(signature);
Delete(returns);
Delete(tmp);
DelWrapper(f);
Delete(f);
delete[] wname;
}
@ -888,7 +895,7 @@ GUILE::variable (DOH *node)
input_file, line_number, SwigType_str(t,0));
}
Delete(proc_name);
DelWrapper(f);
Delete(f);
}
// -----------------------------------------------------------------------
@ -965,7 +972,7 @@ GUILE::constant(DOH *node)
}
Delete(proc_name);
Delete(rvalue);
DelWrapper(f);
Delete(f);
}
void GUILE::cpp_variable(DOH *node)

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

@ -234,9 +234,9 @@ MZSCHEME::get_pointer (String *name, int parm, SwigType *t, Wrapper *f)
{
char p[256];
sprintf(p, "%d", parm);
Printv(f->code, tab4, "if (!swig_get_c_pointer(argv[", p, "], \"", SwigType_manglestr(t),
Printv(f, tab4, "if (!swig_get_c_pointer(argv[", p, "], \"", SwigType_manglestr(t),
"\", (void **) &arg", p, "))\n",0);
Printv(f->code, tab8, "scheme_wrong_type(\"", name,
Printv(f, tab8, "scheme_wrong_type(\"", name,
"\", \"", SwigType_manglestr(t), "\", ", p, ", argc, argv);\n",0);
}
// ----------------------------------------------------------------------
@ -302,9 +302,10 @@ MZSCHEME::function(DOH *node)
Replace(proc_name, "_", "-", DOH_REPLACE_ANY);
// writing the function wrapper function
Printv(f->def, "static Scheme_Object *", wname, " (", 0);
Printv(f->def, "int argc, Scheme_Object **argv", 0);
Printv(f->def, ")\n{", 0);
Printv(f, "static Scheme_Object *", wname, " (", 0);
Printv(f, "int argc, Scheme_Object **argv", 0);
Printv(f, ")\n{\n", 0);
Printf(f, "$locals\n");
// Declare return variable and arguments
// number of parameters
@ -336,13 +337,13 @@ MZSCHEME::function(DOH *node)
// Handle parameter types.
if (Getignore(p))
Printv(f->code, "/* ", Char(Getname(p)), " ignored... */\n", 0);
Printv(f, "/* ", Char(Getname(p)), " ignored... */\n", 0);
else {
++numargs;
if ((tm = Swig_typemap_lookup ((char*)"in",
Gettype(p), Getname(p), source, target, f))) {
Printv(f->code, tm, "\n", 0);
mreplace (f->code, argnum, arg, proc_name);
Printv(f, tm, "\n", 0);
mreplace (f, argnum, arg, proc_name);
}
// no typemap found
// check if typedef and resolve
@ -363,8 +364,8 @@ MZSCHEME::function(DOH *node)
if ((tm = Swig_typemap_lookup ((char*)"check",
Gettype(p), Getname(p), source, target, f))) {
// Yep. Use it instead of the default
Printv(f->code, tm, "\n", 0);
mreplace (f->code, argnum, arg, proc_name);
Printv(f, tm, "\n", 0);
mreplace (f, argnum, arg, proc_name);
}
// Pass output arguments back to the caller.
@ -395,18 +396,18 @@ MZSCHEME::function(DOH *node)
if (SwigType_type(d) == T_VOID) {
if(!argout_set)
Printv(f->code, tab4, "swig_result = scheme_void;\n",0);
Printv(f, tab4, "swig_result = scheme_void;\n",0);
}
else if ((tm = Swig_typemap_lookup ((char*)"out",
d, name, (char*)"result", (char*)"swig_result", f))) {
Printv(f->code, tm, "\n",0);
mreplace (f->code, argnum, arg, proc_name);
Printv(f, tm, "\n",0);
mreplace (f, argnum, arg, proc_name);
}
// no typemap found and not void then create a Scheme_Object holding
// the C pointer and return it
else if (SwigType_ispointer(d)) {
Printv(f->code, tab4,
Printv(f, tab4,
"swig_result = swig_make_c_pointer(",
"result, \"",
SwigType_manglestr(d),
@ -417,18 +418,18 @@ MZSCHEME::function(DOH *node)
}
// Dump the argument output code
Printv(f->code, Char(outarg),0);
Printv(f, Char(outarg),0);
// Dump the argument cleanup code
Printv(f->code, Char(cleanup),0);
Printv(f, Char(cleanup),0);
// Look for any remaining cleanup
if (NewObject) {
if ((tm = Swig_typemap_lookup ((char*)"newfree",
d, iname, (char*)"result", (char*)"", f))) {
Printv(f->code, tm, "\n",0);
mreplace (f->code, argnum, arg, proc_name);
Printv(f, tm, "\n",0);
mreplace (f, argnum, arg, proc_name);
}
}
@ -437,8 +438,8 @@ MZSCHEME::function(DOH *node)
if ((tm = Swig_typemap_lookup ((char*)"ret",
d, name, (char*)"result", (char*)"", f))) {
// Yep. Use it instead of the default
Printv(f->code, tm, "\n",0);
mreplace (f->code, argnum, arg, proc_name);
Printv(f, tm, "\n",0);
mreplace (f, argnum, arg, proc_name);
}
// returning multiple values
@ -446,22 +447,22 @@ MZSCHEME::function(DOH *node)
if(SwigType_type(d) == T_VOID) {
Wrapper_add_local(f, "_lenv", "int _lenv = 0");
Wrapper_add_local(f, "values", "Scheme_Object *values[MAXVALUES]");
Printv(f->code, tab4, "swig_result = scheme_values(_lenv, _values);\n",0);
Printv(f, tab4, "swig_result = scheme_values(_lenv, _values);\n",0);
}
else {
Wrapper_add_local(f, "_lenv", "int _lenv = 1");
Wrapper_add_local(f, "values", "Scheme_Object *values[MAXVALUES]");
Printv(f->code, tab4, "_values[0] = swig_result;\n",0);
Printv(f->code, tab4, "swig_result = scheme_values(_lenv, _values);\n",0);
Printv(f, tab4, "_values[0] = swig_result;\n",0);
Printv(f, tab4, "swig_result = scheme_values(_lenv, _values);\n",0);
}
}
// Wrap things up (in a manner of speaking)
Printv(f->code, tab4, "return swig_result;\n",0);
Printv(f->code, "}\n",0);
Printv(f, tab4, "return swig_result;\n",0);
Printv(f, "}\n",0);
Wrapper_print(f, f_wrappers);
Printf(f_wrappers,"%s", f);
// Now register the function
char temp[256];
@ -479,7 +480,7 @@ MZSCHEME::function(DOH *node)
Delete(outarg);
Delete(cleanup);
Delete(build);
DelWrapper(f);
Delete(f);
}
// -----------------------------------------------------------------------

143
SWIG/Source/Modules1.1/perl5.cxx
View file

@ -521,7 +521,8 @@ PERL5::function(DOH *node)
cleanup = NewString("");
outarg = NewString("");
Printv(f->def, "XS(", Swig_name_wrapper(iname), ") {\n", 0);
Printv(f, "XS(", Swig_name_wrapper(iname), ") {\n", 0);
Printf(f, "$locals\n");
pcount = emit_args(node, f);
numopt = check_numopt(l);
@ -530,8 +531,8 @@ PERL5::function(DOH *node)
/* Check the number of arguments */
Printf(f->code," if ((items < %d) || (items > %d)) \n", pcount-numopt, ParmList_numarg(l));
Printf(f->code," croak(\"Usage: %s\");\n", usage_func(iname,d,l));
Printf(f," if ((items < %d) || (items > %d)) \n", pcount-numopt, ParmList_numarg(l));
Printf(f," croak(\"Usage: %s\");\n", usage_func(iname,d,l));
/* Write code to extract parameters. */
i = 0;
@ -549,12 +550,12 @@ PERL5::function(DOH *node)
if (!Getignore(p)) {
/* Check for optional argument */
if (j>= (pcount-numopt))
Printf(f->code," if (items > %d) {\n", j);
Printf(f," if (items > %d) {\n", j);
if ((tm = Swig_typemap_lookup((char*)"in",pt,pn,source,target,f))) {
Printf(f->code,"%s\n",tm);
Replace(f->code,"$argnum",argnum,DOH_REPLACE_ANY);
Replace(f->code,"$arg",source,DOH_REPLACE_ANY);
Printf(f,"%s\n",tm);
Replace(f,"$argnum",argnum,DOH_REPLACE_ANY);
Replace(f,"$arg",source,DOH_REPLACE_ANY);
} else {
switch(SwigType_type(pt)) {
case T_BOOL:
@ -566,16 +567,16 @@ PERL5::function(DOH *node)
case T_USHORT:
case T_ULONG:
case T_UCHAR:
Printf(f->code," %s = (%s)SvIV(ST(%d));\n", target, SwigType_lstr(pt,0),j);
Printf(f," %s = (%s)SvIV(ST(%d));\n", target, SwigType_lstr(pt,0),j);
break;
case T_CHAR :
Printf(f->code," %s = (char) *SvPV(ST(%d),PL_na);\n", target, j);
Printf(f," %s = (char) *SvPV(ST(%d),PL_na);\n", target, j);
break;
case T_DOUBLE :
case T_FLOAT :
Printf(f->code," %s = (%s)SvNV(ST(%d));\n", target, SwigType_lstr(pt,0), j);
Printf(f," %s = (%s)SvNV(ST(%d));\n", target, SwigType_lstr(pt,0), j);
break;
case T_VOID :
@ -584,18 +585,18 @@ PERL5::function(DOH *node)
case T_USER:
SwigType_add_pointer(pt);
sprintf(temp,"argument %d", i+1);
get_pointer(iname, temp, source, target, pt, f->code, (char *)"XSRETURN(1)");
get_pointer(iname, temp, source, target, pt, f, (char *)"XSRETURN(1)");
SwigType_del_pointer(pt);
break;
case T_STRING:
Printf(f->code," if (! SvOK((SV*) ST(%d))) { %s = 0; }\n", j, target);
Printf(f->code," else { %s = (char *) SvPV(ST(%d),PL_na); }\n", target,j);
Printf(f," if (! SvOK((SV*) ST(%d))) { %s = 0; }\n", j, target);
Printf(f," else { %s = (char *) SvPV(ST(%d),PL_na); }\n", target,j);
break;
case T_POINTER: case T_ARRAY: case T_REFERENCE:
sprintf(temp,"argument %d", i+1);
get_pointer(iname,temp,source,target, pt, f->code, (char*)"XSRETURN(1)");
get_pointer(iname,temp,source,target, pt, f, (char*)"XSRETURN(1)");
break;
default :
@ -606,7 +607,7 @@ PERL5::function(DOH *node)
/* The source is going to be an array of saved values. */
sprintf(temp,"_saved[%d]",num_saved);
if (j>= (pcount-numopt))
Printf(f->code," } \n");
Printf(f," } \n");
j++;
} else {
temp[0] = 0;
@ -614,8 +615,8 @@ PERL5::function(DOH *node)
/* Check if there is any constraint code */
if ((tm = Swig_typemap_lookup((char*)"check",pt,pn,source,target,0))) {
Printf(f->code,"%s\n", tm);
Replace(f->code,"$argnum",argnum, DOH_REPLACE_ANY);
Printf(f,"%s\n", tm);
Replace(f,"$argnum",argnum, DOH_REPLACE_ANY);
}
need_save = 0;
@ -636,7 +637,7 @@ PERL5::function(DOH *node)
/* If we need a saved variable, we need to emit to emit some code for that
This only applies if the argument actually existed (not ignore) */
if ((need_save) && (!Getignore(p))) {
Printv(f->code, tab4, temp, " = ", source, ";\n", 0);
Printv(f, tab4, temp, " = ", source, ";\n", 0);
num_saved++;
}
i++;
@ -653,24 +654,24 @@ PERL5::function(DOH *node)
emit_func_call(node,f);
if ((tm = Swig_typemap_lookup((char*)"out",d,iname,(char*)"result",(char*)"ST(argvi)",0))) {
Printf(f->code, "%s\n", tm);
Printf(f, "%s\n", tm);
} else {
if (SwigType_type(d) != T_VOID) {
Printf(f->code," ST(argvi) = sv_newmortal();\n");
Printf(f," ST(argvi) = sv_newmortal();\n");
switch (SwigType_type(d)) {
case T_INT: case T_BOOL: case T_UINT:
case T_SHORT: case T_USHORT:
case T_LONG : case T_ULONG:
case T_SCHAR: case T_UCHAR :
Printf(f->code," sv_setiv(ST(argvi++),(IV) result);\n");
Printf(f," sv_setiv(ST(argvi++),(IV) result);\n");
break;
case T_DOUBLE :
case T_FLOAT :
Printf(f->code," sv_setnv(ST(argvi++), (double) result);\n");
Printf(f," sv_setnv(ST(argvi++), (double) result);\n");
break;
case T_CHAR :
Wrapper_add_local(f,"_ctemp", "char ctemp[2]");
Printv(f->code,
Printv(f,
tab4, "ctemp[0] = result;\n",
tab4, "ctemp[1] = 0;\n",
tab4, "sv_setpv((SV*)ST(argvi++),ctemp);\n",
@ -680,18 +681,18 @@ PERL5::function(DOH *node)
case T_USER:
SwigType_add_pointer(d);
SwigType_remember(d);
Printv(f->code,
Printv(f,
tab4, "SWIG_MakePtr(ST(argvi++), (void *) result, SWIGTYPE", SwigType_manglestr(d),");\n", 0);
SwigType_del_pointer(d);
break;
case T_STRING:
Printf(f->code," sv_setpv((SV*)ST(argvi++),(char *) result);\n");
Printf(f," sv_setpv((SV*)ST(argvi++),(char *) result);\n");
break;
case T_POINTER: case T_ARRAY: case T_REFERENCE:
SwigType_remember(d);
Printv(f->code, tab4, "SWIG_MakePtr(ST(argvi++), (void *) result, SWIGTYPE", SwigType_manglestr(d), ");\n", 0);
Printv(f, tab4, "SWIG_MakePtr(ST(argvi++), (void *) result, SWIGTYPE", SwigType_manglestr(d), ");\n", 0);
break;
default :
@ -703,35 +704,35 @@ PERL5::function(DOH *node)
/* If there were any output args, take care of them. */
Printv(f->code,outarg,0);
Printv(f,outarg,0);
/* If there was any cleanup, do that. */
Printv(f->code,cleanup,0);
Printv(f,cleanup,0);
if (NewObject) {
if ((tm = Swig_typemap_lookup((char*)"newfree",d,iname,(char*)"result",(char*)"",0))) {
Printf(f->code,"%s\n",tm);
Printf(f,"%s\n",tm);
}
}
if ((tm = Swig_typemap_lookup((char*)"ret",d,iname,(char*)"result",(char*)"",0))) {
Printf(f->code,"%s\n", tm);
Printf(f,"%s\n", tm);
}
Printf(f->code," XSRETURN(argvi);\n}\n");
Printf(f," XSRETURN(argvi);\n}\n");
/* Add the dXSARGS last */
Wrapper_add_local(f,"dXSARGS","dXSARGS");
/* Substitute the cleanup code */
Replace(f->code,"$cleanup",cleanup,DOH_REPLACE_ANY);
Replace(f->code,"$name",iname,DOH_REPLACE_ANY);
Replace(f,"$cleanup",cleanup,DOH_REPLACE_ANY);
Replace(f,"$name",iname,DOH_REPLACE_ANY);
/* Dump the wrapper function */
Wrapper_print(f,f_wrappers);
Printf(f_wrappers,"%s", f);
/* Now register the function */
@ -844,7 +845,7 @@ PERL5::function(DOH *node)
}
Delete(cleanup);
Delete(outarg);
DelWrapper(f);
Delete(f);
}
/* -----------------------------------------------------------------------------
@ -878,57 +879,58 @@ void PERL5::variable(DOH *node) {
/* Create a Perl function for setting the variable value */
if (!(Status & STAT_READONLY)) {
Printf(setf->def,"SWIGCLASS_STATIC int %s(SV* sv, MAGIC *mg) {\n", set_name);
Printv(setf->code,
Printf(setf,"SWIGCLASS_STATIC int %s(SV* sv, MAGIC *mg) {\n", set_name);
Printf(setf,"$locals\n");
Printv(setf,
tab4, "MAGIC_PPERL\n",
tab4, "mg = mg;\n",
0);
/* Check for a few typemaps */
if ((tm = Swig_typemap_lookup((char*)"varin",t,(char*)"",(char*)"sv",name,0))) {
Printf(setf->code,"%s\n", tm);
Printf(setf,"%s\n", tm);
} else if ((tm = Swig_typemap_lookup((char*)"in",t,(char*)"",(char*)"sv",name,0))) {
Printf(setf->code,"%s\n", tm);
Printf(setf,"%s\n", tm);
} else {
switch(SwigType_type(t)) {
case T_INT : case T_BOOL: case T_UINT:
case T_SHORT : case T_USHORT:
case T_LONG : case T_ULONG:
case T_UCHAR: case T_SCHAR:
Printv(setf->code,tab4, name, " = (", SwigType_str(t,0), ") SvIV(sv);\n", 0);
Printv(setf,tab4, name, " = (", SwigType_str(t,0), ") SvIV(sv);\n", 0);
break;
case T_DOUBLE :
case T_FLOAT :
Printv(setf->code, tab4, name, " = (", SwigType_str(t,0), ") SvNV(sv);\n", 0);
Printv(setf, tab4, name, " = (", SwigType_str(t,0), ") SvNV(sv);\n", 0);
break;
case T_CHAR :
Printv(setf->code, tab4, name, " = (char) *SvPV(sv,PL_na);\n", 0);
Printv(setf, tab4, name, " = (char) *SvPV(sv,PL_na);\n", 0);
break;
case T_USER:
SwigType_add_pointer(t);
Wrapper_add_local(setf,"_temp", "void *_temp");
get_pointer(iname,(char*)"value",(char*)"sv",(char*)"_temp", t, setf->code, (char*)"return(1)");
Printv(setf->code, tab4, name, " = *((", SwigType_str(t,0), ") _temp);\n", 0);
get_pointer(iname,(char*)"value",(char*)"sv",(char*)"_temp", t, setf, (char*)"return(1)");
Printv(setf, tab4, name, " = *((", SwigType_str(t,0), ") _temp);\n", 0);
SwigType_del_pointer(t);
break;
case T_STRING:
Wrapper_add_local(setf,"_a","char *_a");
Printf(setf->code," _a = (char *) SvPV(sv,PL_na);\n");
Printf(setf," _a = (char *) SvPV(sv,PL_na);\n");
if (CPlusPlus)
Printv(setf->code,
Printv(setf,
tab4, "if (", name, ") delete [] ", name, ";\n",
tab4, name, " = new char[strlen(_a)+1];\n",
0);
else
Printv(setf->code,
Printv(setf,
tab4, "if (", name, ") free((char*)", name, ");\n",
tab4, name, " = (char *) malloc(strlen(_a)+1);\n",
0);
Printv(setf->code,"strcpy((char*)", name, ",_a);\n", 0);
Printv(setf,"strcpy((char*)", name, ",_a);\n", 0);
break;
case T_ARRAY:
@ -939,7 +941,7 @@ void PERL5::variable(DOH *node) {
if (SwigType_type(ta) == T_CHAR) {
String *dim = SwigType_array_getdim(aop,0);
if (dim && Len(dim)) {
Printf(setf->code, "strncpy(%s,(char*) SvPV(sv,PL_na), %s);\n", name,dim);
Printf(setf, "strncpy(%s,(char*) SvPV(sv,PL_na), %s);\n", name,dim);
setable = 1;
} else {
setable = 0;
@ -954,8 +956,8 @@ void PERL5::variable(DOH *node) {
case T_POINTER: case T_REFERENCE:
Wrapper_add_local(setf,"_temp","void *_temp");
get_pointer(iname,(char*)"value",(char*)"sv",(char*)"_temp", t, setf->code, (char*)"return(1)");
Printv(setf->code,tab4, name, " = (", SwigType_str(t,0), ") _temp;\n", 0);
get_pointer(iname,(char*)"value",(char*)"sv",(char*)"_temp", t, setf, (char*)"return(1)");
Printv(setf,tab4, name, " = (", SwigType_str(t,0), ") _temp;\n", 0);
break;
default :
@ -963,24 +965,25 @@ void PERL5::variable(DOH *node) {
return;
}
}
Printf(setf->code," return 1;\n}\n");
Replace(setf->code,"$name",iname, DOH_REPLACE_ANY);
Wrapper_print(setf,magic);
Printf(setf," return 1;\n}\n");
Replace(setf,"$name",iname, DOH_REPLACE_ANY);
Printf(magic,"%s", setf);
}
/* Now write a function to evaluate the variable */
Printf(getf->def,"SWIGCLASS_STATIC int %s(SV *sv, MAGIC *mg) {\n", val_name);
Printv(getf->code,
Printf(getf,"SWIGCLASS_STATIC int %s(SV *sv, MAGIC *mg) {\n", val_name);
Printf(getf,"$locals\n");
Printv(getf,
tab4, "MAGIC_PPERL\n",
tab4, "mg = mg;\n",
0);
if ((tm = Swig_typemap_lookup((char*)"varout",t,(char*)"",name, (char*)"sv",0))) {
Printf(getf->code,"%s\n", tm);
Printf(getf,"%s\n", tm);
} else if ((tm = Swig_typemap_lookup((char*)"out",t,(char*)"",name,(char*)"sv",0))) {
Printf(getf->code,"%s\n", tm);
Printf(getf,"%s\n", tm);
} else {
switch(SwigType_type(t)) {
@ -988,17 +991,17 @@ void PERL5::variable(DOH *node) {
case T_SHORT : case T_USHORT:
case T_LONG : case T_ULONG:
case T_UCHAR: case T_SCHAR:
Printv(getf->code,tab4, "sv_setiv(sv, (IV) ", name, ");\n", 0);
Printv(getf,tab4, "sv_setiv(sv, (IV) ", name, ");\n", 0);
Printv(vinit, tab4, "sv_setiv(sv,(IV)", name, ");\n",0);
break;
case T_DOUBLE :
case T_FLOAT :
Printv(getf->code, tab4,"sv_setnv(sv, (double) ", name, ");\n", 0);
Printv(getf, tab4,"sv_setnv(sv, (double) ", name, ");\n", 0);
Printv(vinit, tab4, "sv_setnv(sv,(double)", name, ");\n",0);
break;
case T_CHAR :
Wrapper_add_local(getf,"_ptemp","char _ptemp[2]");
Printv(getf->code,
Printv(getf,
tab4, "_ptemp[0] = ", name, ";\n",
tab4, "_ptemp[1] = 0;\n",
tab4, "sv_setpv((SV*) sv, _ptemp);\n",
@ -1006,7 +1009,7 @@ void PERL5::variable(DOH *node) {
break;
case T_USER:
SwigType_add_pointer(t);
Printv(getf->code,
Printv(getf,
tab4, "rsv = SvRV(sv);\n",
tab4, "sv_setiv(rsv,(IV) &", name, ");\n",
0);
@ -1018,7 +1021,7 @@ void PERL5::variable(DOH *node) {
break;
case T_STRING:
Printv(getf->code, tab4, "sv_setpv((SV*) sv, ", name, ");\n", 0);
Printv(getf, tab4, "sv_setpv((SV*) sv, ", name, ");\n", 0);
break;
case T_ARRAY:
@ -1027,7 +1030,7 @@ void PERL5::variable(DOH *node) {
SwigType *ta = Copy(t);
aop = SwigType_pop(ta);
if (SwigType_type(ta) == T_CHAR) {
Printv(getf->code, "sv_setpv((SV*)sv, ", name, ");\n", 0);
Printv(getf, "sv_setpv((SV*)sv, ", name, ");\n", 0);
Delete(ta);
Delete(aop);
break;
@ -1037,7 +1040,7 @@ void PERL5::variable(DOH *node) {
}
/* No break here is intentional */
case T_POINTER: case T_REFERENCE:
Printv(getf->code,
Printv(getf,
tab4, "rsv = SvRV(sv);\n",
tab4, "sv_setiv(rsv,(IV) ", name, ");\n",
0);
@ -1050,10 +1053,10 @@ void PERL5::variable(DOH *node) {
break;
}
}
Printf(getf->code," return 1;\n}\n");
Printf(getf," return 1;\n}\n");
Replace(getf->code,"$name",iname, DOH_REPLACE_ANY);
Wrapper_print(getf,magic);
Replace(getf,"$name",iname, DOH_REPLACE_ANY);
Printf(magic,"%s", getf);
/* Now add symbol to the PERL interpreter */
if ((Status & STAT_READONLY) || (!setable)) {
@ -1082,8 +1085,8 @@ void PERL5::variable(DOH *node) {
if (export_all)
Printf(exported,"$%s ", name);
}
DelWrapper(setf);
DelWrapper(getf);
Delete(setf);
Delete(getf);
}
/* -----------------------------------------------------------------------------

117
SWIG/Source/Modules1.1/python.cxx
View file

@ -361,17 +361,17 @@ PYTHON::function(DOH *node) {
strcpy(wname,Char(Swig_name_wrapper(iname)));
if (!use_kw) {
Printv(f->def,
Printv(f,
"static PyObject *", wname,
"(PyObject *self, PyObject *args) {",
0);
} else {
Printv(f->def,
Printv(f,
"static PyObject *", wname,
"(PyObject *self, PyObject *args, PyObject *kwargs) {",
0);
}
Printf(f,"$locals\n");
Wrapper_add_local(f,"resultobj", "PyObject *resultobj");
/* Get the function usage string for later use */
@ -538,7 +538,8 @@ PYTHON::function(DOH *node) {
Printf(kwargs," NULL }");
if (use_kw) {
Printv(f->locals,tab4, "char *kwnames[] = ", kwargs, ";\n", 0);
Wrapper_add_localv(f,"kwnames","char *kwnames[] = ", kwargs, ";\n", 0);
/* Printv(f->locals,tab4, "char *kwnames[] = ", kwargs, ";\n", 0); */
}
Printf(parse_args,":%s\"", iname);
@ -547,45 +548,45 @@ PYTHON::function(DOH *node) {
0);
/* Now slap the whole first part of the wrapper function together */
Printv(f->code, parse_args, get_pointers, check, 0);
Printv(f, parse_args, get_pointers, check, 0);
/* Emit the function call */
emit_func_call(node,f);
/* Return the function value */
if ((tm = Swig_typemap_lookup((char*)"out",d,iname,(char*)"result",(char*)"resultobj",0))) {
Printf(f->code,"%s\n", tm);
Printf(f,"%s\n", tm);
} else {
switch(SwigType_type(d)) {
case T_INT: case T_UINT: case T_BOOL:
case T_SHORT: case T_USHORT:
case T_LONG : case T_ULONG:
case T_SCHAR: case T_UCHAR :
Printf(f->code," resultobj = PyInt_FromLong((long)result);\n");
Printf(f," resultobj = PyInt_FromLong((long)result);\n");
break;
case T_DOUBLE :
case T_FLOAT :
Printf(f->code," resultobj = PyFloat_FromDouble(result);\n");
Printf(f," resultobj = PyFloat_FromDouble(result);\n");
break;
case T_CHAR :
Printf(f->code," resultobj = Py_BuildValue(\"c\",result);\n");
Printf(f," resultobj = Py_BuildValue(\"c\",result);\n");
break;
case T_USER :
SwigType_add_pointer(d);
SwigType_remember(d);
Printv(f->code,tab4, "resultobj = SWIG_NewPointerObj((void *)result, SWIGTYPE", SwigType_manglestr(d), ");\n",0);
Printv(f,tab4, "resultobj = SWIG_NewPointerObj((void *)result, SWIGTYPE", SwigType_manglestr(d), ");\n",0);
SwigType_del_pointer(d);
break;
case T_STRING:
Printf(f->code," resultobj = Py_BuildValue(\"s\",result);\n");
Printf(f," resultobj = Py_BuildValue(\"s\",result);\n");
break;
case T_POINTER: case T_ARRAY: case T_REFERENCE:
SwigType_remember(d);
Printv(f->code, tab4, "resultobj = SWIG_NewPointerObj((void *) result, SWIGTYPE", SwigType_manglestr(d), ");\n", 0);
Printv(f, tab4, "resultobj = SWIG_NewPointerObj((void *) result, SWIGTYPE", SwigType_manglestr(d), ");\n", 0);
break;
case T_VOID:
Printf(f->code," Py_INCREF(Py_None);\n");
Printf(f->code," resultobj = Py_None;\n");
Printf(f," Py_INCREF(Py_None);\n");
Printf(f," resultobj = Py_None;\n");
break;
default :
Printf(stderr,"%s: Line %d. Unable to use return type %s in function %s.\n", input_file, line_number, SwigType_str(d,0), name);
@ -594,33 +595,33 @@ PYTHON::function(DOH *node) {
}
/* Output argument output code */
Printv(f->code,outarg,0);
Printv(f,outarg,0);
/* Output cleanup code */
Printv(f->code,cleanup,0);
Printv(f,cleanup,0);
/* Look to see if there is any newfree cleanup code */
if (NewObject) {
if ((tm = Swig_typemap_lookup((char*)"newfree",d,iname,(char*)"result",(char*)"",0))) {
Printf(f->code,"%s\n",tm);
Printf(f,"%s\n",tm);
}
}
/* See if there is any return cleanup code */
if ((tm = Swig_typemap_lookup((char*)"ret",d,iname,(char*)"result",(char*)"",0))) {
Printf(f->code,"%s\n",tm);
Printf(f,"%s\n",tm);
}
Printf(f->code," return resultobj;\n}\n");
Printf(f," return resultobj;\n}\n");
/* Substitute the cleanup code */
Replace(f->code,"$cleanup",cleanup, DOH_REPLACE_ANY);
Replace(f,"$cleanup",cleanup, DOH_REPLACE_ANY);
/* Substitute the function name */
Replace(f->code,"$name",iname, DOH_REPLACE_ANY);
Replace(f,"$name",iname, DOH_REPLACE_ANY);
/* Dump the function out */
Wrapper_print(f,f_wrappers);
Printf(f_wrappers,"%s",f);
/* Now register the function with the interpreter. */
add_method(iname, wname, use_kw);
@ -674,7 +675,7 @@ PYTHON::function(DOH *node) {
Delete(outarg);
Delete(check);
Delete(kwargs);
DelWrapper(f);
Delete(f);
}
/* -----------------------------------------------------------------------------
@ -711,11 +712,12 @@ PYTHON::variable(DOH *node) {
/* Create a function for setting the value of the variable */
Printf(setf->def,"static int %s_set(PyObject *val) {", wname);
Printf(setf,"static int %s_set(PyObject *val) {\n", wname);
Printf(setf,"$locals\n");
if (!(Status & STAT_READONLY)) {
if ((tm = Swig_typemap_lookup((char*)"varin",t,name,(char*)"val",name,0))) {
Printf(setf->code,"%s\n",tm);
Replace(setf->code,"$name",iname, DOH_REPLACE_ANY);
Printf(setf,"%s\n",tm);
Replace(setf,"$name",iname, DOH_REPLACE_ANY);
} else {
switch(SwigType_type(t)) {
@ -723,7 +725,7 @@ PYTHON::variable(DOH *node) {
case T_UINT: case T_USHORT: case T_ULONG:
case T_SCHAR: case T_UCHAR: case T_BOOL:
Wrapper_add_localv(setf,"tval",SwigType_lstr(t,0),"tval",0);
Printv(setf->code,
Printv(setf,
tab4, "tval = (", SwigType_lstr(t,0), ") PyInt_AsLong(val);\n",
tab4, "if (PyErr_Occurred()) {\n",
tab8, "PyErr_SetString(PyExc_TypeError,\"C variable '",
@ -736,7 +738,7 @@ PYTHON::variable(DOH *node) {
case T_FLOAT: case T_DOUBLE:
Wrapper_add_localv(setf,"tval",SwigType_lstr(t,0), "tval",0);
Printv(setf->code,
Printv(setf,
tab4, "tval = (", SwigType_lstr(t,0), ") PyFloat_AsDouble(val);\n",
tab4, "if (PyErr_Occurred()) {\n",
tab8, "PyErr_SetString(PyExc_TypeError,\"C variable '",
@ -749,7 +751,7 @@ PYTHON::variable(DOH *node) {
case T_CHAR:
Wrapper_add_local(setf,"tval","char * tval");
Printv(setf->code,
Printv(setf,
tab4, "tval = (char *) PyString_AsString(val);\n",
tab4, "if (PyErr_Occurred()) {\n",
tab8, "PyErr_SetString(PyExc_TypeError,\"C variable '",
@ -763,14 +765,14 @@ PYTHON::variable(DOH *node) {
case T_USER:
SwigType_add_pointer(t);
Wrapper_add_localv(setf,"temp",SwigType_lstr(t,0),"temp",0);
get_pointer((char*)"val",(char*)"temp",t,setf->code,(char*)"1");
Printv(setf->code, tab4, name, " = *temp;\n", 0);
get_pointer((char*)"val",(char*)"temp",t,setf,(char*)"1");
Printv(setf, tab4, name, " = *temp;\n", 0);
SwigType_del_pointer(t);
break;
case T_STRING:
Wrapper_add_local(setf,"tval","char * tval");
Printv(setf->code,
Printv(setf,
tab4, "tval = (char *) PyString_AsString(val);\n",
tab4, "if (PyErr_Occurred()) {\n",
tab8, "PyErr_SetString(PyExc_TypeError,\"C variable '",
@ -780,13 +782,13 @@ PYTHON::variable(DOH *node) {
0);
if (CPlusPlus) {
Printv(setf->code,
Printv(setf,
tab4, "if (", name, ") delete [] ", name, ";\n",
tab4, name, " = new char[strlen(tval)+1];\n",
tab4, "strcpy((char *)", name, ",tval);\n",
0);
} else {
Printv(setf->code,
Printv(setf,
tab4, "if (", name, ") free((char*)", name, ");\n",
tab4, name, " = (char *) malloc(strlen(tval)+1);\n",
tab4, "strcpy((char *)", name, ",tval);\n",
@ -803,12 +805,12 @@ PYTHON::variable(DOH *node) {
if (SwigType_type(ta) == T_CHAR) {
String *dim = SwigType_array_getdim(aop,0);
if (dim && Len(dim)) {
Printf(setf->code, "strncpy(%s,PyString_AsString(val), %s);\n", name,dim);
Printf(setf, "strncpy(%s,PyString_AsString(val), %s);\n", name,dim);
setable = 1;
}
}
if (!setable) {
Printv(setf->code,
Printv(setf,
tab4, "PyErr_SetString(PyExc_TypeError,\"Variable ", iname,
" is read-only.\");\n",
tab4, "return 1;\n",
@ -821,50 +823,51 @@ PYTHON::variable(DOH *node) {
case T_POINTER: case T_REFERENCE:
Wrapper_add_localv(setf,"temp", SwigType_lstr(t,0), "temp",0);
get_pointer((char*)"val",(char*)"temp",t,setf->code,(char*)"1");
Printv(setf->code,tab4, name, " = temp;\n", 0);
get_pointer((char*)"val",(char*)"temp",t,setf,(char*)"1");
Printv(setf,tab4, name, " = temp;\n", 0);
break;
default:
Printf(stderr,"%s : Line %d. Unable to link with type %s.\n", input_file, line_number, SwigType_str(t,0));
}
}
Printf(setf->code," return 0;\n");
Printf(setf," return 0;\n");
} else {
/* Is a readonly variable. Issue an error */
Printv(setf->code,
Printv(setf,
tab4, "PyErr_SetString(PyExc_TypeError,\"Variable ", iname,
" is read-only.\");\n",
tab4, "return 1;\n",
0);
}
Printf(setf->code,"}\n");
Wrapper_print(setf,f_wrappers);
Printf(setf,"}\n");
Printf(f_wrappers,"%s", setf);
/* Create a function for getting the value of a variable */
Printf(getf->def,"static PyObject *%s_get() {", wname);
Printf(getf,"static PyObject *%s_get() {\n", wname);
Printf(getf,"$locals\n");
Wrapper_add_local(getf,"pyobj", "PyObject *pyobj");
if ((tm = Swig_typemap_lookup((char*)"varout",t,name,name,(char*)"pyobj",0))) {
Printf(getf->code,"%s\n",tm);
Replace(getf->code,"$name",iname, DOH_REPLACE_ANY);
Printf(getf,"%s\n",tm);
Replace(getf,"$name",iname, DOH_REPLACE_ANY);
} else if ((tm = Swig_typemap_lookup((char*)"out",t,name,name,(char*)"pyobj",0))) {
Printf(getf->code,"%s\n",tm);
Replace(getf->code,"$name",iname, DOH_REPLACE_ANY);
Printf(getf,"%s\n",tm);
Replace(getf,"$name",iname, DOH_REPLACE_ANY);
} else {
switch(SwigType_type(t)) {
case T_INT: case T_UINT:
case T_SHORT: case T_USHORT:
case T_LONG: case T_ULONG:
case T_SCHAR: case T_UCHAR: case T_BOOL:
Printv(getf->code, tab4, "pyobj = PyInt_FromLong((long) ", name, ");\n", 0);
Printv(getf, tab4, "pyobj = PyInt_FromLong((long) ", name, ");\n", 0);
break;
case T_FLOAT: case T_DOUBLE:
Printv(getf->code, tab4, "pyobj = PyFloat_FromDouble((double) ", name, ");\n", 0);
Printv(getf, tab4, "pyobj = PyFloat_FromDouble((double) ", name, ");\n", 0);
break;
case T_CHAR:
Wrapper_add_local(getf,"ptemp","char ptemp[2]");
Printv(getf->code,
Printv(getf,
tab4, "ptemp[0] = ", name, ";\n",
tab4, "ptemp[1] = 0;\n",
tab4, "pyobj = PyString_FromString(ptemp);\n",
@ -873,14 +876,14 @@ PYTHON::variable(DOH *node) {
case T_USER:
SwigType_add_pointer(t);
SwigType_remember(t);
Printv(getf->code,
Printv(getf,
tab4, "pyobj = SWIG_NewPointerObj((void *) &", name ,
", SWIGTYPE", SwigType_manglestr(t), ");\n",
0);
SwigType_del_pointer(t);
break;
case T_STRING:
Printv(getf->code,
Printv(getf,
tab4, "if (", name, ")\n",
tab8, "pyobj = PyString_FromString(", name, ");\n",
tab4, "else pyobj = PyString_FromString(\"(NULL)\");\n",
@ -889,7 +892,7 @@ PYTHON::variable(DOH *node) {
case T_POINTER: case T_ARRAY: case T_REFERENCE:
SwigType_remember(t);
Printv(getf->code,
Printv(getf,
tab4, "pyobj = SWIG_NewPointerObj((void *)", name,
", SWIGTYPE", SwigType_manglestr(t), ");\n",
0);
@ -901,8 +904,8 @@ PYTHON::variable(DOH *node) {
}
}
Printf(getf->code," return pyobj;\n}\n");
Wrapper_print(getf,f_wrappers);
Printf(getf," return pyobj;\n}\n");
Printf(f_wrappers,"%s", getf);
/* Now add this to the variable linking mechanism */
@ -917,8 +920,8 @@ PYTHON::variable(DOH *node) {
0);
}
}
DelWrapper(setf);
DelWrapper(getf);
Delete(setf);
Delete(getf);
}
/* -----------------------------------------------------------------------------

87
SWIG/Source/Modules1.1/ruby.cxx
View file

@ -449,7 +449,7 @@ void RUBY::function(DOH *node) {
if (current == DESTRUCTOR) {
Wrapper *dummy = NewWrapper();
emit_func_call(node,dummy);
DelWrapper(dummy);
Delete(dummy);
return;
}
@ -502,20 +502,21 @@ void RUBY::function(DOH *node) {
int vararg = (numoptreal != 0);
/* Now write the wrapper function itself */
Printv(f->def, "static VALUE\n", wname, "(", 0);
Printv(f, "static VALUE\n", wname, "(", 0);
if (vararg) {
Printv(f->def, "int argc, VALUE *argv, VALUE self",0);
Printv(f, "int argc, VALUE *argv, VALUE self",0);
} else {
Printv(f->def, "VALUE self", 0);
Printv(f, "VALUE self", 0);
p = l;
for (i = 0; i < start; i++) p = Getnext(p);
for (i = start; p; i++, p = Getnext(p)) {
if (!Getignore(p)) {
Printf(f->def,", VALUE varg%d", i);
Printf(f,", VALUE varg%d", i);
}
}
}
Printf(f->def,") {");
Printf(f,") {\n");
Printf(f,"$locals\n");
/* Emit all of the local variables for holding arguments. */
if (vararg) {
@ -538,14 +539,14 @@ void RUBY::function(DOH *node) {
for (i = start; p; i++, p = Getnext(p)) {
if (!Getignore(p)) numscan++;
}
Printf(f->code,"rb_scan_args(argc, argv, \"%d%d\"", (numarg-numoptreal), numscan - (numarg-numoptreal));
Printf(f,"rb_scan_args(argc, argv, \"%d%d\"", (numarg-numoptreal), numscan - (numarg-numoptreal));
for (p = l, i = 0; i < start; i++) p = Getnext(p);
for (i = start; p; i++, p = Getnext(p)) {
if (!Getignore(p)) {
Printf(f->code,", &varg%d", i);
Printf(f,", &varg%d", i);
}
}
Printf(f->code,");\n");
Printf(f,");\n");
}
/* Now walk the function parameter list and generate code */
@ -569,7 +570,7 @@ void RUBY::function(DOH *node) {
if (!Getignore(p)) {
char *tab = (char*)tab4;
if (j >= (pcount-numopt)) { /* Check if parsing an optional argument */
Printf(f->code," if (argc > %d) {\n", j - start);
Printf(f," if (argc > %d) {\n", j - start);
tab = (char*)tab8;
}
@ -577,15 +578,15 @@ void RUBY::function(DOH *node) {
tm = ruby_typemap_lookup((char*)"in",pt,pn,source,target,f);
if (tm) {
String *s = NewString(tm);
Printv(f->code, s, 0);
Replace(f->code, "$arg", source, DOH_REPLACE_ANY);
Printv(f, s, 0);
Replace(f, "$arg", source, DOH_REPLACE_ANY);
Delete(s);
} else {
Printf(stderr,"%s : Line %d. No typemapping for datatype %s\n",
input_file,line_number, SwigType_str(pt,0));
}
if (j >= (pcount-numopt))
Printv(f->code, tab4, "} \n", 0);
Printv(f, tab4, "} \n", 0);
j++;
}
@ -593,8 +594,8 @@ void RUBY::function(DOH *node) {
tm = ruby_typemap_lookup((char*)"check",pt,pn,source,target);
if (tm) {
String *s = NewString(tm);
Printv(f->code, s, 0);
Replace(f->code, "$arg", source, DOH_REPLACE_ANY);
Printv(f, s, 0);
Replace(f, "$arg", source, DOH_REPLACE_ANY);
Delete(s);
}
@ -625,12 +626,12 @@ void RUBY::function(DOH *node) {
if (SwigType_type(t) != T_VOID) {
need_result = 1;
if (predicate) {
Printv(f->code, tab4, "vresult = (result ? Qtrue : Qfalse);\n", 0);
Printv(f, tab4, "vresult = (result ? Qtrue : Qfalse);\n", 0);
} else {
tm = ruby_typemap_lookup((char*)"out",t,name,(char*)"result",(char*)"vresult");
if (tm) {
String *s = NewString(tm);
Printv(f->code, s, 0);
Printv(f, s, 0);
Delete(s);
} else {
Printf(stderr,"%s : Line %d. No return typemap for datatype %s\n",
@ -640,52 +641,52 @@ void RUBY::function(DOH *node) {
}
/* Dump argument output code; */
Printv(f->code,outarg,0);
Printv(f,outarg,0);
/* Dump the argument cleanup code */
Printv(f->code,cleanup,0);
Printv(f,cleanup,0);
/* Look for any remaining cleanup. This processes the %new directive */
if (NewObject) {
tm = ruby_typemap_lookup((char*)"newfree",t,name,(char*)"result",(char*)"");
if (tm) {
String *s = NewString(tm);
Printv(f->code,s, 0);
Printv(f,s, 0);
Delete(s);
}
}
/* free pragma */
if (current == MEMBER_FUNC && Getattr(klass->freemethods, mname)) {
Printv(f->code, tab4, "DATA_PTR(self) = 0;\n", 0);
Printv(f, tab4, "DATA_PTR(self) = 0;\n", 0);
}
/* Special processing on return value. */
tm = ruby_typemap_lookup((char*)"ret",t,name,(char*)"result",(char*)"");
if (tm) {
String *s = NewString(tm);
Printv(f->code,s, 0);
Printv(f,s, 0);
}
/* Wrap things up (in a manner of speaking) */
if (need_result) {
Wrapper_add_local(f,"vresult","VALUE vresult = Qnil");
Printv(f->code, tab4, "return vresult;\n}\n", 0);
Printv(f, tab4, "return vresult;\n}\n", 0);
} else {
Printv(f->code, tab4, "return Qnil;\n}\n", 0);
Printv(f, tab4, "return Qnil;\n}\n", 0);
}
/* Substitute the cleanup code */
Replace(f->code,"$cleanup",cleanup, DOH_REPLACE_ANY);
Replace(f,"$cleanup",cleanup, DOH_REPLACE_ANY);
/* Emit the function */
Wrapper_print(f,f_wrappers);
Printf(f_wrappers,"%s", f);
/* Now register the function with the language */
create_command(name, iname, (vararg ? -1 : numarg));
Delete(cleanup);
Delete(outarg);
DelWrapper(f);
Delete(f);
}
/* ---------------------------------------------------------------------
@ -713,9 +714,10 @@ void RUBY::variable(DOH *node) {
/* create getter */
getfname = NewString(Swig_name_get(name));
Replace(getfname,"::", "_", DOH_REPLACE_ANY); /* FIXME: Swig_name_get bug? */
Printv(getf->def, "static VALUE\n", getfname, "(", 0);
Printf(getf->def, "VALUE self");
Printf(getf->def, ") {");
Printv(getf, "static VALUE\n", getfname, "(", 0);
Printf(getf, "VALUE self");
Printf(getf, ") {\n");
Printf(getf, "$locals\n");
Wrapper_add_local(getf,"_val","VALUE _val");
if (SwigType_type(t) == T_USER) {
@ -732,14 +734,14 @@ void RUBY::variable(DOH *node) {
tm = ruby_typemap_lookup((char*)"out",t,name,source,(char*)"_val");
if (tm) {
String *s = NewString(tm);
Printv(getf->code,s, 0);
Printv(getf,s, 0);
Delete(s);
} else {
Printf(stderr,"%s: Line %d. Unable to link with variable type %s\n",
input_file,line_number,SwigType_str(t,0));
}
Printv(getf->code, tab4, "return _val;\n}\n", 0);
Wrapper_print(getf,f_wrappers);
Printv(getf, tab4, "return _val;\n}\n", 0);
Printf(f_wrappers,"%s", getf);
if (Status & STAT_READONLY) {
setfname = NewString("NULL");
@ -749,8 +751,9 @@ void RUBY::variable(DOH *node) {
setfname = NewString(Swig_name_set(name));
Replace(setfname,"::", "_", DOH_REPLACE_ANY); /* FIXME: Swig_name_get bug? */
Printv(setf->def, "static VALUE\n", setfname, "(VALUE self, ", 0);
Printf(setf->def, "VALUE _val) {");
Printv(setf, "static VALUE\n", setfname, "(VALUE self, ", 0);
Printf(setf, "VALUE _val) {\n");
Printf(setf, "$locals\n");
if (SwigType_type(t) == T_USER) {
SwigType_add_pointer(t);
@ -766,18 +769,18 @@ void RUBY::variable(DOH *node) {
tm = ruby_typemap_lookup((char*)"in",t,name,(char*)"_val",target);
if (tm) {
String *s = NewString(tm);
Printv(setf->code,s,0);
Printv(setf,s,0);
Delete(s);
} else {
Printf(stderr,"%s: Line %d. Unable to link with variable type %s\n",
input_file,line_number,SwigType_str(t,0));
}
if (SwigType_type(t) == T_USER) {
Printv(setf->code, name, " = *temp;\n",0);
Printv(setf, name, " = *temp;\n",0);
}
Printv(setf->code, tab4, "return _val;\n",0);
Printf(setf->code,"}\n");
Wrapper_print(setf,f_wrappers);
Printv(setf, tab4, "return _val;\n",0);
Printf(setf,"}\n");
Printf(f_wrappers,"%s", setf);
}
/* define accessor method */
@ -823,8 +826,8 @@ void RUBY::variable(DOH *node) {
}
Delete(getfname);
Delete(setfname);
DelWrapper(setf);
DelWrapper(getf);
Delete(setf);
Delete(getf);
}

108
SWIG/Source/Modules1.1/tcl8.cxx
View file

@ -287,9 +287,10 @@ TCL8::function(DOH *node) {
args = NewString("");
f = NewWrapper();
Printv(f->def,
"static int\n ", Swig_name_wrapper(iname), "(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {",
Printv(f,
"static int\n ", Swig_name_wrapper(iname), "(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {\n",
0);
Printf(f,"$locals\n");
/* Print out variables for storing arguments. */
pcount = emit_args(node, f);
@ -433,18 +434,18 @@ TCL8::function(DOH *node) {
}
Printf(argstr,":%s\"",usage_string(iname,d,l));
Printv(f->code,
Printv(f,
"if (SWIG_GetArgs(interp, objc, objv,", argstr, args, ") == TCL_ERROR) return TCL_ERROR;\n",
0);
Printv(f->code,incode,0);
Printv(f,incode,0);
/* Now write code to make the function call */
emit_func_call(node,f);
/* Return value if necessary */
if ((tm = Swig_typemap_lookup((char*)"out",d,name,(char*)"result",(char*)"tcl_result",0))) {
Printf(f->code,"%s\n", tm);
Printf(f,"%s\n", tm);
} else {
switch(SwigType_type(d)) {
case T_BOOL:
@ -456,17 +457,17 @@ TCL8::function(DOH *node) {
case T_USHORT:
case T_ULONG:
case T_UCHAR:
Printv(f->code, "Tcl_SetObjResult(interp,Tcl_NewIntObj((long) result));\n",0);
Printv(f, "Tcl_SetObjResult(interp,Tcl_NewIntObj((long) result));\n",0);
break;
/* Is a single character. We return it as a string */
case T_CHAR :
Printv(f->code, "Tcl_SetObjResult(interp,Tcl_NewStringObj(&result,1));\n",0);
Printv(f, "Tcl_SetObjResult(interp,Tcl_NewStringObj(&result,1));\n",0);
break;
case T_DOUBLE :
case T_FLOAT :
Printv(f->code, "Tcl_SetObjResult(interp,Tcl_NewDoubleObj((double) result));\n",0);
Printv(f, "Tcl_SetObjResult(interp,Tcl_NewDoubleObj((double) result));\n",0);
break;
case T_USER :
@ -475,18 +476,18 @@ TCL8::function(DOH *node) {
Probably dangerous, but safe programming is for wimps. */
SwigType_add_pointer(d);
SwigType_remember(d);
Printv(f->code, "Tcl_SetObjResult(interp,SWIG_NewPointerObj((void *) result,SWIGTYPE",
Printv(f, "Tcl_SetObjResult(interp,SWIG_NewPointerObj((void *) result,SWIGTYPE",
SwigType_manglestr(d), "));\n", 0);
SwigType_del_pointer(d);
break;
case T_STRING:
Printv(f->code, "Tcl_SetObjResult(interp,Tcl_NewStringObj(result,-1));\n",0);
Printv(f, "Tcl_SetObjResult(interp,Tcl_NewStringObj(result,-1));\n",0);
break;
case T_POINTER: case T_REFERENCE: case T_ARRAY:
SwigType_remember(d);
Printv(f->code, "Tcl_SetObjResult(interp,SWIG_NewPointerObj((void *) result,SWIGTYPE",
Printv(f, "Tcl_SetObjResult(interp,SWIG_NewPointerObj((void *) result,SWIGTYPE",
SwigType_manglestr(d), "));\n",
0);
break;
@ -502,29 +503,29 @@ TCL8::function(DOH *node) {
}
/* Dump output argument code */
Printv(f->code,outarg,0);
Printv(f,outarg,0);
/* Dump the argument cleanup code */
Printv(f->code,cleanup,0);
Printv(f,cleanup,0);
/* Look for any remaining cleanup */
if (NewObject) {
if ((tm = Swig_typemap_lookup((char*)"newfree",d,iname,(char*)"result",(char*)"",0))) {
Printf(f->code,"%s\n", tm);
Printf(f,"%s\n", tm);
}
}
if ((tm = Swig_typemap_lookup((char*)"ret",d,name,(char*)"result",(char*)"",0))) {
Printf(f->code,"%s\n", tm);
Printf(f,"%s\n", tm);
}
Printv(f->code, "return TCL_OK;\n}", 0);
Printv(f, "return TCL_OK;\n}\n", 0);
/* Substitute the cleanup code */
Replace(f->code,"$cleanup",cleanup,DOH_REPLACE_ANY);
Replace(f->code,"$name", iname, DOH_REPLACE_ANY);
Replace(f,"$cleanup",cleanup,DOH_REPLACE_ANY);
Replace(f,"$name", iname, DOH_REPLACE_ANY);
/* Dump out the function */
Wrapper_print(f,f_wrappers);
Printf(f_wrappers,"%s",f);
/* Register the function with Tcl */
Printv(cmd_info, tab4, "{ SWIG_prefix \"", iname, "\", ", Swig_name_wrapper(iname), ", NULL},\n", 0);
@ -534,7 +535,7 @@ TCL8::function(DOH *node) {
Delete(outarg);
Delete(argstr);
Delete(args);
DelWrapper(f);
Delete(f);
}
/* -----------------------------------------------------------------------------
@ -584,23 +585,25 @@ TCL8::variable(DOH *node) {
getname = NewStringf("swig_%s_get", Swig_string_mangle(t));
get = NewWrapper();
set = NewWrapper();
Printv(set->def, "static char *", setname, "(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags) {",0);
Printv(set, "static char *", setname, "(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags) {\n",0);
Printf(set,"$locals\n");
Printv(get, "static char *", getname, "(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags) {\n",0);
Printf(get,"$locals\n");
Printv(get->def, "static char *", getname, "(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags) {",0);
SwigType *lt = Swig_clocal_type(t);
if ((tc != T_USER) && (!isarray))
SwigType_add_pointer(lt);
Wrapper_add_localv(get,"addr",SwigType_lstr(lt,"addr"),0);
Wrapper_add_localv(set,"addr",SwigType_lstr(lt,"addr"),0);
Printv(set->code, "addr = (", SwigType_lstr(lt,0), ") clientData;\n", 0);
Printv(get->code, "addr = (", SwigType_lstr(lt,0), ") clientData;\n", 0);
Printv(set, "addr = (", SwigType_lstr(lt,0), ") clientData;\n", 0);
Printv(get, "addr = (", SwigType_lstr(lt,0), ") clientData;\n", 0);
if ((tc != T_USER) && (!isarray))
SwigType_del_pointer(lt);
Delete(lt);
Wrapper_add_local(set, "value", "char *value");
Wrapper_add_local(get, "value", "Tcl_Obj *value");
Printv(set->code, "value = Tcl_GetVar2(interp, name1, name2, flags);\n",
Printv(set, "value = Tcl_GetVar2(interp, name1, name2, flags);\n",
"if (!value) return NULL;\n", 0);
switch(tc) {
@ -611,9 +614,9 @@ TCL8::variable(DOH *node) {
case T_UCHAR:
case T_SCHAR:
case T_BOOL:
Printv(set->code, "*(addr) = (", SwigType_str(t,0), ") atol(value);\n", 0);
Printv(set, "*(addr) = (", SwigType_str(t,0), ") atol(value);\n", 0);
Wrapper_add_local(get,"value","Tcl_Obj *value");
Printv(get->code,
Printv(get,
"value = Tcl_NewIntObj((int) *addr);\n",
"Tcl_SetVar2(interp,name1,name2,Tcl_GetStringFromObj(value,NULL), flags);\n",
"Tcl_DecrRefCount(value);\n",
@ -622,9 +625,9 @@ TCL8::variable(DOH *node) {
case T_UINT:
case T_ULONG:
Printv(set->code, "*(addr) = (", SwigType_str(t,0), ") strtoul(value,0,0);\n",0);
Printv(set, "*(addr) = (", SwigType_str(t,0), ") strtoul(value,0,0);\n",0);
Wrapper_add_local(get,"value","Tcl_Obj *value");
Printv(get->code,
Printv(get,
"value = Tcl_NewIntObj((int) *addr);\n",
"Tcl_SetVar2(interp,name1,name2,Tcl_GetStringFromObj(value,NULL), flags);\n",
"Tcl_DecrRefCount(value);\n",
@ -633,9 +636,9 @@ TCL8::variable(DOH *node) {
case T_FLOAT:
case T_DOUBLE:
Printv(set->code, "*(addr) = (", SwigType_str(t,0), ") atof(value);\n",0);
Printv(set, "*(addr) = (", SwigType_str(t,0), ") atof(value);\n",0);
Wrapper_add_local(get,"value","Tcl_Obj *value");
Printv(get->code,
Printv(get,
"value = Tcl_NewDoubleObj((double) *addr);\n",
"Tcl_SetVar2(interp,name1,name2,Tcl_GetStringFromObj(value,NULL), flags);\n",
"Tcl_DecrRefCount(value);\n",
@ -643,9 +646,9 @@ TCL8::variable(DOH *node) {
break;
case T_CHAR:
Printv(set->code, "*(addr) = *value;\n",0);
Printv(set, "*(addr) = *value;\n",0);
Wrapper_add_local(get,"temp", "char temp[2]");
Printv(get->code, "temp[0] = *addr; temp[1] = 0;\n",
Printv(get, "temp[0] = *addr; temp[1] = 0;\n",
"Tcl_SetVar2(interp,name1,name2,temp,flags);\n",
0);
break;
@ -654,7 +657,7 @@ TCL8::variable(DOH *node) {
/* User defined type. We return it as a pointer */
SwigType_add_pointer(t);
SwigType_remember(t);
Printv(set->code, "{\n",
Printv(set, "{\n",
"void *ptr;\n",
"if (SWIG_ConvertPtrFromString(interp,value,&ptr,SWIGTYPE", SwigType_manglestr(t), ") != TCL_OK) {\n",
"return \"Type Error\";\n",
@ -667,7 +670,7 @@ TCL8::variable(DOH *node) {
Wrapper_add_local(get,"value", "Tcl_Obj *value");
SwigType_add_pointer(t);
SwigType_remember(t);
Printv(get->code, "value = SWIG_NewPointerObj(addr, SWIGTYPE", SwigType_manglestr(t), ");\n",
Printv(get, "value = SWIG_NewPointerObj(addr, SWIGTYPE", SwigType_manglestr(t), ");\n",
"Tcl_SetVar2(interp,name1,name2,Tcl_GetStringFromObj(value,NULL), flags);\n",
"Tcl_DecrRefCount(value);\n",0);
SwigType_del_pointer(t);
@ -675,11 +678,11 @@ TCL8::variable(DOH *node) {
break;
case T_STRING:
Printv(set->code, "if (*addr) free(*addr);\n",
Printv(set, "if (*addr) free(*addr);\n",
"*addr = (char *) malloc(strlen(value)+1);\n",
"strcpy(*addr,value);\n",
0);
Printv(get->code, "Tcl_SetVar2(interp,name1,name2,*addr, flags);\n",0);
Printv(get, "Tcl_SetVar2(interp,name1,name2,*addr, flags);\n",0);
break;
case T_ARRAY:
@ -693,16 +696,16 @@ TCL8::variable(DOH *node) {
if (SwigType_type(ta) == T_CHAR) {
String *dim = SwigType_array_getdim(aop,0);
if (dim && Len(dim)) {
Printf(set->code, "strncpy(addr,value,%s);\n", dim);
Printf(set, "strncpy(addr,value,%s);\n", dim);
setable = 1;
readonly = Status & STAT_READONLY;
}
Printv(get->code, "Tcl_SetVar2(interp,name1,name2,addr, flags);\n",0);
Printv(get, "Tcl_SetVar2(interp,name1,name2,addr, flags);\n",0);
} else {
Printf(stderr,"%s:%d: Array variable '%s' will be read-only.\n", input_file, line_number, name);
Wrapper_add_local(get,"value","Tcl_Obj *value");
SwigType_remember(t);
Printv(get->code,
Printv(get,
"value = SWIG_NewPointerObj(addr, SWIGTYPE", SwigType_manglestr(t), ");\n",
"Tcl_SetVar2(interp,name1,name2,Tcl_GetStringFromObj(value,NULL), flags);\n",
"Tcl_DecrRefCount(value);\n",
@ -715,7 +718,7 @@ TCL8::variable(DOH *node) {
case T_POINTER: case T_REFERENCE:
SwigType_remember(t);
Printv(set->code, "{\n",
Printv(set, "{\n",
"void *ptr;\n",
"if (SWIG_ConvertPtrFromString(interp,value,&ptr,SWIGTYPE", SwigType_manglestr(t), ") != TCL_OK) {\n",
"return \"Type Error\";\n",
@ -725,7 +728,7 @@ TCL8::variable(DOH *node) {
0);
Wrapper_add_local(get,"value","Tcl_Obj *value");
Printv(get->code,
Printv(get,
"value = SWIG_NewPointerObj(*addr, SWIGTYPE", SwigType_manglestr(t), ");\n",
"Tcl_SetVar2(interp,name1,name2,Tcl_GetStringFromObj(value,NULL), flags);\n",
"Tcl_DecrRefCount(value);\n",
@ -739,16 +742,16 @@ TCL8::variable(DOH *node) {
Printf(stderr,"TCL8::link_variable. Unknown type %s!\n", SwigType_str(t,0));
break;
}
Printv(set->code, "return NULL;\n", "}\n",0);
Printv(get->code, "return NULL;\n", "}\n",0);
Wrapper_print(get,f_wrappers);
Printv(set, "return NULL;\n", "}\n",0);
Printv(get, "return NULL;\n", "}\n",0);
Printf(f_wrappers,"%s",get);
Setattr(getf,Copy(t),getname);
if (setable) {
Wrapper_print(set,f_wrappers);
Printf(f_wrappers,"%s",set);
Setattr(setf,Copy(t),setname);
}
DelWrapper(get);
DelWrapper(set);
Delete(get);
Delete(set);
}
Printv(var_info, tab4,"{ SWIG_prefix \"", iname, "\", (void *) ", isarray ? "" : "&", name, ",", getname, ",", 0);
@ -756,11 +759,12 @@ TCL8::variable(DOH *node) {
static int readonlywrap = 0;
if (!readonlywrap) {
Wrapper *ro = NewWrapper();
Printf(ro->def, "static char *swig_readonly(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags) {");
Printv(ro->code, "return \"Variable is read-only\";\n", "}\n", 0);
Wrapper_print(ro,f_wrappers);
Printf(ro, "static char *swig_readonly(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags) {\n");
Printf(ro,"$locals\n");
Printv(ro, "return \"Variable is read-only\";\n", "}\n", 0);
Printf(f_wrappers,"%s",ro);
readonlywrap = 1;
DelWrapper(ro);
Delete(ro);
}
Printf(var_info, "swig_readonly},\n");
} else {