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

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