XS-MLVP
/
swig
mirror of https://github.com/swig/swig
5
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[Chicken] Remove code for Chicken 

We dropped support for it in SWIG 4.0.0 and nobody has stepped forward
to revive it in over 2 years.

See #2009.
This commit is contained in:
Olly Betts 2021-05-13 10:54:04 +12:00
parent 3f78ea64c0
commit 5f38f9cc78
107 changed files with 10 additions and 5763 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
CHANGES.current
View File

@ -7,6 +7,11 @@ the issue number to the end of the URL: https://github.com/swig/swig/issues/
Version 4.1.0 (in progress) Version 4.1.0 (in progress)
=========================== ===========================
2021-05-13: olly
[Chicken] #2009 Remove code for Chicken. We dropped support for it
in SWIG 4.0.0 and nobody has stepped forward to revive it in over 2
years.
2021-05-13: olly 2021-05-13: olly
[Allegrocl] #2009 Remove code for Allegro Common Lisp. We dropped [Allegrocl] #2009 Remove code for Allegro Common Lisp. We dropped
support for it in SWIG 4.0.0 and nobody has stepped forward to support for it in SWIG 4.0.0 and nobody has stepped forward to

597
Doc/Manual/Chicken.html
View File

@ -1,597 +0,0 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<title>SWIG and Chicken</title>
<link rel="stylesheet" type="text/css" href="style.css">
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
</head>
<body bgcolor="#ffffff">
<H1><a name="Chicken">23 SWIG and Chicken</a></H1>
<!-- INDEX -->
<div class="sectiontoc">
<ul>
<li><a href="#Chicken_nn2">Preliminaries</a>
<ul>
<li><a href="#Chicken_nn3">Running SWIG in C mode</a>
<li><a href="#Chicken_nn4">Running SWIG in C++ mode</a>
</ul>
<li><a href="#Chicken_nn5">Code Generation</a>
<ul>
<li><a href="#Chicken_nn6">Naming Conventions</a>
<li><a href="#Chicken_nn7">Modules</a>
<li><a href="#Chicken_nn8">Constants and Variables</a>
<li><a href="#Chicken_nn9">Functions</a>
<li><a href="#Chicken_nn10">Exceptions</a>
</ul>
<li><a href="#Chicken_nn11">TinyCLOS</a>
<li><a href="#Chicken_nn12">Linkage</a>
<ul>
<li><a href="#Chicken_nn13">Static binary or shared library linked at compile time</a>
<li><a href="#Chicken_nn14">Building chicken extension libraries</a>
<li><a href="#Chicken_nn15">Linking multiple SWIG modules with TinyCLOS</a>
</ul>
<li><a href="#Chicken_nn16">Typemaps</a>
<li><a href="#Chicken_nn17">Pointers</a>
<ul>
<li><a href="#Chicken_collection">Garbage collection</a>
</ul>
<li><a href="#Chicken_nn18">Unsupported features and known problems</a>
<ul>
<li><a href="#Chicken_nn19">TinyCLOS problems with Chicken version &lt;= 1.92</a>
</ul>
</ul>
</div>
<!-- INDEX -->
<p>
This chapter describes SWIG's support of CHICKEN. CHICKEN is a
Scheme-to-C compiler supporting most of the language features as
defined in the <i>Revised^5 Report on Scheme</i>. Its main
attributes are that it
</p>
<ol>
<li>generates portable C code</li>
<li>includes a customizable interpreter</li>
<li>links to C libraries with a simple Foreign Function Interface</li>
<li>supports full tail-recursion and first-class continuations</li>
</ol>
<p>
When confronted with a large C library, CHICKEN users can use
SWIG to generate CHICKEN wrappers for the C library. However,
the real advantages of using SWIG with CHICKEN are its
<strong>support for C++</strong> -- object-oriented code is
difficult to wrap by hand in CHICKEN -- and its <strong>typed
pointer representation</strong>, essential for C and C++
libraries involving structures or classes.
</p>
<H2><a name="Chicken_nn2">23.1 Preliminaries</a></H2>
<p>
CHICKEN support was introduced to SWIG in version 1.3.18. SWIG
relies on some recent additions to CHICKEN, which are only
present in releases of CHICKEN with version number
<strong>greater than or equal to 1.89</strong>.
To use a chicken version between 1.40 and 1.89, see the <a href="#Chicken_collection">Garbage collection</a>
section below.
</p>
<p>
You may want to look at any of the examples in Examples/chicken/
directory for the basic steps to run SWIG CHICKEN.
</p>
<H3><a name="Chicken_nn3">23.1.1 Running SWIG in C mode</a></H3>
<p>
To run SWIG CHICKEN in C mode, use
the -chicken option.
</p>
<div class="shell">
<pre>% swig -chicken example.i</pre>
</div>
<p>
To allow the wrapper to take advantage of future CHICKEN code
generation improvements, part of the wrapper is direct CHICKEN
function calls (<tt>example_wrap.c</tt>) and part is CHICKEN
Scheme (<tt>example.scm</tt>). The basic Scheme code must
be compiled to C using your system's CHICKEN compiler or
both files can be compiled directly using the much simpler <tt>csc</tt>.
</p>
<div class="shell">
<pre>
% chicken example.scm -output-file oexample.c
</pre>
</div>
<p>
So for the C mode of SWIG CHICKEN, <tt>example_wrap.c</tt> and
<tt>oexample.c</tt> are the files that must be compiled to
object files and linked into your project.
</p>
<H3><a name="Chicken_nn4">23.1.2 Running SWIG in C++ mode</a></H3>
<p>
To run SWIG CHICKEN in C++ mode, use
the -chicken -c++ option.
</p>
<div class="shell">
<pre>% swig -chicken -c++ example.i</pre>
</div>
<p>
This will generate <tt>example_wrap.cxx</tt> and
<tt>example.scm</tt>. The basic Scheme code must be
compiled to C using your system's CHICKEN compiler or
both files can be compiled directly using the much simpler <tt>csc</tt>.
</p>
<div class="shell">
<pre>% chicken example.scm -output-file oexample.c</pre>
</div>
<p>
So for the C++ mode of SWIG CHICKEN, <tt>example_wrap.cxx</tt>
and <tt>oexample.c</tt> are the files that must be compiled to
object files and linked into your project.
</p>
<H2><a name="Chicken_nn5">23.2 Code Generation</a></H2>
<H3><a name="Chicken_nn6">23.2.1 Naming Conventions</a></H3>
<p>
Given a C variable, function or constant declaration named
<tt>Foo_Bar</tt>, the declaration will be available
in CHICKEN as an identifier ending with
<tt>Foo-Bar</tt>. That is, an underscore is converted
to a dash.
</p>
<p>
You may control what the CHICKEN identifier will be by using the
<tt>%rename</tt> SWIG directive in the SWIG interface file.
</p>
<H3><a name="Chicken_nn7">23.2.2 Modules</a></H3>
<p>
The name of the module must be declared one of two ways:
<ul>
<li>Placing <tt>%module example</tt> in the SWIG interface
file.</li>
<li>Using <tt>-module example</tt> on the SWIG command
line.</li>
</ul>
<p>
The generated example.scm file then exports <code>(declare (unit modulename))</code>.
If you do not want SWIG to export the <code>(declare (unit modulename))</code>, pass
the -nounit option to SWIG.
<p>
CHICKEN will be able to access the module using the <code>(declare
(uses <i>modulename</i>))</code> CHICKEN Scheme form.
</p>
<H3><a name="Chicken_nn8">23.2.3 Constants and Variables</a></H3>
<p>
Constants may be created using any of the four constructs in
the interface file:
</p>
<ol>
<li><code>#define MYCONSTANT1 ...</code></li>
<li><code>%constant int MYCONSTANT2 = ...</code></li>
<li><code>const int MYCONSTANT3 = ...</code></li>
<li><code>enum { MYCONSTANT4 = ... };</code></li>
</ol>
<p>
In all cases, the constants may be accessed from within CHICKEN
using the form <tt>(MYCONSTANT1)</tt>; that is, the constants
may be accessed using the read-only parameter form.
</p>
<p>
Variables are accessed using the full parameter form.
For example, to set the C variable "int my_variable;", use the
Scheme form <tt>(my-variable 2345)</tt>. To get the C variable,
use <tt>(my-variable)</tt>.
</p>
<p>
The <tt>%feature("constasvar")</tt> can be applied to any constant
or immutable variable. Instead of exporting the constant as
a function that must be called, the constant will appear as a
scheme variable. This causes the generated .scm file to just contain the code
<tt>(set! MYCONSTANT1 (MYCONSTANT1))</tt>. See
<a href="Customization.html#Customization_features">Features and the %feature directive</a>
for info on how to apply the %feature.
</p>
<H3><a name="Chicken_nn9">23.2.4 Functions</a></H3>
<p>
C functions declared in the SWIG interface file will have
corresponding CHICKEN Scheme procedures. For example, the C
function "int sqrt(double x);" will be available using the
Scheme form <tt>(sqrt 2345.0)</tt>. A <code>void</code> return
value will give C_SCHEME_UNDEFINED as a result.
</p>
<p>
A function may return more than one value by using the
<code>OUTPUT</code> specifier (see Lib/chicken/typemaps.i).
They will be returned as multiple values using <code>(values)</code> if there is more than one
result (that is, a non-void return value and at least one argout
parameter, or a void return value and at least two argout
parameters). The return values can then be accessed with <code>(call-with-values)</code>.
</p>
<H3><a name="Chicken_nn10">23.2.5 Exceptions</a></H3>
<p>The SWIG chicken module has support for exceptions thrown from
C or C++ code to be caught in scheme.
See <a href="Customization.html#Customization_exception">Exception handling with %exception</a>
for more information about declaring exceptions in the interface file.
</p>
<p>Chicken supports both the <code>SWIG_exception(int code, const char *msg)</code> interface
as well as a <code>SWIG_ThrowException(C_word val)</code> function for throwing exceptions from
inside the %exception blocks. <code>SWIG_exception</code> will throw a list consisting of the code
(as an integer) and the message. Both of these will throw an exception using <code>(abort)</code>,
which can be handled by <code>(handle-exceptions)</code>. See
the Chicken manual on Exceptions
and <a href="http://srfi.schemers.org/srfi-12/srfi-12.html">SFRI-12</a>. Since the exception values are thrown
directly, if <code>(condition-case)</code> is used to catch an exception the exception will come through in the <code>val ()</code> case.
</p>
<p>The following simple module</p>
<div class="code"><pre>
%module exception_test
%inline %{
void test_throw(int i) throws (int) {
if (i == 1) throw 15;
}
%}
</pre></div>
<p>could be run with</p>
<div class="targetlang"><pre>
(handle-exceptions exvar
(if (= exvar 15)
(print "Correct!")
(print "Threw something else " exvar))
(test-throw 1))
</pre></div>
<H2><a name="Chicken_nn11">23.3 TinyCLOS</a></H2>
<p>
The author of TinyCLOS, Gregor Kiczales, describes TinyCLOS as:
"Tiny CLOS is a Scheme implementation of a 'kernelized' CLOS, with a
metaobject protocol. The implementation is even simpler than
the simple CLOS found in 'The Art of the Metaobject Protocol',
weighing in at around 850 lines of code, including (some)
comments and documentation."
</p>
<p>
Almost all good Scheme books describe how to use metaobjects and
generic procedures to implement an object-oriented Scheme
system. Please consult a Scheme book if you are unfamiliar
with the concept.
</p>
<p>
CHICKEN has a modified version of TinyCLOS, which SWIG CHICKEN
uses if the -proxy argument is given. If -proxy is passed, then
the generated example.scm file will contain TinyCLOS class definitions.
A class named Foo is declared as &lt;Foo&gt;, and each member variable
is allocated a slot. Member functions are exported as generic functions.
<p>
Primitive symbols and functions (the interface that would be presented if
-proxy was not passed) are hidden and no longer accessible. If the -unhideprimitive
command line argument is passed to SWIG, then the primitive symbols will be
available, but each will be prefixed by the string "primitive:"
<p>
The exported symbol names can be controlled with the -closprefix and -useclassprefix arguments.
If -useclassprefix is passed to SWIG, every member function will be generated with the class name
as a prefix. If the -closprefix mymod: argument is passed to SWIG, then the exported functions will
be prefixed by the string "mymod:". If -useclassprefix is passed, -closprefix is ignored.
</p>
<H2><a name="Chicken_nn12">23.4 Linkage</a></H2>
<p>
Please refer to <em>CHICKEN - A practical and portable Scheme
system - User's manual</em> for detailed help on how to link
object files to create a CHICKEN Scheme program. Briefly, to
link object files, be sure to add <tt>`chicken-config
-extra-libs -libs`</tt> or <tt>`chicken-config -shared
-extra-libs -libs`</tt>to your linker options. Use the
<tt>-shared</tt> option if you want to create a dynamically
loadable module. You might also want to use the much simpler
<tt>csc</tt> or <tt>csc.bat</tt>.
</p>
<p>Each scheme file that is generated
by SWIG contains <code>(declare (uses <i>modname</i>))</code>. This means that to load the
module from scheme code, the code must include <code>(declare (uses <i>modname</i>))</code>.
</p>
<H3><a name="Chicken_nn13">23.4.1 Static binary or shared library linked at compile time</a></H3>
<p>We can easily use csc to build a static binary.</p>
<div class="shell">
<pre>
$ swig -chicken example.i
$ csc -v example.scm example_impl.c example_wrap.c test_script.scm -o example
$ ./example
</pre>
</div>
<p>Similar to the above, any number of <tt>module.scm</tt> files could be compiled
into a shared library, and then that shared library linked when compiling the
main application.</p>
<div class="shell">
<pre>
$ swig -chicken example.i
$ csc -sv example.scm example_wrap.c example_impl.c -o example.so
</pre>
</div>
<p>The <tt>example.so</tt> file can then linked with <tt>test_script.scm</tt> when it
is compiled, in which case <tt>test_script.scm</tt> must have <code>(declare (uses example))</code>.
Multiple SWIG modules could have been linked into <tt>example.so</tt> and each
one accessed with a <code>(declare (uses ... ))</code>.
</p>
<div class="shell">
<pre>
$ csc -v test_script.scm -lexample
</pre>
</div>
<p>An alternative is that the test_script.scm can have the code <code>(load-library 'example "example.so")</code>,
in which case the test script does not need to be linked with example.so. The test_script.scm file can then
be run with <tt>csi</tt>.
</p>
<H3><a name="Chicken_nn14">23.4.2 Building chicken extension libraries</a></H3>
<p>Building a shared library like in the above section only works if the library
is linked at compile time with a script containing <code>(declare (uses ...))</code> or is
loaded explicitly with <code>(load-library 'example "example.so")</code>. It is
not the format that CHICKEN expects for extension libraries and eggs. The problem is the
<code>(declare (unit <i>modname</i>))</code> inside the <tt>modname.scm</tt> file. There are
two possible solutions to this.</p>
<p>First, SWIG accepts a <tt>-nounit</tt> argument, in which case the <code>(declare (unit <i>modname</i>))</code>
is not generated. Then, the <tt>modname.scm</tt> and <tt>modname_wrap.c</tt> files <b>must</b> be compiled into
their own shared library.</p>
<div class="shell">
<pre>
$ csc -sv modname.scm modname_wrap.c modname_impl.c -o modname.so
</pre>
</div>
<p>This library can then be loaded by scheme code with the <code>(require 'modname)</code> function.
See the
Loading-extension-libraries in the eval unit inside the CHICKEN manual for more information.</p>
<p>Another alternative is to run SWIG normally and create a scheme file that contains <code>(declare (uses <i>modname</i>))</code>
and then compile that file into the shared library as well. For example, inside the <tt>mod_load.scm</tt> file,</p>
<div class="targetlang">
<pre>
(declare (uses mod1))
(declare (uses mod2))
</pre>
</div>
<p>Which would then be compiled with</p>
<div class="shell">
<pre>
$ swig -chicken mod1.i
$ swig -chicken mod2.i
$ csc -sv mod_load.scm mod1.scm mod2.scm mod1_wrap.c mod2_wrap.c mod1_impl.c mod2_impl.c -o mod.so
</pre>
</div>
<p>Then the extension library can be loaded with <code>(require 'mod)</code>. As we can see here,
<tt>mod_load.scm</tt> contains the code that gets executed when the module is loaded. All this code
does is load both mod1 and mod2. As we can see, this technique is more useful when you want to
combine a few SWIG modules into one chicken extension library, especially if modules are related by
<code>%import</code></p>
<p>In either method, the files that are compiled into the shared library could also be
packaged into an egg. The <tt>mod1_wrap.c</tt> and <tt>mod2_wrap.c</tt> files that are created by SWIG
are stand alone and do not need SWIG to be installed to be compiled. Thus the egg could be
distributed and used by anyone, even if SWIG is not installed.</p>
<p>See the <tt>Examples/chicken/egg</tt> directory in the SWIG source for an example that builds
two eggs, one using the first method and one using the second method.</p>
<H3><a name="Chicken_nn15">23.4.3 Linking multiple SWIG modules with TinyCLOS</a></H3>
<p>Linking together multiple modules that share type information using the <code>%import</code>
directive while also using <tt>-proxy</tt> is more complicated. For example, if <tt>mod2.i</tt> imports <tt>mod1.i</tt>, then the
<tt>mod2.scm</tt> file contains references to symbols declared in <tt>mod1.scm</tt>,
and thus a <code>(declare (uses <i>mod1</i>))</code> or <code>(require '<i>mod1</i>)</code> must be exported
to the top of <tt>mod2.scm</tt>. By default, when SWIG encounters an <code>%import "modname.i"</code> directive,
it exports <code>(declare (uses <i>modname</i>))</code> into the scm file. This works fine unless mod1 was compiled with
the <tt>-nounit</tt> argument or was compiled into an extension library with other modules under a different name.</p>
<p>One option is to override the automatic generation of <code>(declare (uses mod1))</code>
by passing the <tt>-noclosuses</tt> option to SWIG when compiling <tt>mod2.i</tt>.
SWIG then provides the <code>%insert(closprefix) %{ %}</code> directive. Any scheme code inside that directive is inserted into the
generated .scm file, and if <tt>mod1</tt> was compiled with <tt>-nounit</tt>, the directive should contain <code>(require 'mod1)</code>.
This option allows for mixed loading as well, where some modules are imported with <code>(declare (uses <i>modname</i>))</code>
(which means they were compiled without -nounit) and some are imported with <code>(require 'modname)</code>.</p>
<p>The other option is to use the second idea in the above section. Compile all the modules normally, without any
<code>%insert(closprefix)</code>, <tt>-nounit</tt>, or <tt>-noclosuses</tt>. Then the modules will import each other correctly
with <code>(declare (uses ...))</code>.
To create an extension library or an egg, just create a <tt>module_load.scm</tt> file that <code>(declare (uses ...))</code>
all the modules.</p>
<H2><a name="Chicken_nn16">23.5 Typemaps</a></H2>
<p>
The Chicken module handles all types via typemaps. This information is
read from <code>Lib/chicken/typemaps.i</code> and
<code>Lib/chicken/chicken.swg</code>.
</p>
<H2><a name="Chicken_nn17">23.6 Pointers</a></H2>
<p>
For pointer types, SWIG uses CHICKEN tagged pointers.
A tagged pointer is an ordinary CHICKEN pointer with an
extra slot for a void *. With SWIG
CHICKEN, this void * is a pointer to a type-info
structure. So each pointer used as input or output from
the SWIG-generated CHICKEN wrappers will have type
information attached to it. This will let the wrappers
correctly determine which method should be called
according to the object type hierarchy exposed in the SWIG
interface files.
</p>
<p>
To construct a Scheme object from a C pointer, the wrapper code
calls the function
<code>SWIG_NewPointerObj(void *ptr, swig_type_info *type, int owner)</code>,
The function that calls <code>SWIG_NewPointerObj</code> must have a variable declared
<code>C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);</code>
It is ok to call <code>SWIG_NewPointerObj</code> more than once,
just make sure known_space has enough space for all the created pointers.
</p>
<p>
To get the pointer represented by a CHICKEN tagged pointer, the
wrapper code calls the function
<code>SWIG_ConvertPtr(C_word s, void **result, swig_type_info *type, int flags)</code>,
passing a pointer to a struct representing the expected pointer
type. flags is either zero or SWIG_POINTER_DISOWN (see below).
</p>
<H3><a name="Chicken_collection">23.6.1 Garbage collection</a></H3>
<p>If the owner flag passed to <code>SWIG_NewPointerObj</code> is 1, <code>NewPointerObj</code> will add a
finalizer to the type which will call the destructor or delete method of
that type. The destructor and delete functions are no longer exported for
use in scheme code, instead SWIG and chicken manage pointers.
In situations where SWIG knows that a function is returning a type that should
be garbage collected, SWIG will automatically set the owner flag to 1. For other functions,
the <code>%newobject</code> directive must be specified for functions whose return values
should be garbage collected. See
<a href="Customization.html#Customization_ownership">Object ownership and %newobject</a> for more information.
</p>
<p>In situations where a C or C++ function will assume ownership of a pointer, and thus
chicken should no longer garbage collect it, SWIG provides the <code>DISOWN</code> input typemap.
After applying this typemap (see the <a href="Typemaps.html#Typemaps">Typemaps chapter</a> for more information on how to apply typemaps),
any pointer that gets passed in will no longer be garbage collected.
An object is disowned by passing the <code>SWIG_POINTER_DISOWN</code> flag to <code>SWIG_ConvertPtr</code>.
<b>Warning:</b> Since the lifetime of the object is now controlled by the underlying code, the object might
get deleted while the scheme code still holds a pointer to it. Further use of this pointer
can lead to a crash.
</p>
<p>Adding a finalizer function from C code was added to chicken in the 1.89 release, so garbage collection
does not work for chicken versions below 1.89. If you would like the SWIG generated code to work with
chicken 1.40 to 1.89, pass the <code>-nocollection</code> argument to SWIG. This will not export code
inside the _wrap.c file to register finalizers, and will then export destructor functions which
must be called manually.
</p>
<H2><a name="Chicken_nn18">23.7 Unsupported features and known problems</a></H2>
<ul>
<li>No director support.</li>
<li>No support for c++ standard types like std::vector.</li>
<li>The TinyCLOS wrappers for overloaded functions will not work correctly when using
<a href="SWIGPlus.html#SWIGPlus_default_args">%feature(compactdefaultargs)</a>.</li>
</ul>
<H3><a name="Chicken_nn19">23.7.1 TinyCLOS problems with Chicken version &lt;= 1.92</a></H3>
<p>In Chicken versions equal to or below 1.92, TinyCLOS has a limitation such that generic methods do not properly work on methods
with different number of specializers: TinyCLOS assumes that every method added to a generic function
will have the same number of specializers. SWIG generates functions with different lengths of specializers
when C/C++ functions are overloaded. For example, the code</p>
<div class="code">
<pre>
class Foo {};
int foo(int a, Foo *b);
int foo(int a);
</pre></div>
<p>will produce scheme code</p>
<div class="targetlang">
<pre>
(define-method (foo (arg0 &lt;top&gt;) (arg1 &lt;Foo&gt;)) (<i>call primitive function</i>))
(define-method (foo (arg0 &lt;top&gt;)) (<i>call primitive function</i>))
</pre></div>
<p>Using unpatched TinyCLOS, the second <code>(define-method)</code> will replace the first one,
so calling <code>(foo 3 f)</code> will produce an error.</p>
<p>There are three solutions to this. The easist is to upgrade to the latest Chicken version. Otherwise, the
file <tt>Lib/chicken/tinyclos-multi-generic.patch</tt> in the SWIG source contains a patch against
tinyclos.scm inside the 1.92 chicken source to add support into TinyCLOS for multi-argument generics. (This patch was accepted into Chicken)
This requires chicken to be rebuilt and custom install of chicken. An alternative is the <tt>Lib/chicken/multi-generic.scm</tt>
file in the SWIG source. This file can be loaded after TinyCLOS is loaded, and it will override some functions
inside TinyCLOS to correctly support multi-argument generics. Please see the comments at the top of both files for more information.</p>
</body>
</html>

12
Examples/chicken/README
View File

@ -1,12 +0,0 @@
This directory contains examples for CHICKEN.
class -- illustrates the proxy class C++ interface
constants -- handling #define and %constant literals
egg -- examples of building chicken extension libraries
multimap -- typemaps with multiple sub-types
overload -- C++ function overloading
simple -- the simple example from the user manual
zlib -- a wrapping of the zlib compression library
You should be able to run make in each of the examples. By default, a shared
library will be built. Run make check to execute the test.

6
Examples/chicken/check.list
View File

@ -1,6 +0,0 @@
# see top-level Makefile.in
class
constants
multimap
overload
simple

40
Examples/chicken/class/Makefile
View File

@ -1,40 +0,0 @@
TOP = ../..
SWIGEXE = $(TOP)/../swig
SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
INTERFACE = example.i
SRCS =
CXXSRCS = example.cxx
TARGET = class
INCLUDE =
SWIGOPT =
VARIANT =
# uncomment the following lines to build a static exe (only pick one of the CHICKEN_MAIN lines)
#CHICKEN_MAIN = runme-lowlevel.scm
#CHICKEN_MAIN = runme-tinyclos.scm
#VARIANT = _static
check: build
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CHICKEN_SCRIPT='runme-lowlevel.scm' chicken_run
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CHICKEN_SCRIPT='runme-tinyclos.scm' chicken_run
build: $(TARGET) $(TARGET)_proxy
$(TARGET): $(INTERFACE) $(SRCS)
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' \
SRCS='$(SRCS)' CXXSRCS='$(CXXSRCS)' CHICKEN_MAIN='$(CHICKEN_MAIN)' \
SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
INCLUDE='$(INCLUDE)' SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' \
INTERFACE='$(INTERFACE)' CHICKENOPTS='$(CHICKENOPTS)' chicken$(VARIANT)_cpp
$(TARGET)_proxy: $(INTERFACE) $(SRCS)
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' \
SRCS='$(SRCS)' CXXSRCS='$(CXXSRCS)' CHICKEN_MAIN='$(CHICKEN_MAIN)' \
SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
INCLUDE='$(INCLUDE)' SWIGOPT='$(SWIGOPT) -proxy' TARGET='$(TARGET)_proxy' \
INTERFACE='$(INTERFACE)' CHICKENOPTS='$(CHICKENOPTS)' chicken$(VARIANT)_cpp
clean:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' chicken_clean
rm -f example.scm
rm -f $(TARGET)

28
Examples/chicken/class/example.cxx
View File

@ -1,28 +0,0 @@
/* File : example.cxx */
#include "example.h"
#define M_PI 3.14159265358979323846
/* Move the shape to a new location */
void Shape::move(double dx, double dy) {
x += dx;
y += dy;
}
int Shape::nshapes = 0;
double Circle::area() {
return M_PI*radius*radius;
}
double Circle::perimeter() {
return 2*M_PI*radius;
}
double Square::area() {
return width*width;
}
double Square::perimeter() {
return 4*width;
}

41
Examples/chicken/class/example.h
View File

@ -1,41 +0,0 @@
/* File : example.h */
class Shape {
public:
Shape() {
nshapes++;
}
virtual ~Shape() {
nshapes--;
}
double x, y;
void move(double dx, double dy);
virtual double area() = 0;
virtual double perimeter() = 0;
static int nshapes;
enum SomeEnum {
First = 0,
Second,
Third,
Last = 1000
};
};
class Circle : public Shape {
private:
double radius;
public:
Circle(double r) : radius(r) { }
virtual double area();
virtual double perimeter();
};
class Square : public Shape {
private:
double width;
public:
Square(double w) : width(w) { }
virtual double area();
virtual double perimeter();
};

9
Examples/chicken/class/example.i
View File

@ -1,9 +0,0 @@
/* File : example.i */
%module example
%{
#include "example.h"
%}
/* Let's just grab the original header file here */
%include "example.h"

76
Examples/chicken/class/runme-lowlevel.scm
View File

@ -1,76 +0,0 @@
;; This file illustrates the low-level C++ interface generated
;; by SWIG.
(load-library 'example "class.so")
(declare (uses example))
;; ----- Object creation -----
(display "Creating some objects:\n")
(define c (new-Circle 10.0))
(display " Created circle ")
(display c)
(display "\n")
(define s (new-Square 10.0))
(display " Created square ")
(display s)
(display "\n")
;; ----- Access a static member -----
(display "\nA total of ")
(display (Shape-nshapes))
(display " shapes were created\n")
;; ----- Member data access -----
;; Set the location of the object
(Shape-x-set c 20.0)
(Shape-y-set c 30.0)
(Shape-x-set s -10.0)
(Shape-y-set s 5.0)
(display "\nHere is their current position:\n")
(display " Circle = (")
(display (Shape-x-get c))
(display ", ")
(display (Shape-y-get c))
(display ")\n")
(display " Square = (")
(display (Shape-x-get s))
(display ", ")
(display (Shape-y-get s))
(display ")\n")
;; ----- Call some methods -----
(display "\nHere are some properties of the shapes:\n")
(let
((disp (lambda (o)
(display " ")
(display o)
(display "\n")
(display " area = ")
(display (Shape-area o))
(display "\n")
(display " perimeter = ")
(display (Shape-perimeter o))
(display "\n"))))
(disp c)
(disp s))
(display "\nGuess I'll clean up now\n")
;; Note: this invokes the virtual destructor
(set! c #f)
(set! s #f)
(gc #t)
(set! s 3)
(display (Shape-nshapes))
(display " shapes remain\n")
(display "Goodbye\n")
(exit)

76
Examples/chicken/class/runme-tinyclos.scm
View File

@ -1,76 +0,0 @@
;; This file illustrates the proxy C++ interface generated
;; by SWIG.
(load-library 'example "class_proxy.so")
(declare (uses example))
(declare (uses tinyclos))
;; ----- Object creation -----
(display "Creating some objects:\n")
(define c (make <Circle> 10.0))
(display " Created circle ")
(display c)
(display "\n")
(define s (make <Square> 10.0))
(display " Created square ")
(display s)
(display "\n")
;; ----- Access a static member -----
(display "\nA total of ")
(display (Shape-nshapes))
(display " shapes were created\n")
;; ----- Member data access -----
;; Set the location of the object
(slot-set! c 'x 20.0)
(slot-set! c 'y 30.0)
(slot-set! s 'x -10.0)
(slot-set! s 'y 5.0)
(display "\nHere is their current position:\n")
(display " Circle = (")
(display (slot-ref c 'x))
(display ", ")
(display (slot-ref c 'y))
(display ")\n")
(display " Square = (")
(display (slot-ref s 'x))
(display ", ")
(display (slot-ref s 'y))
(display ")\n")
;; ----- Call some methods -----
(display "\nHere are some properties of the shapes:\n")
(let
((disp (lambda (o)
(display " ")
(display o)
(display "\n")
(display " area = ")
(display (area o))
(display "\n")
(display " perimeter = ")
(display (perimeter o))
(display "\n"))))
(disp c)
(disp s))
(display "\nGuess I'll clean up now\n")
;; Note: Invoke the virtual destructors by forcing garbage collection
(set! c 77)
(set! s 88)
(gc #t)
(display (Shape-nshapes))
(display " shapes remain\n")
(display "Goodbye\n")
(exit)

31
Examples/chicken/constants/Makefile
View File

@ -1,31 +0,0 @@
TOP = ../..
SWIGEXE = $(TOP)/../swig
SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
INTERFACE = example.i
SRCS =
CXXSRCS =
TARGET = constants
INCLUDE =
SWIGOPT =
VARIANT =
# uncomment the following two lines to build a static exe
#CHICKEN_MAIN = runme.scm
#VARIANT = _static
check: build
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' chicken_run
build: $(TARGET)
$(TARGET): $(INTERFACE) $(SRCS)
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' \
SRCS='$(SRCS)' CXXSRCS='$(CXXSRCS)' CHICKEN_MAIN='$(CHICKEN_MAIN)' \
SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
INCLUDE='$(INCLUDE)' SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' \
INTERFACE='$(INTERFACE)' CHICKENOPTS='$(CHICKENOPTS)' chicken$(VARIANT)
clean:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' chicken_clean
rm -f example.scm
rm -f $(TARGET)

27
Examples/chicken/constants/example.i
View File

@ -1,27 +0,0 @@
/* File : example.i */
%module example
/* A few preprocessor macros */
#define ICONST 42
#define FCONST 2.1828
#define CCONST 'x'
#define CCONST2 '\n'
#define SCONST "Hello World"
#define SCONST2 "\"Hello World\""
/* This should work just fine */
#define EXPR ICONST + 3*(FCONST)
/* This shouldn't do anything */
#define EXTERN extern
/* Neither should this (BAR isn't defined) */
#define FOO (ICONST + BAR)
/* The following directives also produce constants. Remember that
CHICKEN is normally case-insensitive, so don't rely on differing
case to differentiate variable names */
%constant int iconstX = 37;
%constant double fconstX = 3.14;

16
Examples/chicken/constants/runme.scm
View File

@ -1,16 +0,0 @@
;; feel free to uncomment and comment sections
(load-library 'example "./constants.so")
(display "starting test ... you will see 'finished' if successful.\n")
(or (= (ICONST) 42) (exit 1))
(or (< (abs (- (FCONST) 2.1828)) 0.00001) (exit 1))
(or (char=? (CCONST) #\x) (exit 1))
(or (char=? (CCONST2) #\newline) (exit 1))
(or (string=? (SCONST) "Hello World") (exit 1))
(or (string=? (SCONST2) "\"Hello World\"") (exit 1))
(or (< (abs (- (EXPR) (+ (ICONST) (* 3 (FCONST))))) 0.00001) (exit 1))
(or (= (iconstX) 37) (exit 1))
(or (< (abs (- (fconstX) 3.14)) 0.00001) (exit 1))
(display "finished test.\n")
(exit 0)

41
Examples/chicken/egg/Makefile
View File

@ -1,41 +0,0 @@
TOP = ../..
SWIGEXE = $(TOP)/../swig
SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
check: build
cd eggs/install && csi ../../test.scm
build: single multi
# This creates an egg which contains only the single module. Any additional implementation files
# that implement the interface being wrapped should also be added to this egg
single: single_wrap.cxx
mkdir -p eggs
tar czf eggs/single.egg single.setup single.scm single_wrap.cxx
rm -f single.scm single_wrap.cxx
# compile the single module with -nounit
single_wrap.cxx: single.i
$(SWIGEXE) -chicken -c++ -proxy -nounit single.i
# Now build both mod1 and mod2 into a single egg
multi: mod1_wrap.cxx mod2_wrap.cxx
mkdir -p eggs
tar czf eggs/multi.egg multi.setup multi_init.scm mod1.scm mod1_wrap.cxx mod2.scm mod2_wrap.cxx
rm -f mod1.scm mod1_wrap.cxx mod2.scm mod2_wrap.cxx
mod1_wrap.cxx: mod1.i
$(SWIGEXE) -chicken -c++ -proxy mod1.i
mod2_wrap.cxx: mod2.i
$(SWIGEXE) -chicken -c++ -proxy mod2.i
clean:
rm -rf eggs
# this part is for testing...
setup:
cd eggs && \
mkdir -p install && \
chicken-setup -repository `pwd`/install single.egg && \
chicken-setup -repository `pwd`/install multi.egg

19
Examples/chicken/egg/README
View File

@ -1,19 +0,0 @@
These examples show how to build a chicken extension module in the form of an
egg. There are two eggs that get built, single.egg which contains a single
module which is built with -nounit and multi.egg, which contains two modules
mod1 and mod2. These are built normally, and multi_init.scm loads them both.
Read section "17.4.2 Building chicken extension libraries" in the manual
for a description of these two techniques.
To build:
$ make
$ make setup
$ make run
$ make clean
The eggs are built into an eggs subdirectory, because chicken-setup has
problems installing eggs when there are other files named similar in
the same directory. The make setup step runs chicken-setup to install
the eggs into the eggs/install directory.

8
Examples/chicken/egg/mod1.i
View File

@ -1,8 +0,0 @@
%module mod1
%inline %{
class Bar {
public:
int b;
};
%}

17
Examples/chicken/egg/mod2.i
View File

@ -1,17 +0,0 @@
%module mod2
%import "mod1.i"
%{
class Bar {
public:
int b;
};
%}
%inline %{
class Bar2 : public Bar {
public:
int c;
};
%}

2
Examples/chicken/egg/multi.setup
View File

@ -1,2 +0,0 @@
(run (csc -s -o multi.so multi_init.scm mod1.scm mod1_wrap.cxx mod2.scm mod2_wrap.cxx))
(install-extension 'multi '("multi.so"))

2
Examples/chicken/egg/multi_init.scm
View File

@ -1,2 +0,0 @@
(declare (uses mod1))
(declare (uses mod2))

8
Examples/chicken/egg/single.i
View File

@ -1,8 +0,0 @@
%module single
%inline %{
class Foo {
public:
int a;
};
%}

2
Examples/chicken/egg/single.setup
View File

@ -1,2 +0,0 @@
(run (csc -s -o single.so single.scm single_wrap.cxx))
(install-extension 'single '("single.so"))

18
Examples/chicken/egg/test.scm
View File

@ -1,18 +0,0 @@
(require-extension single)
(require-extension multi)
(define f (make <Foo>))
(slot-set! f 'a 3)
(print (slot-ref f 'a))
(define b (make <Bar>))
(slot-set! b 'b 2)
(print (slot-ref b 'b))
(define b2 (make <Bar2>))
(slot-set! b2 'b 4)
(slot-set! b2 'c 6)
(print (slot-ref b2 'b))
(print (slot-ref b2 'c))
(exit 0)

31
Examples/chicken/multimap/Makefile
View File

@ -1,31 +0,0 @@
TOP = ../..
SWIGEXE = $(TOP)/../swig
SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
INTERFACE = example.i
SRCS = example.c
CXXSRCS =
TARGET = multimap
INCLUDE =
SWIGOPT =
VARIANT =
# uncomment the following two lines to build a static exe
#CHICKEN_MAIN = runme.scm
#VARIANT = _static
check: build
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' chicken_run
build: $(TARGET)
$(TARGET): $(INTERFACE) $(SRCS)
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' \
SRCS='$(SRCS)' CXXSRCS='$(CXXSRCS)' CHICKEN_MAIN='$(CHICKEN_MAIN)' \
SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
INCLUDE='$(INCLUDE)' SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' \
INTERFACE='$(INTERFACE)' CHICKENOPTS='$(CHICKENOPTS)' chicken$(VARIANT)
clean:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' chicken_clean
rm -f example.scm
rm -f $(TARGET)

53
Examples/chicken/multimap/example.c
View File

@ -1,53 +0,0 @@
/* File : example.c */
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
/* Compute the greatest common divisor of positive integers */
int gcd(int x, int y) {
int g;
g = y;
while (x > 0) {
g = x;
x = y % x;
y = g;
}
return g;
}
int gcdmain(int argc, char *argv[]) {
int x,y;
if (argc != 3) {
printf("usage: gcd x y\n");
return -1;
}
x = atoi(argv[1]);
y = atoi(argv[2]);
printf("gcd(%d,%d) = %d\n", x,y,gcd(x,y));
return 0;
}
int count(char *bytes, int len, char c) {
int i;
int count = 0;
for (i = 0; i < len; i++) {
if (bytes[i] == c) count++;
}
return count;
}
void capitalize(char *str, int len) {
int i;
for (i = 0; i < len; i++) {
str[i] = (char)toupper(str[i]);
}
}
void circle(double x, double y) {
double a = x*x + y*y;
if (a > 1.0) {
printf("Bad points %g, %g\n", x,y);
} else {
printf("Good points %g, %g\n", x,y);
}
}

96
Examples/chicken/multimap/example.i
View File

@ -1,96 +0,0 @@
/* File : example.i */
%module example
%{
extern int gcd(int x, int y);
extern int gcdmain(int argc, char *argv[]);
extern int count(char *bytes, int len, char c);
extern void capitalize (char *str, int len);
extern void circle (double cx, double cy);
extern int squareCubed (int n, int *OUTPUT);
%}
%include exception.i
%include typemaps.i
extern int gcd(int x, int y);
%typemap(in) (int argc, char *argv[]) {
int i;
if (!C_swig_is_vector ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument $input is not a vector");
}
$1 = C_header_size ($input);
$2 = (char **) malloc(($1+1)*sizeof(char *));
for (i = 0; i < $1; i++) {
C_word o = C_block_item ($input, i);
if (!C_swig_is_string (o)) {
char err[50];
free($2);
sprintf (err, "$input[%d] is not a string", i);
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, err);
}
$2[i] = C_c_string (o);
}
$2[i] = 0;
}
%typemap(freearg) (int argc, char *argv[]) {
free($2);
}
extern int gcdmain(int argc, char *argv[]);
%typemap(in) (char *bytes, int len) {
if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument $input is not a string");
}
$1 = C_c_string ($input);
$2 = C_header_size ($input);
}
extern int count(char *bytes, int len, char c);
/* This example shows how to wrap a function that mutates a string */
%typemap(in) (char *str, int len)
%{ if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument $input is not a string");
}
$2 = C_header_size ($input);
$1 = (char *) malloc ($2+1);
memmove ($1, C_c_string ($input), $2);
%}
/* Return the mutated string as a new object. Notice the if MANY construct ... they must be at column 0. */
%typemap(argout) (char *str, int len) (C_word *scmstr)
%{ scmstr = C_alloc (C_SIZEOF_STRING ($2));
SWIG_APPEND_VALUE(C_string (&scmstr, $2, $1));
free ($1);
%}
extern void capitalize (char *str, int len);
/* A multi-valued constraint. Force two arguments to lie
inside the unit circle */
%typemap(check) (double cx, double cy) {
double a = $1*$1 + $2*$2;
if (a > 1.0) {
SWIG_exception (SWIG_ValueError, "cx and cy must be in unit circle");
}
}
extern void circle (double cx, double cy);
/* Test out multiple return values */
extern int squareCubed (int n, int *OUTPUT);
%{
/* Returns n^3 and set n2 to n^2 */
int squareCubed (int n, int *n2) {
*n2 = n * n;
return (*n2) * n;
};
%}

58
Examples/chicken/multimap/runme.scm
View File

@ -1,58 +0,0 @@
;; feel free to uncomment and comment sections
(load-library 'example "multimap.so")
(display "(gcd 90 12): ")
(display (gcd 90 12))
(display "\n")
(display "(circle 0.5 0.5): ")
(display (circle 0.5 0.5))
(display "\n")
(display "(circle 1.0 1.0): ")
(handle-exceptions exvar
(if (= (car exvar) 9)
(display "success: exception thrown")
(display "an incorrect exception was thrown"))
(begin
(circle 1.0 1.0)
(display "an exception was not thrown when it should have been")))
(display "\n")
(display "(circle 1 1): ")
(handle-exceptions exvar
(if (= (car exvar) 9)
(display "success: exception thrown")
(display "an incorrect exception was thrown"))
(begin
(circle 1 1)
(display "an exception was not thrown when it should have been")))
(display "\n")
(display "(capitalize \"will this be all capital letters?\"): ")
(display (capitalize "will this be all capital letters?"))
(display "\n")
(display "(count \"jumpity little spider\" #\\t): ")
(display (count "jumpity little spider" #\t))
(display "\n")
(display "(gcdmain '#(\"hi\" \"there\")): ")
(display (gcdmain '#("hi" "there")))
(display "\n")
(display "(gcdmain '#(\"gcd\" \"9\" \"28\")): ")
(gcdmain '#("gcd" "9" "28"))
(display "\n")
(display "(gcdmain '#(\"gcd\" \"12\" \"90\")): ")
(gcdmain '#("gcd" "12" "90"))
(display "\n")
(display "squarecubed 3: ")
(call-with-values (lambda() (squareCubed 3))
(lambda (a b) (printf "~A ~A" a b)))
(display "\n")
(exit)

31
Examples/chicken/overload/Makefile
View File

@ -1,31 +0,0 @@
TOP = ../..
SWIGEXE = $(TOP)/../swig
SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
INTERFACE = example.i
SRCS =
CXXSRCS = example.cxx
TARGET = overload
INCLUDE =
SWIGOPT = -proxy -unhideprimitive
VARIANT =
# uncomment the following lines to build a static exe
#CHICKEN_MAIN = runme.scm
#VARIANT = _static
check: build
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' chicken_run
build: $(TARGET)
$(TARGET): $(INTERFACE) $(SRCS)
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' \
SRCS='$(SRCS)' CXXSRCS='$(CXXSRCS)' CHICKEN_MAIN='$(CHICKEN_MAIN)' \
SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
INCLUDE='$(INCLUDE)' SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' \
INTERFACE='$(INTERFACE)' CHICKENOPTS='$(CHICKENOPTS)' chicken$(VARIANT)_cpp
clean:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' chicken_clean
rm -f example.scm
rm -f $(TARGET)

2
Examples/chicken/overload/README
View File

@ -1,2 +0,0 @@
Overloading example from Chapter 5.14 of SWIG Core Documentation for
version 1.3.

33
Examples/chicken/overload/example.cxx
View File

@ -1,33 +0,0 @@
/* File : example.c */
#include "example.h"
#include <stdio.h>
void foo(int x) {
printf("x is %d\n", x);
}
void foo(char *x) {
printf("x is '%s'\n", x);
}
Foo::Foo () {
myvar = 55;
printf ("Foo constructor called\n");
}
Foo::Foo (const Foo &) {
myvar = 66;
printf ("Foo copy constructor called\n");
}
void Foo::bar (int x) {
printf ("Foo::bar(x) method ... \n");
printf("x is %d\n", x);
}
void Foo::bar (char *s, int y) {
printf ("Foo::bar(s,y) method ... \n");
printf ("s is '%s'\n", s);
printf ("y is %d\n", y);
}

14
Examples/chicken/overload/example.h
View File

@ -1,14 +0,0 @@
/* File : example.h */
extern void foo (int x);
extern void foo (char *x);
class Foo {
private:
int myvar;
public:
Foo();
Foo(const Foo &); // Copy constructor
void bar(int x);
void bar(char *s, int y);
};

16
Examples/chicken/overload/example.i
View File

@ -1,16 +0,0 @@
/* File : example.i */
%module example
%{
#include "example.h"
%}
/* Let "Foo" objects be converted back and forth from TinyCLOS into
low-level CHICKEN SWIG procedures */
%typemap(clos_in) Foo * = SIMPLE_CLOS_OBJECT *;
%typemap(clos_out) Foo * = SIMPLE_CLOS_OBJECT *;
/* Let's just grab the original header file here */
%include "example.h"

45
Examples/chicken/overload/runme.scm
View File

@ -1,45 +0,0 @@
;; This file demonstrates the overloading capabilities of SWIG
(load-library 'example "overload.so")
;; Low level
;; ---------
(display "
Trying low level code ...
(foo 1)
(foo \"some string\")
(define A-FOO (new-Foo))
(define ANOTHER-FOO (new-Foo A-FOO)) ;; copy constructor
(Foo-bar A-FOO 2)
(Foo-bar ANOTHER-FOO \"another string\" 3)
")
(primitive:foo 1)
(primitive:foo "some string")
(define A-FOO (slot-ref (primitive:new-Foo) 'swig-this))
(define ANOTHER-FOO (slot-ref (primitive:new-Foo A-FOO) 'swig-this)) ;; copy constructor
(primitive:Foo-bar A-FOO 2)
(primitive:Foo-bar ANOTHER-FOO "another string" 3)
;; TinyCLOS
;; --------
(display "
Trying TinyCLOS code ...
(+foo+ 1)
(+foo+ \"some string\")
(define A-FOO (make <Foo>))
(define ANOTHER-FOO (make <Foo> A-FOO)) ;; copy constructor
(-bar- A-FOO 2)
(-bar- ANOTHER-FOO \"another string\" 3)
")
(foo 1)
(foo "some string")
(define A-FOO (make <Foo>))
(define ANOTHER-FOO (make <Foo> A-FOO)) ;; copy constructor
(bar A-FOO 2)
(bar ANOTHER-FOO "another string" 3)
(exit)

31
Examples/chicken/simple/Makefile
View File

@ -1,31 +0,0 @@
TOP = ../..
SWIGEXE = $(TOP)/../swig
SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
INTERFACE = example.i
SRCS = example.c
CXXSRCS =
TARGET = simple
INCLUDE =
SWIGOPT =
VARIANT =
# uncomment the following two lines to build a static exe
#CHICKEN_MAIN = runme.scm
#VARIANT = _static
check: build
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' chicken_run
build: $(TARGET)
$(TARGET): $(INTERFACE) $(SRCS)
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' \
SRCS='$(SRCS)' CXXSRCS='$(CXXSRCS)' CHICKEN_MAIN='$(CHICKEN_MAIN)' \
SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
INCLUDE='$(INCLUDE)' SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' \
INTERFACE='$(INTERFACE)' CHICKENOPTS='$(CHICKENOPTS)' chicken$(VARIANT)
clean:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' chicken_clean
rm -f example.scm example-generic.scm example-clos.scm
rm -f $(TARGET)

1
Examples/chicken/simple/README
View File

@ -1 +0,0 @@
Simple example from users manual.

24
Examples/chicken/simple/example.c
View File

@ -1,24 +0,0 @@
/* Simple example from documentation */
/* File : example.c */
#include <time.h>
double My_variable = 3.0;
/* Compute factorial of n */
int fact(int n) {
if (n <= 1) return 1;
else return n*fact(n-1);
}
/* Compute n mod m */
int my_mod(int n, int m) {
return (n % m);
}
char *get_time() {
long ltime;
time(&ltime);
return ctime(&ltime);
}

16
Examples/chicken/simple/example.i
View File

@ -1,16 +0,0 @@
/* File : example.i */
%module example
%{
/* Put headers and other declarations here */
%}
%include typemaps.i
%rename(mod) my_mod;
%inline %{
extern double My_variable;
extern int fact(int);
extern int my_mod(int n, int m);
extern char *get_time();
%}

28
Examples/chicken/simple/runme.scm
View File

@ -1,28 +0,0 @@
;; feel free to uncomment and comment sections
(load-library 'example "simple.so")
(display "(My-variable): ")
(display (My-variable))
(display "\n")
(display "(My-variable 3.141259): ")
(display (My-variable 3.141259))
(display "\n")
(display "(My-variable): ")
(display (My-variable))
(display "\n")
(display "(fact 5): ")
(display (fact 5))
(display "\n")
(display "(mod 75 7): ")
(display (mod 75 7))
(display "\n")
(display "(get-time): ")
(display (get-time))
(display "\n")
(exit)

2
Examples/test-suite/apply_strings.i
View File

@ -44,8 +44,6 @@
// unsigned char* as strings // unsigned char* as strings
#if defined(SWIGJAVA) || defined(SWIGCSHARP) #if defined(SWIGJAVA) || defined(SWIGCSHARP)
/* Note: Chicken does not allow unsigned char * in strings */
%apply char [ANY] {TAscii[ANY]} %apply char [ANY] {TAscii[ANY]}
%apply char [] {TAscii []} %apply char [] {TAscii []}
%apply char * {TAscii *} %apply char * {TAscii *}

101
Examples/test-suite/chicken/Makefile.in
View File

@ -1,101 +0,0 @@
#######################################################################
# Makefile for chicken test-suite
#######################################################################
LANGUAGE = chicken
VARIANT =
SCRIPTSUFFIX = _runme.ss
PROXYSUFFIX = _runme_proxy.ss
srcdir = @srcdir@
top_srcdir = @top_srcdir@
top_builddir = @top_builddir@
CHICKEN_CSI = @CHICKEN_CSI@ -quiet -batch -no-init
SO = @SO@
#C_TEST_CASES = long_long list_vector pointer_in_out multivalue
# Skip the STD cases for now, except for li_std_string.i
SKIP_CPP_STD_CASES = Yes
CPP_TEST_CASES += li_std_string
EXTRA_TEST_CASES += chicken_ext_test.externaltest
include $(srcdir)/../common.mk
# Overridden variables here
SWIGOPT += -nounit
# Custom tests - tests with additional commandline options
# If there exists a PROXYSUFFIX runme file, we also generate the wrapper
# with the -proxy argument
%.cppproxy: SWIGOPT += -proxy
%.cppproxy: SCRIPTSUFFIX = $(PROXYSUFFIX)
%.cproxy: SWIGOPT += -proxy
%.cproxy: SCRIPTSUFFIX = $(PROXYSUFFIX)
%.multiproxy: SWIGOPT += -proxy -noclosuses
%.multiproxy: SCRIPTSUFFIX = $(PROXYSUFFIX)
# Rules for the different types of tests
%.cpptest:
$(setup)
+$(swig_and_compile_cpp)
$(run_testcase)
if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(PROXYSUFFIX) ]; then \
$(MAKE) $*.cppproxy; \
fi
%.ctest:
$(setup)
+$(swig_and_compile_c)
$(run_testcase)
if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(PROXYSUFFIX) ]; then \
$(MAKE) $*.cproxy; \
fi
%.multicpptest:
$(setup)
+$(swig_and_compile_multi_cpp)
$(run_testcase)
if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(PROXYSUFFIX) ]; then \
$(MAKE) $*.multiproxy; \
fi
%.externaltest:
$(setup)
+$(swig_and_compile_external)
$(run_testcase)
%.cppproxy:
echo "$(ACTION)ing $(LANGUAGE) testcase $* (with run test) with -proxy"
+$(swig_and_compile_cpp)
$(run_testcase)
%.cproxy:
echo "$(ACTION)ing $(LANGUAGE) testcase $* (with run test) with -proxy"
+$(swig_and_compile_c)
$(run_testcase)
%.multiproxy:
echo "$(ACTION)ing $(LANGUAGE) testcase $* (with run test) with -proxy"
+$(swig_and_compile_multi_cpp)
$(run_testcase)
# Runs the testcase. A testcase is only run if
# a file is found which has _runme.scm appended after the testcase name.
run_testcase = \
if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then \
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(RUNTOOL) $(CHICKEN_CSI) $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
fi
# Clean
%.clean:
@exit 0
clean:
$(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile SRCDIR='$(SRCDIR)' chicken_clean
rm -f *.scm

11
Examples/test-suite/chicken/README
View File

@ -1,11 +0,0 @@
See ../README for common README file.
Any testcases which have _runme.ss appended after the testcase name will be detected and run.
NOTE: I had to use _runme.ss because otherwise it would be hard to implement make clean
Since when SWIG runs it generates an example.scm file for every test, to clean those files
I needed to add a rm -f *.scm to make clean. But we don't want the runme scripts to
disappear as well!
Any testcases which have _runme_proxy.ss appended after the testcase name will be detected
and run with the -proxy argument passed to SWIG. SWIG will not be run with the -unhide-primitive
option, so the _runme_proxy.ss file must use only the tinyclos exported interface.

2
Examples/test-suite/chicken/casts_runme.ss
View File

@ -1,2 +0,0 @@
(load "casts.so")
(include "../schemerunme/casts.scm")

2
Examples/test-suite/chicken/char_constant_runme.ss
View File

@ -1,2 +0,0 @@
(load "char_constant.so")
(include "../schemerunme/char_constant.scm")

21
Examples/test-suite/chicken/chicken_ext_test_external.cxx
View File

@ -1,21 +0,0 @@
#include <chicken/chicken_ext_test_wrap_hdr.h>
#include <imports_a.h>
void test_create(C_word,C_word,C_word) C_noret;
void test_create(C_word argc, C_word closure, C_word continuation) {
C_word resultobj;
swig_type_info *type;
A *newobj;
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
C_trace("test-create");
if (argc!=2) C_bad_argc(argc,2);
newobj = new A();
type = SWIG_TypeQuery("A *");
resultobj = SWIG_NewPointerObj(newobj, type, 1);
C_kontinue(continuation, resultobj);
}

5
Examples/test-suite/chicken/chicken_ext_test_runme.ss
View File

@ -1,5 +0,0 @@
(load "chicken_ext_test.so")
(define a (test-create))
(A-hello a)

2
Examples/test-suite/chicken/class_ignore_runme.ss
View File

@ -1,2 +0,0 @@
(load "class_ignore.so")
(include "../schemerunme/class_ignore.scm")

95
Examples/test-suite/chicken/clientdata_prop_runme_proxy.ss
View File

@ -1,95 +0,0 @@
(require 'clientdata_prop_a)
(require 'clientdata_prop_b)
(define a (make <A>))
(test-A a)
(test-tA a)
(test-t2A a)
(test-t3A a)
(fA a)
(define b (make <B>))
(test-A b)
(test-tA b)
(test-t2A b)
(test-t3A b)
(test-B b)
(fA b)
(fB b)
(define c (make <C>))
(test-A c)
(test-tA c)
(test-t2A c)
(test-t3A c)
(test-C c)
(fA c)
(fC c)
(define d (make <D>))
(test-A d)
(test-tA d)
(test-t2A d)
(test-t3A d)
(test-D d)
(test-tD d)
(test-t2D d)
(fA d)
(fD d)
;; here are the real tests... if the clientdata is correctly
;; propegated, new-tA, new-t2A, should all return wrapped proxy's
;; of class <A>
(define a2 (new-tA))
(if (not (eq? (class-of a2) <A>))
(error "Error 1"))
(test-A a2)
(test-tA a2)
(test-t2A a2)
(test-t3A a2)
(fA a2)
(define a3 (new-t2A))
(if (not (eq? (class-of a3) <A>))
(error "Error 2"))
(test-A a3)
(test-tA a3)
(test-t2A a3)
(test-t3A a3)
(fA a3)
(define a4 (new-t3A))
(if (not (eq? (class-of a4) <A>))
(error "Error 3"))
(test-A a4)
(test-tA a4)
(test-t2A a4)
(test-t3A a4)
(fA a4)
(define d2 (new-tD))
(if (not (eq? (class-of d2) <D>))
(error "Error 4"))
(test-A d2)
(test-tA d2)
(test-t2A d2)
(test-t3A d2)
(test-D d2)
(test-tD d2)
(fA d2)
(fD d2)
(define d3 (new-t2D))
(if (not (eq? (class-of d3) <D>))
(error "Error 5"))
(test-A d3)
(test-tA d3)
(test-t2A d3)
(test-t3A d3)
(test-D d3)
(test-tD d3)
(fA d3)
(fD d3)
(exit 0)

2
Examples/test-suite/chicken/constover_runme.ss
View File

@ -1,2 +0,0 @@
(load "constover.so")
(include "../schemerunme/constover.scm")

3
Examples/test-suite/chicken/contract_runme.ss
View File

@ -1,3 +0,0 @@
(load "contract.so")
(include "testsuite.ss")
(include "../schemerunme/contract.scm")

64
Examples/test-suite/chicken/cpp_basic_runme_proxy.ss
View File

@ -1,64 +0,0 @@
(require 'cpp_basic)
(define-macro (check test)
`(if (not ,test) (error "Error in test " ',test)))
(define f (make <Foo> 4))
(check (= (slot-ref f 'num) 4))
(slot-set! f 'num -17)
(check (= (slot-ref f 'num) -17))
(define b (make <Bar>))
(slot-set! b 'fptr f)
(check (= (slot-ref (slot-ref b 'fptr) 'num) -17))
(check (= (test b -3 (slot-ref b 'fptr)) -5))
(slot-set! f 'num 12)
(check (= (slot-ref (slot-ref b 'fptr) 'num) 12))
(check (= (slot-ref (slot-ref b 'fref) 'num) -4))
(check (= (test b 12 (slot-ref b 'fref)) 23))
;; references don't take ownership, so if we didn't define this here it might get garbage collected
(define f2 (make <Foo> 23))
(slot-set! b 'fref f2)
(check (= (slot-ref (slot-ref b 'fref) 'num) 23))
(check (= (test b -3 (slot-ref b 'fref)) 35))
(check (= (slot-ref (slot-ref b 'fval) 'num) 15))
(check (= (test b 3 (slot-ref b 'fval)) 33))
(slot-set! b 'fval (make <Foo> -15))
(check (= (slot-ref (slot-ref b 'fval) 'num) -15))
(check (= (test b 3 (slot-ref b 'fval)) -27))
(define f3 (testFoo b 12 (slot-ref b 'fref)))
(check (= (slot-ref f3 'num) 32))
;; now test global
(define f4 (make <Foo> 6))
(Bar-global-fptr f4)
(check (= (slot-ref (Bar-global-fptr) 'num) 6))
(slot-set! f4 'num 8)
(check (= (slot-ref (Bar-global-fptr) 'num) 8))
(check (= (slot-ref (Bar-global-fref) 'num) 23))
(Bar-global-fref (make <Foo> -7))
(check (= (slot-ref (Bar-global-fref) 'num) -7))
(check (= (slot-ref (Bar-global-fval) 'num) 3))
(Bar-global-fval (make <Foo> -34))
(check (= (slot-ref (Bar-global-fval) 'num) -34))
;; Now test function pointers
(define func1ptr (get-func1-ptr))
(define func2ptr (get-func2-ptr))
(slot-set! f 'num 4)
(check (= (func1 f 2) 16))
(check (= (func2 f 2) -8))
(slot-set! f 'func-ptr func1ptr)
(check (= (test-func-ptr f 2) 16))
(slot-set! f 'func-ptr func2ptr)
(check (= (test-func-ptr f 2) -8))
(exit 0)

2
Examples/test-suite/chicken/cpp_enum_runme.ss
View File

@ -1,2 +0,0 @@
(load "cpp_enum.so")
(include "../schemerunme/cpp_enum.scm")

2
Examples/test-suite/chicken/cpp_namespace_runme.ss
View File

@ -1,2 +0,0 @@
(load "cpp_namespace.so")
(include "../schemerunme/cpp_namespace.scm")

2
Examples/test-suite/chicken/dynamic_cast_runme.ss
View File

@ -1,2 +0,0 @@
(load "dynamic_cast.so")
(include "../schemerunme/dynamic_cast.scm")

2
Examples/test-suite/chicken/global_vars_runme.ss
View File

@ -1,2 +0,0 @@
(require 'global_vars)
(load "../schemerunme/global_vars.scm")

2
Examples/test-suite/chicken/global_vars_runme_proxy.ss
View File

@ -1,2 +0,0 @@
(require 'global_vars)
(load "../schemerunme/global_vars_proxy.scm")

2
Examples/test-suite/chicken/import_nomodule_runme.ss
View File

@ -1,2 +0,0 @@
(load "import_nomodule.so")
(include "../schemerunme/import_nomodule.scm")

3
Examples/test-suite/chicken/imports_runme.ss
View File

@ -1,3 +0,0 @@
(load "imports_a.so")
(load "imports_b.so")
(include "../schemerunme/imports.scm")

2
Examples/test-suite/chicken/inherit_missing_runme.ss
View File

@ -1,2 +0,0 @@
(load "inherit_missing.so")
(include "../schemerunme/inherit_missing.scm")

2
Examples/test-suite/chicken/li_std_string_runme.ss
View File

@ -1,2 +0,0 @@
(load "li_std_string.so")
(include "../schemerunme/li_std_string.scm")

47
Examples/test-suite/chicken/li_std_string_runme_proxy.ss
View File

@ -1,47 +0,0 @@
(load "li_std_string.so")
(define x "hello")
(if (not (string=? (test-value x) x))
(begin (error "Error 1") (exit 1)))
(if (not (string=? (test-const-reference x) x))
(begin (error "Error 2") (exit 1)))
(define y (test-pointer-out))
(test-pointer y)
(define z (test-const-pointer-out))
(test-const-pointer z)
(define a (test-reference-out))
(test-reference a)
;; test global variables
(GlobalString "whee")
(if (not (string=? (GlobalString) "whee"))
(error "Error 3"))
(if (not (string=? (GlobalString2) "global string 2"))
(error "Error 4"))
(define struct (make <Structure>))
;; MemberString should be a wrapped class
(if (not (string=? (slot-ref struct 'MemberString) ""))
(error "Error 4.5"))
;(slot-set! (slot-ref struct 'MemberString) "and how")
;;(if (not (string=? (slot-ref struct 'MemberString) "and how"))
;; (error "Error 5"))
(if (not (string=? (slot-ref struct 'MemberString2) "member string 2"))
(error "Error 6"))
(Structure-StaticMemberString "static str")
(if (not (string=? (Structure-StaticMemberString) "static str"))
(error "Error 7"))
(if (not (string=? (Structure-StaticMemberString2) "static member string 2"))
(error "Error 8"))
;(if (not (string=? (Structure-ConstMemberString-get struct) "const member string"))
; (error "Error 9"))
(if (not (string=? (Structure-ConstStaticMemberString) "const static member string"))
(error "Error 10"))
(exit 0)

12
Examples/test-suite/chicken/li_typemaps_runme.ss
View File

@ -1,12 +0,0 @@
(require 'li_typemaps)
(load "../schemerunme/li_typemaps.scm")
(call-with-values (lambda () (inoutr-int2 3 -2))
(lambda (a b)
(if (not (and (= a 3) (= b -2)))
(error "Error in inoutr-int2"))))
(call-with-values (lambda () (out-foo 4))
(lambda (a b)
(if (not (and (= (Foo-a-get a) 4) (= b 8)))
(error "Error in out-foo"))))
(exit 0)

13
Examples/test-suite/chicken/li_typemaps_runme_proxy.ss
View File

@ -1,13 +0,0 @@
(require 'li_typemaps)
(load "../schemerunme/li_typemaps_proxy.scm")
(call-with-values (lambda () (inoutr-int2 3 -2))
(lambda (a b)
(if (not (and (= a 3) (= b -2)))
(error "Error in inoutr-int2"))))
(call-with-values (lambda () (out-foo 4))
(lambda (a b)
(if (not (and (= (slot-ref a 'a) 4) (= b 8)))
(error "Error in out-foo"))))
(exit 0)

2
Examples/test-suite/chicken/list_vector_runme.ss
View File

@ -1,2 +0,0 @@
(load "list_vector.so")
(include "../schemerunme/list_vector.scm")

28
Examples/test-suite/chicken/member_pointer_runme.ss
View File

@ -1,28 +0,0 @@
(require 'member_pointer)
(define (check-eq? msg expected actual)
(if (not (= expected actual))
(error "Error " msg ": expected " expected " got " actual)))
(define area-pt (areapt))
(define perim-pt (perimeterpt))
(define s (new-Square 10))
(check-eq? "Square area" 100.0 (do-op s area-pt))
(check-eq? "Square perim" 40.0 (do-op s perim-pt))
(check-eq? "Square area" 100.0 (do-op s (areavar)))
(check-eq? "Square perim" 40.0 (do-op s (perimetervar)))
;; Set areavar to return value of function
(areavar perim-pt)
(check-eq? "Square perim" 40 (do-op s (areavar)))
(check-eq? "Square area" 100.0 (do-op s (AREAPT)))
(check-eq? "Square perim" 40.0 (do-op s (PERIMPT)))
(define test (NULLPT))
(perimetervar (AREAPT))
(check-eq? "Square area" 100.0 (do-op s (perimetervar)))

2
Examples/test-suite/chicken/multiple_inheritance_runme_proxy.ss
View File

@ -1,2 +0,0 @@
(require 'multiple_inheritance)
(load "../schemerunme/multiple_inheritance_proxy.scm")

4
Examples/test-suite/chicken/multivalue_runme.ss
View File

@ -1,4 +0,0 @@
;; this doesn't work yet :(
(load "multivalue.so")
(include "../schemerunme/multivalue.scm")
(exit 0)

2
Examples/test-suite/chicken/name_runme.ss
View File

@ -1,2 +0,0 @@
(load "name.so")
(include "../schemerunme/name.scm")

30
Examples/test-suite/chicken/newobject1_runme_proxy.ss
View File

@ -1,30 +0,0 @@
(require 'newobject1)
(define-macro (check-count val)
`(if (not (= (Foo-fooCount) ,val)) (error "Error checking val " ,val " != " ,(Foo-fooCount))))
(define f (Foo-makeFoo))
(check-count 1)
(define f2 (makeMore f))
(check-count 2)
(set! f #f)
(gc #t)
(check-count 1)
(define f3 (makeMore f2))
(check-count 2)
(set! f3 #f)
(set! f2 #f)
(gc #t)
(check-count 0)
(exit 0)

29
Examples/test-suite/chicken/newobject2_runme.ss
View File

@ -1,29 +0,0 @@
(load "newobject2.so")
(define f (new-Foo))
(Foo-dummy-set f 14)
(if (not (= (Foo-dummy-get f) 14))
(error "Bad dummy value"))
(if (not (= (fooCount) 0))
(error "Bad foo count 1"))
(define f2 (makeFoo))
(if (not (= (fooCount) 1))
(error "Bad foo count 2"))
(Foo-dummy-set f2 16)
(if (not (= (Foo-dummy-get f2) 16))
(error "Bad dummy value for f2"))
(set! f #f)
(set! f2 #f)
(gc #t)
(if (not (= (fooCount) -1))
(error "Bad foo count 3"))
(exit 0)

29
Examples/test-suite/chicken/newobject2_runme_proxy.ss
View File

@ -1,29 +0,0 @@
(load "newobject2.so")
(define f (make <Foo>))
(slot-set! f 'dummy 14)
(if (not (= (slot-ref f 'dummy) 14))
(error "Bad dummy value"))
(if (not (= (fooCount) 0))
(error "Bad foo count 1"))
(define f2 (makeFoo))
(if (not (= (fooCount) 1))
(error "Bad foo count 2"))
(slot-set! f2 'dummy 16)
(if (not (= (slot-ref f2 'dummy) 16))
(error "Bad dummy value for f2"))
(set! f #f)
(set! f2 #f)
(gc #t)
(if (not (= (fooCount) -1))
(error "Bad foo count 3"))
(exit 0)

2
Examples/test-suite/chicken/overload_complicated_runme.ss
View File

@ -1,2 +0,0 @@
(load "overload_complicated.so")
(include "../schemerunme/overload_complicated.scm")

2
Examples/test-suite/chicken/overload_copy_runme.ss
View File

@ -1,2 +0,0 @@
(load "overload_copy.so")
(include "../schemerunme/overload_copy.scm")

6
Examples/test-suite/chicken/overload_copy_runme_proxy.ss
View File

@ -1,6 +0,0 @@
(load "./overload_copy.so")
(define f (make <Foo>))
(define g (make <Foo> f))
(exit 0)

2
Examples/test-suite/chicken/overload_extend_c_runme.ss
View File

@ -1,2 +0,0 @@
(load "overload_extend_c.so")
(include "../schemerunme/overload_extend_c.scm")

2
Examples/test-suite/chicken/overload_extend_runme.ss
View File

@ -1,2 +0,0 @@
(load "overload_extend.so")
(include "../schemerunme/overload_extend.scm")

14
Examples/test-suite/chicken/overload_extend_runme_proxy.ss
View File

@ -1,14 +0,0 @@
(load "./overload_extend.so")
(define f (make <Foo>))
(if (not (= (test f 3) 1))
(error "test integer bad"))
(if (not (= (test f "hello") 2))
(error "test string bad"))
(if (not (= (test f 3.5 2.5) 6.0))
(error "test reals bad"))
(exit 0)

2
Examples/test-suite/chicken/overload_simple_runme.ss
View File

@ -1,2 +0,0 @@
(load "overload_simple.so")
(include "../schemerunme/overload_simple.scm")

56
Examples/test-suite/chicken/overload_simple_runme_proxy.ss
View File

@ -1,56 +0,0 @@
(load "overload_simple.so")
(define-macro (check test)
`(if (not ,test) (error ',test)))
(check (string=? (foo) "foo:"))
(check (string=? (foo 3) "foo:int"))
(check (string=? (foo 3.01) "foo:double"))
(check (string=? (foo "hey") "foo:char *"))
(define f (make <Foo>))
(define b (make <Bar>))
(define b2 (make <Bar> 3))
(check (= (slot-ref b 'num) 0))
(check (= (slot-ref b2 'num) 3))
(check (string=? (foo f) "foo:Foo *"))
(check (string=? (foo b) "foo:Bar *"))
(check (string=? (foo f 3) "foo:Foo *,int"))
(check (string=? (foo 3.2 b) "foo:double,Bar *"))
;; now check blah
(check (string=? (blah 2.01) "blah:double"))
(check (string=? (blah "hey") "blah:char *"))
;; now check spam member functions
(define s (make <Spam>))
(define s2 (make <Spam> 3))
(define s3 (make <Spam> 3.2))
(define s4 (make <Spam> "whee"))
(define s5 (make <Spam> f))
(define s6 (make <Spam> b))
(check (string=? (slot-ref s 'type) "none"))
(check (string=? (slot-ref s2 'type) "int"))
(check (string=? (slot-ref s3 'type) "double"))
(check (string=? (slot-ref s4 'type) "char *"))
(check (string=? (slot-ref s5 'type) "Foo *"))
(check (string=? (slot-ref s6 'type) "Bar *"))
;; now check Spam member functions
(check (string=? (foo s 2) "foo:int"))
(check (string=? (foo s 2.1) "foo:double"))
(check (string=? (foo s "hey") "foo:char *"))
(check (string=? (foo s f) "foo:Foo *"))
(check (string=? (foo s b) "foo:Bar *"))
;; check static member funcs
(check (string=? (Spam-bar 3) "bar:int"))
(check (string=? (Spam-bar 3.2) "bar:double"))
(check (string=? (Spam-bar "hey") "bar:char *"))
(check (string=? (Spam-bar f) "bar:Foo *"))
(check (string=? (Spam-bar b) "bar:Bar *"))
(exit 0)

2
Examples/test-suite/chicken/overload_subtype_runme.ss
View File

@ -1,2 +0,0 @@
(load "overload_subtype.so")
(include "../schemerunme/overload_subtype.scm")

12
Examples/test-suite/chicken/overload_subtype_runme_proxy.ss
View File

@ -1,12 +0,0 @@
(load "./overload_subtype.so")
(define f (make <Foo>))
(define b (make <Bar>))
(if (not (= (spam f) 1))
(error "Error in foo"))
(if (not (= (spam b) 2))
(error "Error in bar"))
(exit 0)

2
Examples/test-suite/chicken/pointer_in_out_runme.ss
View File

@ -1,2 +0,0 @@
(load "pointer_in_out.so")
(include "../schemerunme/pointer_in_out.scm")

2
Examples/test-suite/chicken/reference_global_vars_runme.ss
View File

@ -1,2 +0,0 @@
(load "reference_global_vars.so")
(include "../schemerunme/reference_global_vars.scm")

12
Examples/test-suite/chicken/testsuite.ss
View File

@ -1,12 +0,0 @@
(define (lookup-ext-tag tag)
(cond
((equal? tag '(quote swig-contract-assertion-failed))
'( ((exn type) #f)) )
(#t '())))
(define-macro (expect-throw tag-form form)
`(if (condition-case (begin ,form #t)
,@(lookup-ext-tag tag-form)
((exn) (print "The form threw a different error than expected: " ',form) (exit 1))
(var () (print "The form did not error as expected: " ',form) (exit 1)))
(begin (print "The form returned normally when it was expected to throw an error: " ',form) (exit 1))))

29
Examples/test-suite/chicken/throw_exception_runme.ss
View File

@ -1,29 +0,0 @@
(load "throw_exception.so")
(define-macro (check-throw expr check)
`(if (handle-exceptions exvar (if ,check #f (begin (print "Error executing: " ',expr " " exvar) (exit 1))) ,expr #t)
(print "Expression did not throw an error: " ',expr)))
(define f (new-Foo))
(check-throw (Foo-test-int f) (= exvar 37))
(check-throw (Foo-test-msg f) (string=? exvar "Dead"))
(check-throw (Foo-test-cls f) (test-is-Error exvar))
(check-throw (Foo-test-cls-ptr f) (test-is-Error exvar))
(check-throw (Foo-test-cls-ref f) (test-is-Error exvar))
(check-throw (Foo-test-cls-td f) (test-is-Error exvar))
(check-throw (Foo-test-cls-ptr-td f) (test-is-Error exvar))
(check-throw (Foo-test-cls-ref-td f) (test-is-Error exvar))
(check-throw (Foo-test-enum f) (= exvar (enum2)))
; don't know how to test this... it is returning a SWIG wrapped int *
;(check-throw (Foo-test-array f) (equal? exvar '(0 1 2 3 4 5 6 7 8 9)))
(check-throw (Foo-test-multi f 1) (= exvar 37))
(check-throw (Foo-test-multi f 2) (string=? exvar "Dead"))
(check-throw (Foo-test-multi f 3) (test-is-Error exvar))
(set! f #f)
(gc #t)
(exit 0)

2
Examples/test-suite/chicken/typedef_inherit_runme.ss
View File

@ -1,2 +0,0 @@
(load "typedef_inherit.so")
(include "../schemerunme/typedef_inherit.scm")

2
Examples/test-suite/chicken/typename_runme.ss
View File

@ -1,2 +0,0 @@
(load "typename.so")
(include "../schemerunme/typename.scm")

2
Examples/test-suite/chicken/unions_runme.ss
View File

@ -1,2 +0,0 @@
(load "unions.so")
(include "../schemerunme/unions.scm")

2
Examples/test-suite/chicken/unions_runme_proxy.ss
View File

@ -1,2 +0,0 @@
(load "unions.so")
(include "../schemerunme/unions_proxy.scm")

21
Examples/test-suite/chicken_ext_test.i
View File

@ -1,21 +0,0 @@
%module chicken_ext_test
/* just use the imports_a.h header... for this test we only need a class */
%{
#include "imports_a.h"
%}
%include "imports_a.h"
%{
void test_create(C_word,C_word,C_word) C_noret;
%}
%init %{
{
C_word *space = C_alloc(2 + C_SIZEOF_INTERNED_SYMBOL(11));
sym = C_intern (&space, 11, "test-create");
C_mutate ((C_word*)sym+1, (*space=C_CLOSURE_TYPE|1, space[1]=(C_word)test_create, tmp=(C_word)space, space+=2, tmp));
}
%}

2
Examples/test-suite/cpp_basic.i
View File

@ -1,4 +1,4 @@
/* This is a basic test of proxy classes, used by chicken */ /* This is a basic test of proxy classes */
%warnfilter(SWIGWARN_TYPEMAP_SWIGTYPELEAK); /* memory leak when setting a ptr/ref variable */ %warnfilter(SWIGWARN_TYPEMAP_SWIGTYPELEAK); /* memory leak when setting a ptr/ref variable */

6
Examples/test-suite/exception_partial_info.i
View File

@ -30,8 +30,6 @@ class ex2 : public myException
#if !defined(SWIGUTL) #if !defined(SWIGUTL)
#if !defined(SWIGCHICKEN)
%inline %{ %inline %{
class Impl class Impl
{ {
@ -41,10 +39,6 @@ class Impl
}; };
%} %}
#else
#warning "Chicken needs fixing for partial exception information"
#endif
#else #else
#warning "UTL needs fixing for partial exception information" #warning "UTL needs fixing for partial exception information"
#endif #endif

4
Examples/test-suite/overload_arrays.i
View File

@ -2,10 +2,6 @@
// Based on overload_simple testcase // Based on overload_simple testcase
%module overload_arrays %module overload_arrays
#ifdef SWIGCHICKEN
%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) fbool;
#endif
#ifdef SWIGLUA #ifdef SWIGLUA
// lua only has one numeric type, so most of the overloads shadow each other creating warnings // lua only has one numeric type, so most of the overloads shadow each other creating warnings
%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) foo; %warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) foo;

4
Examples/test-suite/overload_simple.i
View File

@ -1,10 +1,6 @@
// Simple tests of overloaded functions // Simple tests of overloaded functions
%module overload_simple %module overload_simple
#ifdef SWIGCHICKEN
%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) fbool;
#endif
#ifdef SWIGLUA #ifdef SWIGLUA
// lua only has one numeric type, so most of the overloads shadow each other creating warnings // lua only has one numeric type, so most of the overloads shadow each other creating warnings
%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) foo; %warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) foo;

5
Examples/test-suite/preproc.i
View File

@ -298,11 +298,6 @@ inline const char* mangle_macro ## #@__VA_ARGS__ () {
/* chiao */ /* chiao */
#endif; #endif;
#ifdef SWIGCHICKEN
/* define is a scheme keyword (and thus an invalid variable name), so SWIG warns about it */
%warnfilter(SWIGWARN_PARSE_KEYWORD) define;
#endif
#ifdef SWIGRUBY #ifdef SWIGRUBY
%rename(ddefined) defined; %rename(ddefined) defined;
#endif #endif

4
Examples/test-suite/schemerunme/li_typemaps.scm
View File

@ -24,8 +24,8 @@
;(check "ulonglong" 6432 =) ;(check "ulonglong" 6432 =)
;; The checking of inoutr-int2 and out-foo is done in the individual ;; The checking of inoutr-int2 and out-foo is done in the individual
;; language runme scripts, since chicken returns multiple values ;; language runme scripts, since how multiple values are returned
;; and must be checked with call-with-values, while guile just returns a list ;; differs between scheme variants.
;(call-with-values (lambda () (inoutr-int2 3 -2)) ;(call-with-values (lambda () (inoutr-int2 3 -2))
; (lambda (a b) ; (lambda (a b)

4
Examples/test-suite/schemerunme/li_typemaps_proxy.scm
View File

@ -24,8 +24,8 @@
(check "ulonglong" 6432 =) (check "ulonglong" 6432 =)
;; The checking of inoutr-int2 and out-foo is done in the individual ;; The checking of inoutr-int2 and out-foo is done in the individual
;; language runme scripts, since chicken returns multiple values ;; language runme scripts, since how multiple values are returned
;; and must be checked with call-with-values, while guile just returns a list ;; differs between scheme variants.
;(call-with-values (lambda () (inoutr-int2 3 -2)) ;(call-with-values (lambda () (inoutr-int2 3 -2))
; (lambda (a b) ; (lambda (a b)

2
Examples/test-suite/sizet.i
View File

@ -3,9 +3,7 @@
#include <vector> #include <vector>
%} %}
#ifndef SWIGCHICKEN
%include "std_common.i" %include "std_common.i"
#endif
%inline %inline
{ {

4
Examples/test-suite/template_default.i
View File

@ -196,7 +196,6 @@ namespace ns1 {
%} %}
#ifndef SWIGCHICKEN
%include std_vector.i %include std_vector.i
%{ %{
@ -211,6 +210,3 @@ void q(double = 0) {}
%constant void (*Bf)(std::vector<double> *p = 0) = g; %constant void (*Bf)(std::vector<double> *p = 0) = g;
%constant void (*Cf)(double = 0) = q; %constant void (*Cf)(double = 0) = q;
#endif

809
Lib/chicken/chicken.swg
View File

@ -1,809 +0,0 @@
/* -----------------------------------------------------------------------------
* chicken.swg
*
* CHICKEN configuration module.
* ----------------------------------------------------------------------------- */
/* chicken.h has to appear first. */
%insert(runtime) %{
#include <assert.h>
#include <chicken.h>
%}
%insert(runtime) "swigrun.swg" // Common C API type-checking code
%insert(runtime) "swigerrors.swg" // SWIG errors
%insert(runtime) "chickenrun.swg" // CHICKEN run-time code
/* -----------------------------------------------------------------------------
* standard typemaps
* ----------------------------------------------------------------------------- */
/*
CHICKEN: C
----------
fixnum: int, short, unsigned int, unsigned short, unsigned char,
signed char
char: char
bool: bool
flonum: float, double, long, long long, unsigned long, unsigned long
long
*/
/* --- Primitive types --- */
%define SIMPLE_TYPEMAP(type_, from_scheme, to_scheme, checker, convtype, storage_)
%typemap(in) type_
%{ if (!checker ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument #$argnum is not of type 'type_'");
}
$1 = ($1_ltype) from_scheme ($input); %}
/* Const primitive references. Passed by value */
%typemap(in) const type_ & ($*1_ltype temp)
%{ if (!checker ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument #$argnum is not of type 'type_'");
}
temp = ($*1_ltype) from_scheme ($input);
$1 = &temp; %}
/* --- Variable input --- */
%typemap(varin) type_
%{ if (!checker ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Cannot use '$1_ltype' for variable '$name' of type 'type_'");
}
$1 = ($1_ltype) from_scheme ($input); %}
#if "storage_" == "0"
%typemap(out) type_
%{
$result = to_scheme (convtype ($1));
%}
/* References to primitive types. Return by value */
%typemap(out) const type_ &
%{
$result = to_scheme (convtype (*$1));
%}
/* --- Variable output --- */
%typemap(varout) type_
%{
$result = to_scheme (convtype ($varname));
%}
%typemap(throws) type_
%{
SWIG_Chicken_ThrowException(to_scheme ( convtype ($1)));
%}
#else
%typemap(out) type_
%{
{
C_word *space = C_alloc(storage_);
$result = to_scheme (&space, convtype ($1));
}
%}
/* References to primitive types. Return by value */
%typemap(out) const type_ &
%{
{
C_word *space = C_alloc(storage_);
$result = to_scheme (&space, convtype (*$1));
}
%}
/* --- Variable output --- */
%typemap(varout) type_
%{
{
C_word *space = C_alloc(storage_);
$result = to_scheme (&space, convtype ($varname));
}
%}
%typemap(throws) type_
%{
{
C_word *space = C_alloc(storage_);
SWIG_Chicken_ThrowException(to_scheme (&space, convtype ($1)));
}
%}
#endif
/* --- Constants --- */
%typemap(constcode) type_
"static const $1_type $result = $value;"
%enddef
SIMPLE_TYPEMAP(int, C_num_to_int, C_fix, C_swig_is_number, (int), 0);
//SIMPLE_TYPEMAP(enum SWIGTYPE, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
SIMPLE_TYPEMAP(short, C_num_to_int, C_fix, C_swig_is_number, (int), 0);
SIMPLE_TYPEMAP(long, C_num_to_long, C_long_to_num, C_swig_is_long, (long), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(long long, C_num_to_long, C_long_to_num, C_swig_is_long, (long), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(unsigned int, C_num_to_unsigned_int, C_unsigned_int_to_num, C_swig_is_number, (unsigned int), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(unsigned short, C_num_to_unsigned_int, C_fix, C_swig_is_number, (unsigned int), 0);
SIMPLE_TYPEMAP(unsigned long, C_num_to_unsigned_long, C_unsigned_long_to_num, C_swig_is_long, (unsigned long), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(unsigned long long, C_num_to_unsigned_long, C_unsigned_long_to_num, C_swig_is_long, (unsigned long), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(unsigned char, C_character_code, C_make_character, C_swig_is_char, (unsigned int), 0);
SIMPLE_TYPEMAP(signed char, C_character_code, C_make_character, C_swig_is_char, (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_c_double, C_flonum, C_swig_is_number, (double), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(double, C_c_double, C_flonum, C_swig_is_number, (double), C_SIZEOF_FLONUM);
/* enum SWIGTYPE */
%apply int { enum SWIGTYPE };
%apply const int& { const enum SWIGTYPE& };
%apply const int& { const enum SWIGTYPE&& };
%typemap(varin) enum SWIGTYPE
{
if (!C_swig_is_fixnum($input) && sizeof(int) != sizeof($1)) {
swig_barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, "enum variable '$name' can not be set");
}
*((int *)(void *)&$1) = C_unfix($input);
}
/* --- Input arguments --- */
/* Strings */
%typemap(in) char *
{ if ($input == C_SCHEME_FALSE) {
$1 = NULL;
}
else {
if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument #$argnum is not of type 'char *'");
}
$1 = ($ltype) SWIG_MakeString ($input);
}
}
%typemap(freearg) char * "if ($1 != NULL) { free ($1); }"
/* Pointers, references, and arrays */
%typemap(in,closcode="(slot-ref $input 'swig-this)") SWIGTYPE *, SWIGTYPE [], SWIGTYPE &, SWIGTYPE && {
$1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, $disown);
}
%typemap(in,closcode="(slot-ref $input 'swig-this)") SWIGTYPE *DISOWN {
$1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, SWIG_POINTER_DISOWN);
}
/* Void pointer. Accepts any kind of pointer */
%typemap(in) void * {
$1 = ($1_ltype)SWIG_MustGetPtr($input, NULL, $argnum, 0);
}
%typemap(varin,closcode="(slot-ref $input 'swig-this)") SWIGTYPE * {
$1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, SWIG_POINTER_DISOWN);
}
%typemap(varin,closcode="(slot-ref $input 'swig-this)") SWIGTYPE & {
$1 = *(($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, 0));
}
%typemap(varin,closcode="(slot-ref $input 'swig-this)") 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 &&, 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);
}
%typemap(varout) SWIGTYPE && {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
$result = SWIG_NewPointerObj((void *) &$varname, $1_descriptor, 0);
}
/* special typemaps for class pointers */
%typemap(in) SWIGTYPE (CLASS::*) {
char err_msg[256];
if (C_swig_is_pair($input)) {
/* try and convert pointer object */
void *result;
if (!SWIG_ConvertPtr(C_block_item($input,1), &result, $descriptor, 0)) {
C_word ptr = C_block_item($input,0);
if (C_swig_is_string(ptr)) {
SWIG_UnpackData(C_c_string(ptr), (void *) &$1, sizeof($1));
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", $argnum, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", $argnum, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", $argnum, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
}
%typemap(out) SWIGTYPE (CLASS::*) {
size_t ptr_size = sizeof($type);
C_word *known_space = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(2*ptr_size) + C_SIZEOF_SWIG_POINTER);
char *temp = (char *)malloc(2*ptr_size);
C_word ptr = SWIG_NewPointerObj((void *) known_space, $descriptor, 0);
SWIG_PackData(temp, (void *) &$1, ptr_size);
$result = C_pair(&known_space, C_string(&known_space, 2*ptr_size, temp), ptr);
free(temp);
}
%typemap(varin) SWIGTYPE (CLASS::*) {
char err_msg[256];
if (C_swig_is_pair($input)) {
/* try and convert pointer object */
void *result;
if (!SWIG_ConvertPtr(C_block_item($input,1), &result, $descriptor, 0)) {
C_word ptr = C_block_item($input,0);
if (C_swig_is_string(ptr)) {
SWIG_UnpackData(C_c_string(ptr), (void *) &$1, sizeof($1));
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", 1, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", 1, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", 1, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
}
%typemap(varout) SWIGTYPE (CLASS::*) {
size_t ptr_size = sizeof($type);
C_word *known_space = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(2*ptr_size) + C_SIZEOF_SWIG_POINTER);
char *temp = (char *)malloc(2*ptr_size);
C_word ptr = SWIG_NewPointerObj((void *) known_space, $descriptor, 0);
SWIG_PackData(temp, (void *) &$varname, ptr_size);
$result = C_pair(&known_space, C_string(&known_space, 2*ptr_size, temp), ptr);
free(temp);
}
/* Pass-by-value */
%typemap(in,closcode="(slot-ref $input 'swig-this)") SWIGTYPE($&1_ltype argp) {
argp = ($&1_ltype)SWIG_MustGetPtr($input, $&1_descriptor, $argnum, 0);
$1 = *argp;
}
%typemap(varin,closcode="(slot-ref $input 'swig-this)") 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((const $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((const $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)
char *
{ char *s = (char*) $1;
if ($1 == NULL) {
$result = C_SCHEME_FALSE;
}
else {
int string_len = strlen ((char *) ($1));
C_word *string_space = C_alloc (C_SIZEOF_STRING (string_len));
$result = C_string (&string_space, string_len, s);
}
}
%typemap(varout)
char *
{ char *s = (char*) $varname;
if ($varname == NULL) {
$result = C_SCHEME_FALSE;
}
else {
int string_len = strlen ($varname);
C_word *string_space = C_alloc (C_SIZEOF_STRING (string_len));
$result = C_string (&string_space, string_len, s);
}
}
%typemap(throws) char *
{
if ($1 == NULL) {
SWIG_Chicken_ThrowException(C_SCHEME_FALSE);
} else {
int string_len = strlen($1);
C_word *string_space = C_alloc(C_SIZEOF_STRING(string_len));
SWIG_Chicken_ThrowException(C_string(&string_space, string_len, (char *) $1));
}
}
/* Void */
%typemap(out) void
%{
$result = C_SCHEME_UNDEFINED;
%}
/* Special typemap for character array return values */
%typemap(out)
char [ANY], const char [ANY]
%{ if ($1 == NULL) {
$result = C_SCHEME_FALSE;
}
else {
const int string_len = strlen ($1);
C_word *string_space = C_alloc (C_SIZEOF_STRING (string_len));
$result = C_string (&string_space, string_len, $1);
} %}
/* Primitive types--return by value */
/* --- Variable input --- */
/* A string */
#ifdef __cplusplus
%typemap(varin) char * {
if ($input == C_SCHEME_FALSE) {
$1 = NULL;
}
else if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "C variable '$name ($1_ltype)'");
}
else {
char *temp = C_c_string ($input);
int len = C_header_size ($input);
if ($1) delete [] $1;
$1 = ($type) new char[len+1];
strncpy((char*)$1, temp, len);
((char*)$1) [len] = 0;
}
}
%typemap(varin,warning="451:Setting const char * variable may leak memory") const char * {
if ($input == C_SCHEME_FALSE) {
$1 = NULL;
}
else if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "C variable '$name ($1_ltype)'");
}
else {
char *temp = C_c_string ($input);
int len = C_header_size ($input);
$1 = ($type) new char[len+1];
strncpy((char*)$1,temp,len);
((char*)$1) [len] = 0;
}
}
#else
%typemap(varin) char * {
if ($input == C_SCHEME_FALSE) {
$1 = NULL;
}
else if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "C variable '$name ($1_ltype)'");
}
else {
char *temp = C_c_string ($input);
int len = C_header_size ($input);
if ($1) free((char*) $1);
$1 = ($type) malloc(len+1);
strncpy((char*)$1,temp,len);
((char*)$1) [len] = 0;
}
}
%typemap(varin,warning="451:Setting const char * variable may leak memory") const char * {
if ($input == C_SCHEME_FALSE) {
$1 = NULL;
}
else if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "C variable '$name ($1_ltype)'");
}
else {
char *temp = C_c_string ($input);
int len = C_header_size ($input);
$1 = ($type) malloc(len+1);
strncpy((char*)$1,temp,len);
((char*)$1) [len] = 0;
}
}
#endif
%typemap(varin) char [] {
swig_barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, "C/C++ variable '$name' is read-only");
}
/* Special case for string array variables */
%typemap(varin) char [ANY] {
if ($input == C_SCHEME_FALSE) {
memset($1,0,$1_dim0*sizeof(char));
}
else if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "C variable '$name ($1_ltype)'");
}
else {
char *temp = C_c_string ($input);
strncpy($1,temp,$1_dim0*sizeof(char));
}
}
/* --- Variable output --- */
/* Void */
%typemap(varout) void "$result = C_SCHEME_UNDEFINED;";
/* Special typemap for character array return values */
%typemap(varout) char [ANY], const char [ANY]
%{ if ($varname == NULL) {
$result = C_SCHEME_FALSE;
}
else {
const int string_len = strlen ($varname);
C_word *string_space = C_alloc (C_SIZEOF_STRING (string_len));
$result = C_string (&string_space, string_len, (char *) $varname);
}
%}
/* --- Constants --- */
%typemap(constcode) char *
"static const char *$result = $value;"
%typemap(constcode) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE []
"static const void *$result = (void*) $value;"
/* ------------------------------------------------------------
* String & length
* ------------------------------------------------------------ */
%typemap(in) (char *STRING, int LENGTH), (char *STRING, size_t LENGTH) {
if ($input == C_SCHEME_FALSE) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Cannot use a null/#f string for a char*, int arguments");
}
else if (C_swig_is_string ($input)) {
$1 = ($1_ltype) C_c_string ($input);
$2 = ($2_ltype) C_header_size ($input);
}
else {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument #$argnum is not of type 'string'");
}
}
/* ------------------------------------------------------------
* CHICKEN types
* ------------------------------------------------------------ */
%typemap(in) C_word "$1 = $input;";
%typemap(out) C_word "$result = $1;";
/* ------------------------------------------------------------
* Typechecking rules
* ------------------------------------------------------------ */
%typecheck(SWIG_TYPECHECK_INTEGER)
bool, const bool &
{
$1 = C_swig_is_bool ($input);
}
%typecheck(SWIG_TYPECHECK_INTEGER)
int, short,
unsigned int, unsigned short,
signed char, unsigned char,
const int &, const short &,
const unsigned int &, const unsigned short &,
enum SWIGTYPE
{
$1 = C_swig_is_fixnum ($input);
}
%typecheck(SWIG_TYPECHECK_INTEGER)
long,
unsigned long,
long long, unsigned long long,
const long &,
const unsigned long &,
const long long &, const unsigned long long &
{
$1 = (C_swig_is_bool ($input) ||
C_swig_is_fixnum ($input) ||
C_swig_is_flonum ($input)) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_DOUBLE)
float, double,
const float &, const double &
{
$1 = C_swig_is_flonum ($input);
}
%typecheck(SWIG_TYPECHECK_CHAR) char {
$1 = C_swig_is_string ($input);
}
%typecheck(SWIG_TYPECHECK_STRING) char * {
$1 = C_swig_is_string ($input);
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE [] {
void *ptr;
$1 = !SWIG_ConvertPtr($input, &ptr, $1_descriptor, 0);
}
%typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
void *ptr;
$1 = !SWIG_ConvertPtr($input, &ptr, 0, 0);
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE &
{
void *ptr = 0;
if (SWIG_ConvertPtr($input, &ptr, $descriptor, SWIG_POINTER_NO_NULL)) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE &&
{
void *ptr = 0;
if (SWIG_ConvertPtr($input, &ptr, $descriptor, SWIG_POINTER_NO_NULL)) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE
{
void *ptr = 0;
if (SWIG_ConvertPtr($input, &ptr, $&descriptor, SWIG_POINTER_NO_NULL)) {
$1 = 0;
} else {
$1 = 1;
}
}
/* ------------------------------------------------------------
* Exception handling
* ------------------------------------------------------------ */
/* ------------------------------------------------------------
* --- Exception handling ---
* ------------------------------------------------------------ */
%typemap(throws) SWIGTYPE {
$&ltype temp = new $ltype($1);
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
C_word ptr = SWIG_NewPointerObj(temp, $&descriptor,1);
SWIG_Chicken_ThrowException(ptr);
}
%typemap(throws) SWIGTYPE * {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
C_word ptr = SWIG_NewPointerObj((void *) $1, $descriptor, 0);
SWIG_Chicken_ThrowException(ptr);
}
%typemap(throws) SWIGTYPE [ANY] {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
C_word ptr = SWIG_NewPointerObj((void *) $1, $descriptor, 0);
SWIG_Chicken_ThrowException(ptr);
}
%typemap(throws) SWIGTYPE & {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
C_word ptr = SWIG_NewPointerObj((void *)&($1),$descriptor,0);
SWIG_Chicken_ThrowException(ptr);
}
%typemap(throws) SWIGTYPE && {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
C_word ptr = SWIG_NewPointerObj((void *)&($1),$descriptor,0);
SWIG_Chicken_ThrowException(ptr);
}
/* ------------------------------------------------------------
* ANSI C typemaps
* ------------------------------------------------------------ */
%apply unsigned long { size_t };
/* ------------------------------------------------------------
* Various
* ------------------------------------------------------------ */
/* Array reference typemaps */
%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) }
%apply SWIGTYPE && { SWIGTYPE ((&&)[ANY]) }
/* const pointers */
%apply SWIGTYPE * { SWIGTYPE *const }
%apply SWIGTYPE (CLASS::*) { SWIGTYPE (CLASS::*const) }
%apply SWIGTYPE & { SWIGTYPE (CLASS::*const&) }
/* ------------------------------------------------------------
* Overloaded operator support
* ------------------------------------------------------------ */
#ifdef __cplusplus
%rename(__add__) *::operator+;
%rename(__pos__) *::operator+();
%rename(__pos__) *::operator+() const;
%rename(__sub__) *::operator-;
%rename(__neg__) *::operator-();
%rename(__neg__) *::operator-() const;
%rename(__mul__) *::operator*;
%rename(__div__) *::operator/;
%rename(__mod__) *::operator%;
%rename(__lshift__) *::operator<<;
%rename(__rshift__) *::operator>>;
%rename(__and__) *::operator&;
%rename(__or__) *::operator|;
%rename(__xor__) *::operator^;
%rename(__invert__) *::operator~;
%rename(__iadd__) *::operator+=;
%rename(__isub__) *::operator-=;
%rename(__imul__) *::operator*=;
%rename(__idiv__) *::operator/=;
%rename(__imod__) *::operator%=;
%rename(__ilshift__) *::operator<<=;
%rename(__irshift__) *::operator>>=;
%rename(__iand__) *::operator&=;
%rename(__ior__) *::operator|=;
%rename(__ixor__) *::operator^=;
%rename(__lt__) *::operator<;
%rename(__le__) *::operator<=;
%rename(__gt__) *::operator>;
%rename(__ge__) *::operator>=;
%rename(__eq__) *::operator==;
%rename(__ne__) *::operator!=;
/* Special cases */
%rename(__call__) *::operator();
#endif
/* Warnings for certain CHICKEN keywords */
%include <chickenkw.swg>
/* TinyCLOS <--> Low-level CHICKEN */
%typemap("clos_in") SIMPLE_CLOS_OBJECT * "(slot-ref $input (quote this))"
%typemap("clos_out") SIMPLE_CLOS_OBJECT * "(make $class (quote this) $1)"
%insert(header) %{
#ifdef __cplusplus
extern "C" {
#endif
/* Chicken initialization function */
SWIGEXPORT void SWIG_init(C_word, C_word, C_word) C_noret;
#ifdef __cplusplus
}
#endif
%}
%insert(closprefix) "swigclosprefix.scm"
%insert(init) "swiginit.swg"
%insert(init) %{
/* CHICKEN initialization function */
#ifdef __cplusplus
extern "C" {
#endif
SWIGEXPORT void SWIG_init(C_word argc, C_word closure, C_word continuation) {
int i;
C_word sym;
C_word tmp;
C_word *a;
C_word ret;
C_word *return_vec;
SWIG_InitializeModule(0);
SWIG_PropagateClientData();
ret = C_SCHEME_TRUE;
#if $veclength
return_vec = C_alloc(C_SIZEOF_VECTOR($veclength));
ret = (C_word) return_vec;
*(return_vec++) = C_VECTOR_TYPE | $veclength;
#endif
a = C_alloc(2*$nummethods$symsize);
%}

31
Lib/chicken/chickenkw.swg
View File

@ -1,31 +0,0 @@
#ifndef CHICKEN_CHICKENKW_SWG_
#define CHICKEN_CHICKENKW_SWG_
/* Warnings for certain CHICKEN keywords. From Section 7.1.1 of
Revised^5 Report on the Algorithmic Language Scheme */
#define CHICKENKW(x) %namewarn("314: '" #x "' is a R^5RS syntatic keyword") #x
CHICKENKW(else);
CHICKENKW(=>);
CHICKENKW(define);
CHICKENKW(unquote);
CHICKENKW(unquote-splicing);
CHICKENKW(quote);
CHICKENKW(lambda);
CHICKENKW(if);
CHICKENKW(set!);
CHICKENKW(begin);
CHICKENKW(cond);
CHICKENKW(and);
CHICKENKW(or);
CHICKENKW(case);
CHICKENKW(let);
CHICKENKW(let*);
CHICKENKW(letrec);
CHICKENKW(do);
CHICKENKW(delay);
CHICKENKW(quasiquote);
#undef CHICKENKW
#endif //CHICKEN_CHICKENKW_SWG_

375
Lib/chicken/chickenrun.swg
View File

@ -1,375 +0,0 @@
/* -----------------------------------------------------------------------------
* chickenrun.swg
* ----------------------------------------------------------------------------- */
#include <chicken.h>
#include <assert.h>
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#if (defined(_MSC_VER) && (_MSC_VER < 1900)) || defined(__BORLANDC__) || defined(_WATCOM)
# ifndef snprintf
# define snprintf _snprintf
# endif
#endif
#ifdef __cplusplus
extern "C" {
#endif
#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 SWIG_ThrowException(val) SWIG_Chicken_ThrowException(val)
#define SWIG_contract_assert(expr, message) if (!(expr)) { \
SWIG_Chicken_Barf(SWIG_BARF1_CONTRACT_ASSERT, C_text(message)); } else
/* Runtime API */
#define SWIG_GetModule(clientdata) SWIG_Chicken_GetModule(clientdata)
#define SWIG_SetModule(clientdata, pointer) SWIG_Chicken_SetModule(pointer)
#define C_swig_is_bool(x) C_truep (C_booleanp (x))
#define C_swig_is_char(x) C_truep (C_charp (x))
#define C_swig_is_fixnum(x) C_truep (C_fixnump (x))
#define C_swig_is_flonum(x) (C_truep (C_blockp (x)) && C_truep (C_flonump (x)))
#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_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 C_swig_is_closurep(x) (C_truep (C_blockp(x)) && C_truep(C_closurep(x)))
#define C_swig_is_number(x) (C_swig_is_fixnum(x) || C_swig_is_flonum(x))
#define C_swig_is_long(x) C_swig_is_number(x)
#define C_swig_sizeof_closure(num) (num+1)
#define SWIG_Chicken_SetupArgout { \
C_word *a = C_alloc(C_swig_sizeof_closure(2)); \
C_word *closure = a; \
*(a++)=C_CLOSURE_TYPE|2; \
*(a++)=(C_word)SWIG_Chicken_ApplyResults; \
*(a++)=continuation; \
continuation=(C_word)closure; \
}
#define SWIG_APPEND_VALUE(obj) { \
C_word val = (C_word)(obj); \
if (val != C_SCHEME_UNDEFINED) { \
C_word *a = C_alloc(C_swig_sizeof_closure(3)); \
C_word *closure = a; \
*(a++)=C_CLOSURE_TYPE|3; \
*(a++)=(C_word)SWIG_Chicken_MultiResultBuild; \
*(a++)=(C_word)continuation; \
*(a++)=val; \
continuation=(C_word)closure; \
} }
#define SWIG_Chicken_FindCreateProxy(func,obj) \
if (C_swig_is_swigpointer(obj)) { \
swig_type_info *t = (swig_type_info *) C_block_item(obj, 1); \
if (t && t->clientdata && ((swig_chicken_clientdata *)t->clientdata)->gc_proxy_create) { \
func = CHICKEN_gc_root_ref( ((swig_chicken_clientdata *)t->clientdata)->gc_proxy_create); \
} else { \
func = C_SCHEME_FALSE; \
} \
} else { \
func = C_SCHEME_FALSE; \
}
enum {
SWIG_BARF1_BAD_ARGUMENT_TYPE /* 1 arg */,
SWIG_BARF1_ARGUMENT_NULL /* 1 arg */,
SWIG_BARF1_CONTRACT_ASSERT /* 1 arg */,
};
typedef C_word (*swig_chicken_destructor)(C_word,C_word,C_word,C_word);
typedef struct swig_chicken_clientdata {
void *gc_proxy_create;
swig_chicken_destructor destroy;
} swig_chicken_clientdata;
static char *
SWIG_Chicken_MakeString(C_word str) {
char *ret;
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;
}
static C_word SWIG_Chicken_LookupSymbol(char *name, C_SYMBOL_TABLE *stable) {
C_word *a = C_alloc(C_SIZEOF_STRING (strlen (name)));
C_word n = C_string2(&a, name);
C_word sym = C_find_symbol(n, stable);
if (C_truep(sym)) {
return C_symbol_value(sym);
} else {
return C_SCHEME_FALSE;
}
}
/* 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);
C_halt (scmmsg);
exit (5); /* should never get here */
}
static void
SWIG_Chicken_Barf(int code, C_char *msg, ...) C_noret;
static 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)));
C_word err = C_intern2 (&a, errorhook);
int c = -1;
int i, barfval;
va_list v;
C_temporary_stack = C_temporary_stack_bottom;
err = C_block_item(err, 0);
if(C_immediatep (err))
SWIG_Chicken_Panic (C_text ("`##sys#error-hook' is not defined"));
switch (code) {
case SWIG_BARF1_BAD_ARGUMENT_TYPE:
barfval = C_BAD_ARGUMENT_TYPE_ERROR;
c = 1;
break;
case SWIG_BARF1_ARGUMENT_NULL:
barfval = C_BAD_ARGUMENT_TYPE_ERROR;
c = 1;
break;
case SWIG_BARF1_CONTRACT_ASSERT:
barfval = C_BAD_ARGUMENT_TYPE_ERROR;
c = 1;
break;
default:
SWIG_Chicken_Panic (C_text (msg));
};
if(c > 0 && !C_immediatep (err)) {
C_save (C_fix (barfval));
i = c;
if (i) {
C_word *b = C_alloc (C_SIZEOF_STRING (strlen (msg)));
C_word scmmsg = C_string2 (&b, msg);
C_save (scmmsg);
i--;
}
va_start (v, msg);
while(i--)
C_save (va_arg (v, C_word));
va_end (v);
C_do_apply (c + 1, err,
C_SCHEME_UNDEFINED); /* <- no continuation is passed:
'##sys#error-hook' may not
return! */
}
else if (msg) {
SWIG_Chicken_Panic (msg);
}
else {
SWIG_Chicken_Panic (C_text ("unspecified panic"));
}
}
static void SWIG_Chicken_ThrowException(C_word value) C_noret;
static void SWIG_Chicken_ThrowException(C_word value)
{
char *aborthook = C_text("\003sysabort");
C_word *a = C_alloc(C_SIZEOF_STRING(strlen(aborthook)));
C_word abort = C_intern2(&a, aborthook);
abort = C_block_item(abort, 0);
if (C_immediatep(abort))
SWIG_Chicken_Panic(C_text("`##sys#abort' is not defined"));
C_save(value);
C_do_apply(1, abort, C_SCHEME_UNDEFINED);
}
static void
SWIG_Chicken_Finalizer(C_word argc, C_word closure, C_word continuation, C_word s)
{
swig_type_info *type;
swig_chicken_clientdata *cdata;
if (argc == 3 && s != C_SCHEME_FALSE && C_swig_is_swigpointer(s)) {
type = (swig_type_info *) C_block_item(s, 1);
if (type) {
cdata = (swig_chicken_clientdata *) type->clientdata;
if (cdata && cdata->destroy) {
/* this will not return, but will continue correctly */
cdata->destroy(3,closure,continuation,s);
}
}
}
C_kontinue(continuation, C_SCHEME_UNDEFINED);
}
static C_word finalizer_obj[2] = {(C_word) (C_CLOSURE_TYPE|1), (C_word) SWIG_Chicken_Finalizer};
static C_word
SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, C_word **data)
{
swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) type->clientdata;
if (ptr == NULL)
return C_SCHEME_FALSE;
else {
C_word cptr = C_swigmpointer(data, ptr, type);
/* add finalizer to object */
#ifndef SWIG_CHICKEN_NO_COLLECTION
if (owner)
C_do_register_finalizer(cptr, (C_word) finalizer_obj);
#endif
return cptr;
}
}
/* Return 0 if successful. */
static int
SWIG_Chicken_ConvertPtr(C_word s, void **result, swig_type_info *type, int flags)
{
swig_cast_info *cast;
swig_type_info *from;
if (s == C_SCHEME_FALSE) {
*result = NULL;
return (flags & SWIG_POINTER_NO_NULL) ? SWIG_NullReferenceError : SWIG_OK;
} else if (C_swig_is_swigpointer(s)) {
/* try and convert type */
from = (swig_type_info *) C_block_item(s, 1);
if (!from) return 1;
if (type) {
cast = SWIG_TypeCheckStruct(from, type);
if (cast) {
int newmemory = 0;
*result = SWIG_TypeCast(cast, (void *) C_block_item(s, 0), &newmemory);
assert(!newmemory); /* newmemory handling not yet implemented */
} else {
return 1;
}
} else {
*result = (void *) C_block_item(s, 0);
}
/* check if we are disowning this object */
if (flags & SWIG_POINTER_DISOWN) {
C_do_unregister_finalizer(s);
}
} else {
return 1;
}
return 0;
}
static SWIGINLINE void *
SWIG_Chicken_MustGetPtr (C_word s, swig_type_info *type, int argnum, int flags)
{
void *result;
char err_msg[256];
if (SWIG_Chicken_ConvertPtr(s, &result, type, flags)) {
/* type mismatch */
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", argnum, (type->str ? type->str : type->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
return result;
}
static char *chicken_runtimevar_name = "type_pointer" SWIG_TYPE_TABLE_NAME;
static swig_module_info *
SWIG_Chicken_GetModule(void *SWIGUNUSEDPARM(clientdata)) {
swig_module_info *ret = 0;
C_word sym;
/* lookup the type pointer... it is stored in its own symbol table */
C_SYMBOL_TABLE *stable = C_find_symbol_table("swig_runtime_data" SWIG_RUNTIME_VERSION);
if (stable != NULL) {
sym = SWIG_Chicken_LookupSymbol(chicken_runtimevar_name, stable);
if (C_truep(sym) && C_swig_is_ptr(sym)) {
ret = (swig_module_info *) C_block_item(sym, 0);
}
}
return ret;
}
static void
SWIG_Chicken_SetModule(swig_module_info *module) {
C_word *a;
C_SYMBOL_TABLE *stable;
C_word sym;
C_word pointer;
static C_word *space = 0;
/* type pointer is stored in its own symbol table */
stable = C_find_symbol_table("swig_runtime_data" SWIG_RUNTIME_VERSION);
if (stable == NULL) {
stable = C_new_symbol_table("swig_runtime_data" SWIG_RUNTIME_VERSION, 16);
}
if (!space) {
space = (C_word *) C_malloc((C_SIZEOF_POINTER + C_SIZEOF_INTERNED_SYMBOL(C_strlen(chicken_runtimevar_name))) * sizeof(C_word));
}
a = space;
pointer = C_mpointer(&a, (void *) module);
sym = C_intern_in(&a, C_strlen(chicken_runtimevar_name), chicken_runtimevar_name, stable);
C_set_block_item(sym, 0, pointer);
}
static C_word SWIG_Chicken_MultiResultBuild(C_word num, C_word closure, C_word lst) {
C_word cont = C_block_item(closure,1);
C_word obj = C_block_item(closure,2);
C_word func;
SWIG_Chicken_FindCreateProxy(func,obj);
if (C_swig_is_closurep(func)) {
((C_proc4)(void *)C_block_item(func, 0))(4,func,cont,obj,lst);
} else {
C_word *a = C_alloc(C_SIZEOF_PAIR);
C_kontinue(cont,C_pair(&a,obj,lst));
}
return C_SCHEME_UNDEFINED; /* never reached */
}
static C_word SWIG_Chicken_ApplyResults(C_word num, C_word closure, C_word result) {
C_apply_values(3,C_SCHEME_UNDEFINED,C_block_item(closure,1),result);
return C_SCHEME_UNDEFINED; /* never reached */
}
#ifdef __cplusplus
}
#endif

Some files were not shown because too many files have changed in this diff Show More