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

Fix bug 782468

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@5898 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
John Lenz 2004-05-02 21:24:39 +00:00
commit c0a2aea4cc
9 changed files with 310 additions and 806 deletions
Download patch file Download diff file Expand all files Collapse all files

14
CHANGES.current
View file

@ -1,6 +1,20 @@
Version 1.3.22 (in progress)
==================================
05/02/2004: wuzzeb (John Lenz)
[Chicken] Fix bug 782468.
To fix this bug, the runtime code has been rewritten, and
pointers are now represented as a C_SWIG_POINTER_TYPE.
Chicken version > 1.40 is now required!
* Typemap incompatibility: typemaps no longer use chicken_words.
If a typemap needs some space, it should just call C_alloc
* argout typemaps no longer use the /* if ONE */ construct to
build an output list. A SWIG_APPEND_VALUE macro, exactly like
guile and mzscheme is now used.
04/25/2004: mkoeppe (Matthias Koeppe)
[Guile] In the generated GOOPS code, don't create methods
that would not specialize any arguments; simply re-export

8
Examples/chicken/multimap/example.i
View file

@ -54,13 +54,9 @@ extern int count(char *bytes, int len, char c);
/* Return the mutated string as a new object. Notice the if MANY construct ... they must be at column 0. */
%typemap(chicken,argout,fragment="list_output_helper",chicken_words="0") (char *str, int len) (C_word *scmstr)
%typemap(chicken,argout) (char *str, int len) (C_word *scmstr)
%{ scmstr = C_alloc (C_SIZEOF_STRING ($2));
/*if MANY*/
$result = list_output_helper (&known_space, $result, C_string (&scmstr, $2, $1));
/*else*/
$result = C_string (&scmstr, $2, $1);
/*endif*/
SWIG_APPEND_VALUE(C_string (&scmstr, $2, $1));
free ($1);
%}

18
Examples/chicken/zlib/README.html
View file

@ -1616,15 +1616,11 @@ zlib:inflate-init
$1 = (char *) malloc (*$2);
%}
/* Return the mutated string as a new object. Notice the if MANY construct ... they must be at column 0. */
%typemap(chicken,argout,fragment="list_output_helper",chicken_words="0") (Bytef *dest, uLongf *destLen)
/* Return the mutated string as a new object. */
%typemap(chicken,argout) (Bytef *dest, uLongf *destLen)
(C_word *scmstr)
%{ scmstr = C_alloc (C_SIZEOF_STRING (*$2));
/*if MANY*/
$result = list_output_helper (&known_space, $result, C_string (&scmstr, *$2, $1));
/*else*/
$result = C_string (&scmstr, *$2, $1);
/*endif*/
SWIG_APPEND_VALUE(C_string (&scmstr, *$2, $1));
free ($1);
%}
</font>
@ -1637,14 +1633,10 @@ zlib:inflate-init
"$1 = &amp;len;";
/* Return a sized string as a new object. */
%typemap(chicken,argout,fragment="list_output_helper",chicken_words="0")
%typemap(chicken,argout)
(void *outstr, uLongf *destLen) (C_word *scmstr)
%{ scmstr = C_alloc (C_SIZEOF_STRING (*$2));
/*if MANY*/
$result = list_output_helper (&amp;known_space, $result, C_string (&amp;scmstr, *$2, $1));
/*else*/
$result = C_string (&amp;scmstr, *$2, $1);
/*endif*/
SWIG_APPEND_VALUE(C_string (&amp;scmstr, *$2, $1));
%}
</font>
%inline %{

18
Examples/chicken/zlib/example.i
View file

@ -33,15 +33,11 @@
$1 = (char *) malloc (*$2);
%}
/* Return the mutated string as a new object. Notice the if MANY construct ... they must be at column 0. */
%typemap(chicken,argout,fragment="list_output_helper",chicken_words="0") (Bytef *dest, uLongf *destLen)
/* Return the mutated string as a new object. */
%typemap(chicken,argout) (Bytef *dest, uLongf *destLen)
(C_word *scmstr)
%{ scmstr = C_alloc (C_SIZEOF_STRING (*$2));
/*if MANY*/
$result = list_output_helper (&known_space, $result, C_string (&scmstr, *$2, $1));
/*else*/
$result = C_string (&scmstr, *$2, $1);
/*endif*/
SWIG_APPEND_VALUE(C_string (&scmstr, *$2, $1));
free ($1);
%}
@ -54,14 +50,10 @@
"$1 = &len;";
/* Return a sized string as a new object. */
%typemap(chicken,argout,fragment="list_output_helper",chicken_words="0")
%typemap(chicken,argout)
(void *outstr, uLongf *destLen) (C_word *scmstr)
%{ scmstr = C_alloc (C_SIZEOF_STRING (*$2));
/*if MANY*/
$result = list_output_helper (&known_space, $result, C_string (&scmstr, *$2, $1));
/*else*/
$result = C_string (&scmstr, *$2, $1);
/*endif*/
SWIG_APPEND_VALUE(C_string (&scmstr, *$2, $1));
%}
%inline %{

388
Lib/chicken/chicken.swg
View file

@ -35,8 +35,6 @@
/* --- Primitive types --- */
%include "fragments.i"
%define SIMPLE_TYPEMAP(type_, from_scheme, to_scheme, checker, convtype, storage_)
%typemap(in) type_
@ -63,55 +61,45 @@
#if "storage_" == "0"
%typemap(out, fragment="list_output_helper",chicken_words="storage_") type_
%{/*if ONE*/
%typemap(out) type_
%{
$result = to_scheme (convtype ($1));
/*else*/
$result = list_output_helper (&known_space, $result, to_scheme (convtype ($1)));
/*endif*/ %}
%}
/* References to primitive types. Return by value */
%typemap(out, fragment="list_output_helper",chicken_words="storage_") const type_ &
%{/*if ONE*/
%typemap(out) const type_ &
%{
$result = to_scheme (convtype (*$1));
/*else*/
$result = list_output_helper (&known_space, $result, to_scheme (convtype (*$1)));
/*endif*/ %}
%}
/* --- Variable output --- */
%typemap(varout, fragment="list_output_helper",chicken_words="storage_") type_
%{/*if ONE*/
%typemap(varout) type_
%{
$result = to_scheme (convtype ($varname));
/*else*/
$result = list_output_helper (&known_space, $result, to_scheme (convtype ($varname)));
/*endif*/ %}
%}
#else
%typemap(out, fragment="list_output_helper",chicken_words="storage_") type_
%{/*if ONE*/
$result = to_scheme (&known_space, convtype ($1));
/*else*/
$result = list_output_helper (&known_space, $result, to_scheme (&known_space, convtype ($1)));
/*endif*/ %}
%typemap(out) type_
%{
C_word *space = C_alloc(storage_);
$result = to_scheme (&space, convtype ($1));
%}
/* References to primitive types. Return by value */
%typemap(out, fragment="list_output_helper",chicken_words="storage_") const type_ &
%{/*if ONE*/
%typemap(out) const type_ &
%{
$result = to_scheme (convtype (*$1));
/*else*/
$result = list_output_helper (&known_space, $result, to_scheme (convtype (*$1)));
/*endif*/ %}
%}
/* --- Variable output --- */
%typemap(varout, fragment="list_output_helper",chicken_words="storage_") type_
%{/*if ONE*/
$result = to_scheme (&known_space, convtype ($varname));
/*else*/
$result = list_output_helper (&known_space, $result, to_scheme (&known_space, convtype ($varname)));
/*endif*/ %}
%typemap(varout) type_
%{
C_word *space = C_alloc(storage_);
$result = to_scheme (&space, convtype ($varname));
%}
#endif
@ -130,18 +118,18 @@
SIMPLE_TYPEMAP(int, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
SIMPLE_TYPEMAP(enum SWIGTYPE, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
SIMPLE_TYPEMAP(short, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
SIMPLE_TYPEMAP(long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
SIMPLE_TYPEMAP(long long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
SIMPLE_TYPEMAP(long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(long long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(unsigned int, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
SIMPLE_TYPEMAP(unsigned short, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
SIMPLE_TYPEMAP(unsigned long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
SIMPLE_TYPEMAP(unsigned long long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
SIMPLE_TYPEMAP(unsigned long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(unsigned long long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(unsigned char, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
SIMPLE_TYPEMAP(signed char, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
SIMPLE_TYPEMAP(char, C_character_code, C_make_character, C_swig_is_char, (char), 0);
SIMPLE_TYPEMAP(bool, C_truep, C_mk_bool, C_swig_is_bool, (bool), 0);
SIMPLE_TYPEMAP(float, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
SIMPLE_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
SIMPLE_TYPEMAP(float, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLONUM);
/* --- Input arguments --- */
@ -155,38 +143,122 @@ SIMPLE_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double),
if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument #$argnum is not of type 'char *'");
}
$1 = ($ltype) swig_make_string ($input);
$1 = ($ltype) SWIG_MakeString ($input);
}
}
%typemap(freearg) char * "if ($1 != NULL) { free ($1); }"
/* Pointers, references, and arrays */
%typemap(in) SWIGTYPE *,
SWIGTYPE []
"swig_convert_ptr($input,(void **) &$1, $1_descriptor,SWIG_POINTER_EXCEPTION);"
/* Additional check for null references */
%typemap(in) SWIGTYPE &
"swig_convert_ptr($input,(void **) &$1, $1_descriptor,SWIG_POINTER_EXCEPTION);
if ($1 == NULL) swig_barf (SWIG_BARF1_ARGUMENT_NULL, \"null reference\");"
%typemap(in) SWIGTYPE *, SWIGTYPE [], SWIGTYPE & {
$1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, 0);
}
/* Void pointer. Accepts any kind of pointer */
%typemap(in) void * "swig_convert_ptr($input,(void **) &$1, 0, SWIG_POINTER_EXCEPTION);"
%typemap(in) void * {
$1 = SWIG_MustGetPtr($input, NULL, $argnum, 0);
}
/* Object passed by value. Convert to a pointer */
%typemap(in) SWIGTYPE ($&1_ltype argp) "swig_convert_ptr($input,(void **) &argp, $&1_descriptor,SWIG_POINTER_EXCEPTION);
$1 = *argp; ";
%typemap(varin) SWIGTYPE * {
$1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, 0);
}
/* Pointer to a class member */
%typemap(in) SWIGTYPE (CLASS::*) "swig_convert_packed($input, (void *) &$1, sizeof($1_type), $1_descriptor,SWIG_POINTER_EXCEPTION);";
%typemap(varin) SWIGTYPE & {
$1 = *(($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, 0));
}
%typemap(varin) SWIGTYPE [] {
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, "Type error");
}
%typemap(varin) SWIGTYPE [ANY] {
void *temp;
int ii;
$1_basetype *b = 0;
temp = SWIG_MustGetPtr($input, $1_descriptor, 1, 0);
b = ($1_basetype *) $1;
for (ii = 0; ii < $1_size; ii++) b[ii] = *(($1_basetype *) temp + ii);
}
%typemap(varin) void * {
$1 = SWIG_MustGetPtr($input, NULL, 1, 0);
}
%typemap(out) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
$result = SWIG_NewPointerObj ($1, $descriptor, $owner);
}
%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1);
$result = SWIG_NewPointerObj ($1, ty, $owner);
}
%typemap(varout) SWIGTYPE *, SWIGTYPE [] {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
$result = SWIG_NewPointerObj ($varname, $descriptor, 0);
}
%typemap(varout) SWIGTYPE & {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
$result = SWIG_NewPointerObj((void *) &$varname, $1_descriptor, 0);
}
/* Pass-by-value */
%typemap(in) SWIGTYPE($&1_ltype argp) {
argp = ($&1_ltype)SWIG_MustGetPtr($input, $&1_descriptor, $argnum, 0);
$1 = *argp;
}
%typemap(varin) SWIGTYPE {
$&1_ltype argp;
argp = ($&1_ltype)SWIG_MustGetPtr($input, $&1_descriptor, 1, 0);
$1 = *argp;
}
%typemap(out) SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultptr;
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
resultptr = new $1_ltype(($1_ltype &) $1);
$result = SWIG_NewPointerObj (resultptr, $&1_descriptor, 1);
}
#else
{
$&1_ltype resultptr;
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 1);
}
#endif
%typemap(varout) SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultptr;
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
resultptr = new $1_ltype(($1_ltype&) $1);
$result = SWIG_NewPointerObj (resultptr, $&1_descriptor, 0);
}
#else
{
$&1_ltype resultptr;
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 0);
}
#endif
/* --- Output values --- */
/* Strings */
%typemap(out,fragment="list_output_helper",chicken_words="0")
%typemap(out)
char *
{ char *s = (char*) $1;
if ($1 == NULL) {
@ -195,15 +267,11 @@ $1 = *argp; ";
else {
int string_len = strlen ($1);
C_word *string_space = C_alloc (C_SIZEOF_STRING (string_len));
/*if ONE*/
$result = C_string (&string_space, string_len, s);
/*else*/
$result = list_output_helper (&known_space, $result, C_string (&string_space, string_len, s));
/*endif*/
}
}
%typemap(varout,fragment="list_output_helper",chicken_words="0")
%typemap(varout)
char *
{ char *s = (char*) $varname;
if ($varname == NULL) {
@ -212,43 +280,19 @@ $1 = *argp; ";
else {
int string_len = strlen ($varname);
C_word *string_space = C_alloc (C_SIZEOF_STRING (string_len));
/*if ONE*/
$result = C_string (&string_space, string_len, s);
/*else*/
$result = list_output_helper (&known_space, $result, C_string (&string_space, string_len, s));
/*endif*/
}
}
/* Pointers, references, and arrays */
%typemap(out,chicken_words="SWIG_ALLOCSZ_POINTER($typename)") SWIGTYPE *, SWIGTYPE &, SWIGTYPE []
"$result = swig_new_pointer_obj((void *) $1, &known_space, $1_descriptor);";
/* Dynamic casts */
%typemap(out,chicken_words="SWIG_ALLOCSZ_POINTER($typename)") SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor, (void **) &$1);
$result = swig_new_pointer_obj((void *) $1, &known_space, ty);
}
/* Member pointer */
%typemap(out,chicken_words="SWIG_ALLOCSZ_PACKED_OBJ(sizeof($1_type),$typename)") SWIGTYPE (CLASS::*) "$result = swig_new_packed_obj((void *) &$1, &known_space, sizeof($1_type), $1_descriptor);";
/* Void */
%typemap(out,chicken_words="void") void
%typemap(out) void
%{
/*if ONE*/
$result = C_SCHEME_UNDEFINED;
/*else*/
/* void return value, no need to be in $result */
/*endif*/
%}
/* Special typemap for character array return values */
%typemap(out,fragment="list_output_helper",chicken_words="0")
%typemap(out)
char [ANY], const char [ANY]
%{ if ($1 == NULL) {
$result = C_SCHEME_FALSE;
@ -256,31 +300,11 @@ $result = C_SCHEME_UNDEFINED;
else {
const int string_len = strlen ($1);
C_word *string_space = C_alloc (C_SIZEOF_STRING (string_len));
/*if ONE*/
$result = C_string (&string_space, string_len, $1);
/*else*/
$result = list_output_helper (&known_space, $result, C_string (&string_space, string_len, $1));
/*endif*/
} %}
/* Primitive types--return by value */
%typemap(out,chicken_words="SWIG_ALLOCSZ_POINTER($typename)") SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultptr;
resultptr = new $1_ltype(($1_ltype &) $1);
$result = swig_new_pointer_obj((void *) resultptr, &known_space, $&1_descriptor);
}
#else
{
$&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = swig_new_pointer_obj((void *) resultptr, &known_space, $&1_descriptor);
}
#endif
/* --- Variable input --- */
/* A string */
@ -364,55 +388,8 @@ $result = C_SCHEME_UNDEFINED;
}
}
%typemap(varin) SWIGTYPE * {
if ($input == C_SCHEME_FALSE) {
$1 = NULL;
}
else {
void *temp;
swig_convert_ptr($input,(void **) &temp, $1_descriptor, SWIG_POINTER_EXCEPTION);
$1 = ($1_ltype) temp;
}
}
%typemap(varin) SWIGTYPE & {
void *temp;
swig_convert_ptr($input,(void **) &temp, $1_descriptor, SWIG_POINTER_EXCEPTION);
if (temp == NULL) {
swig_barf (SWIG_BARF1_ARGUMENT_NULL, "$name is a null reference");
return 1;
}
$1 = ($1_ltype) temp;
}
%typemap(varin) void * {
void * temp;
swig_convert_ptr($input,(void **) &temp, 0, SWIG_POINTER_EXCEPTION | SWIG_POINTER_DISOWN);
$1 = ($1_ltype) temp;
}
%typemap(varin) SWIGTYPE (CLASS::*) {
char temp[sizeof($1_type)];
swig_convert_packed($input,(void *) temp, sizeof($1_type), $1_descriptor, SWIG_POINTER_EXCEPTION);
memmove((void *) &$1,temp,sizeof($1_type));
}
%typemap(varin) SWIGTYPE {
$&1_ltype temp;
swig_convert_ptr($input, (void **) &temp, $&1_descriptor, SWIG_POINTER_EXCEPTION);
$1 = *(($&1_type) temp);
}
/* --- Variable output --- */
/* Pointers, references, and arrays */
%typemap(varout,chicken_words="SWIG_ALLOCSZ_POINTER($typename)") SWIGTYPE *, SWIGTYPE &, SWIGTYPE []
"$result = swig_new_pointer_obj((void *) $varname, &known_space, $1_descriptor);";
/* Member pointer */
%typemap(varout,chicken_words="SWIG_ALLOCSZ_PACKED_OBJ(sizeof($1_type),$typename)") SWIGTYPE (CLASS::*)
"$result = swig_new_packed_obj((void *) &$varname, sizeof($1_type), &known_space, $1_descriptor);";
/* Void */
%typemap(varout) void "$result = C_SCHEME_UNDEFINED;";
@ -422,13 +399,12 @@ $result = C_SCHEME_UNDEFINED;
$result = NULL;
}
else if (C_swig_is_string ($varname)) {
$result = swig_make_string ($varname);
$result = SWIG_MakeString ($varname);
}
else {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument #$argnum is not of type 'string'");
} %}
%typemap(varout,chicken_words="SWIG_ALLOCSZ_POINTER($typename)") SWIGTYPE "$result = swig_new_pointer_obj((void *) &$varname, &known_space, $&1_descriptor);";
/* --- Constants --- */
@ -530,29 +506,12 @@ $result = C_SCHEME_UNDEFINED;
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {
void *ptr;
if (swig_convert_ptr($input, (void **) &ptr, $1_descriptor, 0) == -1) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE {
void *ptr;
if (swig_convert_ptr($input, (void **) &ptr, $&1_descriptor, 0) == -1) {
$1 = 0;
} else {
$1 = 1;
}
$1 = !SWIG_ConvertPtr($input, &ptr, $1_descriptor, 0);
}
%typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
void *ptr;
if (swig_convert_ptr($input, (void **) &ptr, 0, 0) == -1) {
$1 = 0;
} else {
$1 = 1;
}
$1 = !SWIG_ConvertPtr($input, &ptr, 0, 0);
}
/* ------------------------------------------------------------
@ -619,20 +578,12 @@ $result = C_SCHEME_UNDEFINED;
%typemap("clos_in") SIMPLE_CLOS_OBJECT * "(slot-ref $input (quote this))"
%typemap("clos_out") SIMPLE_CLOS_OBJECT * "(make $class (quote this) $1)"
/* VERBATIM CODE INSERTIONS */
%insert(header) %{
#ifdef __cplusplus
extern "C" {
#endif
/* Chicken initialization function */
SWIGEXPORT(void) $realmodule_swig_init(int, C_word, C_word) C_noret;
/* Tag functions */
SWIGEXPORT(int) $realmodule_swig_num_types (void);
SWIGEXPORT(const char*) $realmodule_swig_type_name (int);
SWIGEXPORT(void*) $realmodule_swig_type_ptr (int);
SWIGEXPORT(const char*) $realmodule_swig_type_str (int);
SWIGEXPORT(void) $realmodule_swig_type_tag (int, C_word);
#ifdef __cplusplus
}
#endif
@ -657,75 +608,4 @@ $realmodule_swig_init(int argc, C_word closure, C_word continuation) {
}
}
/* Tag functions */
SWIGEXPORT(int)
$realmodule_swig_num_types (void)
{
int i;
for (i=0; swig_types_initial[i]; i++);
return i;
}
SWIGEXPORT(const char*)
$realmodule_swig_type_name (int index)
{
return swig_types[index]->name;
}
SWIGEXPORT(void*)
$realmodule_swig_type_ptr (int index)
{
return (void*) (swig_types[index]);
}
SWIGEXPORT(const char*)
$realmodule_swig_type_str (int index)
{
return swig_types[index]->str;
}
SWIGEXPORT(void)
$realmodule_swig_type_tag (int index, C_word tag)
{
swig_chicken_clientdata *data =
(swig_chicken_clientdata*) malloc (sizeof (swig_chicken_clientdata));
C_mutate (&(data->tag), tag);
data->literal_frame = C_register_lf (&(data->tag), 1);
SWIG_TypeClientData (swig_types[index], (void*) data);
}
%}
%insert(chicken) %{
(declare
(foreign-declare "C_extern int $realmodule_swig_num_types (void);")
(foreign-declare "C_extern char* $realmodule_swig_type_name (int);")
(foreign-declare "C_extern void* $realmodule_swig_type_ptr (int);")
(foreign-declare "C_extern char* $realmodule_swig_type_str (int);")
(foreign-declare "C_extern void $realmodule_swig_type_tag (int, C_word);"))
(define-record swig-$module-tag class name ptr str)
(define-record-printer (swig-$module-tag tag out)
(fprintf out "#<c++ ~S>(~A)" (swig-$module-tag-str tag)
(swig-$module-tag-ptr tag)))
(define swig-$module-tag-num
((foreign-lambda int "$realmodule_swig_num_types")))
(define swig-$module-tags (make-vector swig-$module-tag-num #f))
(letrec
((gen
(lambda (l i)
(if (= i 0) (cons 0 l) (gen (cons i l) (- i 1))))))
(let ((indices (if (<= swig-$module-tag-num 0) (quote ())
(gen (quote ()) (- swig-$module-tag-num 1)))))
(for-each
(lambda (index)
(let
((tag
(make-swig-$module-tag
1000
((foreign-lambda
c-string "$realmodule_swig_type_name" int) index)
((foreign-lambda
c-pointer "$realmodule_swig_type_ptr" int) index)
((foreign-lambda
c-string "$realmodule_swig_type_str" int) index))))
(vector-set! swig-$module-tags index tag)
((foreign-lambda void "$realmodule_swig_type_tag"
int scheme-object) index tag)))
indices)))
%}

391
Lib/chicken/chickenrun.swg
View file

@ -1,28 +1,32 @@
/***********************************************************************
* chickenrun.swg
/* -*- c -*-
* -----------------------------------------------------------------------
* swig_lib/chicken/chickenrun.swg
*
* This file contains the runtime support for CHICKEN modules
* and includes code for managing global variables and pointer
* type checking.
*
* Author : Jonah Beckford
* Derived from - file : pyrun.swg
* Derived from - author : David Beazley (beazley@cs.uchicago.edu)
************************************************************************/
* Author: John Lenz <jelenz@wisc.edu>
* ----------------------------------------------------------------------- */
#include <chicken.h>
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#ifdef __cplusplus
extern "C" {
#endif
#ifdef C_SIXTY_FOUR
# define WORDS_PER_FLONUM 2
#else
# define WORDS_PER_FLONUM 4
#endif
/* Flags for pointer conversion */
#define SWIG_POINTER_EXCEPTION 0x1
#define SWIG_malloc(size) \
malloc(size)
#define SWIG_free(mem) \
free(mem)
#define SWIG_MakeString(c) \
SWIG_Chicken_MakeString(c)
#define SWIG_ConvertPtr(s, result, type, flags) \
SWIG_Chicken_ConvertPtr(s, result, type, flags)
#define SWIG_MustGetPtr(s, type, argnum, flags) \
SWIG_Chicken_MustGetPtr(s, type, argnum, flags)
#define SWIG_NewPointerObj(ptr, type, owner) \
SWIG_Chicken_NewPointerObj((void*)ptr, type, owner, &known_space)
#define swig_barf SWIG_Chicken_Barf
#define C_swig_is_bool(x) C_truep (C_booleanp (x))
#define C_swig_is_char(x) C_truep (C_charp (x))
@ -31,62 +35,68 @@ extern "C" {
#define C_swig_is_string(x) (C_truep (C_blockp (x)) && C_truep (C_stringp (x)))
#define C_swig_is_vector(x) (C_truep (C_blockp (x)) && C_truep (C_vectorp (x)))
#define C_swig_is_list(x) (C_truep (C_i_listp (x)))
#define C_swig_is_tagged_ptr(x) (C_truep (C_blockp (x)) && C_truep (C_taggedpointerp (x)))
#define C_swig_is_tag_struct(x) (C_truep (C_blockp (x)) && C_truep (C_structurep (x)) && (C_header_size (x) >= 3))
#define C_swig_is_pair(x) (C_truep (C_blockp(x)) && C_truep (C_pairp(x)))
#define C_swig_is_ptr(x) (C_truep (C_blockp (x)) && C_truep (C_pointerp (x)))
#define C_swig_is_swigpointer(x) (C_truep (C_blockp(x)) && C_truep (C_swigpointerp(x)))
#define SWIG_APPEND_VALUE(object) \
if (resultobj == C_SCHEME_UNDEFINED) \
resultobj = object; \
else { \
C_word *pair_space = C_alloc(C_SIZEOF_PAIR); \
if (!gswig_list_p) { \
gswig_list_p = 1; \
C_word *pair_space2 = C_alloc(C_SIZEOF_PAIR); \
resultobj = C_pair(&pair_space2, resultobj, C_SCHEME_END_OF_LIST); \
resultobjlast = resultobj; \
} \
C_word tmp = C_pair(&pair_space, object, C_SCHEME_END_OF_LIST); \
C_set_block_item(resultobjlast, 1, tmp); \
resultobjlast = tmp; \
}
enum {
SWIG_BARF1_BAD_ARGUMENT_TYPE /* 1 arg */,
SWIG_BARF1_ARGUMENT_NULL /* 1 arg */
};
typedef struct swig_chicken_clientdata {
void* literal_frame;
C_word tag;
} swig_chicken_clientdata;
#ifdef SWIG_NOINCLUDE
SWIGEXPORT(char *) swig_make_string (C_word string);
SWIGEXPORT(char *) swig_make_string2 (char *data, int len);
SWIGEXPORT(void) swig_barf (int code, C_char *msg, ...) C_noret;
SWIGEXPORT(void) swig_panic (C_char *msg) C_noret;
SWIGEXPORT(int) swig_convert_ptr(C_word , void **,
swig_type_info *, int);
SWIGEXPORT(int) swig_convert_packed(C_word , void *, int sz,
swig_type_info *, int);
SWIGEXPORT(char *) swig_pack_data(char *c, void *, int);
SWIGEXPORT(char *) swig_unpack_data(char *c, void *, int);
SWIGEXPORT(C_word) swig_new_pointer_obj(void *, swig_type_info *,
int own);
SWIGEXPORT(C_word) swig_new_packed_obj(void *, int sz,
swig_type_info *);
/*SWIGIMPORT(void) SWIG_Chicken_Init();*/
/* Interface helper function */
SWIGIMPORT(char *) SWIG_Chicken_MakeString(C_word str);
/* Get a pointer value from a C_word. If there is a type-mismatch,
return nonzero; on success, return 0. */
SWIGIMPORT(int) SWIG_Chicken_ConvertPtr(C_word s, void **result, swig_type_info *type, int flags);
/* Get a pointer value from a C_word. If there is a type-mismatch,
signal a wrong-type-arg error for the given argument number. */
SWIGIMPORT(void *) SWIG_Chicken_MustGetPtr(C_word s, swig_type_info *type, int argnum, int flags);
/* Make a smob from a pointer and typeinfo, using space as the memory for the new object */
SWIGIMPORT(C_word) SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, C_word **space);
/* generate an error message and halt */
SWIGIMPORT(void) SWIG_Chicken_Barf(int code, C_char *msg, ...);
#else
/* Allocate a zero-terminated string. No error-checking. */
SWIGRUNTIME(char *)
swig_make_string2 (char *data, int len)
{
SWIG_Chicken_MakeString(C_word str) {
char *ret;
if (data == NULL) return NULL;
ret = (char *) malloc (len + 1);
strncpy (ret, data, len);
ret [len] = 0;
size_t l;
l = C_header_size(str);
ret = (char *) SWIG_malloc( (l + 1) * sizeof(char));
if (!ret) return NULL;
memcpy(ret, C_c_string(str), l);
ret[l] = '\0';
return ret;
}
/* Allocate a zero-terminated string. No error-checking. */
SWIGRUNTIME(char *)
swig_make_string (C_word string)
{
return swig_make_string2 (C_c_string (string),
C_header_size (string));
}
SWIGRUNTIME(void) swig_panic (C_char *) C_noret;
SWIGRUNTIME(void)
swig_panic (C_char *msg)
/* Just a helper function. Do not export it */
static void SWIG_Chicken_Panic (C_char *) C_noret;
static void SWIG_Chicken_Panic (C_char *msg)
{
C_word *a = C_alloc (C_SIZEOF_STRING (strlen (msg)));
C_word scmmsg = C_string2 (&a, msg);
@ -94,9 +104,10 @@ swig_panic (C_char *msg)
exit (5); /* should never get here */
}
SWIGRUNTIME(void) swig_barf (int, C_char *, ...) C_noret;
SWIGRUNTIME(void)
swig_barf (int code, C_char *msg, ...)
SWIG_Chicken_Barf(int code, C_char *msg, ...) C_noret;
SWIGRUNTIME(void)
SWIG_Chicken_Barf(int code, C_char *msg, ...)
{
char *errorhook = C_text("\003syserror-hook");
C_word *a = C_alloc (C_SIZEOF_STRING (strlen (errorhook)));
@ -110,7 +121,7 @@ swig_barf (int code, C_char *msg, ...)
err = C_block_item(err, 0);
if(C_immediatep (err))
swig_panic (C_text ("`##sys#error-hook' is not defined"));
SWIG_Chicken_Panic (C_text ("`##sys#error-hook' is not defined"));
switch (code) {
case SWIG_BARF1_BAD_ARGUMENT_TYPE:
@ -122,7 +133,7 @@ swig_barf (int code, C_char *msg, ...)
c = 1;
break;
default:
swig_panic (C_text (msg));
SWIG_Chicken_Panic (C_text (msg));
};
if(c > 0 && !C_immediatep (err)) {
@ -148,225 +159,69 @@ swig_barf (int code, C_char *msg, ...)
return! */
}
else if (msg) {
swig_panic (msg);
SWIG_Chicken_Panic (msg);
}
else {
swig_panic (C_text ("unspecified panic"));
SWIG_Chicken_Panic (C_text ("unspecified panic"));
}
}
/* Pack binary data into a string */
SWIGRUNTIME(char *)
swig_pack_data(char *c, void *ptr, int sz) {
static char hex[17] = "0123456789abcdef";
int i;
unsigned char *u = (unsigned char *) ptr;
register unsigned char uu;
for (i = 0; i < sz; i++,u++) {
uu = *u;
*(c++) = hex[(uu & 0xf0) >> 4];
*(c++) = hex[uu & 0xf];
}
return c;
}
/* Unpack binary data from a string */
SWIGRUNTIME(char *)
swig_unpack_data(char *c, void *ptr, int sz) {
register unsigned char uu = 0;
register int d;
unsigned char *u = (unsigned char *) ptr;
int i;
for (i = 0; i < sz; i++, u++) {
d = *(c++);
if ((d >= '0') && (d <= '9'))
uu = ((d - '0') << 4);
else if ((d >= 'a') && (d <= 'f'))
uu = ((d - ('a'-10)) << 4);
d = *(c++);
if ((d >= '0') && (d <= '9'))
uu |= (d - '0');
else if ((d >= 'a') && (d <= 'f'))
uu |= (d - ('a'-10));
*u = uu;
}
return c;
}
/* Convert a pointer value */
SWIGRUNTIME(int)
swig_convert_ptr(C_word obj, void **ptr, swig_type_info *ty, int flags) {
swig_type_info *tc;
#ifdef SWIG_POINTER_AS_STRING
char *s;
char *c;
if (obj == C_SCHEME_FALSE) {
*ptr = 0;
return 0;
}
c = s = 0;
if (!(C_swig_is_string (obj))) goto type_error;
s = c = swig_make_string (obj);
if (!c) goto type_error;
/* Pointer values must start with leading underscore */
if (*c != '_') goto type_error;
c++;
c = swig_unpack_data (c,ptr,sizeof(void *));
if (ty) {
tc = SWIG_TypeCheck(c,ty);
if (!tc) goto type_error;
*ptr = SWIG_TypeCast(tc,(void*) *ptr);
}
free (s);
#else
C_word tag;
C_word tag_ptr;
if (obj == C_SCHEME_FALSE) {
*ptr = 0;
return 0;
}
if (!(C_swig_is_tagged_ptr (obj))) goto type_error;
*ptr = (void*) C_pointer_address (obj);
if (ty) {
tag = C_block_item (obj, 1);
if (!(C_swig_is_tag_struct (tag))) goto type_error;
tag_ptr = C_block_item (tag, 3);
if (!(C_swig_is_ptr (tag_ptr))) goto type_error;
tc = (swig_type_info *) C_pointer_address (tag_ptr);
if (!tc) goto type_error;
*ptr = SWIG_TypeCast(tc,(void*) *ptr);
}
#endif
return 0;
type_error:
#ifdef SWIG_POINTER_AS_STRING
if (s) { free (s); }
#endif
if (flags & SWIG_POINTER_EXCEPTION) {
if (ty) {
char *temp = (char *) malloc(64+strlen(ty->name));
sprintf(temp,"Type error. Expected %s", ty->name);
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, temp);
free((char *) temp);
} else {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Expected a pointer");
}
}
return -1;
}
/* Convert a packed value */
SWIGRUNTIME(int)
swig_convert_packed(C_word obj, void *ptr, int sz, swig_type_info *ty, int flags) {
swig_type_info *tc;
char *c;
char *s;
if (!C_swig_is_string (obj)) goto type_error;
s = c = swig_make_string (obj);
/* Pointer values must start with leading underscore */
if (!c || *c != '_') goto type_error;
c++;
c = swig_unpack_data(c,ptr,sz);
if (ty) {
tc = SWIG_TypeCheck(c,ty);
if (!tc) goto type_error;
}
free (s);
return 0;
type_error:
free (s);
if (flags) {
if (ty) {
char *temp = (char *) malloc(64+strlen(ty->name));
sprintf(temp,"Type error. Expected %s", ty->name);
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, temp);
free((char *) temp);
} else {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Expected a pointer");
}
}
return -1;
}
#define SWIG_STRLEN_PACKED_OBJ(obj_sz,name) (2*obj_sz+1+strlen(name))
#define SWIG_ALLOCSZ_PACKED_OBJ(obj_sz,name) (C_SIZEOF_STRING (SWIG_STRLEN_PACKED_OBJ (obj_sz,name)))
/* #define SWIG_ALLOCSZ_POINTER(name) SWIG_ALLOCSZ_PACKED_OBJ(sizeof(void*),name) */
#define SWIG_ALLOCSZ_POINTER(name) 3
/* Create a new pointer object. 'a' should be a pointer to some
C_alloc result with SWIG_ALLOCSZ_POINTER (type->name) room */
SWIGRUNTIME(C_word)
swig_new_pointer_obj(void *ptr, C_word **a, swig_type_info *type) {
SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, C_word **data)
{
if (ptr == NULL)
return C_SCHEME_FALSE;
#ifdef SWIG_POINTER_AS_STRING
{
char result[1024];
char *r = result;
*(r++) = '_';
r = swig_pack_data(r,&ptr,sizeof(void *));
strcpy(r,type->name);
return C_string2 (a, result);
else
return C_swigmpointer(data, ptr, type);
}
/* Return 0 if successful. */
SWIGRUNTIME(int)
SWIG_Chicken_ConvertPtr(C_word s, void **result, swig_type_info *type, int flags)
{
swig_type_info *cast;
swig_type_info *from;
if (s == C_SCHEME_FALSE) {
*result = NULL;
return 0;
} else if (C_swig_is_swigpointer(s)) {
from = (swig_type_info *) C_block_item(s, 1);
if (!from) return 1;
if (type) {
cast = SWIG_TypeCheck((char*)from->name, type);
if (cast) {
*result = SWIG_TypeCast(cast, (void *) C_block_item(s, 0));
return 0;
} else {
return 1;
}
} else {
*result = (void *) C_block_item(s, 0);
return 0;
}
}
#else
{
/* similar to C_mpointer */
C_word *p = *a,
*p0 = p;
return 1;
}
*(p++) = C_TAGGED_POINTER_TAG;
*((void **)(p++)) = ptr;
C_mutate ((C_word*)(p++),
((swig_chicken_clientdata*) type->clientdata)->tag);
*a = p;
return (C_word)p0;
SWIGRUNTIME(void *)
SWIG_Chicken_MustGetPtr (C_word s, swig_type_info *type, int argnum, int flags)
{
void *result;
if (SWIG_Chicken_ConvertPtr(s, &result, type, flags)) {
/* type mismatch */
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE,
"Type error in argument %i: expected a %s.", argnum, type->name);
}
#endif
return result;
}
/* 'a' should be a pointer to some C_alloc result with
SWIG_ALLOCSZ_PACKED_OBJ (sz,type->name) room */
SWIGRUNTIME(C_word)
swig_new_packed_obj (void *ptr, C_word **a, int sz, swig_type_info *type) {
char result[1024];
char *r = result;
if (SWIG_STRLEN_PACKED_OBJ (sz, type->name) > 1000) return 0;
*(r++) = '_';
r = swig_pack_data(r,ptr,sz);
strcpy(r,type->name);
return C_string2 (a, result);
}
/*
SWIGRUNTIME(void)
SWIG_Chicken_Init ()
{
}*/
/* Standard Chicken function */
static void C_fcall swig_tr2(C_proc2 k) C_regparm C_noret;
static void C_fcall swig_tr2(C_proc2 k) {
C_word t1=C_pick(0);
C_word t0=C_pick(1);
C_adjust_stack(-2);
(k)(2,t0,t1);
}
/* Standard Chicken function */
static void C_fcall swig_tr2r(C_proc2 k) C_regparm C_noret;
static void C_fcall swig_tr2r(C_proc2 k) {
int n;
C_word *a,t2;
C_word t1=C_pick(0);
C_word t0=C_pick(1);
C_adjust_stack(-2);
n=C_rest_count(0);
a=C_alloc(n*3);
t2=C_restore_rest(a,n);
(k)(t0,t1,t2);
}
#endif

21
Lib/chicken/fragments.i
View file

@ -1,21 +0,0 @@
/* Helper function to return tuples.
* Jonah Beckford
*
* Derived from Lib/python/fragments.i; Author: Robin Dunn
*
*
*/
%fragment("list_output_helper","header") %{
static C_word list_output_helper(C_word **ptr, C_word target, C_word o)
/* Prepends 'o' to list 'target'. ptr must be from C_alloc and have
room for 3 C_words. */
{
if (!target || C_truep (C_undefinedp (target))) {
target = C_pair (ptr, o, C_SCHEME_END_OF_LIST);
} else {
target = C_pair (ptr, o, target);
}
return target;
}
%}

45
Lib/chicken/typemaps.i
View file

@ -119,8 +119,6 @@ output values, in reverse order.
// Author: Robin Dunn
//----------------------------------------------------------------------
%include "fragments.i"
// Simple types
%define INOUT_TYPEMAP(type_, from_scheme, to_scheme, checker, convtype, storage_)
@ -140,29 +138,26 @@ output values, in reverse order.
#if "storage_" == "0"
%typemap(argout,fragment="list_output_helper",chicken_words="storage_")
type_ *OUTPUT, type_ &OUTPUT
%{ if ($1 == NULL) {
%typemap(argout) type_ *OUTPUT, type_ &OUTPUT
%{
if ($1 == NULL) {
swig_barf (SWIG_BARF1_ARGUMENT_NULL, "Argument #$argnum must be non-null");
}
/*if ONE*/
$result = to_scheme (convtype (*$1));
/*else*/
$result = list_output_helper (&known_space, $result, to_scheme (convtype (*$1)));
/*endif*/ %}
SWIG_APPEND_VALUE(to_scheme (convtype (*$1)));
%}
#else
%typemap(argout,fragment="list_output_helper",chicken_words="storage_")
type_ *OUTPUT, type_ &OUTPUT
%{if ($1 == NULL) {
swig_barf (SWIG_BARF1_ARGUMENT_NULL, "Variable '$1' must be non-null");
%typemap(argout) type_ *OUTPUT, type_ &OUTPUT
%{
{
C_word *known_space = C_alloc(storage_);
if ($1 == NULL) {
swig_barf (SWIG_BARF1_ARGUMENT_NULL, "Variable '$1' must be non-null");
}
SWIG_APPEND_VALUE(to_scheme (&known_space, convtype (*$1)));
}
/*if ONE*/
$result = to_scheme (&known_space, convtype (*$1));
/*else*/
$result = list_output_helper (&known_space, $result, to_scheme (&known_space, convtype (*$1)));
/*endif*/ %}
%}
#endif
@ -171,18 +166,18 @@ output values, in reverse order.
INOUT_TYPEMAP(int, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
INOUT_TYPEMAP(enum SWIGTYPE, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
INOUT_TYPEMAP(short, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
INOUT_TYPEMAP(long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
INOUT_TYPEMAP(long long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
INOUT_TYPEMAP(long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLOWNUM);
INOUT_TYPEMAP(long long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLONUM);
INOUT_TYPEMAP(unsigned int, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
INOUT_TYPEMAP(unsigned short, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
INOUT_TYPEMAP(unsigned long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
INOUT_TYPEMAP(unsigned long long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
INOUT_TYPEMAP(unsigned long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLONUM);
INOUT_TYPEMAP(unsigned long long, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLONUM);
INOUT_TYPEMAP(unsigned char, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
INOUT_TYPEMAP(signed char, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
INOUT_TYPEMAP(char, C_character_code, C_make_character, C_swig_is_char, (char), 0);
INOUT_TYPEMAP(bool, C_truep, C_mk_bool, C_swig_is_bool, (bool), 0);
INOUT_TYPEMAP(float, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
INOUT_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), WORDS_PER_FLONUM);
INOUT_TYPEMAP(float, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLONUM);
INOUT_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_SIZEOF_FLONUM);
// INOUT
// Mappings for an argument that is both an input and output

213
Source/Modules/chicken.cxx
View file

@ -123,7 +123,6 @@ protected:
for output typemaps or Getattr(parm, "name") for an input
parameter, and 'n' may be a class definition or anything else. */
String* recurseSearch(const char *typemap, char *argname, Node *n);
void selectOutOneOrMany(String *tm, int is_many);
};
/* -----------------------------------------------------------------------
@ -277,11 +276,6 @@ CHICKEN::top(Node *n)
";; Don't modify this file, modify the SWIG interface instead.\n",
NIL);
Printv(f_scm,"(cond-expand ((or chicken-compile-shared shared)) (else (declare (unit ", module, "))))\n\n", NIL);
#ifdef JONAH_IS_CRAZY
Printv(f_scm,"(declare \n",
tab4, "(foreign-declare \"void* ", realmodule,
"_swig_get_type(char*);\"))\n", NIL);
#endif
#ifndef INIT_BINDING
Printv(f_scm,"(declare \n",
tab4, "(hide swig-init)\n",
@ -291,13 +285,6 @@ CHICKEN::top(Node *n)
"_swig_init\"))\n", NIL);
Printv(f_scm,"(swig-init)\n\n", NIL);
#endif
#ifdef JONAH_IS_CRAZY
Printv(f_scm,"(define-record swig-",prefix,"tag class name ptr str)\n",
"(define-record-printer (swig-",prefix,"tag tag out)\n",
tab4, "(fprintf out \"#<tag ~S>(~A)\" (swig-",prefix,
"tag-str tag)\n",
tab8, "(swig-",prefix,"tag-ptr tag)))\n", NIL);
#endif
// Include some information in the code
Printf(f_header,"\n/*-----------------------------------------------\n @(target):= %s.so\n\
@ -344,21 +331,6 @@ CHICKEN::top(Node *n)
Printf(f_wrappers,"extern \"C\" {\n");
Printf(f_wrappers,"#endif\n\n");
#ifdef JONAH_IS_CRAZY
Printv(f_init_helper,
"#ifdef __cplusplus\n",
"extern \"C\"\n",
"#endif\n",
"SWIGEXPORT(void *) ", realmodule, "_swig_get_type (char *type) {\n",
"int i;\n",
"for (i = 0; swig_types_initial[i]; i++) {\n",
"if (strcmp (type, swig_types[i]->name) == 0) ",
"return swig_types[i];\n",
"}\n",
"return NULL;\n",
"}\n\n",
NIL);
#endif
Printf(f_init_helper,
"static void swig_init_helper (C_word continuation) C_noret;\n");
Printf(f_init_helper,
@ -466,13 +438,10 @@ CHICKEN::functionWrapper(Node *n)
char source[64];
Wrapper *f;
String *mangle = NewString("");
String *known_alloca;
String *known_alloca_plus;
String *get_pointers;
String *cleanup;
String *outarg;
String *tm;
String *am;
String *overname = 0;
String *declfunc = 0;
String *scmname;
@ -493,8 +462,6 @@ CHICKEN::functionWrapper(Node *n)
f = NewWrapper();
wname = NewString("");
known_alloca = NewString("");
known_alloca_plus = NewString("");
get_pointers = NewString("");
cleanup = NewString("");
outarg = NewString("");
@ -506,6 +473,8 @@ CHICKEN::functionWrapper(Node *n)
/* Local vars */
Wrapper_add_local(f,"resultobj", "C_word resultobj");
Wrapper_add_local(f,"resultobjlast", "C_word resultobjlast");
Wrapper_add_local(f,"gswig_list_p", "int gswig_list_p = 0");
/* Write code to extract function parameters. */
emit_args(d, l, f);
@ -539,64 +508,6 @@ CHICKEN::functionWrapper(Node *n)
"(int,C_word,C_word",
NIL);
/* Calculate fixed alloca code */
int result_list_len = 0;
int has_void_return = 0;
int will_alloca = 0;
for (p = l; p;) {
if ((tm = Getattr(p,"tmap:argout:chicken_words"))) {
Replaceall(tm,"$typename", mangle);
if (strcmp(Char(tm), "void") == 0) continue;
if (strcmp(Char(tm), "0") != 0) will_alloca = 1;
if (result_list_len) {
Printf(known_alloca_plus, " + ");
} else {
Printf(known_alloca, "%s /*%s*/", tm, Getattr(p,"lname"));
}
Printf(known_alloca_plus, "3+%s /*%s*/", tm, Getattr(p,"lname"));
result_list_len++;
p = Getattr(p,"tmap:argout:next");
} else {
p = nextSibling(p);
}
}
if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) {
if ((am = Getattr(n,"tmap:out:chicken_words"))) {
Replaceall(am,"$typename", mangle);
if (strcmp(Char(am), "void") == 0) {
has_void_return = 1;
}
else {
if (strcmp(Char(am), "0") != 0) will_alloca = 1;
if (result_list_len) {
Printf(known_alloca_plus, " + ");
} else {
Printf(known_alloca, "%s /*result*/", am);
}
Printf(known_alloca_plus, "3+%s /*result*/", am);
result_list_len++;
}
}
}
/* Generate known_space code */
if (result_list_len > 1 || (will_alloca && result_list_len == 1)) {
if (result_list_len == 1) {
Wrapper_add_local(f,"known_space", "C_word *known_space");
Printf(f->code, " known_space = C_alloc (%s);\n",
known_alloca);
}
else {
Wrapper_add_local(f,"known_space", "C_word *known_space");
Printf(f->code, " /* allocate space for fixed-size scheme objects "
"used for output */\n");
Printf(f->code, " known_space = C_alloc (%s); "
"/* The '3' in 3+... is to alloc a C_pair "
"in the Scheme list 'resultobj' */ \n",
known_alloca_plus);
}
}
/* Generate code for argument marshalling */
for (i = 0, p=l; i < num_arguments; i++) {
@ -715,15 +626,11 @@ CHICKEN::functionWrapper(Node *n)
}
}
/* Want outputs done in reverse order */
List *l_out = NewList();
/* Emit the function call */
emit_action(n,f);
/* Return the function value */
if (has_void_return && result_list_len == 1) {
/* do absolutely nothing since result will be initted elsewhere
by one argout */
}
else if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) {
if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) {
Replaceall(tm,"$source", "result");
Replaceall(tm,"$target", "resultobj");
Replaceall(tm,"$result", "resultobj");
@ -732,8 +639,7 @@ CHICKEN::functionWrapper(Node *n)
} else {
Replaceall(tm,"$owner","0");
}
selectOutOneOrMany(tm, result_list_len > 1);
Append(l_out, tm);
Printf(f->code, "%s", tm);
} else {
Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number,
"Unable to use return type %s in function %s.\n",
@ -747,26 +653,13 @@ CHICKEN::functionWrapper(Node *n)
Replaceall(tm,"$target","resultobj");
Replaceall(tm,"$arg",Getattr(p,"emit:input"));
Replaceall(tm,"$input",Getattr(p,"emit:input"));
selectOutOneOrMany(tm, result_list_len > 1);
Append(l_out, tm);
Printf(f->code, "%s", tm);
p = Getattr(p,"tmap:argout:next");
} else {
p = nextSibling(p);
}
}
/* Emit the function call */
emit_action(n,f);
/* Output argument output code */
int i_out;
if (result_list_len > 1) {
Printv(f->code, "resultobj = C_SCHEME_UNDEFINED;\n", NIL);
}
for (i_out = Len(l_out); i_out > 0; ) {
Printv(f->code, (String *) Getitem(l_out, --i_out), "\n", NIL);
}
/* Output cleanup code */
Printv(f->code,cleanup,NIL);
@ -871,9 +764,6 @@ CHICKEN::functionWrapper(Node *n)
Delete(closparam);
Delete(wname);
Delete(l_out);
Delete(known_alloca);
Delete(known_alloca_plus);
Delete(get_pointers);
Delete(cleanup);
Delete(outarg);
@ -898,11 +788,9 @@ CHICKEN::variableWrapper(Node *n) {
String *wname = NewString("");
String *mangle = NewString("");
String *tm;
String *am;
String *tm2 = NewString("");;
String *argnum = NewString("0");
String *arg = NewString("argv[0]");
String *known_alloca = NewString("");
Wrapper *f;
String *overname = 0;
String *scmname;
@ -1026,19 +914,7 @@ CHICKEN::variableWrapper(Node *n) {
// Now return the value of the variable - regardless
// of evaluating or setting.
if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
/* Calculate fixed alloca code */
if ((am = Getattr(n,"tmap:varout:chicken_words"))) {
Replaceall(am,"$typename", mangle);
if (strcmp(Char(am), "0") != 0) {
Wrapper_add_local(f,"known_space", "C_word *known_space");
Printf(f->code,
" known_space = C_alloc (%s);\n",
am);
}
}
selectOutOneOrMany(tm, 0);
Replaceall(tm,"$source",name);
Replaceall(tm,"$varname",name);
Replaceall(tm,"$target","resultobj");
@ -1119,7 +995,6 @@ CHICKEN::variableWrapper(Node *n) {
}
Delete(wname);
Delete(known_alloca);
Delete(proc_name);
Delete(argnum);
Delete(arg);
@ -1150,12 +1025,10 @@ CHICKEN::constantWrapper(Node *n)
String *wname = NewString("");
String *mangle = NewString("");
String *tm;
String *am;
String *tm2 = NewString("");
String *source = NewString("");
String *argnum = NewString("0");
String *arg = NewString("argv[0]");
String *known_alloca = NewString("");
Wrapper *f;
String *overname = 0;
String *scmname;
@ -1242,19 +1115,7 @@ CHICKEN::constantWrapper(Node *n)
// Return the value of the variable
if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
/* Calculate fixed alloca code */
if ((am = Getattr(n,"tmap:varout:chicken_words"))) {
Replaceall(am,"$typename", mangle);
if (strcmp(Char(am), "0") != 0) {
Wrapper_add_local(f,"known_space", "C_word *known_space");
Printf(f->code,
" known_space = C_alloc (%s);\n",
am);
}
}
selectOutOneOrMany(tm, 0);
Replaceall(tm,"$source",source);
Replaceall(tm,"$varname",source);
Replaceall(tm,"$target","resultobj");
@ -1298,7 +1159,6 @@ CHICKEN::constantWrapper(Node *n)
}
Delete(wname);
Delete(known_alloca);
Delete(proc_name);
Delete(argnum);
Delete(arg);
@ -2012,62 +1872,3 @@ CHICKEN::namify(String *scmname)
while (changedcase);
}
}
void
CHICKEN::selectOutOneOrMany(String *tm, int is_many)
{
char *s = Char(tm);
const char IFMANY[] = "/*if MANY*/";
const char IFONE[] = "/*if ONE*/";
const char ELSE[] = "/*else*/";
const char ENDIF[] = "/*endif*/";
enum { NONE, ONE, MANY } mode = NONE;
while (s) {
int displayline = 1;
/* set nextline */
char * nextline = strstr(s, "\n");
if (nextline) nextline += strlen("\n");
/* set displayline if necessary */
if (is_many && mode == ONE) displayline = 0;
if (!is_many && mode == MANY) displayline = 0;
/* which control line are we on? */
if (strncmp(s, IFMANY, sizeof(IFMANY) - 1) == 0) {
mode = MANY;
displayline = 0;
}
else if (strncmp(s, IFONE, sizeof(IFONE) - 1) == 0) {
mode = ONE;
displayline = 0;
}
else if (strncmp(s, ELSE, sizeof(ELSE) - 1) == 0) {
if (mode == ONE) mode = MANY;
else if (mode == MANY) mode = ONE;
displayline = 0;
}
else if (strncmp (s, ENDIF, sizeof(ENDIF) - 1) == 0) {
mode = NONE;
displayline = 0;
}
/* display line */
if (displayline) {
/* advance to next line */
s = nextline;
}
/* or don't display line */
else {
if (!nextline) {
memset(s, ' ', strlen(s)); /* truncate this (last) line */
s = 0;
}
else {
memset(s, ' ', nextline - s); /* remove this line */
s = nextline;
}
}
};
};