Merge remote-tracking branch 'upstream/master' into memleak
# Conflicts:
# CHANGES.current
diff --git a/CHANGES.current b/CHANGES.current
index 19b2e90..d82cde7 100644
--- a/CHANGES.current
+++ b/CHANGES.current
@@ -7,8 +7,8 @@
Version 4.1.0 (in progress)
===========================
-2021-05-12: adr26
- #1985 [Python] Fix memory leaks:
+2021-05-17: adr26
+ [Python] #1985 Fix memory leaks:
1. Python object references were being incorrectly retained by
SwigPyClientData, causing swig_varlink_dealloc() never to run / free
@@ -33,6 +33,41 @@
SWIG_Python_SetModule() (failure could be caused by OOM or a name
clash caused by malicious code)
+2021-05-13: olly
+ [UFFI] #2009 Remove code for Common Lisp UFFI. 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
+ [S-EXP] #2009 Remove code for Common Lisp S-Exp. 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
+ [Pike] #2009 Remove code for Pike. 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
+ [Modula3] #2009 Remove code for Modula3. 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
+ [CLISP] #2009 Remove code for GNU Common Lisp. 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
+ [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
+ [Allegrocl] #2009 Remove code for Allegro Common Lisp. We dropped
+ support for it in SWIG 4.0.0 and nobody has stepped forward to
+ revive it in over 2 years.
+
2021-05-04: olly
[PHP] #1982 #1457 https://sourceforge.net/p/swig/bugs/1339/
SWIG now only use PHP's C API to implement its wrappers, and no
diff --git a/Doc/Manual/Allegrocl.html b/Doc/Manual/Allegrocl.html
deleted file mode 100644
index 4069ecd..0000000
--- a/Doc/Manual/Allegrocl.html
+++ /dev/null
@@ -1,2150 +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 Allegro Common Lisp</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="Allegrocl">20 SWIG and Allegro Common Lisp</a></H1>
-<!-- INDEX -->
-<div class="sectiontoc">
-<ul>
-<li><a href="#Allegrocl_nn2">Basics</a>
-<ul>
-<li><a href="#Allegrocl_nn3">Running SWIG</a>
-<li><a href="#Allegrocl_nn4">Command Line Options</a>
-<li><a href="#Allegrocl_nn5">Inserting user code into generated files</a>
-</ul>
-<li><a href="#Allegrocl_nn6">Wrapping Overview</a>
-<ul>
-<li><a href="#Allegrocl_nn7">Function Wrapping</a>
-<li><a href="#Allegrocl_nn8">Foreign Wrappers</a>
-<li><a href="#Allegrocl_nn9">FFI Wrappers</a>
-<li><a href="#Allegrocl_nn10">Non-overloaded Defuns</a>
-<li><a href="#Allegrocl_nn11">Overloaded Defuns</a>
-<li><a href="#Allegrocl_nn12">What about constant and variable access?</a>
-<li><a href="#Allegrocl_nn13">Object Wrapping</a>
-</ul>
-<li><a href="#Allegrocl_nn14">Wrapping Details</a>
-<ul>
-<li><a href="#Allegrocl_nn15">Namespaces</a>
-<li><a href="#Allegrocl_nn16">Constants</a>
-<li><a href="#Allegrocl_nn17">Variables</a>
-<li><a href="#Allegrocl_nn18">Enumerations</a>
-<li><a href="#Allegrocl_nn19">Arrays</a>
-<li><a href="#Allegrocl_nn20">Classes and Structs and Unions (oh my!)</a>
-<ul>
-<li><a href="#Allegrocl_nn21">CLOS wrapping of</a>
-<li><a href="#Allegrocl_nn22">CLOS Inheritance</a>
-<li><a href="#Allegrocl_nn23">Member fields and functions</a>
-<li><a href="#Allegrocl_nn24">Why not directly access C++ classes using foreign types?</a>
-</ul>
-<li><a href="#Allegrocl_nn25">Templates</a>
-<ul>
-<li><a href="#Allegrocl_nn26">Generating wrapper code for templates</a>
-<li><a href="#Allegrocl_nn27">Implicit Template instantiation</a>
-</ul>
-<li><a href="#Allegrocl_nn28">Typedef, Templates, and Synonym Types</a>
-<ul>
-<li><a href="#Allegrocl_nn29">Choosing a primary type</a>
-</ul>
-<li><a href="#Allegrocl_nn30">Function overloading/Parameter defaulting</a>
-<li><a href="#Allegrocl_nn31">Operator wrapping and Operator overloading</a>
-<li><a href="#Allegrocl_nn32">Varargs</a>
-<li><a href="#Allegrocl_nn33">C++ Exceptions</a>
-<li><a href="#Allegrocl_nn34">Pass by value, pass by reference</a>
-</ul>
-<li><a href="#Allegrocl_nn35">Typemaps</a>
-<ul>
-<li><a href="#Allegrocl_nn36">Code Generation in the C++ Wrapper</a>
-<ul>
-<li><a href="#Allegrocl_nn37">IN Typemap</a>
-<li><a href="#Allegrocl_nn38">OUT Typemap</a>
-<li><a href="#Allegrocl_nn39">CTYPE Typemap</a>
-</ul>
-<li><a href="#Allegrocl_nn40">Code generation in Lisp wrappers</a>
-<ul>
-<li><a href="#Allegrocl_nn41">LIN Typemap</a>
-<li><a href="#Allegrocl_nn42">LOUT Typemap</a>
-<li><a href="#Allegrocl_nn43">FFITYPE Typemap</a>
-<li><a href="#Allegrocl_nn44">LISPTYPE Typemap</a>
-<li><a href="#Allegrocl_nn45">LISPCLASS Typemap</a>
-</ul>
-<li><a href="#Allegrocl_nn46">Modifying SWIG behavior using typemaps</a>
-</ul>
-<li><a href="#Allegrocl_nn47">Identifier Converter functions</a>
-<ul>
-<li><a href="#Allegrocl_nn48">Creating symbols in the lisp environment</a>
-<li><a href="#Allegrocl_nn49">Existing identifier-converter functions</a>
-<ul>
-<li><a href="#Allegrocl_nn50">identifier-convert-null</a>
-<li><a href="#Allegrocl_nn51">identifier-convert-lispify</a>
-<li><a href="#Allegrocl_nn52">Default identifier to symbol conversions</a>
-</ul>
-<li><a href="#Allegrocl_nn53">Defining your own identifier-converter</a>
-<li><a href="#Allegrocl_nn54">Instructing SWIG to use a particular identifier-converter</a>
-</ul>
-</ul>
-</div>
-<!-- INDEX -->
-
-
-
-<p>
-This chapter describes SWIG's support of Allegro Common Lisp. Allegro
-CL is a full-featured implementation of the Common Lisp language
-standard that includes many vendor-specific enhancements and add-on
-modules for increased usability.
-</p>
-
-<p>
-One such module included in Allegro CL is the Foreign Functions
-Interface (FFI). This module, tailored primarily toward interfacing
-with C/C++ and, historically, Fortran, provides a means by which
-compiled foreign code can be loaded into a running lisp
-environment and executed. The interface supports the calling of
-foreign functions and methods, allows for executing lisp routines
-from foreign code (callbacks), and the passing of data between foreign
-and lisp code.
-</p>
-
-<p>
-The goal of this module is to make it possible to quickly generate the
-necessary foreign function definitions so one can make use of C/C++
-foreign libraries directly from lisp without the tedium of having to
-code them by hand. When necessary, it will also generate further C/C++
-code that will need to be linked with the intended library for proper
-interfacing from lisp. It has been designed with an eye toward
-flexibility. Some foreign function calls may release the heap, while
-other should not. Some foreign functions should automatically convert
-lisp strings into native strings, while others should not. These
-adjustments and many more are possible with the current module.
-</p>
-
-<p>
-It is significant to note that, while this is a vendor-specific
-module, we would like to acknowledge the current and ongoing
-work by developers in the open source lisp community that are
-working on similar interfaces to implementation-independent
-foreign function interfaces (CFFI, for example). Such
-work can only benefit the lisp community, and we would not
-be unhappy to see some enterprising folk use this work to add
-to it.
-</p>
-
-<H2><a name="Allegrocl_nn2">20.1 Basics</a></H2>
-
-
-<H3><a name="Allegrocl_nn3">20.1.1 Running SWIG</a></H3>
-
-
-<p>
-If you're reading this, you must have some library you need to
-generate an interface for. In order for SWIG to do this work, however,
-it needs a bit of information about how it should go about creating
-your interface, and what you are interfacing to.
-</p>
-
-<p>
-SWIG expects a description of what in the foreign interface you wish
-to connect to. It must consisting of C/C++ declarations and special
-SWIG directives. SWIG can be furnished with a header file, but an
-interface can also be generated without library headers by supplying a
-simple text file--called the interface file, which is typically named
-with a <tt>.i</tt> extension--containing any foreign declarations of
-identifiers you wish to use. The most common approach is to use an
-interface file with directives to parse the needed headers. A straight
-parse of library headers will result in usable code, but SWIG
-directives provides much freedom in how a user might tailor the
-generated code to their needs or style of coding.
-</p>
-
-<p>
-Note that SWIG does not require any function definitions; the
-declarations of those functions is all that is necessary. Be careful
-when tuning the interface as it is quite possible to generate code
-that will not load or compile.
-</p>
-
-<p>
-An example interface file is shown below. It makes use of two SWIG
-directives, one of which requests that the declarations in a header
-file be used to generate part of the interface, and also includes an
-additional declaration to be added.</p>
-
-<div class="code">example.i
-<pre>
-%module example
-
-%include "header.h"
-
-int fact(int n);
-</pre>
-</div>
-
-<p>The contents of header.h are very simple:</p>
-<div class="code">header.h
-<pre>
-int fact(char *statement); // pass it a fact, and it will rate it.
-</pre>
-</div>
-
-<p>The contents of example.cl will look like this:</p>
-
-<div class="targetlang">example.cl
-<pre>
-(defpackage :example
- (:use :common-lisp :swig :ff :excl))
-
- ... helper routines for defining the interface ...
-
-(swig-in-package ())
-
-(swig-defun ("fact")
- ((PARM0_statement cl:string (* :char) ))
- (:returning (:int )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_statement))
- (swig-ff-call SWIG_arg0)))
-
-(swig-defun ("fact")
- ((PARM0_n cl:integer :int ))
- (:returning (:int )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_n))
- (swig-ff-call SWIG_arg0)))
-
-(swig-dispatcher ("fact" :type :function :arities (1)))
-</pre>
-</div>
-
-<p>
-The generated file contains calls to internal swig helper
-functions. In this case there are two calls to swig-defun.
-These calls will expand into code that will make the appropriate
-definitions using the Allegro FFI. Note also, that this code is
-<b>erroneous</b>. Function overloading is not supported in C, and this
-code will not compile even though SWIG did not complain.
-</p>
-
-<p>
-In order to generate a C interface to Allegro CL using this code run
-swig using the <tt>-allegrocl</tt> option, as below:
-</p>
-
-<div class="shell">
-<pre>
-% swig -allegrocl example.i
-</pre>
-</div>
-
-<p>
-When building an interface to C++ code, include the <tt>-c++</tt> option:
-</p>
-
-<div class="shell">
-<pre>
-% swig -allegrocl -c++ example.i
-</pre>
-</div>
-
-<p>
-As a result of running one of the above commands, a file named <tt>example.cl</tt>
-will be generated containing the lisp side of the interface. As well, a file
-<tt>example_wrap.cxx</tt> is also generated, containing C/C++ wrapper code to
-facilitate access to C++ methods, enumeration values, and constant values.
-Wrapper functions are necessary in C++ due to the lack of a standard for mangling
-the names of symbols across all C++ compilers. These wrapper functions are
-exported from the shared library as appropriate, using the C name mangling
-convention. The lisp code that is generated will interface to your foreign
-library through these wrappers.
-</p>
-
-<p>
-It is possible to disable the creation of the .cxx file when generating a C
-interface by using the -nocwrap command-line argument. For interfaces that
-don't contain complex enum or constant expressions, contain nested struct/union
-declarations, or doesn't need to use many of the SWIG customization featuers,
-this will result in a more streamlined, direct interface to the
-intended module.
-</p>
-
-<p>
-The generated wrapper file is below. It contains very simple
-wrappers by default, that simply pass the arguments to the
-actual function.
-</p>
-
-<div class="code">example_wrap.i
-<pre>
- ... lots of SWIG internals ...
-
-EXPORT int ACL___fact__SWIG_0 (char *larg1) {
- int lresult = (int)0 ;
- char *arg1 = (char *) 0 ;
- int result;
-
- arg1 = larg1;
- try {
- result = (int)fact(arg1);
-
- lresult = result;
- return lresult;
- } catch (...) {
- return (int)0;
- }
-}
-
-
-EXPORT int ACL___fact__SWIG_1 (int larg1) {
- int lresult = (int)0 ;
- int arg1 ;
- int result;
-
- arg1 = larg1;
- try {
- result = (int)fact(arg1);
-
- lresult = result;
- return lresult;
- } catch (...) {
- return (int)0;
- }
-}
-</pre>
-</div>
-
-<p>
-And again, the generated lisp code. Note that it differs from
-what is generated when parsing C code:
-</p>
-
-<div class="targetlang">
-<pre>
- ...
-
-(swig-in-package ())
-
-(swig-defmethod ("fact" "ACL___fact__SWIG_0" :type :function :arity 1)
- ((PARM0_statement cl:string (* :char) ))
- (:returning (:int )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_statement))
- (swig-ff-call SWIG_arg0)))
-
-(swig-defmethod ("fact" "ACL___fact__SWIG_1" :type :function :arity 1)
- ((PARM0_n cl:integer :int ))
- (:returning (:int )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_n))
- (swig-ff-call SWIG_arg0)))
-
-(swig-dispatcher ("fact" :type :function :arities (1)))
-</pre>
-</div>
-
-<p>In this case, the interface generates two swig-defmethod forms and
-a swig-dispatcher form. This provides a single functional interface for
-all overloaded routines. A more detailed description of this features
-is to be found in the section titled <b>Function overloading/Parameter defaulting</b>.
-
-<p>
-In order to load a C++ interface, you will need to build a shared library
-from example_wrap.cxx. Be sure to link in the actual library you created
-the interface for, as well as any other dependent shared libraries. For
-example, if you intend to be able to call back into lisp, you will also
-need to link in the Allegro shared library. The library you create from
-the C++ wrapper will be what you then load into Allegro CL.
-</p>
-
-<H3><a name="Allegrocl_nn4">20.1.2 Command Line Options</a></H3>
-
-
-<p>
-There are three Allegro CL specific command-line option:
-</p>
-
-<div class="shell">
-<pre>
-swig -allegrocl [ options ] filename
-
- -identifier-converter [name] - Binds the variable swig:*swig-identifier-convert*
- in the generated .cl file to <tt>name</tt>.
- This function is used to generate symbols
- for the lisp side of the interface.
-
- -cwrap - [default] Generate a .cxx file containing C wrapper function when
- wrapping C code. The interface generated is similar to what is
- done for C++ code.
- -nocwrap - Explicitly turn off generation of .cxx wrappers for C code. Reasonable
- for modules with simple interfaces. Can not handle all legal enum
- and constant constructs, or take advantage of SWIG customization features.
-
- -isolate - With this command-line argument, all lisp helper functions are defined
- in a unique package named <tt>swig.<module-name></tt> rather than
- <tt>swig</tt>. This prevents conflicts when the module is
- intended to be used with other swig generated interfaces that may,
- for instance, make use of different identifier converters.
-</pre>
-</div>
-
-<p>
-See <a href="#Allegrocl_nn47">Section 17.5 Identifier converter
-functions</a> for more details.
-</p>
-
-<H3><a name="Allegrocl_nn5">20.1.3 Inserting user code into generated files</a></H3>
-
-
-<p>
-It is often necessary to include user-defined code into the
-automatically generated interface files. For example, when building
-a C++ interface, example_wrap.cxx will likely not compile unless
-you add a <tt>#include "header.h"</tt> directive. This can be done
-using the SWIG <tt>%insert(section) %{ ...code... %}</tt> directive:
-</p>
-
-<div class="code">
-<pre>
-%module example
-
-%{
-#include "header.h"
-%}
-
-%include "header.h"
-
-int fact(int n);
-</pre>
-</div>
-
-<p>
-Additional sections have been added for inserting into the
-generated lisp interface file
-</p>
-<ul>
- <li><tt>lisphead</tt> - inserts before type declarations</li>
- <li><tt>lisp</tt> - inserts after type declarations according to
- where it appears in the .i file</li>
-</ul>
-<p>
-Note that the block <tt>%{ ... %}</tt> is effectively a shortcut for
-<tt>%insert("header") %{ ... %}</tt>.
-</p>
-
-
-<H2><a name="Allegrocl_nn6">20.2 Wrapping Overview</a></H2>
-
-
-<p>
-New users to SWIG are encouraged to read
-<a href="SWIG.html#SWIG">SWIG Basics</a>, and
-<a href="SWIGPlus.html#SWIGPlus">SWIG and C++</a>, for those
-interested in generating an interface to C++.
-</p>
-
-<H3><a name="Allegrocl_nn7">20.2.1 Function Wrapping</a></H3>
-
-
- <p>
- Writing lisp code that directly invokes functions at the foreign
- function interface level can be cumbersome. Data must often be
- translated between lisp and foreign types, data extracted from
- objects, foreign objects allocated and freed upon completion of
- the foreign call. Dealing with pointers can be unwieldy when it
- comes to keeping them distinct from other valid integer values.
- </p>
-
- <p>
- We make an attempt to ease some of these burdens by making the
- interface to foreign code much more lisp-like, rather than C
- like. How this is done is described in later chapters. The
- layers themselves, appear as follows:
- </p>
-
- <div class="diagram">
- <pre>
- ______________
- | | (foreign side)
- | Foreign Code | What we're generating an interface to.
- |______________|
- |
- |
- _______v______
- | | (foreign side)
- | Wrapper code | extern "C" wrappers calling C++
- |______________| functions and methods.
- |
- . . . - - + - - . . .
- _______v______
- | | (lisp side)
- | FFI Layer | Low level lisp interface. ff:def-foreign-call,
- |______________| ff:def-foreign-variable
- |
- +----------------------------
- _______v______ _______v______
- | | | | (lisp side)
- | Defuns | | Defmethods | wrapper for overloaded
- |______________| |______________| functions or those with
- (lisp side) | defaulted arguments
- Wrapper for non-overloaded |
- functions and methods _______v______
- | | (lisp side)
- | Defuns | dispatch function
- |______________| to overloads based
- on arity
- </pre>
- </div>
-
-<H3><a name="Allegrocl_nn8">20.2.2 Foreign Wrappers</a></H3>
-
-
- <p>
- These wrappers are as generated by SWIG default. The types of
- function parameters can be transformed in place using the CTYPE
- typemap. This is use for converting pass-by-value parameters to
- pass-by-reference where necessary. All wrapper parameters are then
- bound to local variables for possible transformation of values
- (see LIN typemap). Return values can be transformed via the OUT
- typemap.
- </p>
-
-<H3><a name="Allegrocl_nn9">20.2.3 FFI Wrappers</a></H3>
-
-
- <p>
- These are the generated ff:def-foreign-call forms. No typemaps are
- applicable to this layer, but the <tt>%ffargs</tt> directive is
- available for use in .i files, to specify which keyword arguments
- should be specified for a given function.
- </p>
-
- <div class="code">ffargs.i:
- <pre>
-%module ffargs
-
-%ffargs(strings_convert="nil", call_direct="t") foo;
-%ffargs(strings_convert="nil", release_heap=":never", optimize_for_space="t") bar;
-
-int foo(float f1, float f2);
-int foo(float f1, char c2);
-
-void bar(void *lisp_fn);
-
-char *xxx();
- </pre>
- </div>
-
- <p>Generates:
- </p>
- <div class="targetlang">ffargs.cl:
- <pre>
-(swig-in-package ())
-
-(swig-defmethod ("foo" "ACL___foo__SWIG_0" :type :function :arity 2)
- ((PARM0_f1 cl:single-float :float )
- (PARM1_f2 cl:single-float :float ))
- (:returning (:int )
- :call-direct t
- :strings-convert nil)
- (let ((SWIG_arg0 PARM0_f1))
- (let ((SWIG_arg1 PARM1_f2))
- (swig-ff-call SWIG_arg0 SWIG_arg1))))
-
-(swig-defmethod ("foo" "ACL___foo__SWIG_1" :type :function :arity 2)
- ((PARM0_f1 cl:single-float :float )
- (PARM1_c2 cl:character :char character))
- (:returning (:int )
- :call-direct t
- :strings-convert nil)
- (let ((SWIG_arg0 PARM0_f1))
- (let ((SWIG_arg1 PARM1_c2))
- (swig-ff-call SWIG_arg0 SWIG_arg1))))
-
-(swig-dispatcher ("foo" :type :function :arities (2)))
-(swig-defun ("bar" "ACL___bar__SWIG_0" :type :function)
- ((PARM0_lisp_fn (* :void) ))
- (:returning (:void )
- :release-heap :never
- :optimize-for-space t
- :strings-convert nil)
- (let ((SWIG_arg0 PARM0_lisp_fn))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("xxx" "ACL___xxx__SWIG_0" :type :function)
- (:void)
- (:returning ((* :char) )
- :strings-convert t)
- (swig-ff-call))
- </pre>
- </div>
-
- <div class="code">
- <pre>%ffargs(strings_convert="t");</pre>
- </div>
-
- <p>
- Is the only default value specified in <tt>allegrocl.swg</tt> to force
- the muffling of warnings about automatic string conversion when defining
- ff:def-foreign-call's.
- </p>
-
-<H3><a name="Allegrocl_nn10">20.2.4 Non-overloaded Defuns</a></H3>
-
-
- <p>
- These are simple defuns. There is no typechecking of arguments.
- Parameters are bound to local variables for possible
- transformation of values, such as pulling values out of instance
- slots or allocating temporary stack allocated structures, via the
- <tt>lin</tt> typemap. These arguments are then passed to the
- foreign-call (where typechecking may occur). The return value from
- this function can be manipulated via the <tt>lout</tt> typemap.
- </p>
-
-<H3><a name="Allegrocl_nn11">20.2.5 Overloaded Defuns</a></H3>
-
-
- <p>
- In the case of overloaded functions, multiple layers are
- generated. First, all the overloads for a given name are separated
- out into groups based on arity, and are wrapped in
- defmethods. Each method calls a distinct wrapper function, but are
- themselves distinguished by the types of their arguments
- (see <tt>lispclass</tt> typemap). These are further wrapped in a
- dispatching function (defun) which will invoke the appropriate
- generic-function based on arity. This provides a single functional
- interface to all overloads. The return value from this function
- can be manipulated via the <tt>lout</tt> typemap.
- </p>
-
-<H3><a name="Allegrocl_nn12">20.2.6 What about constant and variable access?</a></H3>
-
-
- <p>
- Along with the described functional layering, when creating a .cxx wrapper,
- this module will generate getter and--if not immutable--setter,
- functions for variables and constants. If the -nocwrap option is used,
- <tt>defconstant</tt> and <tt>ff:def-foreign-variable</tt> forms will be
- generated for accessing constants and global variables. These, along with
- the <tt>defuns</tt> listed above are the intended API for calling
- into the foreign module.
- </p>
-
-<H3><a name="Allegrocl_nn13">20.2.7 Object Wrapping</a></H3>
-
-
- <p>
- All non-primitive types (Classes, structs, unions, and typedefs
- involving same) have a corresponding foreign-type defined on the
- lisp side via ff:def-foreign-type.
- </p>
-
- <p>
- All non-primitive types are further represented by a CLOS class,
- created via defclass. An attempt is made to create the same class
- hierarchy, with all classes inheriting directly or indirectly from
- ff:foreign-pointer. Further, wherever it is apparent, all pointers
- returned from foreign code are wrapped in a CLOS instance of the
- appropriate class. For ff:def-foreign-calls that have been defined
- to expect a :foreign-address type as argument, these CLOS instances
- can legally be passed and the pointer to the C++ object
- automatically extracted. This is a natural feature of Allegro's
- foreign function interface.
- </p>
-
-<H2><a name="Allegrocl_nn14">20.3 Wrapping Details</a></H2>
-
-
- <p>
- In this section is described how particular C/C++ constructs are
- translated into lisp.
- </p>
-
-<H3><a name="Allegrocl_nn15">20.3.1 Namespaces</a></H3>
-
-
- <p>
- C++ namespaces are translated into Lisp packages by SWIG. The
- Global namespace is mapped to a package named by the <tt>%module</tt>
- directive or the <tt>-module</tt> command-line argument. Further
- namespaces are generated by the <tt>swig-defpackage</tt> utility
- function and given names based on Allegro CLs nested namespace
- convention. For example:
- </p>
-
- <div class="code">foo.i:
- <pre>
-%module foo
-
-%{
-#include "foo.h"
-%}
-
-%include "foo.h"
-
-namespace car {
- ...
- namespace tires {
- int do_something(int n);
- }
-}
- </pre>
- </div>
- <p>Generates the following code.
- </p>
- <div class="targetlang">foo.cl
- <pre>
-(defpackage :foo
- (:use :common-lisp :swig :ff :excl))
-
-...
-
-(swig-defpackage ("car"))
-(swig-defpackage ("car" "tires"))
-
-...
-
-(swig-in-package ("car" "tires"))
-(swig-defun ("do_something" "ACL_car_tires__do_something__SWIG_0" :type :function)
- ((PARM0_n :int ))
- (:returning (:int )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_n))
- (swig-ff-call SWIG_arg0)))
- </pre>
- </div>
-
- <p>
- The above interface file would cause packages foo, foo.car, and
- foo.car.tires to be created. One would find the function wrapper
- for do_something defined in the foo.car.tires package(*).
- </p>
-
- <p>(<b>*</b>) Except for the package named by the module, all
- namespace names are passed to the identifier-converter-function
- as strings with a <tt>:type</tt> of <tt>:namespace</tt>. It is the
- job of this function to generate the desired symbol, accounting for
- case preferences, additional naming cues, etc.
- </p>
-
- <p>
- Note that packages created by <tt>swig-defpackage</tt> do not
- use the COMMON-LISP or EXCL package. This reduces possible
- conflicts when defining foreign types via the SWIG interface
- in <b>all but the toplevel modules package</b>. This may
- lead to confusion if, for example, the current package is
- <tt>foo.car.tires</tt> and you attempt to use a common-lisp
- function such as <tt>(car '(1 2 3)</tt>.
- </p>
-
-<H3><a name="Allegrocl_nn16">20.3.2 Constants</a></H3>
-
-
-
- <p>
- Constants, as declared by the preprocessor #define macro or SWIG
- <tt>%constant</tt> directive, are included in SWIG's parse tree
- when it can be determined that they are, or could be reduced to,
- a literal value. Such values are translated into defconstant
- forms in the generated lisp wrapper when the -nocwrap command-line
- options is used. Else, wrapper functions are generated as in the
- case of variable access (see section below).
- </p>
- <p>
- Here are examples of simple preprocessor constants when using -nocwrap.
- </p>
- <div class="code">
- <pre>
-#define A 1 => (swig-defconstant "A" 1)
-#define B 'c' => (swig-defconstant "B" #\c)
-#define C B => (swig-defconstant "C" #\c)
-#define D 1.0e2 => (swig-defconstant "D" 1.0d2)
-#define E 2222 => (swig-defconstant "E" 2222)
-#define F (unsigned int)2222 => no code generated
-#define G 1.02e2f => (swig-defconstant "G" 1.02f2)
-#define H foo => no code generated
- </pre>
- </div>
-
- <p>
- Note that where SWIG is unable to determine if a constant is
- a literal, no node is added to the SWIG parse tree, and so
- no values can be generated.
- </p>
-
- <p>
- For preprocessor constants containing expressions which can be
- reduced to literal values, nodes are created, but with no simplification
- of the constant value. A very very simple infix to prefix converter
- has been implemented that tries to do the right thing for simple cases, but
- does not for more complex expressions. If the literal parser determines
- that something is wrong, a warning will be generated and the literal
- expression will be included in the generated code, but commented out.
- </p>
-
- <div class="code">
- <pre>
-#define I A + E => (swig-defconstant "I" (+ 1 2222))
-#define J 1|2 => (swig-defconstant "J" (logior 1 2))
-#define Y 1 + 2 * 3 + 4 => (swig-defconstant "Y" (* (+ 1 2) (+ 3 4)))
-#define Y1 (1 + 2) * (3 + 4) => (swig-defconstant "Y1" (* (+ 1 2) (+ 3 4)))
-#define Y2 1 * 2 + 3 * 4 => (swig-defconstant "Y2" (* 1 (+ 2 3) 4)) ;; WRONG
-#define Y3 (1 * 2) + (3 * 4) => (swig-defconstant "Y3" (* 1 (+ 2 3) 4)) ;; WRONG
-#define Z 1 + 2 - 3 + 4 * 5 => (swig-defconstant "Z" (* (+ 1 (- 2 3) 4) 5)) ;; WRONG
- </pre>
- </div>
- <p>
- Users are cautioned to get to know their constants before use, or
- not use the <tt>-nocwrap</tt> command-line option.
- </p>
-
-<H3><a name="Allegrocl_nn17">20.3.3 Variables</a></H3>
-
-
- <p>
- For C wrapping, a def-foreign-variable call is generated for access
- to global variables.
- </p>
- <p>
- When wrapping C++ code, both global and member variables, getter
- wrappers are generated for accessing their value, and if not immutable,
- setter wrappers as well. In the example below, note the lack of a
- setter wrapper for global_var, defined as const.
- </p>
-
- <div class="code">vars.h
- <pre>
-namespace nnn {
- int const global_var = 2;
- float glob_float = 2.0;
-}
- </pre>
- </div>
-
- <p>
- Generated code:
- </p>
- <div class="targetlang">vars.cl
- <pre>
-(swig-in-package ("nnn"))
-(swig-defun ("global_var" "ACL_nnn__global_var_get__SWIG_0" :type :getter)
- (:void)
- (:returning (:int )
- :strings-convert t)
- (swig-ff-call))
-
-
-(swig-defun ("glob_float" "ACL_nnn__glob_float_set__SWIG_0" :type :setter)
- ((PARM0_glob_float :float ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_glob_float))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("glob_float" "ACL_nnn__glob_float_get__SWIG_0" :type :getter)
- (:void)
- (:returning (:float )
- :strings-convert t)
- (swig-ff-call))
- </pre>
- </div>
-
- <p>
- Note also, that where applicable, setter wrappers are implemented
- as setf methods on the getter function, providing a lispy interface
- to the foreign code.
- </p>
-
- <div class="targetlang">
- <pre>
-user> (load "globalvar.dll")
-; Foreign loading globalvar.dll.
-t
-user> (load "globalvar.cl")
-; Loading c:\mikel\src\swig\test\globalvar.cl
-t
-user>
-globalvar> (globalvar.nnn::global_var)
-2
-globalvar> (globalvar.nnn::glob_float)
-2.0
-globalvar> (setf (globalvar.nnn::glob_float) 3.0)
-3.0
-globalvar> (globalvar.nnn::glob_float)
-3.0
- </pre>
- </div>
-
-<H3><a name="Allegrocl_nn18">20.3.4 Enumerations</a></H3>
-
-
- <p>
- In C, an enumeration value is an integer value, while in C++ an
- enumeration value is implicitly convertible to an integer value,
- but can also be distinguished by its enum type. For each enum
- declaration a def-foreign-type is generated, assigning the enum
- a default type of :int. Users may adjust the foreign type of
- enums via SWIG <tt>typemaps</tt>.
- </p>
-
- <p>
- Enum values are a bit trickier as they can be initialized using
- any valid C/C++ expression. In C with the -nocwrap command-line option,
- we handle the typical cases (simple integer initialization) and
- generate a defconstant form for each enum value. This has the advantage
- of it not being necessary to probe into foreign space to retrieve enum
- values. When generating a .cxx wrapper file, a more general solution is
- employed. A wrapper variable is created in the module_wrap.cxx file, and
- a ff:def-foreign-variable call is generated to retrieve its value into lisp.
- </p>
-
- <p>For example, the following header file
- <div class="code">enum.h:
- <pre>
-enum COL { RED, GREEN, BLUE };
-enum FOO { FOO1 = 10, FOO2, FOO3 };
- </pre>
- </div>
- <p>
- In -nocwrap mode, generates
- </p>
- <div class="targetlang">enum.cl:
- <pre>
-(swig-def-foreign-type "COL" :int)
-(swig-defconstant "RED" 0)
-(swig-defconstant "GREEN" (+ #.(swig-insert-id "RED" () :type :constant) 1))
-(swig-defconstant "BLUE" (+ #.(swig-insert-id "GREEN" () :type :constant) 1))
-
-(swig-def-foreign-type "FOO" :int)
-(swig-defconstant "FOO1" 10)
-(swig-defconstant "FOO2" (+ #.(swig-insert-id "FOO1" () :type :constant) 1))
-(swig-defconstant "FOO3" (+ #.(swig-insert-id "FOO2" () :type :constant) 1))
- </pre>
- </div>
-
- <p>And when generating a .cxx wrapper
- <div class="code">enum_wrap.cxx:
- <pre>
-EXPORT const int ACL_ENUM___RED__SWIG_0 = RED;
-EXPORT const int ACL_ENUM___GREEN__SWIG_0 = GREEN;
-EXPORT const int ACL_ENUM___BLUE__SWIG_0 = BLUE;
-EXPORT const int ACL_ENUM___FOO1__SWIG_0 = FOO1;
-EXPORT const int ACL_ENUM___FOO2__SWIG_0 = FOO2;
-EXPORT const int ACL_ENUM___FOO3__SWIG_0 = FOO3;
- </pre>
- </div>
- <p>
- and
- </p>
- <div class="targetlang">enum.cl:
- <pre>
-(swig-def-foreign-type "COL" :int)
-(swig-defvar "RED" "ACL_ENUM___RED__SWIG_0" :type :constant)
-(swig-defvar "GREEN" "ACL_ENUM___GREEN__SWIG_0" :type :constant)
-(swig-defvar "BLUE" "ACL_ENUM___BLUE__SWIG_0" :type :constant)
-
-(swig-def-foreign-type "FOO" :int)
-(swig-defvar "FOO1" "ACL_ENUM___FOO1__SWIG_0" :type :constant)
-(swig-defvar "FOO2" "ACL_ENUM___FOO2__SWIG_0" :type :constant)
-(swig-defvar "FOO3" "ACL_ENUM___FOO3__SWIG_0" :type :constant)
-
- </pre>
- </div>
-
-<H3><a name="Allegrocl_nn19">20.3.5 Arrays</a></H3>
-
-
- <p>
- One limitation in the Allegro CL foreign-types module, is that,
- without macrology, expressions may not be used to specify the
- dimensions of an array declaration. This is not a horrible
- drawback unless it is necessary to allocate foreign structures
- based on the array declaration using ff:allocate-fobject. When it
- can be determined that an array bound is a valid numeric value,
- SWIG will include this in the generated array declaration on the
- lisp side, otherwise the value will be included, but commented out.
- </p>
-
- <p>
- Below is a comprehensive example, showing a number of legal
- C/C++ array declarations and how they are translated
- into foreign-type specifications in the generated lisp code.
- </p>
- <div class="code">array.h
- <pre>
-#define MAX_BUF_SIZE 1024
-
-namespace FOO {
- int global_var1[13];
- float global_var2[MAX_BUF_SIZE];
-
-}
-
-enum COLOR { RED = 10, GREEN = 20, BLUE, PURPLE = 50, CYAN };
-
-namespace BAR {
- char global_var3[MAX_BUF_SIZE + 1];
- float global_var4[MAX_BUF_SIZE][13];
- signed short global_var5[MAX_BUF_SIZE + MAX_BUF_SIZE];
-
- int enum_var5[GREEN];
- int enum_var6[CYAN];
-
- COLOR enum_var7[CYAN][MAX_BUF_SIZE];
-}
- </pre>
- </div>
-
- <p>
- Generates:
- </p>
-
- <div class="targetlang">array.cl
- <pre>
-(in-package #.*swig-module-name*)
-
-(swig-defpackage ("FOO"))
-(swig-defpackage ("BAR"))
-
-(swig-in-package ())
-(swig-def-foreign-type "COLOR" :int)
-(swig-defvar "RED" "ACL_ENUM___RED__SWIG_0" :type :constant)
-(swig-defvar "GREEN" "ACL_ENUM___GREEN__SWIG_0" :type :constant)
-(swig-defvar "BLUE" "ACL_ENUM___BLUE__SWIG_0" :type :constant)
-(swig-defvar "PURPLE" "ACL_ENUM___PURPLE__SWIG_0" :type :constant)
-(swig-defvar "CYAN" "ACL_ENUM___CYAN__SWIG_0" :type :constant)
-
-(swig-in-package ())
-
-(swig-defconstant "MAX_BUF_SIZE" 1024)
-(swig-in-package ("FOO"))
-
-(swig-defun ("global_var1" "ACL_FOO__global_var1_get__SWIG_0" :type :getter)
- (:void)
- (:returning ((* :int) )
- :strings-convert t)
- (make-instance 'ff:foreign-pointer :foreign-address (swig-ff-call)))
-
-
-(swig-defun ("global_var2" "ACL_FOO__global_var2_set__SWIG_0" :type :setter)
- ((global_var2 (:array :float 1024) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 global_var2))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-in-package ())
-(swig-in-package ("BAR"))
-(swig-defun ("global_var3" "ACL_BAR__global_var3_set__SWIG_0" :type :setter)
- ((global_var3 (:array :char #|1024+1|#) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 global_var3))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("global_var4" "ACL_BAR__global_var4_set__SWIG_0" :type :setter)
- ((global_var4 (:array (:array :float 13) 1024) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 global_var4))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("global_var4" "ACL_BAR__global_var4_get__SWIG_0" :type :getter)
- (:void)
- (:returning ((* (:array :float 13)) )
- :strings-convert t)
- (make-instance 'ff:foreign-pointer :foreign-address (swig-ff-call)))
-
-
-(swig-defun ("global_var5" "ACL_BAR__global_var5_set__SWIG_0" :type :setter)
- ((global_var5 (:array :short #|1024+1024|#) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 global_var5))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("enum_var5" "ACL_BAR__enum_var5_set__SWIG_0" :type :setter)
- ((enum_var5 (:array :int #|GREEN|#) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 enum_var5))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("enum_var6" "ACL_BAR__enum_var6_set__SWIG_0" :type :setter)
- ((enum_var6 (:array :int #|CYAN|#) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 enum_var6))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("enum_var7" "ACL_BAR__enum_var7_set__SWIG_0" :type :setter)
- ((enum_var7 (:array (:array #.(swig-insert-id "COLOR" ()) 1024) #|CYAN|#) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 enum_var7))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("enum_var7" "ACL_BAR__enum_var7_get__SWIG_0" :type :getter)
- (:void)
- (:returning ((* (:array #.(swig-insert-id "COLOR" ()) 1024)) )
- :strings-convert t)
- (make-instance 'ff:foreign-pointer :foreign-address (swig-ff-call)))
- </pre>
- </div>
-
-<H3><a name="Allegrocl_nn20">20.3.6 Classes and Structs and Unions (oh my!)</a></H3>
-
-
-<H4><a name="Allegrocl_nn21">20.3.6.1 CLOS wrapping of</a></H4>
-
-
- <p>
- Classes, unions, and structs are all treated the same way by the
- interface generator. For any of these objects, a
- def-foreign-type and a defclass form are generated. For every
- function that returns an object (or pointer/reference) of C/C++
- type <tt>X</tt>, the wrapping defun (or defmethod) on the Lisp
- side will automatically wrap the pointer returned in an instance
- of the appropriate class. This makes it much easier to write and
- debug code than if pointers were passed around as a jumble of
- integer values.
- </p>
-
-<H4><a name="Allegrocl_nn22">20.3.6.2 CLOS Inheritance</a></H4>
-
-
- <p>
- The CLOS class schema generated by the interface mirrors the
- inheritance of the classes in foreign code, with the
- ff:foreign-pointer class at its root. ff:foreign-pointer is a thin
- wrapper for pointers that is made available by the foreign function
- interface. Its key benefit is that it may be passed as an argument
- to any ff:def-foreign-call that is expecting a pointer as the
- parameter.
- </p>
-
-<H4><a name="Allegrocl_nn23">20.3.6.3 Member fields and functions</a></H4>
-
-
- <p>
- All public fields will have accessor getter/setter functions
- generated for them, as appropriate. All public member functions
- will have wrapper functions generated.
- </p>
-
- <p>
- We currently ignore anything that isn't <tt>public</tt> (i.e.
- <tt>private</tt> or <tt>protected</tt>), because the C++ compiler
- won't allow the wrapper functions to access such fields. Likewise,
- the interface does nothing for <tt>friend</tt> directives,
- </p>
-
-<H4><a name="Allegrocl_nn24">20.3.6.4 Why not directly access C++ classes using foreign types?</a></H4>
-
-
- <p>
- The def-foreign-type generated by the SWIG interface is
- currently incomplete. We can reliably generate the object layout
- of simple structs and unions; they can be allocated via
- ff:allocate-fobject, and their member variables accessed
- directly using the various ff:fslot-value-* functions. However,
- the layout of C++ classes is more complicated. Different
- compilers adjust class layout based on inheritance patterns, and
- the presence of virtual member functions. The size of member
- function pointers vary across compilers as well. As a result, it
- is recommended that users of any generated interface not attempt
- to access C++ instances via the foreign type system, but instead
- use the more robust wrapper functions.
- </p>
-
-<H3><a name="Allegrocl_nn25">20.3.7 Templates</a></H3>
-
-
-
-<H4><a name="Allegrocl_nn26">20.3.7.1 Generating wrapper code for templates</a></H4>
-
-
-<p>
-SWIG provides support for dealing with templates, but by
-default, it will not generate any member variable or function
-wrappers for templated classes. In order to create these
-wrappers, you need to explicitly tell SWIG to instantiate
-them. This is done via the
-<a href="SWIGPlus.html#SWIGPlus_nn30"><tt>%template</tt></a>
-directive.
-</p>
-
-<H4><a name="Allegrocl_nn27">20.3.7.2 Implicit Template instantiation</a></H4>
-
-
-<p>
-While no wrapper code is generated for accessing member
-variables, or calling member functions, type code is generated
-to include these templated classes in the foreign-type and CLOS
-class schema.
-</p>
-
-<H3><a name="Allegrocl_nn28">20.3.8 Typedef, Templates, and Synonym Types</a></H3>
-
-
- <p>
- In C/C++ it is possible, via typedef, to have many names refer to
- the same <tt>type</tt>. In general, this is not a problem, though
- it can lead to confusion. Assume the below C++ header file:
- </p>
-
- <div class="code">synonyms.h
- <pre>
-class A {
- int x;
- int y;
-};
-
-typedef A Foo;
-
-A *xxx(int i); /* sets A->x = A->y = i */
-Foo *yyy(int i); /* sets Foo->x = Foo->y = i */
-
-int zzz(A *inst = 0); /* return inst->x + inst->y */
- </pre>
- </div>
-
- <p>
- The function <tt>zzz</tt> is an overloaded functions; the
- foreign function call to it will be wrapped in a
- generic-function whose argument will be checked against a type
- of <tt>A</tt>. Assuming a simple implementation, a call
- to <tt>xxx(1)</tt> will return a pointer to an A object, which
- will be wrapped in a CLOS instance of class <tt>A</tt>, and a
- call to <tt>yyy(1)</tt> will result in a CLOS instance of
- type <tt>Foo</tt> being returned. Without establishing a clear
- type relationship between <tt>Foo</tt> and <tt>A</tt>, an
- attempt to call <tt>zzz(yyy(1))</tt> will result in an error.
- </p>
-
- <p>
- We resolve this issue, by noting synonym relationships between
- types while generating the interface. A Primary type is selected
- (more on this below) from the candidate list of synonyms. For
- all other synonyms, instead of generating a distinct CLOS class
- definition, we generate a form that expands to:
- </p>
- <div class="targetlang">
- <tt>(setf (find-class <synonym>) <primary>)</tt>
- </div>
- <p>
- The result is that all references to synonym types in foreign
- code, are wrapped in the same CLOS wrapper, and, in particular,
- method specialization in wrapping generic functions works as
- expected.
- </p>
-
- <p>
- Given the above header file, synonym.h, a Lisp session would
- appear as follows:
- </p>
- <div class="targetlang">
- <pre>
-CL-USER> (load "synonym.dll")
-; Foreign loading synonym.dll.
-t
-CL-USER> (load "synonym.cl")
-; Loading c:\mikel\src\swig\test\synonym.cl
-t
-CL-USER>
-synonym> (setf a (xxx 3))
-#<A nil #x3261a0 @ #x207299da>
-synonym> (setf foo (yyy 10))
-#<A nil #x3291d0 @ #x2072e982>
-synonym> (zzz a)
-6
-synonym> (zzz foo)
-20
-synonym>
- </pre>
- </div>
-
-<H4><a name="Allegrocl_nn29">20.3.8.1 Choosing a primary type</a></H4>
-
-
- <p>
- The choice of a primary type is selected by the following
- criteria from a set of synonym types.
- </p>
- <ul>
- <li>
- If a synonym type has a class definition, it is the primary type.
- </li>
- <li>
- If a synonym type is a class template and has been explicitly
- instantiated via <tt>%template</tt>, it is the primary type.
- </li>
- <li>
- For all other sets of synonymous types, the synonym which is
- parsed first becomes the primary type.
- </li>
- </ul>
-
-<H3><a name="Allegrocl_nn30">20.3.9 Function overloading/Parameter defaulting</a></H3>
-
-
- <p>
- For each possible argument combination, a distinct wrapper
- function is created in the .cxx file. On the Lisp side, a
- generic functions is defined for each possible arity the
- overloaded/defaulted call may have. Each distinct wrapper is
- then called from within a defmethod on the appropriate generic
- function. These are further wrapped inside a dispatch function
- that checks the number of arguments it is called with and passes
- them via apply to the appropriate generic-function. This allows
- for a single entry point to overloaded functions on the lisp
- side.
- </p>
-
- <p>Example:
- </p>
- <div class="code">overload.h:
- <pre>
-
-class A {
- public:
- int x;
- int y;
-};
-
-float xxx(int i, int x = 0); /* return i * x */
-float xxx(A *inst, int x); /* return x + A->x + A->y */
- </pre>
- </div>
-
- <p>Creates the following three wrappers, for each of the possible argument
- combinations
- </p>
- <div class="code">overload_wrap.cxx
- <pre>
-EXPORT void ACL___delete_A__SWIG_0 (A *larg1) {
- A *arg1 = (A *) 0 ;
-
- arg1 = larg1;
- try {
- delete arg1;
-
- } catch (...) {
-
- }
-}
-
-
-EXPORT float ACL___xxx__SWIG_0 (int larg1, int larg2) {
- float lresult = (float)0 ;
- int arg1 ;
- int arg2 ;
- float result;
-
- arg1 = larg1;
- arg2 = larg2;
- try {
- result = (float)xxx(arg1, arg2);
-
- lresult = result;
- return lresult;
- } catch (...) {
- return (float)0;
- }
-}
-
-
-EXPORT float ACL___xxx__SWIG_1 (int larg1) {
- float lresult = (float)0 ;
- int arg1 ;
- float result;
-
- arg1 = larg1;
- try {
- result = (float)xxx(arg1);
-
- lresult = result;
- return lresult;
- } catch (...) {
- return (float)0;
- }
-}
-
-
-EXPORT float ACL___xxx__SWIG_2 (A *larg1, int larg2) {
- float lresult = (float)0 ;
- A *arg1 = (A *) 0 ;
- int arg2 ;
- float result;
-
- arg1 = larg1;
- arg2 = larg2;
- try {
- result = (float)xxx(arg1, arg2);
-
- lresult = result;
- return lresult;
- } catch (...) {
- return (float)0;
- }
-}
- </pre>
- </div>
-
- <p>
- And the following foreign-function-call and method definitions on the
- lisp side:
- </p>
- <div class="targetlang">overload.cl
- <pre>
-(swig-defmethod ("xxx" "ACL___xxx__SWIG_0" :type :function :arity 2)
- ((PARM0_i cl:integer :int )
- (PARM1_x cl:integer :int ))
- (:returning (:float )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_i))
- (let ((SWIG_arg1 PARM1_x))
- (swig-ff-call SWIG_arg0 SWIG_arg1))))
-
-(swig-defmethod ("xxx" "ACL___xxx__SWIG_1" :type :function :arity 1)
- ((PARM0_i cl:integer :int ))
- (:returning (:float )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_i))
- (swig-ff-call SWIG_arg0)))
-
-(swig-defmethod ("xxx" "ACL___xxx__SWIG_2" :type :function :arity 2)
- ((PARM0_inst #.(swig-insert-id "A" () :type :class) (* #.(swig-insert-id "A" ())) )
- (PARM1_x cl:integer :int ))
- (:returning (:float )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_inst))
- (let ((SWIG_arg1 PARM1_x))
- (swig-ff-call SWIG_arg0 SWIG_arg1))))
-
-(swig-dispatcher ("xxx" :type :function :arities (1 2)))
- </pre>
- </div>
-
- <p>And their usage in a sample lisp session:
- </p>
- <div class="targetlang">
- <pre>
-overload> (setf a (new_A))
-#<A nil #x329268 @ #x206cf612>
-overload> (setf (A_x a) 10)
-10
-overload> (setf (A_y a) 20)
-20
-overload> (xxx 1)
-0.0
-overload> (xxx 3 10)
-30.0
-overload> (xxx a 1)
-31.0
-overload> (xxx a 2)
-32.0
-overload>
- </pre>
- </div>
-
-<H3><a name="Allegrocl_nn31">20.3.10 Operator wrapping and Operator overloading</a></H3>
-
-
- <p>
- Wrappers to defined C++ Operators are automatically renamed, using
- <tt>%rename</tt>, to the following defaults:
- </p>
- <div class="code">
- <pre>
-/* name conversion for overloaded operators. */
-#ifdef __cplusplus
-%rename(__add__) *::operator+;
-%rename(__pos__) *::operator+();
-%rename(__pos__) *::operator+() const;
-
-%rename(__sub__) *::operator-;
-%rename(__neg__) *::operator-() const;
-%rename(__neg__) *::operator-();
-
-%rename(__mul__) *::operator*;
-%rename(__deref__) *::operator*();
-%rename(__deref__) *::operator*() const;
-
-%rename(__div__) *::operator/;
-%rename(__mod__) *::operator%;
-%rename(__logxor__) *::operator^;
-%rename(__logand__) *::operator&;
-%rename(__logior__) *::operator|;
-%rename(__lognot__) *::operator~();
-%rename(__lognot__) *::operator~() const;
-
-%rename(__not__) *::operator!();
-%rename(__not__) *::operator!() const;
-
-%rename(__assign__) *::operator=;
-
-%rename(__add_assign__) *::operator+=;
-%rename(__sub_assign__) *::operator-=;
-%rename(__mul_assign__) *::operator*=;
-%rename(__div_assign__) *::operator/=;
-%rename(__mod_assign__) *::operator%=;
-%rename(__logxor_assign__) *::operator^=;
-%rename(__logand_assign__) *::operator&=;
-%rename(__logior_assign__) *::operator|=;
-
-%rename(__lshift__) *::operator<<;
-%rename(__lshift_assign__) *::operator<<=;
-%rename(__rshift__) *::operator>>;
-%rename(__rshift_assign__) *::operator>>=;
-
-%rename(__eq__) *::operator==;
-%rename(__ne__) *::operator!=;
-%rename(__lt__) *::operator<;
-%rename(__gt__) *::operator>;
-%rename(__lte__) *::operator<=;
-%rename(__gte__) *::operator>=;
-
-%rename(__and__) *::operator&&;
-%rename(__or__) *::operator||;
-
-%rename(__preincr__) *::operator++();
-%rename(__postincr__) *::operator++(int);
-%rename(__predecr__) *::operator--();
-%rename(__postdecr__) *::operator--(int);
-
-%rename(__comma__) *::operator,();
-%rename(__comma__) *::operator,() const;
-
-%rename(__member_ref__) *::operator->;
-%rename(__member_func_ref__) *::operator->*;
-
-%rename(__funcall__) *::operator();
-%rename(__aref__) *::operator[];
- </pre>
- </div>
-
- <p>
- Name mangling occurs on all such renamed identifiers, so that wrapper name
- generated by <tt>B::operator=</tt> will be <tt>B___eq__</tt>, i.e.
- <tt><class-or-namespace>_</tt> has been added. Users may modify
- these default names by adding <tt>%rename</tt> directives in their own .i files.
- </p>
-
- <p>
- Operator overloading can be achieved by adding functions based
- on the mangled names of the function. In the following example,
- a class B is defined with a Operator== method defined. The
- swig <tt>%extend</tt> directive is used to add an overload method
- on Operator==.
- </p>
-
- <div class="code">opoverload.h
- <pre>
-class B {
- public:
- int x;
- int y;
- bool operator==(B const& other) const;
-};
- </pre>
- </div>
-
- <p>
- and
- </p>
- <div class="code">opoverload.i
- <pre>
-%module opoverload
-
-%{
-#include <fstream>
-#include "opoverload.h"
-%}
-
-%{
-bool B___eq__(B const *inst, int const x)
-{
- // insert the function definition into the wrapper code before
- // the wrapper for it.
- // ... do stuff ...
-}
-%}
-
-%include "opoverload.h"
-
-%extend B {
- public:
- bool __eq__(int const x) const;
-};
- </pre>
- </div>
-
- <p>
- Either operator can be called via a single call
- to the dispatch function:
- </p>
- <div class="targetlang">
- <pre>
-opoverload> (B___eq__ x1 x2)
-nil
-opoverload> (B___eq__ x1 3)
-nil
-opoverload>
- </pre>
- </div>
-
-<H3><a name="Allegrocl_nn32">20.3.11 Varargs</a></H3>
-
-
- <p>
- Variable length argument lists are not supported, by default. If
- such a function is encountered, a warning will generated to
- stderr. Varargs are supported via the SWIG <tt>%varargs</tt>
- directive. This directive allows you to specify a (finite)
- argument list which will be inserted into the wrapper in place
- of the variable length argument indicator. As an example,
- consider the function <tt>printf()</tt>. Its declaration would
- appear as follows:
- </p>
-
- <p>
- See the following section
- on <a href="Varargs.html#Varargs">Variable Length arguments</a>
- provides examples on how <tt>%varargs</tt> can be used, along
- with other ways such functions can be wrapped.
- </p>
-
-<H3><a name="Allegrocl_nn33">20.3.12 C++ Exceptions</a></H3>
-
-
- <p>
- Each C++ wrapper includes a handler to catch any exceptions that may
- be thrown while in foreign code. This helps prevent simple C++ errors
- from killing the entire lisp process. There is currently no mechanism
- to have these exceptions forwarded to the lisp condition system, nor
- has any explicit support of the exception related SWIG typemaps been
- implemented.
- </p>
-
-<H3><a name="Allegrocl_nn34">20.3.13 Pass by value, pass by reference</a></H3>
-
-
- <p>
- Allegro CL does not support the passing of non-primitive foreign
- structures by value. As a result, SWIG must automatically detect
- and convert function parameters and return values to pointers
- whenever necessary. This is done via the use of <tt>typemaps</tt>,
- and should not require any fine tuning by the user, even for
- newly defined types.
- </p>
-
-<H2><a name="Allegrocl_nn35">20.4 Typemaps</a></H2>
-
-
-<p>
- SWIG Typemaps provide a powerful tool for automatically generating
- code to handle various menial tasks required of writing an interface
- to foreign code. The purpose of this section is to describe each of
- the typemaps used by the Allegro CL module. Please read the chapter
- on <a href="Typemaps.html#Typemaps">Typemaps</a> for more information.
-</p>
-
-<H3><a name="Allegrocl_nn36">20.4.1 Code Generation in the C++ Wrapper</a></H3>
-
-
-
- <p>
- Every C++ wrapper generated by SWIG takes the following form:
- </p>
-
- <div class="diagram">
- <pre>
-return-val wrapper-name(parm0, parm1, ..., parmN)
-{
- return-val lresult; /* return value from wrapper */
- <local-declaration>
- ... results; /* return value from function call */
-
- <binding locals to parameters>
-
- try {
- result = function-name(local0, local1, ..., localN);
-
- <convert and bind result to lresult>
-
- return lresult;
- catch (...) {
- return (int)0;
- }
- </pre>
- </div>
-
-<H4><a name="Allegrocl_nn37">20.4.1.1 IN Typemap</a></H4>
-
-
- <p>
- the <tt>in</tt> typemap is used to generate code to convert parameters
- passed to C++ wrapper functions into the arguments desired for the
- call being wrapped. That is, it fills in the code for the
- <tt><binding locals to parameters></tt> section above. We
- use this map to automatically convert parameters passed by
- reference to the wrapper function into by-value arguments for
- the wrapped call, and also to convert boolean values, which are
- passed as integers from lisp (by default), into the appropriate
- type for the language of code being wrapped.
- </p>
-
- <p>These are the default specifications for the IN typemap. Here,
- <tt>$input</tt> refers to the parameter code is being generated
- for, and <tt>$1</tt> is the local variable to which it is
- being assigned. The default settings of this typemap are as follows:
- </p>
-
- <div class="code">
- <pre>
-%typemap(in) bool "$1 = (bool)$input;";
-%typemap(in) char, unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- float, double, long double, char *, void *, void,
- enum SWIGTYPE, SWIGTYPE *,
- SWIGTYPE[ANY], SWIGTYPE & "$1 = $input;";
-%typemap(in) SWIGTYPE "$1 = *$input;";
- </pre>
- </div>
-
-<H4><a name="Allegrocl_nn38">20.4.1.2 OUT Typemap</a></H4>
-
-
- <p>
- The <tt>out</tt> typemap is used to generate code to form the
- return value of the wrapper from the return value of the wrapped
- function. This code is placed in the <convert and bind result to lresult>
- section of the above code diagram. Its default mapping is as follows:
- </p>
-
- <div class="code">
- <pre>
-%typemap(out) bool "$result = (int)$1;";
-%typemap(out) char, unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- float, double, long double, char *, void *, void,
- enum SWIGTYPE, SWIGTYPE *,
- SWIGTYPE[ANY], SWIGTYPE & "$result = $1;";
-%typemap(out) SWIGTYPE "$result = new $1_type($1);";
- </pre>
- </div>
-
-<H4><a name="Allegrocl_nn39">20.4.1.3 CTYPE Typemap</a></H4>
-
-
- <p>
- This typemap is not used for code generation, but purely for the
- transformation of types in the parameter list of the wrapper function.
- Its primary use is to handle by-value to by-reference conversion in the
- wrappers parameter list. Its default settings are:
- </p>
-
- <div class="code">
- <pre>
-%typemap(ctype) bool "int";
-%typemap(ctype) char, unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- float, double, long double, char *, void *, void,
- enum SWIGTYPE, SWIGTYPE *,
- SWIGTYPE[ANY], SWIGTYPE & "$1_ltype";
-%typemap(ctype) SWIGTYPE "$&1_type";
- </pre>
- </div>
-
- <p>
- These three typemaps are specifically employed by the
- Allegro CL interface generator. SWIG also implements a number of
- other typemaps that can be used for generating code in the C/C++
- wrappers. You can read about
- these <a href="Typemaps.html#Typemaps_nn25">common typemaps</a> here.
- </p>
-
-<H3><a name="Allegrocl_nn40">20.4.2 Code generation in Lisp wrappers</a></H3>
-
-
- <p>
- A number of custom typemaps have also been added to facilitate
- the generation of code in the lisp side of the interface. These
- are described below. The basic code generation structure is
- applied as a series of nested expressions, one for each
- parameter, then one for manipulating the return value, and last,
- the foreign function call itself.
- </p>
-
- <p>
- Note that the typemaps below use fully qualified symbols where
- necessary. Users writing their own typemaps should do likewise.
- See the explanation in the last paragraph of
- <a href="#Allegrocl_nn15">16.3.1 Namespaces</a> for details.
- </p>
-
-<H4><a name="Allegrocl_nn41">20.4.2.1 LIN Typemap</a></H4>
-
-
- <p>
- The LIN typemap allows for the manipulating the lisp objects
- passed as arguments to the wrapping defun before passing them to
- the foreign function call. For example, when passing lisp
- strings to foreign code, it is often necessary to copy the
- string into a foreign structure of type (:char *) of appropriate
- size, and pass this copy to the foreign call. Using the LIN
- typemap, one could arrange for the stack-allocation of a foreign
- char array, copy your string into it, and not have to worry
- about freeing the copy after the function returns.
- </p>
-
- <p>The LIN typemap accepts the following <tt>$variable</tt> references.
- </p>
- <ul>
- <li><tt>$in</tt> - expands to the name of the parameter being
- applied to this typemap
- </li>
- <li><tt>$out</tt> - expands to the name of the local variable
- assigned to this typemap
- </li>
- <li><tt>$in_fftype</tt> - the foreign function type of the C type.</li>
- <li><tt>$*in_fftype</tt> - the foreign function type of the C type
- with one pointer removed. If there is no pointer, then $*in_fftype
- is the same as $in_fftype.
- </li>
- <li><tt>$body</tt> - very important. Instructs SWIG where
- subsequent code generation steps should be inserted into the
- current typemap. Leaving out a <tt>$body</tt> reference
- will result in lisp wrappers that do very little by way of
- calling into foreign code. Not recommended.
- </li>
- </ul>
-
- <div class="code">
- <pre>
-%typemap(lin) SWIGTYPE "(cl:let (($out $in))\n $body)";
- </pre>
- </div>
-
-<H4><a name="Allegrocl_nn42">20.4.2.2 LOUT Typemap</a></H4>
-
-
- <p>
- The LOUT typemap is the means by which we effect the wrapping of
- foreign pointers in CLOS instances. It is applied after all LIN
- typemaps, and immediately before the actual foreign-call.
- </p>
-
- <p>The LOUT typemap uses the following $variable
- </p>
- <ul>
- <li><tt>$lclass</tt> - Expands to the CLOS class that
- represents foreign-objects of the return type matching this
- typemap.
- </li>
- <li><tt>$body</tt> - Same as for the LIN map. Place this
- variable where you want the foreign-function call to occur.
- </li>
- <li><tt>$ldestructor</tt> - Expands to the symbol naming the destructor for this
- class ($lclass) of object. Allows you to insert finalization or automatic garbage
- collection into the wrapper code (see default mappings below).
- </li>
- </ul>
-
- <div class="code">
- <pre>
-%typemap(lout) bool, char, unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- float, double, long double, char *, void *, void,
- enum SWIGTYPE "$body";
-%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *,
- SWIGTYPE & "(cl:make-instance '$lclass :foreign-address $body)";
-%typemap(lout) SWIGTYPE "(cl:let* ((address $body)\n
- (ACL_result (cl:make-instance '$lclass :foreign-address address)))\n
- (cl:unless (cl::zerop address)\n
- (excl:schedule-finalization ACL_result #'$ldestructor))\n
- ACL_result)";
- </pre>
- </div>
-
-<H4><a name="Allegrocl_nn43">20.4.2.3 FFITYPE Typemap</a></H4>
-
-
-
- <p>
- The FFITYPE typemap works as a helper for a body of code that
- converts C/C++ type specifications into Allegro CL foreign-type
- specifications. These foreign-type specifications appear in
- ff:def-foreing-type declarations, and in the argument list and
- return values of ff:def-foreign-calls. You would modify this
- typemap if you want to change how the FFI passes through
- arguments of a given type. For example, if you know that a
- particular compiler represents booleans as a single byte, you
- might add an entry for:
- </p>
-
- <div class="code">
- <pre>
-%typemap(ffitype) bool ":unsigned-char";
- </pre>
- </div>
-
- <p>
- Note that this typemap is pure type transformation, and is not
- used in any code generations step the way the LIN and LOUT
- typemaps are. The default mappings for this typemap are:
- </p>
-
- <div class="code">
- <pre>
-%typemap(ffitype) bool ":int";
-%typemap(ffitype) char ":char";
-%typemap(ffitype) unsigned char ":unsigned-char";
-%typemap(ffitype) signed char ":char";
-%typemap(ffitype) short, signed short ":short";
-%typemap(ffitype) unsigned short ":unsigned-short";
-%typemap(ffitype) int, signed int ":int";
-%typemap(ffitype) unsigned int ":unsigned-int";
-%typemap(ffitype) long, signed long ":long";
-%typemap(ffitype) unsigned long ":unsigned-long";
-%typemap(ffitype) float ":float";
-%typemap(ffitype) double ":double";
-%typemap(ffitype) char * "(* :char)";
-%typemap(ffitype) void * "(* :void)";
-%typemap(ffitype) void ":void";
-%typemap(ffitype) enum SWIGTYPE ":int";
-%typemap(ffitype) SWIGTYPE & "(* :void)";
- </pre>
- </div>
-
-<H4><a name="Allegrocl_nn44">20.4.2.4 LISPTYPE Typemap</a></H4>
-
-
- <p>
- This is another type only transformation map, and is used to
- provide the lisp-type, which is the optional third argument in
- argument specifier in a ff:def-foreign-call form. Specifying a
- lisp-type allows the foreign call to perform type checking on
- the arguments passed in. The default entries in this typemap are:
- </p>
-
- <div class="code">
- <pre>
-%typemap(lisptype) bool "cl:boolean";
-%typemap(lisptype) char "cl:character";
-%typemap(lisptype) unsigned char "cl:integer";
-%typemap(lisptype) signed char "cl:integer";
- </pre>
- </div>
-
-<H4><a name="Allegrocl_nn45">20.4.2.5 LISPCLASS Typemap</a></H4>
-
-
- <p>
- The LISPCLASS typemap is used to generate the method signatures
- for the generic-functions which wrap overloaded functions and
- functions with defaulted arguments. The default entries are:
- </p>
-
- <div class="code">
- <pre>
-%typemap(lispclass) bool "t";
-%typemap(lispclass) char "cl:character";
-%typemap(lispclass) unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- enum SWIGTYPE "cl:integer";
-%typemap(lispclass) float "cl:single-float";
-%typemap(lispclass) double "cl:double-float";
-%typemap(lispclass) char * "cl:string";
- </pre>
- </div>
-
-<H3><a name="Allegrocl_nn46">20.4.3 Modifying SWIG behavior using typemaps</a></H3>
-
-
- <p>
- The following example shows how we made use of the above
- typemaps to add support for the wchar_t type.
- </p>
-
- <div class="code">
- <pre>
-%typecheck(SWIG_TYPECHECK_UNICHAR) wchar_t { $1 = 1; };
-
-%typemap(in) wchar_t "$1 = $input;";
-%typemap(lin) wchar_t "(cl:let (($out (cl:char-code $in)))\n $body)";
-%typemap(lin) wchar_t* "(excl:with-native-string
- ($out $in
- :external-format #+little-endian :fat-le
- #-little-endian :fat)\n
- $body)"
-
-%typemap(out) wchar_t "$result = $1;";
-%typemap(lout) wchar_t "(cl:code-char $body)";
-%typemap(lout) wchar_t* "(excl:native-to-string $body
- :external-format #+little-endian :fat-le
- #-little-endian :fat)";
-
-%typemap(ffitype) wchar_t ":unsigned-short";
-%typemap(lisptype) wchar_t "";
-%typemap(ctype) wchar_t "wchar_t";
-%typemap(lispclass) wchar_t "cl:character";
-%typemap(lispclass) wchar_t* "cl:string";
- </pre>
- </div>
-
-<H2><a name="Allegrocl_nn47">20.5 Identifier Converter functions</a></H2>
-
-
-<H3><a name="Allegrocl_nn48">20.5.1 Creating symbols in the lisp environment</a></H3>
-
-
-<p>
- Various symbols must be generated in the lisp environment to which
- class definitions, functions, constants, variables, etc. must be
- bound. Rather than force a particular convention for naming these
- symbols, an identifier (to symbol) conversion function is used. A
- user-defined identifier-converter can then implement any symbol
- naming, case-modifying, scheme desired.
-</p>
-
-<p>
- In generated SWIG code, whenever some interface object must be
- referenced by its lisp symbol, a macro is inserted that calls the
- identifier-converter function to generate the appropriate symbol
- reference. It is therefore expected that the identifier-converter
- function reliably return the same (eq) symbol given the same set
- of arguments.
-</p>
-
-<H3><a name="Allegrocl_nn49">20.5.2 Existing identifier-converter functions</a></H3>
-
-
- <p>Two basic identifier routines have been defined.
-<H4><a name="Allegrocl_nn50">20.5.2.1 identifier-convert-null</a></H4>
-
-
- <p>
- No modification of the identifier string is performed. Based on
- other arguments, the identifier may be concatenated with other
- strings, from which a symbol will be created.
- </p>
-
-<H4><a name="Allegrocl_nn51">20.5.2.2 identifier-convert-lispify</a></H4>
-
-
- <p>
- All underscores in the identifier string are converted to
- hyphens. Otherwise, identifier-convert-lispify performs the
- same symbol transformations.
- </p>
-
-<H4><a name="Allegrocl_nn52">20.5.2.3 Default identifier to symbol conversions</a></H4>
-
-
- <p>
- Check the definitions of the above two default
- identifier-converters in <tt>Lib/allegrocl/allegrocl.swg</tt> for
- default naming conventions.
- </p>
-
-<H3><a name="Allegrocl_nn53">20.5.3 Defining your own identifier-converter</a></H3>
-
-
-<p>
- A user-defined identifier-converter function should conform to the following
- specification:
-</p>
-
-<div class="targetlang">
-<pre>
-(defun identifier-convert-fn (id &key type class arity) ...body...)
-result ==> symbol or (setf symbol)
-</pre>
-</div>
-
-<p>The <tt>ID</tt> argument is a string representing an identifier in the
-foreign environment.
-</p>
-
-<p>
-The :type keyword argument provides more information on the type of
-identifier. Its value is a symbol. This allows the
-identifier-converter to apply different heuristics when mapping
-different types of identifiers to symbols. SWIG will generate calls
-to your identifier-converter using the following types.
-</p>
-
-<ul>
- <li>:class - names a CLOS class.</li>
- <li>:constant - names a defconstant</li>
- <li>:constructor - names a function for creating a foreign object</li>
- <li>:destructor - names a function for freeing a foreign object</li>
- <li>:function - names a CLOS wrapping defmethod or defun.</li>
- <li>:ff-operator - names a foreign call defined via ff:def-foreign-call</li>
- <li>:getter - getter function</li>
- <li>:namespace - names a C++ namespace</li>
- <li>:setter - names a setter function. May return a (setf symbol) reference</li>
- <li>:operator - names a C++ operator, such as Operator=, Operator*.</li>
- <li>:slot - names a slot in a struct/class/union declaration.</li>
- <li>:type - names a foreign-type defined via ff:def-foreign-type.</li>
- <li>:variable - names a variable defined via ff:def-foreign-variable.</li>
-</ul>
-
-<p>
-The :class keyword argument is a string naming a foreign
-class. When non-nil, it indicates that the current identifier has
-scope in the specified class.
-</p>
-
-<p>
-The :arity keyword argument only appears in swig:swig-defmethod forms
-generated for overloaded functions. Its value is an integer
-indicating the number of arguments passed to the routine indicated by
-this identifier.
-</p>
-
-<H3><a name="Allegrocl_nn54">20.5.4 Instructing SWIG to use a particular identifier-converter</a></H3>
-
-
-<p>
- By default, SWIG will use identifier-converter-null. To specify
- another convert function, use the <tt>-identifier-converter</tt>
- command-line argument. The value should be a string naming the
- function you wish the interface to use instead, when generating
- symbols. ex:
-</p>
-
-<div class="code">
-<pre>
-% swig -allegrocl -c++ -module mymodule -identifier-converter my-identifier-converter
-</pre>
-</div>
-
-
-</body>
-</html>
diff --git a/Doc/Manual/Chicken.html b/Doc/Manual/Chicken.html
deleted file mode 100644
index 3a80811..0000000
--- a/Doc/Manual/Chicken.html
+++ /dev/null
@@ -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 <= 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 <Foo>, 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 <= 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 <top>) (arg1 <Foo>)) (<i>call primitive function</i>))
-(define-method (foo (arg0 <top>)) (<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>
diff --git a/Doc/Manual/Modula3.html b/Doc/Manual/Modula3.html
deleted file mode 100644
index fc4ffa0..0000000
--- a/Doc/Manual/Modula3.html
+++ /dev/null
@@ -1,942 +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 Modula-3</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="Modula3">31 SWIG and Modula-3</a></H1>
-<!-- INDEX -->
-<div class="sectiontoc">
-<ul>
-<li><a href="#Modula3_modula3_overview">Overview</a>
-<ul>
-<li><a href="#Modula3_motivation">Motivation</a>
-</ul>
-<li><a href="#Modula3_conception">Conception</a>
-<ul>
-<li><a href="#Modula3_cinterface">Interfaces to C libraries</a>
-<li><a href="#Modula3_cppinterface">Interfaces to C++ libraries</a>
-</ul>
-<li><a href="#Modula3_preliminaries">Preliminaries</a>
-<ul>
-<li><a href="#Modula3_compilers">Compilers</a>
-<li><a href="#Modula3_commandline">Additional Commandline Options</a>
-</ul>
-<li><a href="#Modula3_typemaps">Modula-3 typemaps</a>
-<ul>
-<li><a href="#Modula3_inoutparam">Inputs and outputs</a>
-<li><a href="#Modula3_ordinals">Subranges, Enumerations, Sets</a>
-<li><a href="#Modula3_class">Objects</a>
-<li><a href="#Modula3_imports">Imports</a>
-<li><a href="#Modula3_exceptions">Exceptions</a>
-<li><a href="#Modula3_typemap_example">Example</a>
-</ul>
-<li><a href="#Modula3_hints">More hints to the generator</a>
-<ul>
-<li><a href="#Modula3_features">Features</a>
-<li><a href="#Modula3_pragmas">Pragmas</a>
-</ul>
-<li><a href="#Modula3_remarks">Remarks</a>
-</ul>
-</div>
-<!-- INDEX -->
-
-
-
-<p>
-This chapter describes SWIG's support for
-<a href="http://modula3.org/">Modula-3</a>.
-You should be familiar with the
-<a href="SWIG.html#SWIG">basics</a>
-of SWIG,
-especially
-<a href="Typemaps.html#Typemaps">typemaps</a>.
-</p>
-
-<H2><a name="Modula3_modula3_overview">31.1 Overview</a></H2>
-
-
-<p>
-Modula-3 is a compiled language in the tradition of Niklaus Wirth's Modula 2,
-which is in turn a successor to Pascal.
-</p>
-
-<p>
-SWIG's Modula-3 support is currently very basic and highly experimental!
-Many features are still not designed satisfyingly
-and I need more discussion about the odds and ends.
-Don't rely on any feature, incompatible changes are likely in the future!
-However, the Modula-3 generator was already useful for interfacing
-to the libraries:
-</p>
-
-<ol>
-<li>
-<a href="http://www.elegosoft.com/cgi-bin/cvsweb.cgi/cm3/m3-libs/plplot/">
-PLPlot
-</a>
-</li>
-<li>
-<a href="http://www.elegosoft.com/cgi-bin/cvsweb.cgi/cm3/m3-libs/fftw/">
-FFTW
-</a>
-</li>
-</ol>
-
-<H3><a name="Modula3_motivation">31.1.1 Motivation</a></H3>
-
-
-<p>
-Although it is possible to write Modula-3 code that performs as well as C/C++
-most existing libraries are not written in Modula-3 but in C or C++, and
-even libraries in other languages may provide C header files.
-</p>
-
-<p>
-Fortunately Modula-3 can call C functions, but you have to write Modula-3
-interfaces to them, and to make things comfortable you will also need
-wrappers that convert between high-level features of Modula-3 (garbage
-collecting, exceptions) and the explicit tracking of allocated memory and
-exception codes used by C APIs.
-</p>
-
-<p>
-SWIG converts C headers to Modula-3 interfaces for you, and using typemaps
-you can pass <tt>TEXT</tt>s or open arrays, and convert error return codes
-into exceptions.
-</p>
-
-<p>
-If the library API is ill designed
-writing appropriate typemaps can still be time-consuming.
-E.g. C programmers are very creative to work-around
-missing data types like (real) enumerations and sets.
-You should turn such work-arounds back to the Modula-3 way
-otherwise you lose static safety and consistency.
-</p>
-
-<p>
-Without SWIG you would probably never consider trying to call C++ libraries
-from Modula-3, but with SWIG this is becomes feasible.
-SWIG can generate C wrappers to C++ functions and object methods
-that may throw exceptions, and then wrap these C wrappers for Modula-3.
-To make it complete you can then hide the C interface with Modula-3 classes and
-exceptions.
-</p>
-
-<p>
-SWIG allows you to call C and C++ libraries from Modula-3 (even with call back
-functions), but it doesn't allow you to easily integrate a Modula-3 module into
-a C/C++ project.
-</p>
-
-<H2><a name="Modula3_conception">31.2 Conception</a></H2>
-
-
-<H3><a name="Modula3_cinterface">31.2.1 Interfaces to C libraries</a></H3>
-
-
-<p>
-Modula-3 has integrated support for calling C functions.
-This is also extensively used by the standard Modula-3 libraries
-to call OS functions.
-The Modula-3 part of SWIG and the corresponding SWIG library
-modula3.swg
-contain code that uses these features.
-Because of the built-in support there is no need
-for calling the SWIG kernel to generate wrappers written in C.
-All conversion and argument checking can be done in Modula-3
-and the interfacing is quite efficient.
-All you have to do is to write pieces of Modula-3 code
-that SWIG puts together.
-</p>
-
-<table border summary="Modula-3 C library support">
-<tr><th colspan=2>C library support integrated in Modula-3<th></tr>
-<tr>
-<td>Pragma <tt><* EXTERNAL *></tt></td>
-<td>Precedes a declaration of a PROCEDURE that is implemented
-in an external library instead of a Modula-3 module.</td>
-</tr>
-<tr>
-<td>Pragma <tt><* CALLBACK *></tt></td>
-<td>Precedes a declaration of a PROCEDURE that should be called
-by external library code.</td>
-</tr>
-<tr>
-<td>Module <tt>Ctypes</tt></td>
-<td>Contains Modula-3 types that match some basic C types.</td>
-</tr>
-<tr>
-<td>Module <tt>M3toC</tt></td>
-<td>Contains routines that convert between Modula-3's <tt>TEXT</tt> type
-and C's <tt>char *</tt> type.</td>
-</tr>
-</table>
-
-<p>
-In each run of SWIG the Modula-3 part
-generates several files:
-</p>
-<table border summary="Modula-3 generated files">
-<tr>
- <th>Module name scheme</th>
- <th>Identifier for <tt>%insert</tt></th>
- <th>Description</th>
-</tr>
-<tr>
- <td>Module<tt>Raw.i3</tt></td>
- <td><tt>m3rawintf</tt></td>
- <td>Declaration of types that are equivalent to those of the C library,
- <tt>EXTERNAL</tt> procedures as interface to the C library functions</td>
-</tr>
-<tr>
- <td>Module<tt>Raw.m3</tt></td>
- <td><tt>m3rawimpl</tt></td>
- <td>Almost empty.</td>
-</tr>
-<tr>
- <td>Module<tt>.i3</tt></td>
- <td><tt>m3wrapintf</tt></td>
- <td>Declaration of comfortable wrappers to the C library functions.</td>
-</tr>
-<tr>
- <td>Module<tt>.m3</tt></td>
- <td><tt>m3wrapimpl</tt></td>
- <td>Implementation of the wrappers that
- convert between Modula-3 and C types,
- check for validity of values,
- hand-over resource management to the garbage collector using <tt>WeakRef</tt>s
- and raises exceptions.</td>
-</tr>
-<tr>
- <td><tt>m3makefile</tt></td>
- <td><tt>m3makefile</tt></td>
- <td>Add the modules above to the Modula-3 project and
- specify the name of the Modula-3 wrapper library
- to be generated.
-
- Today I'm not sure if it is a good idea
- to create a <tt>m3makefile</tt> in each run,
- because SWIG must be started for each Modula-3 module it creates.
- Thus the m3makefile is overwritten each time. :-(
- </td>
-</tr>
-</table>
-
-<p>
-Here's a scheme of how the function calls to Modula-3 wrappers
-are redirected to C library functions:
-</p>
-
-<table summary="Modula-3 C library">
-<tr>
- <td align=center>
- Modula-3 wrapper<br>
- Module<tt>.i3</tt><br>
- generated by Modula-3 part of SWIG
- </td>
- <td></td>
- <td align=center></td>
-</tr>
-<tr>
- <td align=center>
- <!-- pre tag overrides centering -->
- |<br>
- v
- </td>
- <td></td>
- <td align=center></td>
-</tr>
-<tr>
- <td align=center>
- Modula-3 interface to C<br>
- Module<tt>Raw.i3</tt><br>
- generated by Modula-3 part of SWIG
- </td>
- <td>--></td>
- <td align=center>
- C library
- </td>
-</tr>
-</table>
-
-
-<p>
-I have still no good conception how one can split C library interfaces
-into type oriented interfaces.
-A Module in Modula-3 represents an Abstract DataType
-(or call it a static classes, i.e. a class without virtual methods).
-E.g. if you have a principal type, say <tt>Database</tt>,
-it is good Modula-3 style to set up one Module with the name <tt>Database</tt>
-where the database type is declared with the name <tt>T</tt>
-and where all functions are declared that operates on it.
-</p>
-
-<p>
-The normal operation of SWIG is to generate a fixed set of files per call.
-To generate multiple modules one has to write one SWIG interface
-(different SWIG interfaces can share common data) per module.
-Identifiers belonging to a different module may ignored (<tt>%ignore</tt>)
-and the principal type must be renamed (<tt>%typemap</tt>).
-</p>
-
-
-<H3><a name="Modula3_cppinterface">31.2.2 Interfaces to C++ libraries</a></H3>
-
-
-<p>
-Interfaces to C++ files are much more complicated and
-there are some more design decisions that are not made, yet.
-Modula-3 has no support for C++ functions
-but C++ compilers should support generating C++ functions
-with a C interface.
-</p>
-
-<p>
-Here's a scheme of how the function calls to Modula-3 wrappers
-are redirected to C library functions:
-</p>
-
-<table summary="Modula-3 C++ library">
-<tr>
- <td align=center>
- Modula-3 wrapper<br>
- Module<tt>.i3</tt><br>
- generated by Modula-3 part of SWIG
- </td>
- <td></td>
- <td align=center>C++ library</td>
-</tr>
-<tr>
- <td align=center>
- <!-- pre tag overrides centering -->
- |<br>
- v
- </td>
- <td></td>
- <td align=center>
- ^<br>
- |
- </td>
-</tr>
-<tr>
- <td align=center>
- Modula-3 interface to C<br>
- Module<tt>Raw.i3</tt><br>
- generated by Modula-3 part of SWIG
- </td>
- <td>--></td>
- <td align=center>
- C interface to C++<br>
- module<tt>_wrap.cxx</tt><br>
- generated by the SWIG core
- </td>
-</tr>
-</table>
-
-<p>
-Wrapping C++ libraries arises additional problems:
-</p>
-<ul>
-<li>
-Is it sensible to wrap C++ classes with Modula-3 classes?
-</li>
-<li>
-How to find the wrapping Modula-3 class
-for a class pointer that is returned by a C++ routine?
-</li>
-<li>
-How to deal with multiple inheritance
-which was neglected for Modula-3 for good reasons?
-</li>
-<li>
-Is it possible to sub-class C++ classes with Modula-3 code?
-This issue is addressed by directors,
-a feature that was experimentally added to some Language modules
-like
-<a href="Java.html#Java_directors">Java</a> and
-<a href="Python.html#Python_directors">Python</a>.
-</li>
-<li>
-How to manage storage with the garbage collector of Modula-3?
-Support for
-<a href="Customization.html#Customization_ownership">
-<tt>%newobject</tt> and <tt>%typemap(newfree)</tt></a>
-isn't implemented, yet.
-What's about resources that are managed by the garbage collector
-but shall be passed back to the storage management of the C++ library?
-This is a general issue which is not solved in a satisfying fashion
-as far as I know.
-</li>
-<li>
-How to turn C++ exceptions into Modula-3 exceptions?
-There's also no support for
-<a href="Customization.html#Customization_exception">
-<tt>%exception</tt></a>, yet.
-</li>
-</ul>
-
-<p>
-Be warned:
-There is no C++ library I wrote a SWIG interface for,
-so I'm not sure if this is possible or sensible, yet.
-</p>
-
-<H2><a name="Modula3_preliminaries">31.3 Preliminaries</a></H2>
-
-
-<H3><a name="Modula3_compilers">31.3.1 Compilers</a></H3>
-
-
-<p>
-There are different Modula-3 compilers around:
-cm3, pm3, ezm3, Klagenfurth Modula-3, Cambridge Modula-3.
-SWIG itself does not contain compiler specific code
-but the modula3.swg library file
-may do so.
-For testing examples I use Critical Mass cm3.
-</p>
-
-
-<H3><a name="Modula3_commandline">31.3.2 Additional Commandline Options</a></H3>
-
-
-<p>
-There are some experimental command line options
-that prevent SWIG from generating interface files.
-Instead files are emitted that may assist you
-when writing SWIG interface files.
-</p>
-
-<table border summary="Modula-3 specific options">
-<tr>
-<th>Modula-3 specific options</th>
-<th>Description</th>
-</tr>
-
-<tr>
-<td valign=top>-generateconst <file></td>
-<td>
-Disable generation of interfaces and wrappers.
-Instead write code for computing numeric values of constants
-to the specified file.
-<br>
-C code may contain several constant definitions
-written as preprocessor macros.
-Other language modules of SWIG use
-compute-once-use-readonly variables or
-functions to wrap such definitions.
-All of them can invoke C code dynamically
-for computing the macro values.
-But if one wants to turn them into Modula-3
-integer constants, enumerations or set types,
-the values of these expressions has to be known statically.
-Although definitions like <tt>(1 << FLAG_MAXIMIZEWINDOW)</tt>
-must be considered as good C style
-they are hard to convert to Modula-3
-since the value computation can use every feature of C.
-<br>
-Thus I implemented these switch
-to extract all constant definitions
-and write a C program that output the values of them.
-It works for numeric constants only
-and treats all of them as <tt>double</tt>.
-Future versions may generate a C++ program
-that can detect the type of the macros
-by overloaded output functions.
-Then strings can also be processed.
-</td>
-</tr>
-
-<tr>
-<td valign=top>-generaterename <file></td>
-<td>
-Disable generation of interfaces and wrappers.
-Instead generate suggestions for <tt>%rename</tt>.
-<br>
-C libraries use a naming style
-that is neither homogeneous nor similar to that of Modula-3.
-C function names often contain a prefix denoting the library
-and some name components separated by underscores
-or capitalization changes.
-To get library interfaces that are really Modula-3 like
-you should rename the function names with the <tt>%rename</tt> directive.
-This switch outputs a list of such directives
-with a name suggestion generated by a simple heuristic.
-</td>
-</tr>
-
-<tr>
-<td valign=top>-generatetypemap <file></td>
-<td>
-Disable generation of interfaces and wrappers.
-Instead generate templates for some basic typemaps.
-</td>
-</tr>
-</table>
-
-<H2><a name="Modula3_typemaps">31.4 Modula-3 typemaps</a></H2>
-
-
-<H3><a name="Modula3_inoutparam">31.4.1 Inputs and outputs</a></H3>
-
-
-<p>
-Each C procedure has a bunch of inputs and outputs.
-Inputs are passed as function arguments,
-outputs are updated referential arguments and
-the function value.
-</p>
-
-<p>
-Each C type can have several typemaps
-that apply only in case if a type is used
-for an input argument, for an output argument,
-or for a return value.
-A further typemap may specify
-the direction that is used for certain parameters.
-I have chosen this separation
-in order to be able to write general typemaps for the modula3.swg typemap library.
-In the library code the final usage of the type is not known.
-Using separate typemaps for each possible use
-allows appropriate definitions for each case.
-If these pre-definitions are fine
-then the direction of the function parameter
-is the only hint the user must give.
-</p>
-
-<p>
-The typemaps specific to Modula-3 have a common name scheme:
-A typemap name starts with "m3",
-followed by "raw" or "wrap"
-depending on whether it controls the generation
-of the Module<tt>Raw.i3</tt> or the Module<tt>.i3</tt>, respectively.
-It follows an "in" for typemaps applied to input argument,
-"out" for output arguments, "arg" for all kind of arguments,
-"ret" for returned values.
-</p>
-
-<p>
-The main task of SWIG is to build wrapper function,
-i.e. functions that convert values between C and Modula-3
-and call the corresponding C function.
-Modula-3 wrapper functions generated by SWIG
-consist of the following parts:
-</p>
-<ul>
-<li>Generate <tt>PROCEDURE</tt> signature.</li>
-<li>Declare local variables.</li>
-<li>Convert input values from Modula-3 to C.</li>
-<li>Check for input value integrity.</li>
-<li>Call the C function.</li>
-<li>Check returned values, e.g. error codes.</li>
-<li>Convert and write back values into Modula-3 records.</li>
-<li>Free temporary storage.</li>
-<li>Return values.</li>
-</ul>
-
-<table border summary="Modula-3 typemaps">
-<tr>
- <th>Typemap</th>
- <th>Example</th>
- <th>Description</th>
-</tr>
-<tr>
- <td>m3wrapargvar</td>
- <td><tt>$1: INTEGER := $1_name;</tt></td>
- <td>
- Declaration of some variables needed for temporary results.
- </td>
-</tr>
-<tr>
- <td>m3wrapargconst</td>
- <td><tt>$1 = "$1_name";</tt></td>
- <td>
- Declaration of some constant, maybe for debug purposes.
- </td>
-</tr>
-<tr>
- <td>m3wrapargraw</td>
- <td><tt>ORD($1_name)</tt></td>
- <td>
- The expression that should be passed as argument to the raw Modula-3 interface function.
- </td>
-</tr>
-<tr>
- <td>m3wrapargdir</td>
- <td><tt>out</tt></td>
- <td>
- Referential arguments can be used for input, output, update.
- ???
- </td>
-</tr>
-<tr>
- <td>m3wrapinmode</td>
- <td><tt>READONLY</tt></td>
- <td>
- One of Modula-3 parameter modes
- <tt>VALUE</tt> (or empty),
- <tt>VAR</tt>,
- <tt>READONLY</tt>
- </td>
-</tr>
-<tr>
- <td>m3wrapinname</td>
- <td></td>
- <td>
- New name of the input argument.
- </td>
-</tr>
-<tr>
- <td>m3wrapintype</td>
- <td></td>
- <td>
- Modula-3 type of the input argument.
- </td>
-</tr>
-<tr>
- <td>m3wrapindefault</td>
- <td></td>
- <td>
- Default value of the input argument
- </td>
-</tr>
-<tr>
- <td>m3wrapinconv</td>
- <td><tt>$1 := M3toC.SharedTtoS($1_name);</tt></td>
- <td>
- Statement for converting the Modula-3 input value to C compliant value.
- </td>
-</tr>
-<tr>
- <td>m3wrapincheck</td>
- <td><tt>IF Text.Length($1_name) > 10 THEN RAISE E("str too long"); END;</tt></td>
- <td>
- Check the integrity of the input value.
- </td>
-</tr>
-<tr>
- <td>m3wrapoutname</td>
- <td></td>
- <td>
- Name of the <tt>RECORD</tt> field to be used for returning multiple values.
- This applies to referential output arguments that shall be turned
- into return values.
- </td>
-</tr>
-<tr>
- <td>m3wrapouttype</td>
- <td></td>
- <td>
- Type of the value that is returned instead of a referential output argument.
- </td>
-</tr>
-<tr>
- <td>m3wrapoutconv</td>
- <td></td>
- <td>
- </td>
-</tr>
-<tr>
- <td>m3wrapoutcheck</td>
- <td></td>
- <td>
- </td>
-</tr>
-<tr>
- <td>m3wrapretraw</td>
- <td></td>
- <td>
- </td>
-</tr>
-<tr>
- <td>m3wrapretname</td>
- <td></td>
- <td>
- </td>
-</tr>
-<tr>
- <td>m3wraprettype</td>
- <td></td>
- <td>
- </td>
-</tr>
-<tr>
- <td>m3wrapretvar</td>
- <td></td>
- <td>
- </td>
-</tr>
-<tr>
- <td>m3wrapretconv</td>
- <td></td>
- <td>
- </td>
-</tr>
-<tr>
- <td>m3wrapretcheck</td>
- <td></td>
- <td>
- </td>
-</tr>
-<tr>
- <td>m3wrapfreearg</td>
- <td><tt>M3toC.FreeSharedS(str, arg1);</tt></td>
- <td>
- Free resources that were temporarily used in the wrapper.
- Since this step should never be skipped,
- SWIG will put it in the <tt>FINALLY</tt> branch
- of a <tt>TRY .. FINALLY</tt> structure.
- </td>
-</tr>
-</table>
-
-
-<H3><a name="Modula3_ordinals">31.4.2 Subranges, Enumerations, Sets</a></H3>
-
-
-<p>
-Subranges, enumerations, and sets are machine oriented types
-that make Modula very strong and expressive compared
-with the type systems of many other languages.
-</p>
-
-<ul>
-<li>
-Subranges are used for statically restricted choices of integers.
-</li>
-<li>
-Enumerations are used for named choices.
-</li>
-<li>
-Sets are commonly used for flag (option) sets.
-</li>
-</ul>
-
-<p>
-Using them extensively makes Modula code very safe and readable.
-</p>
-
-<p>
-C supports enumerations, too, but they are not as safe as the ones of Modula.
-Thus they are abused for many things:
-For named choices, for integer constant definitions, for sets.
-To make it complete every way of defining a value in C
-(<tt>#define</tt>, <tt>const int</tt>, <tt>enum</tt>)
-is somewhere used for defining something
-that must be handled completely different in Modula-3
-(<tt>INTEGER</tt>, enumeration, <tt>SET</tt>).
-</p>
-
-<p>
-I played around with several <tt>%feature</tt>s and <tt>%pragma</tt>s
-that split the task up into converting
-the C bit patterns (integer or bit set)
-into Modula-3 bit patterns (integer or bit set)
-and change the type as requested.
-See the corresponding example in the
-Examples/modula3/enum/example.i file.
-This is quite messy and not satisfying.
-So the best what you can currently do is
-to rewrite constant definitions manually.
-Though this is a tedious work
-that I'd like to automate.
-</p>
-
-
-<H3><a name="Modula3_class">31.4.3 Objects</a></H3>
-
-
-<p>
-Declarations of C++ classes are mapped to <tt>OBJECT</tt> types
-while it is tried to retain the access hierarchy
-"public - protected - private" using partial revelation.
-Though the example in
-Examples/modula3/class/example.i
-is not really useful, yet.
-</p>
-
-
-<H3><a name="Modula3_imports">31.4.4 Imports</a></H3>
-
-
-<p>
-Pieces of Modula-3 code provided by typemaps
-may contain identifiers from foreign modules.
-If the typemap <tt>m3wrapinconv</tt> for <tt>blah *</tt>
-contains code using the function <tt>M3toC.SharedTtoS</tt>
-you may declare <tt>%typemap("m3wrapinconv:import") blah * %{M3toC%}</tt>.
-Then the module <tt>M3toC</tt> is imported
-if the <tt>m3wrapinconv</tt> typemap for <tt>blah *</tt>
-is used at least once.
-Use <tt>%typemap("m3wrapinconv:import") blah * %{MyConversions AS M3toC%}</tt>
-if you need module renaming.
-Unqualified import is not supported.
-</p>
-
-<p>
-It is cumbersome to add this typemap to each piece of Modula-3 code.
-It is especially useful when writing general typemaps
-for the modula3.swg typemap library.
-For a monolithic module you might be better off
-if you add the imports directly:
-</p>
-
-<div class="code">
-<pre>
-%insert(m3rawintf) %{
-IMPORT M3toC;
-%}
-</pre></div>
-
-
-<H3><a name="Modula3_exceptions">31.4.5 Exceptions</a></H3>
-
-
-<p>
-Modula-3 provides another possibility
-of an output of a function: exceptions.
-</p>
-
-<p>
-Any piece of Modula-3 code that SWIG inserts
-due to a typemap can raise an exception.
-This way you can also convert an error code
-from a C function into a Modula-3 exception.
-</p>
-
-<p>
-The <tt>RAISES</tt> clause is controlled
-by typemaps with the <tt>throws</tt> extension.
-If the typemap <tt>m3wrapinconv</tt> for <tt>blah *</tt>
-contains code that may raise the exceptions <tt>OSError.E</tt>
-you should declare
-<tt>%typemap("m3wrapinconv:throws") blah * %{OSError.E%}</tt>.
-</p>
-
-<H3><a name="Modula3_typemap_example">31.4.6 Example</a></H3>
-
-
-<p>
-The generation of wrappers in Modula-3 needs very fine control
-to take advantage of the language features.
-Here is an example of a generated wrapper
-where almost everything is generated by a typemap:
-</p>
-
-<div class="code"><pre>
-<I> (* %relabel m3wrapinmode m3wrapinname m3wrapintype m3wrapindefault *)</I>
- PROCEDURE Name (READONLY str : TEXT := "" )
-<I> (* m3wrapoutcheck:throws *)</I>
- : NameResult RAISES {E} =
- CONST
- arg1name = "str"; <I>(* m3wrapargconst *)</I>
- VAR
- arg0 : C.char_star; <I>(* m3wrapretvar *)</I>
- arg1 : C.char_star; <I>(* m3wrapargvar *)</I>
- arg2 : C.int;
- result : RECORD
-<I> (*m3wrapretname m3wraprettype*)</I>
- unixPath : TEXT;
-<I> (*m3wrapoutname m3wrapouttype*)</I>
- checksum : CARDINAL;
- END;
- BEGIN
- TRY
- arg1 := M3toC.SharedTtoS(str); <I>(* m3wrapinconv *)</I>
- IF Text.Length(arg1) > 10 THEN <I>(* m3wrapincheck *)</I>
- RAISE E("str too long");
- END;
-<I> (* m3wrapretraw m3wrapargraw *)</I>
- arg0 := MessyToUnix (arg1, arg2);
- result.unixPath := M3toC.CopyStoT(arg0); <I>(* m3wrapretconv *)</I>
- result.checksum := arg2; <I>(* m3wrapoutconv *)</I>
- IF result.checksum = 0 THEN <I>(* m3wrapoutcheck *)</I>
- RAISE E("invalid checksum");
- END;
- FINALLY
- M3toC.FreeSharedS(str, arg1); <I>(* m3wrapfreearg *)</I>
- END;
- END Name;
-</pre></div>
-
-
-<H2><a name="Modula3_hints">31.5 More hints to the generator</a></H2>
-
-
-<H3><a name="Modula3_features">31.5.1 Features</a></H3>
-
-
-<table border summary="Modula-3 features">
-<tr>
- <th>Feature</th>
- <th>Example</th>
- <th>Description</th>
-</tr>
-<tr>
- <td>multiretval</td>
- <td><tt>%m3multiretval get_box;</tt> or
- <tt>%feature("modula3:multiretval") get_box;</tt></td>
- <td>Let the denoted function return a <tt>RECORD</tt>
- rather than a plain value.
- This <tt>RECORD</tt> contains all arguments with "out" direction
- including the return value of the C function (if there is one).
- If more than one argument is "out"
- then the function <b>must</b> have the <tt>multiretval</tt> feature activated,
- but it is explicitly requested from the user to prevent mistakes.</td>
-</tr>
-<tr>
- <td>constnumeric</td>
- <td><tt>%constnumeric(12) twelve;</tt> or
- <tt>%feature("constnumeric", "12") twelve;</tt></td>
- <td>This feature can be used to tell Modula-3's back-end of SWIG
- the value of an identifier.
- This is necessary in the cases
- where it was defined by a non-trivial C expression.
- This feature is used by the
- <tt>-generateconst</tt> <a href="#Modula3_commandline">option</a>.
- In future it may be generalized to other kind of values
- such as strings.
- </td>
-</tr>
-</table>
-
-<H3><a name="Modula3_pragmas">31.5.2 Pragmas</a></H3>
-
-
-<table border summary="Modula-3 pragmas">
-<tr>
- <th>Pragma</th>
- <th>Example</th>
- <th>Description</th>
-</tr>
-<tr>
- <td>unsafe</td>
- <td><tt>%pragma(modula3) unsafe="true";</tt></td>
- <td>Mark the raw interface modules as <tt>UNSAFE</tt>.
- This will be necessary in many cases.</td>
-</tr>
-<tr>
- <td>library</td>
- <td><tt>%pragma(modula3) library="m3fftw";</tt></td>
- <td>Specifies the library name for the wrapper library to be created.
- It should be distinct from the name of the library to be wrapped.</td>
-</tr>
-</table>
-
-<H2><a name="Modula3_remarks">31.6 Remarks</a></H2>
-
-
-<ul>
-<li>
-The Modula-3 part of SWIG doesn't try to generate nicely formatted code.
-If you need to read the generated code, use <tt>m3pp</tt> to postprocess the
-Modula files.
-</li>
-</ul>
-
-</body>
-</html>
diff --git a/Doc/Manual/Pike.html b/Doc/Manual/Pike.html
deleted file mode 100644
index 2b84323..0000000
--- a/Doc/Manual/Pike.html
+++ /dev/null
@@ -1,246 +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 Pike</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="Pike">37 SWIG and Pike</a></H1>
-<!-- INDEX -->
-<div class="sectiontoc">
-<ul>
-<li><a href="#Pike_nn2">Preliminaries</a>
-<ul>
-<li><a href="#Pike_nn3">Running SWIG</a>
-<li><a href="#Pike_nn4">Getting the right header files</a>
-<li><a href="#Pike_nn5">Using your module</a>
-</ul>
-<li><a href="#Pike_nn6">Basic C/C++ Mapping</a>
-<ul>
-<li><a href="#Pike_nn7">Modules</a>
-<li><a href="#Pike_nn8">Functions</a>
-<li><a href="#Pike_nn9">Global variables</a>
-<li><a href="#Pike_nn10">Constants and enumerated types</a>
-<li><a href="#Pike_nn11">Constructors and Destructors</a>
-<li><a href="#Pike_nn12">Static Members</a>
-</ul>
-</ul>
-</div>
-<!-- INDEX -->
-
-
-
-<p>
-This chapter describes SWIG support for Pike. As of this writing, the
-SWIG Pike module is still under development and is not considered
-ready for prime time. The Pike module is being developed against the
-Pike 7.4.10 release and may not be compatible with previous versions
-of Pike.
-</p>
-
-<p>
-This chapter covers most SWIG features, but certain low-level details
-are covered in less depth than in earlier chapters. At the very
-least, make sure you read the "<a href="SWIG.html#SWIG">SWIG Basics</a>"
-chapter.<br>
-</p>
-
-<H2><a name="Pike_nn2">37.1 Preliminaries</a></H2>
-
-
-<H3><a name="Pike_nn3">37.1.1 Running SWIG</a></H3>
-
-
-<p>
-Suppose that you defined a SWIG module such as the following:
-</p>
-
-<div class="code">
- <pre>%module example<br><br>%{<br>#include "example.h"<br>%}<br><br>int fact(int n);<br></pre>
-</div>
-
-<p>
-To build a C extension module for Pike, run SWIG using the <tt>-pike</tt> option :
-</p>
-
-<div class="code">
- <pre>$ <b>swig -pike example.i</b><br></pre>
-</div>
-
-<p>
-If you're building a C++ extension, be sure to add the <tt>-c++</tt> option:
-</p>
-
-<div class="code">
- <pre>$ <b>swig -c++ -pike example.i</b><br></pre>
-</div>
-
-<p>
-This creates a single source file named <tt>example_wrap.c</tt> (or <tt>example_wrap.cxx</tt>, if you
-ran SWIG with the <tt>-c++</tt> option).
-The SWIG-generated source file contains the low-level wrappers that need
-to be compiled and linked with the rest of your C/C++ application to
-create an extension module.
-</p>
-
-<p>
-The name of the wrapper file is derived from the name of the input
-file. For example, if the input file is <tt>example.i</tt>, the name
-of the wrapper file is <tt>example_wrap.c</tt>. To change this, you
-can use the <tt>-o</tt> option:
-</p>
-
-<div class="code">
- <pre>$ <b>swig -pike -o pseudonym.c example.i</b><br></pre>
-</div>
-<H3><a name="Pike_nn4">37.1.2 Getting the right header files</a></H3>
-
-
-<p>
-In order to compile the C/C++ wrappers, the compiler needs to know the
-path to the Pike header files. These files are usually contained in a
-directory such as
-</p>
-
-<div class="code">
- <pre>/usr/local/pike/7.4.10/include/pike<br></pre>
-</div>
-
-<p>
-There doesn't seem to be any way to get Pike itself to reveal the
-location of these files, so you may need to hunt around for them.
-You're looking for files with the names <tt>global.h</tt>, <tt>program.h</tt>
-and so on.
-</p>
-
-<H3><a name="Pike_nn5">37.1.3 Using your module</a></H3>
-
-
-<p>
-To use your module, simply use Pike's <tt>import</tt> statement:
-</p>
-
-<div class="code"><pre>
-$ <b>pike</b>
-Pike v7.4 release 10 running Hilfe v3.5 (Incremental Pike Frontend)
-> <b>import example;</b>
-> <b>fact(4);</b>
-(1) Result: 24
-</pre></div>
-
-<H2><a name="Pike_nn6">37.2 Basic C/C++ Mapping</a></H2>
-
-
-<H3><a name="Pike_nn7">37.2.1 Modules</a></H3>
-
-
-<p>
-All of the code for a given SWIG module is wrapped into a single Pike
-module. Since the name of the shared library that implements your
-module ultimately determines the module's name (as far as Pike is
-concerned), SWIG's <tt>%module</tt> directive doesn't really have any
-significance.
-</p>
-
-<H3><a name="Pike_nn8">37.2.2 Functions</a></H3>
-
-
-<p>
-Global functions are wrapped as new Pike built-in functions. For
-example,
-</p>
-
-<div class="code"><pre>
-%module example
-
-int fact(int n);
-</pre></div>
-
-<p>
-creates a new built-in function <tt>example.fact(n)</tt> that works
-exactly as you'd expect it to:
-</p>
-
-<div class="code"><pre>
-> <b>import example;</b>
-> <b>fact(4);</b>
-(1) Result: 24
-</pre></div>
-
-<H3><a name="Pike_nn9">37.2.3 Global variables</a></H3>
-
-
-<p>
-Global variables are currently wrapped as a pair of functions, one to get
-the current value of the variable and another to set it. For example, the
-declaration
-</p>
-
-<div class="code"><pre>
-%module example
-
-double Foo;
-</pre></div>
-
-<p>
-will result in two functions, <tt>Foo_get()</tt> and <tt>Foo_set()</tt>:
-</p>
-
-<div class="code"><pre>
-> <b>import example;</b>
-> <b>Foo_get();</b>
-(1) Result: 3.000000
-> <b>Foo_set(3.14159);</b>
-(2) Result: 0
-> <b>Foo_get();</b>
-(3) Result: 3.141590
-</pre></div>
-
-<H3><a name="Pike_nn10">37.2.4 Constants and enumerated types</a></H3>
-
-
-<p>
-Enumerated types in C/C++ declarations are wrapped as Pike constants,
-not as Pike enums.
-</p>
-
-<H3><a name="Pike_nn11">37.2.5 Constructors and Destructors</a></H3>
-
-
-<p>
-Constructors are wrapped as <tt>create()</tt> methods, and destructors are
-wrapped as <tt>destroy()</tt> methods, for Pike classes.
-</p>
-
-<H3><a name="Pike_nn12">37.2.6 Static Members</a></H3>
-
-
-<p>
-Since Pike doesn't support static methods or data for Pike classes, static
-member functions in your C++ classes are wrapped as regular functions and
-static member variables are wrapped as pairs of functions (one to get the
-value of the static member variable, and another to set it). The names of
-these functions are prepended with the name of the class.
-For example, given this C++ class declaration:
-</p>
-
-<div class="code"><pre>
-class Shape
-{
-public:
- static void print();
- static int nshapes;
-};
-</pre></div>
-
-<p>
-SWIG will generate a <tt>Shape_print()</tt> method that invokes the static
-<tt>Shape::print()</tt> member function, as well as a pair of methods,
-<tt>Shape_nshapes_get()</tt> and <tt>Shape_nshapes_set()</tt>, to get and set
-the value of <tt>Shape::nshapes</tt>.
-</p>
-
-</body>
-</html>
diff --git a/Examples/Makefile.in b/Examples/Makefile.in
index 16973c9..eeb7a25 100644
--- a/Examples/Makefile.in
+++ b/Examples/Makefile.in
@@ -1251,46 +1251,6 @@
rm -f *.@OBJEXT@ *$(LUA_SO)
##################################################################
-##### ALLEGRO CL ######
-##################################################################
-
-ALLEGROCL = @ALLEGROCLBIN@
-ALLEGROCL_SCRIPT=$(RUNME).lisp
-
-allegrocl: $(SRCDIR_SRCS)
- $(SWIG) -allegrocl -cwrap $(SWIGOPT) -o $(ISRCS) $(INTERFACEPATH)
- $(CC) -c $(CCSHARED) $(CPPFLAGS) $(CFLAGS) $(ISRCS) $(INCLUDES) $(SRCDIR_SRCS)
- $(LDSHARED) $(CFLAGS) $(LDFLAGS) $(OBJS) $(IOBJS) $(LIBS) -o $(LIBPREFIX)$(TARGET)$(SO)
-
-allegrocl_cpp: $(SRCDIR_SRCS)
- $(SWIG) -c++ -allegrocl $(SWIGOPT) -o $(ICXXSRCS) $(INTERFACEPATH)
- $(CXX) -c $(CCSHARED) $(CPPFLAGS) $(CXXFLAGS) $(ICXXSRCS) $(SRCDIR_SRCS) $(SRCDIR_CXXSRCS) $(INCLUDES)
- $(CXXSHARED) $(CXXFLAGS) $(LDFLAGS) $(OBJS) $(IOBJS) $(LIBS) $(CPP_DLLIBS) -o $(LIBPREFIX)$(TARGET)$(SO)
-
-# -----------------------------------------------------------------
-# Run ALLEGRO CL example
-# -----------------------------------------------------------------
-
-allegrocl_run:
- $(RUNTOOL) $(ALLEGROCL) -batch -s $(ALLEGROCL_SCRIPT) $(RUNPIPE)
-
-# -----------------------------------------------------------------
-# Version display
-# -----------------------------------------------------------------
-
-allegrocl_version:
- $(ALLEGROCL) --version
-
-# -----------------------------------------------------------------
-# Cleaning the ALLEGRO CL examples
-# -----------------------------------------------------------------
-
-allegrocl_clean:
- rm -f *_wrap* *~ .~*
- rm -f core @EXTRA_CLEAN@
- rm -f *.@OBJEXT@ *@SO@
-
-##################################################################
##### CFFI ######
##################################################################
diff --git a/Examples/chicken/README b/Examples/chicken/README
deleted file mode 100644
index d4f91ba..0000000
--- a/Examples/chicken/README
+++ /dev/null
@@ -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.
diff --git a/Examples/chicken/check.list b/Examples/chicken/check.list
deleted file mode 100644
index 9ea022b..0000000
--- a/Examples/chicken/check.list
+++ /dev/null
@@ -1,6 +0,0 @@
-# see top-level Makefile.in
-class
-constants
-multimap
-overload
-simple
diff --git a/Examples/chicken/class/Makefile b/Examples/chicken/class/Makefile
deleted file mode 100644
index ea2d8b6..0000000
--- a/Examples/chicken/class/Makefile
+++ /dev/null
@@ -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)
diff --git a/Examples/chicken/class/example.cxx b/Examples/chicken/class/example.cxx
deleted file mode 100644
index 0463045..0000000
--- a/Examples/chicken/class/example.cxx
+++ /dev/null
@@ -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;
-}
diff --git a/Examples/chicken/class/example.h b/Examples/chicken/class/example.h
deleted file mode 100644
index 5bad316..0000000
--- a/Examples/chicken/class/example.h
+++ /dev/null
@@ -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();
-};
diff --git a/Examples/chicken/class/example.i b/Examples/chicken/class/example.i
deleted file mode 100644
index fbdf724..0000000
--- a/Examples/chicken/class/example.i
+++ /dev/null
@@ -1,9 +0,0 @@
-/* File : example.i */
-%module example
-
-%{
-#include "example.h"
-%}
-
-/* Let's just grab the original header file here */
-%include "example.h"
diff --git a/Examples/chicken/class/runme-lowlevel.scm b/Examples/chicken/class/runme-lowlevel.scm
deleted file mode 100644
index 7c59c0a..0000000
--- a/Examples/chicken/class/runme-lowlevel.scm
+++ /dev/null
@@ -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)
diff --git a/Examples/chicken/class/runme-tinyclos.scm b/Examples/chicken/class/runme-tinyclos.scm
deleted file mode 100644
index 5ba1d6a..0000000
--- a/Examples/chicken/class/runme-tinyclos.scm
+++ /dev/null
@@ -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)
diff --git a/Examples/chicken/constants/Makefile b/Examples/chicken/constants/Makefile
deleted file mode 100644
index 2fdde0a..0000000
--- a/Examples/chicken/constants/Makefile
+++ /dev/null
@@ -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)
diff --git a/Examples/chicken/constants/example.i b/Examples/chicken/constants/example.i
deleted file mode 100644
index 0995c19..0000000
--- a/Examples/chicken/constants/example.i
+++ /dev/null
@@ -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;
diff --git a/Examples/chicken/constants/runme.scm b/Examples/chicken/constants/runme.scm
deleted file mode 100644
index 1b10b26..0000000
--- a/Examples/chicken/constants/runme.scm
+++ /dev/null
@@ -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)
diff --git a/Examples/chicken/egg/Makefile b/Examples/chicken/egg/Makefile
deleted file mode 100644
index 0137dc0..0000000
--- a/Examples/chicken/egg/Makefile
+++ /dev/null
@@ -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
diff --git a/Examples/chicken/egg/README b/Examples/chicken/egg/README
deleted file mode 100644
index b5df0e6..0000000
--- a/Examples/chicken/egg/README
+++ /dev/null
@@ -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.
diff --git a/Examples/chicken/egg/mod1.i b/Examples/chicken/egg/mod1.i
deleted file mode 100644
index 6a2940b..0000000
--- a/Examples/chicken/egg/mod1.i
+++ /dev/null
@@ -1,8 +0,0 @@
-%module mod1
-
-%inline %{
-class Bar {
- public:
- int b;
-};
-%}
diff --git a/Examples/chicken/egg/mod2.i b/Examples/chicken/egg/mod2.i
deleted file mode 100644
index e9ae4a6..0000000
--- a/Examples/chicken/egg/mod2.i
+++ /dev/null
@@ -1,17 +0,0 @@
-%module mod2
-
-%import "mod1.i"
-
-%{
-class Bar {
- public:
- int b;
-};
-%}
-
-%inline %{
- class Bar2 : public Bar {
- public:
- int c;
- };
-%}
diff --git a/Examples/chicken/egg/multi.setup b/Examples/chicken/egg/multi.setup
deleted file mode 100644
index 95aeb00..0000000
--- a/Examples/chicken/egg/multi.setup
+++ /dev/null
@@ -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"))
diff --git a/Examples/chicken/egg/multi_init.scm b/Examples/chicken/egg/multi_init.scm
deleted file mode 100644
index 600491d..0000000
--- a/Examples/chicken/egg/multi_init.scm
+++ /dev/null
@@ -1,2 +0,0 @@
-(declare (uses mod1))
-(declare (uses mod2))
diff --git a/Examples/chicken/egg/single.i b/Examples/chicken/egg/single.i
deleted file mode 100644
index 46266b4..0000000
--- a/Examples/chicken/egg/single.i
+++ /dev/null
@@ -1,8 +0,0 @@
-%module single
-
-%inline %{
-class Foo {
- public:
- int a;
-};
-%}
diff --git a/Examples/chicken/egg/single.setup b/Examples/chicken/egg/single.setup
deleted file mode 100644
index 4b503ec..0000000
--- a/Examples/chicken/egg/single.setup
+++ /dev/null
@@ -1,2 +0,0 @@
-(run (csc -s -o single.so single.scm single_wrap.cxx))
-(install-extension 'single '("single.so"))
diff --git a/Examples/chicken/egg/test.scm b/Examples/chicken/egg/test.scm
deleted file mode 100644
index 4ec94ed..0000000
--- a/Examples/chicken/egg/test.scm
+++ /dev/null
@@ -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)
diff --git a/Examples/chicken/multimap/Makefile b/Examples/chicken/multimap/Makefile
deleted file mode 100644
index 551d1c7..0000000
--- a/Examples/chicken/multimap/Makefile
+++ /dev/null
@@ -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)
diff --git a/Examples/chicken/multimap/example.c b/Examples/chicken/multimap/example.c
deleted file mode 100644
index b8360fa..0000000
--- a/Examples/chicken/multimap/example.c
+++ /dev/null
@@ -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);
- }
-}
diff --git a/Examples/chicken/multimap/example.i b/Examples/chicken/multimap/example.i
deleted file mode 100644
index 02567f4..0000000
--- a/Examples/chicken/multimap/example.i
+++ /dev/null
@@ -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;
-};
-%}
diff --git a/Examples/chicken/multimap/runme.scm b/Examples/chicken/multimap/runme.scm
deleted file mode 100644
index ebe6440..0000000
--- a/Examples/chicken/multimap/runme.scm
+++ /dev/null
@@ -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)
diff --git a/Examples/chicken/overload/Makefile b/Examples/chicken/overload/Makefile
deleted file mode 100644
index 0193901..0000000
--- a/Examples/chicken/overload/Makefile
+++ /dev/null
@@ -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)
diff --git a/Examples/chicken/overload/README b/Examples/chicken/overload/README
deleted file mode 100644
index 9487c3f..0000000
--- a/Examples/chicken/overload/README
+++ /dev/null
@@ -1,2 +0,0 @@
-Overloading example from Chapter 5.14 of SWIG Core Documentation for
-version 1.3.
diff --git a/Examples/chicken/overload/example.cxx b/Examples/chicken/overload/example.cxx
deleted file mode 100644
index 65e7439..0000000
--- a/Examples/chicken/overload/example.cxx
+++ /dev/null
@@ -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);
-}
diff --git a/Examples/chicken/overload/example.h b/Examples/chicken/overload/example.h
deleted file mode 100644
index 1c135d5..0000000
--- a/Examples/chicken/overload/example.h
+++ /dev/null
@@ -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);
-};
diff --git a/Examples/chicken/overload/example.i b/Examples/chicken/overload/example.i
deleted file mode 100644
index 23a2998..0000000
--- a/Examples/chicken/overload/example.i
+++ /dev/null
@@ -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"
-
diff --git a/Examples/chicken/overload/runme.scm b/Examples/chicken/overload/runme.scm
deleted file mode 100644
index 168490f..0000000
--- a/Examples/chicken/overload/runme.scm
+++ /dev/null
@@ -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)
diff --git a/Examples/chicken/simple/Makefile b/Examples/chicken/simple/Makefile
deleted file mode 100644
index f5dd1a9..0000000
--- a/Examples/chicken/simple/Makefile
+++ /dev/null
@@ -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)
diff --git a/Examples/chicken/simple/README b/Examples/chicken/simple/README
deleted file mode 100644
index 07e8da0..0000000
--- a/Examples/chicken/simple/README
+++ /dev/null
@@ -1 +0,0 @@
-Simple example from users manual.
diff --git a/Examples/chicken/simple/example.c b/Examples/chicken/simple/example.c
deleted file mode 100644
index f2b0747..0000000
--- a/Examples/chicken/simple/example.c
+++ /dev/null
@@ -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(<ime);
- return ctime(<ime);
-}
diff --git a/Examples/chicken/simple/example.i b/Examples/chicken/simple/example.i
deleted file mode 100644
index 5b3e955..0000000
--- a/Examples/chicken/simple/example.i
+++ /dev/null
@@ -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();
-%}
diff --git a/Examples/chicken/simple/runme.scm b/Examples/chicken/simple/runme.scm
deleted file mode 100644
index 05aa870..0000000
--- a/Examples/chicken/simple/runme.scm
+++ /dev/null
@@ -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)
diff --git a/Examples/modula3/check.list b/Examples/modula3/check.list
deleted file mode 100644
index 37ac8c1..0000000
--- a/Examples/modula3/check.list
+++ /dev/null
@@ -1,7 +0,0 @@
-# see top-level Makefile.in
-class
-enum
-exception
-reference
-simple
-typemap
diff --git a/Examples/modula3/class/Makefile b/Examples/modula3/class/Makefile
deleted file mode 100644
index b25f636..0000000
--- a/Examples/modula3/class/Makefile
+++ /dev/null
@@ -1,26 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-SRCS =
-TARGET = example
-PLATFORM = LINUXLIBC6
-INTERFACE = example.i
-SWIGOPT = -c++
-MODULA3SRCS = *.[im]3
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_run
-
-build:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' SRCS='$(SRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' modula3
- m3ppinplace $(MODULA3SRCS)
-# compilation of example_wrap.cxx is started by cm3
-# $(CXX) -c $(TARGET)_wrap.cxx
- mv example_wrap.cxx m3makefile $(MODULA3SRCS) src/
- ln -sf ../example.h src/example.h
- cm3
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_clean
diff --git a/Examples/modula3/class/example.cxx b/Examples/modula3/class/example.cxx
deleted file mode 100644
index 0463045..0000000
--- a/Examples/modula3/class/example.cxx
+++ /dev/null
@@ -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;
-}
diff --git a/Examples/modula3/class/example.h b/Examples/modula3/class/example.h
deleted file mode 100644
index 0dff185..0000000
--- a/Examples/modula3/class/example.h
+++ /dev/null
@@ -1,34 +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;
-};
-
-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();
-};
diff --git a/Examples/modula3/class/example.i b/Examples/modula3/class/example.i
deleted file mode 100644
index 2fafadb..0000000
--- a/Examples/modula3/class/example.i
+++ /dev/null
@@ -1,32 +0,0 @@
-/* File : example.i */
-%module Example
-
-%{
-#include "example.h"
-%}
-
-%insert(m3makefile) %{template("../swig")
-cxx_source("example_wrap")%}
-
-%typemap(m3rawinmode) Shape *, Circle *, Square * ""
-%typemap(m3rawrettype) Shape *, Circle *, Square * "$1_basetype"
-
-%typemap(m3wrapinmode) Shape *, Circle *, Square * ""
-%typemap(m3wrapargraw) Shape *, Circle *, Square * "self.cxxObj"
-
-%typemap(m3wrapretvar) Circle *, Square * "cxxObj : ExampleRaw.$1_basetype;"
-%typemap(m3wrapretraw) Circle *, Square * "cxxObj"
-%typemap(m3wrapretconv) Circle *, Square * "NEW($1_basetype,cxxObj:=cxxObj)"
-%typemap(m3wraprettype) Circle *, Square * "$1_basetype"
-
-/* Should work with and without renaming
-%rename(M3Shape) Shape;
-%rename(M3Circle) Circle;
-%rename(M3Square) Square;
-%typemap(m3wrapintype) Shape *, Circle *, Square * "M3$1_basetype"
-%typemap(m3wraprettype) Shape *, Circle *, Square * "M3$1_basetype"
-%typemap(m3wrapretconv) Circle *, Square * "NEW(M3$1_basetype,cxxObj:=cxxObj)"
-*/
-
-/* Let's just grab the original header file here */
-%include "example.h"
diff --git a/Examples/modula3/class/swig.tmpl b/Examples/modula3/class/swig.tmpl
deleted file mode 100644
index e3e9bf1..0000000
--- a/Examples/modula3/class/swig.tmpl
+++ /dev/null
@@ -1,11 +0,0 @@
-
-readonly proc cxx_source (X) is
- local cxxfile = X&".cxx"
- local objfile = X&".o"
- %exec("echo $PWD")
- if stale(objfile,cxxfile)
- exec("cd",path(),"; g++ -I.. -c -o",objfile,cxxfile)
- end
- import_obj(X)
- %unlink_file(path()&SL&objfile)
-end
diff --git a/Examples/modula3/enum/Makefile b/Examples/modula3/enum/Makefile
deleted file mode 100644
index 2c5c9b0..0000000
--- a/Examples/modula3/enum/Makefile
+++ /dev/null
@@ -1,27 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-SRCS =
-TARGET = example
-INTERFACE = example.i
-CONSTNUMERIC = example_const
-SWIGOPT = -c++
-MODULA3SRCS = *.[im]3
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_run
-
-build:
- $(SWIGEXE) -modula3 $(SWIGOPT) -module Example -generateconst $(CONSTNUMERIC) $(TARGET).h
- $(CXX) -Wall $(CONSTNUMERIC).c -o $(CONSTNUMERIC)
- $(CONSTNUMERIC) >$(CONSTNUMERIC).i
-
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' SRCS='$(SRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' modula3
- m3ppinplace $(MODULA3SRCS)
- mv m3makefile $(MODULA3SRCS) src/
- cm3
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_clean
diff --git a/Examples/modula3/enum/example.cxx b/Examples/modula3/enum/example.cxx
deleted file mode 100644
index bd808ff..0000000
--- a/Examples/modula3/enum/example.cxx
+++ /dev/null
@@ -1,32 +0,0 @@
-/* File : example.cxx */
-
-#include "example.h"
-#include <stdio.h>
-
-void Foo::enum_test(speed s) {
- if (s == IMPULSE) {
- printf("IMPULSE speed\n");
- } else if (s == WARP) {
- printf("WARP speed\n");
- } else if (s == LUDICROUS) {
- printf("LUDICROUS speed\n");
- } else if (s == HYPER) {
- printf("HYPER speed\n");
- } else {
- printf("Unknown speed\n");
- }
-}
-
-void enum_test(color c, Foo::speed s) {
- if (c == RED) {
- printf("color = RED, ");
- } else if (c == BLUE) {
- printf("color = BLUE, ");
- } else if (c == GREEN) {
- printf("color = GREEN, ");
- } else {
- printf("color = Unknown color!, ");
- }
- Foo obj;
- obj.enum_test(s);
-}
diff --git a/Examples/modula3/enum/example.h b/Examples/modula3/enum/example.h
deleted file mode 100644
index 2f44a6c..0000000
--- a/Examples/modula3/enum/example.h
+++ /dev/null
@@ -1,83 +0,0 @@
-/* File : example.h */
-
-#define PI 3.141
-
-#define DAY_MONDAY 0
-#define DAY_TUESDAY 1
-#define DAY_WEDNESDAY 2
-#define DAY_THURSDAY 3
-#define DAY_FRIDAY 4
-#define DAY_SATURDAY 5
-#define DAY_SUNDAY 6
-
-enum color { BLUE, RED, GREEN };
-
-#define CLB_BLACK 0
-#define CLB_BLUE 1
-#define CLB_RED 2
-#define CLB_MAGENTA 3
-#define CLB_GREEN 4
-#define CLB_CYAN 5
-#define CLB_YELLOW 6
-#define CLB_WHITE 7
-
-/* Using this would be good style
- which cannot be expected for general C header files.
- Instead I want to demonstrate how to live without it.
-enum month {
- MTHF_JANUARY,
- MTHF_FEBRUARY,
- MTHF_MARCH,
- MTHF_APRIL,
- MTHF_MAY,
- MTHF_JUNE,
- MTHF_JULY,
- MTHF_AUGUST,
- MTHF_SEPTEMBER,
- MTHF_OCTOBER,
- MTHF_NOVEMBER,
- MTHF_DECEMBER,
-}
-*/
-
-/* Since there are no compile time constants in C / C++
- it is a common abuse
- to declare bit set (flag) constants
- as enumerations. */
-enum calendar {
- MTHB_JANUARY = 1 << 0, /* 1 << MTHF_JANUARY, */
- MTHB_FEBRUARY = 1 << 1, /* 1 << MTHF_FEBRUARY, */
- MTHB_MARCH = 1 << 2, /* 1 << MTHF_MARCH, */
- MTHB_APRIL = 1 << 3, /* 1 << MTHF_APRIL, */
- MTHB_MAY = 1 << 4, /* 1 << MTHF_MAY, */
- MTHB_JUNE = 1 << 5, /* 1 << MTHF_JUNE, */
- MTHB_JULY = 1 << 6, /* 1 << MTHF_JULY, */
- MTHB_AUGUST = 1 << 7, /* 1 << MTHF_AUGUST, */
- MTHB_SEPTEMBER = 1 << 8, /* 1 << MTHF_SEPTEMBER, */
- MTHB_OCTOBER = 1 << 9, /* 1 << MTHF_OCTOBER, */
- MTHB_NOVEMBER = 1 << 10, /* 1 << MTHF_NOVEMBER, */
- MTHB_DECEMBER = 1 << 11, /* 1 << MTHF_DECEMBER, */
-
- MTHB_SPRING = MTHB_MARCH | MTHB_APRIL | MTHB_MAY,
- MTHB_SUMMER = MTHB_JUNE | MTHB_JULY | MTHB_AUGUST,
- MTHB_AUTUMN = MTHB_SEPTEMBER | MTHB_OCTOBER | MTHB_NOVEMBER,
- MTHB_WINTER = MTHB_DECEMBER | MTHB_JANUARY | MTHB_FEBRUARY,
-};
-
-
-namespace Answer {
- enum {
- UNIVERSE_AND_EVERYTHING = 42,
- SEVENTEEN_AND_FOUR = 21,
- TWOHUNDRED_PERCENT_OF_NOTHING = 0,
- };
-
- class Foo {
- public:
- Foo() { }
- enum speed { IMPULSE = -2, WARP = 0, HYPER, LUDICROUS = 3};
- void enum_test(speed s);
- };
-};
-
-void enum_test(color c, Answer::Foo::speed s);
diff --git a/Examples/modula3/enum/example.i b/Examples/modula3/enum/example.i
deleted file mode 100644
index f5947b3..0000000
--- a/Examples/modula3/enum/example.i
+++ /dev/null
@@ -1,72 +0,0 @@
-/* File : example.i */
-%module Example
-
-%{
-#include "example.h"
-%}
-
-%include "example_const.i"
-
-// such features are generated by the following pragmas
-#if 0
-%feature("modula3:enumitem:enum","Days") DAY_MONDAY;
-%feature("modula3:enumitem:name","monday") DAY_MONDAY;
-%feature("modula3:enumitem:conv","int:int") DAY_MONDAY;
-
-%feature("modula3:enumitem:enum","Month") MTHB_JANUARY;
-%feature("modula3:enumitem:name","january") MTHB_JANUARY;
-%feature("modula3:enumitem:conv","set:int") MTHB_JANUARY;
-//%feature("modula3:constset:type","MonthSet") MTHB_JANUARY; /*type in the constant definition*/
-%feature("modula3:constset:set", "MonthSet") MTHB_JANUARY; /*remarks that the 'type' is a set type*/
-%feature("modula3:constset:base","Month") MTHB_JANUARY;
-%feature("modula3:constset:name","monthsJanuary") MTHB_JANUARY;
-%feature("modula3:constset:conv","set:set") MTHB_JANUARY; /*conversion of the bit pattern: no change*/
-
-%feature("modula3:enumitem:enum","Color") BLUE;
-%feature("modula3:enumitem:name","blue") BLUE;
-%feature("modula3:enumitem:conv","int:int") BLUE;
-
-%feature("modula3:constint:type","INTEGER") Foo::IMPULSE;
-%feature("modula3:constint:name","impulse") Foo::IMPULSE;
-%feature("modula3:constint:conv","int:int") Foo::IMPULSE;
-#endif
-
-%rename(pi) PI;
-
-%pragma(modula3) enumitem="prefix=DAY_;int;srcstyle=underscore;Day";
-
-%pragma(modula3) enumitem="enum=color;int;srcstyle=underscore;Color";
-%pragma(modula3) makesetofenum="Color";
-%pragma(modula3) constset="prefix=CLB_;set;srcstyle=underscore,prefix=clb;ColorSet,Color";
-
-%pragma(modula3) enumitem="prefix=MTHB_,enum=calendar;set;srcstyle=underscore;Month";
-%pragma(modula3) makesetofenum="Month";
-%pragma(modula3) constset="prefix=MTHB_,enum=calendar;set;srcstyle=underscore,prefix=monthset;MonthSet,Month";
-
-%pragma(modula3) constint="prefix=Answer::Foo::,enum=Answer::Foo::speed;int;srcstyle=underscore,prefix=speed;INTEGER";
-
-%pragma(modula3) constint="prefix=Answer::,enum=Answer::;int;srcstyle=underscore,prefix=answer;CARDINAL";
-
-%rename(AnswerFoo) Answer::Foo;
-%typemap("m3rawrettype") Answer::Foo * %{AnswerFoo%}
-%typemap("m3rawintype") Answer::Foo * %{AnswerFoo%}
-%typemap("m3rawinmode") Answer::Foo * %{%}
-%typemap("m3wraprettype") Answer::Foo * %{AnswerFoo%}
-%typemap("m3wrapintype") Answer::Foo * %{AnswerFoo%}
-%typemap("m3wrapinmode") Answer::Foo * %{%}
-%typemap("m3wrapargraw") Answer::Foo * %{self.cxxObj%}
-
-%typemap("m3wrapretvar") Answer::Foo * %{cxxObj : ExampleRaw.AnswerFoo;%}
-%typemap("m3wrapretraw") Answer::Foo * %{cxxObj%}
-%typemap("m3wrapretconv") Answer::Foo * %{NEW(AnswerFoo,cxxObj:=cxxObj)%}
-
-
-%typemap("m3rawintype") Answer::Foo::speed %{C.int%};
-%typemap("m3rawintype:import") Answer::Foo::speed %{Ctypes AS C%};
-%typemap("m3wrapintype") Answer::Foo::speed %{[-2..3]%};
-
-%typemap("m3wrapintype") color %{Color%};
-%typemap("m3wrapargraw") color %{ORD($1_name)%};
-
-/* Let's just grab the original header file here */
-%include "example.h"
diff --git a/Examples/modula3/exception/Makefile b/Examples/modula3/exception/Makefile
deleted file mode 100644
index 8d12ef1..0000000
--- a/Examples/modula3/exception/Makefile
+++ /dev/null
@@ -1,24 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-CXXSRCS = example.cxx
-TARGET = example
-INTERFACE = example.i
-SWIGOPT =
-MODULA3SRCS = *.[im]3
-MODULA3FLAGS= -o runme
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_run
-
-build:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CXXSRCS='$(CXXSRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' modula3_cpp
-# $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' MODULA3SRCS='$(MODULA3SRCS)' MODULA3FLAGS='$(MODULA3FLAGS)' modula3_compile
- m3ppinplace $(MODULA3SRCS)
- mv m3makefile $(MODULA3SRCS) src/
- cm3
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_clean
diff --git a/Examples/modula3/exception/example.h b/Examples/modula3/exception/example.h
deleted file mode 100644
index 0e9e0e8..0000000
--- a/Examples/modula3/exception/example.h
+++ /dev/null
@@ -1,18 +0,0 @@
-/* File : example.h */
-
-enum error {OK, OVERFLOW, DIVISION_BY_ZERO, NEGATIVE_RADICAND, NEGATIVE_BASE};
-typedef error errorstate; /* just to separate the typemaps */
-
-error acc_add (double &x, double y);
-error acc_sub (double &x, double y);
-error acc_mul (double &x, double y);
-error acc_div (double &x, double y);
-
-double op_add (double x, double y, errorstate &err);
-double op_sub (double x, double y, errorstate &err);
-double op_mul (double x, double y, errorstate &err);
-double op_div (double x, double y, errorstate &err);
-double op_sqrt (double x, errorstate &err);
-double op_pow (double x, double y, errorstate &err);
-
-double op_noexc (double x, double y);
diff --git a/Examples/modula3/exception/example.i b/Examples/modula3/exception/example.i
deleted file mode 100644
index 92a716f..0000000
--- a/Examples/modula3/exception/example.i
+++ /dev/null
@@ -1,43 +0,0 @@
-/* File : example.i */
-%module Example
-
-%{
-#include "example.h"
-%}
-
-%insert(m3wrapintf) %{
-EXCEPTION E(Error);
-%}
-%insert(m3wrapimpl) %{
-IMPORT Ctypes AS C;
-%}
-
-%pragma(modula3) enumitem="enum=error;int;srcstyle=underscore;Error";
-
-%typemap("m3rawintype") double & %{C.double%};
-%typemap("m3wrapintype") double & %{LONGREAL%};
-
-%typemap("m3wraprettype") error ""
-%typemap("m3wrapretvar") error "rawerr: C.int;"
-%typemap("m3wrapretraw") error "rawerr"
-%typemap("m3wrapretcheck:throws") error "E"
-%typemap("m3wrapretcheck") error
-%{VAR err := VAL(rawerr, Error);
-BEGIN
-IF err # Error.ok THEN
-RAISE E(err);
-END;
-END;%}
-
-%typemap("m3rawintype") errorstate & %{C.int%};
-%typemap("m3wrapintype",numinputs=0) errorstate & %{%};
-%typemap("m3wrapargvar") errorstate & %{err:C.int:=ORD(Error.ok);%};
-%typemap("m3wrapoutcheck:throws") errorstate & "E";
-%typemap("m3wrapoutcheck") errorstate &
-%{IF VAL(err,Error) # Error.ok THEN
-RAISE E(VAL(err,Error));
-END;%}
-
-/* Let's just grab the original header file here */
-
-%include "example.h"
diff --git a/Examples/modula3/reference/Makefile b/Examples/modula3/reference/Makefile
deleted file mode 100644
index eaceceb..0000000
--- a/Examples/modula3/reference/Makefile
+++ /dev/null
@@ -1,22 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-SRCS =
-TARGET = example
-INTERFACE = example.i
-SWIGOPT = -c++
-MODULA3SRCS = *.[im]3
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_run
-
-build:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' SRCS='$(SRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' modula3
- m3ppinplace $(MODULA3SRCS)
- mv m3makefile $(MODULA3SRCS) src/
- cm3
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_clean
diff --git a/Examples/modula3/reference/example.cxx b/Examples/modula3/reference/example.cxx
deleted file mode 100644
index 9dbaed2..0000000
--- a/Examples/modula3/reference/example.cxx
+++ /dev/null
@@ -1,46 +0,0 @@
-/* File : example.cxx */
-
-/* Deal with Microsoft's attempt at deprecating C standard runtime functions */
-#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER)
-# define _CRT_SECURE_NO_DEPRECATE
-#endif
-
-#include "example.h"
-#include <stdio.h>
-#include <stdlib.h>
-
-Vector operator+(const Vector &a, const Vector &b) {
- Vector r;
- r.x = a.x + b.x;
- r.y = a.y + b.y;
- r.z = a.z + b.z;
- return r;
-}
-
-char *Vector::print() {
- static char temp[512];
- sprintf(temp,"Vector %p (%g,%g,%g)", (void *)this, x,y,z);
- return temp;
-}
-
-VectorArray::VectorArray(int size) {
- items = new Vector[size];
- maxsize = size;
-}
-
-VectorArray::~VectorArray() {
- delete [] items;
-}
-
-Vector &VectorArray::operator[](int index) {
- if ((index < 0) || (index >= maxsize)) {
- printf("Panic! Array index out of bounds.\n");
- exit(1);
- }
- return items[index];
-}
-
-int VectorArray::size() {
- return maxsize;
-}
-
diff --git a/Examples/modula3/reference/example.h b/Examples/modula3/reference/example.h
deleted file mode 100644
index 7b4ba8f..0000000
--- a/Examples/modula3/reference/example.h
+++ /dev/null
@@ -1,22 +0,0 @@
-/* File : example.h */
-
-struct Vector {
-private:
- double x,y,z;
-public:
- Vector() : x(0), y(0), z(0) { }
- Vector(double x, double y, double z) : x(x), y(y), z(z) { }
- Vector operator+(const Vector &b) const;
- char *print();
-};
-
-struct VectorArray {
-private:
- Vector *items;
- int maxsize;
-public:
- VectorArray(int maxsize);
- ~VectorArray();
- Vector &operator[](int);
- int size();
-};
diff --git a/Examples/modula3/reference/example.i b/Examples/modula3/reference/example.i
deleted file mode 100644
index 0020909..0000000
--- a/Examples/modula3/reference/example.i
+++ /dev/null
@@ -1,32 +0,0 @@
-/* File : example.i */
-
-/* This file has a few "typical" uses of C++ references. */
-
-%module Example
-
-%{
-#include "example.h"
-%}
-
-%pragma(modula3) unsafe="1";
-
-%insert(m3wrapintf) %{FROM ExampleRaw IMPORT Vector, VectorArray;%}
-%insert(m3wrapimpl) %{FROM ExampleRaw IMPORT Vector, VectorArray;%}
-
-%typemap(m3wrapretvar) Vector %{vec: UNTRACED REF Vector;%}
-%typemap(m3wrapretraw) Vector %{vec%}
-%typemap(m3wrapretconv) Vector %{vec^%}
-
-
-/* This helper function calls an overloaded operator */
-%inline %{
-Vector addv(const Vector &a, const Vector &b) {
- return a+b;
-}
-%}
-
-%rename(Vector_Clear) Vector::Vector();
-%rename(Add) Vector::operator+;
-%rename(GetItem) VectorArray::operator[];
-
-%include "example.h"
diff --git a/Examples/modula3/simple/Makefile b/Examples/modula3/simple/Makefile
deleted file mode 100644
index 3ba35d1..0000000
--- a/Examples/modula3/simple/Makefile
+++ /dev/null
@@ -1,22 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-SRCS =
-TARGET = example
-INTERFACE = example.i
-SWIGOPT =
-MODULA3SRCS = *.[im]3
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_run
-
-build:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' SRCS='$(SRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' modula3
- m3ppinplace $(MODULA3SRCS)
- mv m3makefile $(MODULA3SRCS) src/
- cm3
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_clean
diff --git a/Examples/modula3/simple/example.c b/Examples/modula3/simple/example.c
deleted file mode 100644
index 1c2af78..0000000
--- a/Examples/modula3/simple/example.c
+++ /dev/null
@@ -1,18 +0,0 @@
-/* File : example.c */
-
-/* A global variable */
-double Foo = 3.0;
-
-/* 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;
-}
-
-
diff --git a/Examples/modula3/simple/example.i b/Examples/modula3/simple/example.i
deleted file mode 100644
index 1694e6d..0000000
--- a/Examples/modula3/simple/example.i
+++ /dev/null
@@ -1,7 +0,0 @@
-/* File : example.i */
-%module Example
-
-%inline %{
-extern int gcd(int x, int y);
-extern double Foo;
-%}
diff --git a/Examples/modula3/typemap/Makefile b/Examples/modula3/typemap/Makefile
deleted file mode 100644
index 3ba35d1..0000000
--- a/Examples/modula3/typemap/Makefile
+++ /dev/null
@@ -1,22 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-SRCS =
-TARGET = example
-INTERFACE = example.i
-SWIGOPT =
-MODULA3SRCS = *.[im]3
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_run
-
-build:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' SRCS='$(SRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' modula3
- m3ppinplace $(MODULA3SRCS)
- mv m3makefile $(MODULA3SRCS) src/
- cm3
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' modula3_clean
diff --git a/Examples/modula3/typemap/example.i b/Examples/modula3/typemap/example.i
deleted file mode 100644
index 2f454ef..0000000
--- a/Examples/modula3/typemap/example.i
+++ /dev/null
@@ -1,90 +0,0 @@
-/* File : example.i */
-%module Example
-
-%pragma(modula3) unsafe="true";
-
-%insert(m3wrapintf) %{FROM ExampleRaw IMPORT Window, Point;
-%}
-%insert(m3wrapimpl) %{FROM ExampleRaw IMPORT Window, Point;
-IMPORT M3toC;
-IMPORT Ctypes AS C;
-%}
-
-/* Typemap applied to patterns of multiple arguments */
-
-%typemap(m3rawinmode) (char *outstr) %{VAR%}
-%typemap(m3rawintype) (char *outstr) %{CHAR%}
-%typemap(m3wrapinmode) (char *outstr, int size) %{VAR%}
-%typemap(m3wrapintype) (char *outstr, int size) %{ARRAY OF CHAR%}
-%typemap(m3wrapargraw) (char *outstr, int size) %{$1_name[0], NUMBER($1_name)%}
-
-
-%typemap(m3rawinmode) (const struct Window *) %{READONLY%}
-%typemap(m3wrapinmode) (const struct Window *) %{READONLY%}
-%typemap(m3rawintype) ( struct Window *) %{Window%}
-%typemap(m3wrapintype) ( struct Window *) %{Window%}
-
-%typemap(m3rawinmode) (const char *str []) %{READONLY%}
-%typemap(m3wrapinmode) (const char *str []) %{READONLY%}
-%typemap(m3rawintype) (const char *str []) %{(*ARRAY OF*) C.char_star%}
-%typemap(m3wrapintype) (const char *str []) %{ARRAY OF TEXT%}
-%typemap(m3wrapargvar) (const char *str []) %{$1: REF ARRAY OF C.char_star;%}
-%typemap(m3wrapargraw) (const char *str []) %{$1[0]%}
-%typemap(m3wrapinconv) (const char *str []) %{$1:= NEW(REF ARRAY OF C.char_star,NUMBER($1_name));
-FOR i:=FIRST($1_name) TO LAST($1_name) DO
-$1[i]:=M3toC.SharedTtoS($1_name[i]);
-END;%}
-%typemap(m3wrapfreearg) (const char *str [])
-%{FOR i:=FIRST($1_name) TO LAST($1_name) DO
-M3toC.FreeSharedS($1_name[i],$1[i]);
-END;%}
-
-%typemap(m3wraprettype) char * %{TEXT%}
-%typemap(m3wrapretvar) char * %{result_string: C.char_star;%}
-%typemap(m3wrapretraw) char * %{result_string%}
-%typemap(m3wrapretconv) char * %{M3toC.CopyStoT(result_string)%}
-
-struct Window {
- char *label;
- int left,top,width,height;
-};
-
-
-%typemap(m3wrapinname) (int x, int y) %{p%}
-%typemap(m3wrapinmode) (int x, int y) %{READONLY%}
-%typemap(m3wrapintype) (int x, int y) %{Point%}
-%typemap(m3wrapargraw) (int x, int y) %{p.$1_name, p.$2_name%}
-
-%typemap(m3wrapargraw) (int &x, int &y) %{p.$1_name, p.$2_name%}
-%typemap(m3wrapintype) (int &x, int &y) %{Point%}
-%typemap(m3wrapoutname) (int &x, int &y) %{p%}
-%typemap(m3wrapouttype) (int &x, int &y) %{Point%}
-%typemap(m3wrapargdir) (int &x, int &y) "out"
-
-
-%typemap(m3wrapargvar) int &left, int &top, int &width, int &height "$1:C.int;"
-%typemap(m3wrapargraw) int &left, int &top, int &width, int &height "$1"
-%typemap(m3wrapoutconv) int &left, int &top, int &width, int &height "$1"
-
-%typemap(m3wrapargdir) int &left, int &top "out"
-
-%typemap(m3wrapouttype) int &width, int &height "CARDINAL"
-%typemap(m3wrapargdir) int &width, int &height "out"
-
-struct Point {
- int x,y;
-};
-
-%m3multiretval get_box;
-
-void set_label ( struct Window *win, const char *str, bool activate);
-void set_multi_label ( struct Window *win, const char *str []);
-void write_label (const struct Window *win, char *outstr, int size);
-int get_label (const struct Window *win, char *outstr, int size);
-char *get_label_ptr (const struct Window *win);
-void move(struct Window *win, int x, int y);
-int get_area(const struct Window *win);
-void get_box(const struct Window *win, int &left, int &top, int &width, int &height);
-void get_left(const struct Window *win, int &left);
-void get_mouse(const struct Window *win, int &x, int &y);
-int get_attached_data(const struct Window *win, const char *id);
diff --git a/Examples/ocaml/shapes/example.i b/Examples/ocaml/shapes/example.i
index ac0fa4a..a261b92 100644
--- a/Examples/ocaml/shapes/example.i
+++ b/Examples/ocaml/shapes/example.i
@@ -1,10 +1,8 @@
/* File : example.i */
%module(directors="1") example
-#ifndef SWIGSEXP
%{
#include "example.h"
%}
-#endif
%feature("director");
%include "example.h"
diff --git a/Examples/pike/check.list b/Examples/pike/check.list
deleted file mode 100644
index d6c8e2e..0000000
--- a/Examples/pike/check.list
+++ /dev/null
@@ -1,7 +0,0 @@
-# see top-level Makefile.in
-class
-constants
-enum
-overload
-simple
-template
diff --git a/Examples/pike/class/Makefile b/Examples/pike/class/Makefile
deleted file mode 100644
index e5319db..0000000
--- a/Examples/pike/class/Makefile
+++ /dev/null
@@ -1,23 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-CXXSRCS = example.cxx
-TARGET = example
-INTERFACE = example.i
-LIBS = -lm
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_run
-
-build:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CXXSRCS='$(CXXSRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' pike_cpp
-
-static:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CXXSRCS='$(CXXSRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- TARGET='mypike' INTERFACE='$(INTERFACE)' pike_cpp_static
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_clean
diff --git a/Examples/pike/class/example.cxx b/Examples/pike/class/example.cxx
deleted file mode 100644
index 0463045..0000000
--- a/Examples/pike/class/example.cxx
+++ /dev/null
@@ -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;
-}
diff --git a/Examples/pike/class/example.h b/Examples/pike/class/example.h
deleted file mode 100644
index 0dff185..0000000
--- a/Examples/pike/class/example.h
+++ /dev/null
@@ -1,34 +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;
-};
-
-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();
-};
diff --git a/Examples/pike/class/example.i b/Examples/pike/class/example.i
deleted file mode 100644
index fbdf724..0000000
--- a/Examples/pike/class/example.i
+++ /dev/null
@@ -1,9 +0,0 @@
-/* File : example.i */
-%module example
-
-%{
-#include "example.h"
-%}
-
-/* Let's just grab the original header file here */
-%include "example.h"
diff --git a/Examples/pike/class/runme.pike b/Examples/pike/class/runme.pike
deleted file mode 100644
index a637760..0000000
--- a/Examples/pike/class/runme.pike
+++ /dev/null
@@ -1,53 +0,0 @@
-import .example;
-
-int main()
-{
- // ----- Object creation -----
-
- write("Creating some objects:\n");
- Circle c = Circle(10.0);
- write(" Created circle.\n");
- Square s = Square(10.0);
- write(" Created square.\n");
-
- // ----- Access a static member -----
-
- write("\nA total of " + Shape_nshapes_get() + " shapes were created\n");
-
- // ----- Member data access -----
-
- // Set the location of the object
-
- c->x_set(20.0);
- c->y_set(30.0);
-
- s->x_set(-10.0);
- s->y_set(5.0);
-
- write("\nHere is their current position:\n");
- write(" Circle = (%f, %f)\n", c->x_get(), c->y_get());
- write(" Square = (%f, %f)\n", s->x_get(), s->y_get());
-
- // ----- Call some methods -----
-
- write("\nHere are some properties of the shapes:\n");
- write(" The circle:\n");
- write(" area = %f.\n", c->area());
- write(" perimeter = %f.\n", c->perimeter());
- write(" The square:\n");
- write(" area = %f.\n", s->area());
- write(" perimeter = %f.\n", s->perimeter());
-
- write("\nGuess I'll clean up now\n");
-
- /* See if we can force 's' to be garbage-collected */
- s = 0;
-
- /* Now we should be down to only 1 shape */
- write("%d shapes remain\n", Shape_nshapes_get());
-
- /* Done */
- write("Goodbye\n");
-
- return 0;
-}
diff --git a/Examples/pike/constants/Makefile b/Examples/pike/constants/Makefile
deleted file mode 100644
index 45da7d2..0000000
--- a/Examples/pike/constants/Makefile
+++ /dev/null
@@ -1,22 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-SRCS =
-TARGET = example
-INTERFACE = example.i
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_run
-
-build:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' SRCS='$(SRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' pike
-
-static:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' SRCS='$(SRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- TARGET='mypike' INTERFACE='$(INTERFACE)' pike_static
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_clean
diff --git a/Examples/pike/constants/example.i b/Examples/pike/constants/example.i
deleted file mode 100644
index 4f7b1a4..0000000
--- a/Examples/pike/constants/example.i
+++ /dev/null
@@ -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 */
-
-%constant int iconst = 37;
-%constant double fconst = 3.14;
-
-
diff --git a/Examples/pike/constants/runme.pike b/Examples/pike/constants/runme.pike
deleted file mode 100644
index a8d9f94..0000000
--- a/Examples/pike/constants/runme.pike
+++ /dev/null
@@ -1,24 +0,0 @@
-int main()
-{
- write("ICONST = %d (should be 42)\n", .example.ICONST);
- write("FCONST = %f (should be 2.1828)\n", .example.FCONST);
- write("CCONST = %c (should be 'x')\n", .example.CCONST);
- write("CCONST2 = %c (this should be on a new line)\n", .example.CCONST2);
- write("SCONST = %s (should be 'Hello World')\n", .example.SCONST);
- write("SCONST2 = %s (should be '\"Hello World\"')\n", .example.SCONST2);
- write("EXPR = %f (should be 48.5484)\n", .example.EXPR);
- write("iconst = %d (should be 37)\n", .example.iconst);
- write("fconst = %f (should be 3.14)\n", .example.fconst);
-
- if (search(indices(.example), "EXTERN") == -1)
- write("EXTERN isn't defined (good)\n");
- else
- write("EXTERN is defined (bad)\n");
-
- if (search(indices(.example), "FOO") == -1)
- write("FOO isn't defined (good)\n");
- else
- write("FOO is defined (bad)\n");
-
- return 0;
-}
diff --git a/Examples/pike/enum/Makefile b/Examples/pike/enum/Makefile
deleted file mode 100644
index e5319db..0000000
--- a/Examples/pike/enum/Makefile
+++ /dev/null
@@ -1,23 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-CXXSRCS = example.cxx
-TARGET = example
-INTERFACE = example.i
-LIBS = -lm
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_run
-
-build:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CXXSRCS='$(CXXSRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' pike_cpp
-
-static:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CXXSRCS='$(CXXSRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- TARGET='mypike' INTERFACE='$(INTERFACE)' pike_cpp_static
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_clean
diff --git a/Examples/pike/enum/README b/Examples/pike/enum/README
deleted file mode 100644
index 055aa9f..0000000
--- a/Examples/pike/enum/README
+++ /dev/null
@@ -1,13 +0,0 @@
-This example will not compile with Pike versions 7.4.20 unless you first
-patch the Pike sources. The problem is for line 91 of Pike's "stralloc.h"
-(usually installed as /usr/local/pike/7.4.10/include/pike/stralloc.h). That
-line reads:
-
- tmp.ptr=ptr;
-
-but should be patched to read:
-
- tmp.ptr=(p_wchar0 *) ptr;
-
-This bug has been reported to the Pike developers.
-
diff --git a/Examples/pike/enum/example.cxx b/Examples/pike/enum/example.cxx
deleted file mode 100644
index 6785e57..0000000
--- a/Examples/pike/enum/example.cxx
+++ /dev/null
@@ -1,37 +0,0 @@
-/* File : example.c */
-
-#include "example.h"
-#include <stdio.h>
-
-void Foo::enum_test(speed s) {
- if (s == IMPULSE) {
- printf("IMPULSE speed\n");
- } else if (s == WARP) {
- printf("WARP speed\n");
- } else if (s == LUDICROUS) {
- printf("LUDICROUS speed\n");
- } else {
- printf("Unknown speed\n");
- }
-}
-
-void enum_test(color c, Foo::speed s) {
- if (c == RED) {
- printf("color = RED, ");
- } else if (c == BLUE) {
- printf("color = BLUE, ");
- } else if (c == GREEN) {
- printf("color = GREEN, ");
- } else {
- printf("color = Unknown color!, ");
- }
- if (s == Foo::IMPULSE) {
- printf("speed = IMPULSE speed\n");
- } else if (s == Foo::WARP) {
- printf("speed = WARP speed\n");
- } else if (s == Foo::LUDICROUS) {
- printf("speed = LUDICROUS speed\n");
- } else {
- printf("speed = Unknown speed!\n");
- }
-}
diff --git a/Examples/pike/enum/example.h b/Examples/pike/enum/example.h
deleted file mode 100644
index 525d62a..0000000
--- a/Examples/pike/enum/example.h
+++ /dev/null
@@ -1,13 +0,0 @@
-/* File : example.h */
-
-enum color { RED, BLUE, GREEN };
-
-class Foo {
- public:
- Foo() { }
- enum speed { IMPULSE, WARP, LUDICROUS };
- void enum_test(speed s);
-};
-
-void enum_test(color c, Foo::speed s);
-
diff --git a/Examples/pike/enum/example.i b/Examples/pike/enum/example.i
deleted file mode 100644
index 23ee8a8..0000000
--- a/Examples/pike/enum/example.i
+++ /dev/null
@@ -1,11 +0,0 @@
-/* File : example.i */
-%module example
-
-%{
-#include "example.h"
-%}
-
-/* Let's just grab the original header file here */
-
-%include "example.h"
-
diff --git a/Examples/pike/enum/runme.pike b/Examples/pike/enum/runme.pike
deleted file mode 100644
index 4846356..0000000
--- a/Examples/pike/enum/runme.pike
+++ /dev/null
@@ -1,28 +0,0 @@
-int main()
-{
- write("*** color ***\n");
- write(" RED = " + .example.RED + "\n");
- write(" BLUE = " + .example.BLUE + "\n");
- write(" GREEN = " + .example.GREEN + "\n");
-
- write("\n*** Foo::speed ***\n");
- write(" Foo_IMPULSE = " + .example.Foo.IMPULSE + "\n");
- write(" Foo_WARP = " + .example.Foo.WARP + "\n");
- write(" Foo_LUDICROUS = " + .example.Foo.LUDICROUS + "\n");
-
- write("\nTesting use of enums with functions\n\n");
-
- .example.enum_test(.example.RED, .example.Foo.IMPULSE);
- .example.enum_test(.example.BLUE, .example.Foo.WARP);
- .example.enum_test(.example.GREEN, .example.Foo.LUDICROUS);
- .example.enum_test(1234, 5678);
-
- write("\nTesting use of enum with class method\n");
- .example.Foo f = .example.Foo();
-
- f->enum_test(.example.Foo.IMPULSE);
- f->enum_test(.example.Foo.WARP);
- f->enum_test(.example.Foo.LUDICROUS);
-
- return 0;
-}
diff --git a/Examples/pike/overload/Makefile b/Examples/pike/overload/Makefile
deleted file mode 100644
index 5e5fe66..0000000
--- a/Examples/pike/overload/Makefile
+++ /dev/null
@@ -1,23 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-CXXSRCS = example.cxx
-TARGET = example
-INTERFACE = example.i
-LIBS = -lstdc++ -lm
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_run
-
-build:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CXXSRCS='$(CXXSRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' pike_cpp
-
-static:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CXXSRCS='$(CXXSRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- TARGET='mypike' INTERFACE='$(INTERFACE)' pike_cpp_static
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_clean
diff --git a/Examples/pike/overload/example.cxx b/Examples/pike/overload/example.cxx
deleted file mode 100644
index 3760fdd..0000000
--- a/Examples/pike/overload/example.cxx
+++ /dev/null
@@ -1,115 +0,0 @@
-#include <iostream>
-
-#include "example.h"
-
-// Overloaded constructors for class Bar
-Bar::Bar() {
- std::cout << "Called Bar::Bar()" << std::endl;
-}
-
-Bar::Bar(const Bar&) {
- std::cout << "Called Bar::Bar(const Bar&)" << std::endl;
-}
-
-Bar::Bar(double x) {
- std::cout << "Called Bar::Bar(double) with x = " << x << std::endl;
-}
-
-Bar::Bar(double x, char *y) {
- std::cout << "Called Bar::Bar(double, char *) with x, y = " << x << ", \"" << y << "\"" << std::endl;
-}
-
-Bar::Bar(int x, int y) {
- std::cout << "Called Bar::Bar(int, int) with x, y = " << x << ", " << y << std::endl;
-}
-
-Bar::Bar(char *x) {
- std::cout << "Called Bar::Bar(char *) with x = \"" << x << "\"" << std::endl;
-}
-
-Bar::Bar(int x) {
- std::cout << "Called Bar::Bar(int) with x = " << x << std::endl;
-}
-
-Bar::Bar(long x) {
- std::cout << "Called Bar::Bar(long) with x = " << x << std::endl;
-}
-
-Bar::Bar(Bar *x) {
- std::cout << "Called Bar::Bar(Bar *) with x = " << x << std::endl;
-}
-
-// Overloaded member functions
-void Bar::foo(const Bar& x) {
- std::cout << "Called Bar::foo(const Bar&) with &x = " << &x << std::endl;
-}
-
-void Bar::foo(double x) {
- std::cout << "Called Bar::foo(double) with x = " << x << std::endl;
-}
-
-void Bar::foo(double x, char *y) {
- std::cout << "Called Bar::foo(double, char *) with x, y = " << x << ", \"" << y << "\"" << std::endl;
-}
-
-void Bar::foo(int x, int y) {
- std::cout << "Called Bar::foo(int, int) with x, y = " << x << ", " << y << std::endl;
-}
-
-void Bar::foo(char *x) {
- std::cout << "Called Bar::foo(char *) with x = \"" << x << "\"" << std::endl;
-}
-
-void Bar::foo(int x) {
- std::cout << "Called Bar::foo(int) with x = " << x << std::endl;
-}
-
-void Bar::foo(long x) {
- std::cout << "Called Bar::foo(long) with x = " << x << std::endl;
-}
-
-void Bar::foo(Bar *x) {
- std::cout << "Called Bar::foo(Bar *) with x = " << x << std::endl;
-}
-
-void Bar::spam(int x, int y, int z) {
- std::cout << "Called Bar::spam(int, int, int) with x, y, z = " << x << ", " << y << ", " << z << std::endl;
-}
-
-void Bar::spam(double x, int y, int z) {
- std::cout << "Called Bar::spam(double, int, int) with x, y, z = " << x << ", " << y << ", " << z << std::endl;
-}
-
-// Overloaded global methods
-void foo(const Bar& x) {
- std::cout << "Called foo(const Bar& x) with &x = " << &x << std::endl;
-}
-
-void foo(double x) {
- std::cout << "Called foo(double) with x = " << x << std::endl;
-}
-
-void foo(double x, char *y) {
- std::cout << "Called foo(double, char *) with x, y = " << x << ", \"" << y << "\"" << std::endl;
-}
-
-void foo(int x, int y) {
- std::cout << "Called foo(int, int) with x, y = " << x << ", " << y << std::endl;
-}
-
-void foo(char *x) {
- std::cout << "Called foo(char *) with x = \"" << x << "\"" << std::endl;
-}
-
-void foo(int x) {
- std::cout << "Called foo(int) with x = " << x << std::endl;
-}
-
-void foo(long x) {
- std::cout << "Called foo(long) with x = " << x << std::endl;
-}
-
-void foo(Bar *x) {
- std::cout << "Called foo(Bar *) with x = " << x << std::endl;
-}
-
diff --git a/Examples/pike/overload/example.h b/Examples/pike/overload/example.h
deleted file mode 100644
index e47a122..0000000
--- a/Examples/pike/overload/example.h
+++ /dev/null
@@ -1,41 +0,0 @@
-#ifndef EXAMPLE_H
-#define EXAMPLE_H
-
-class Bar {
-public:
- Bar();
- Bar(const Bar&);
- Bar(double);
- Bar(double, char *);
- Bar(int, int);
- Bar(char *);
- Bar(long);
- Bar(int);
- Bar(Bar *);
-
- void foo(const Bar&);
- void foo(double);
- void foo(double, char *);
- void foo(int, int);
- void foo(char *);
- void foo(long);
- void foo(int);
- void foo(Bar *);
-
- void spam(int x, int y=2, int z=3);
- void spam(double x, int y=2, int z=3);
-};
-
-void foo(const Bar&);
-void foo(double);
-void foo(double, char *);
-void foo(int, int);
-void foo(char *);
-void foo(int);
-void foo(long);
-void foo(Bar *);
-
-void spam(int x, int y=2, int z=3);
-void spam(double x, int y=2, int z=3);
-
-#endif
diff --git a/Examples/pike/overload/example.i b/Examples/pike/overload/example.i
deleted file mode 100644
index ddcd006..0000000
--- a/Examples/pike/overload/example.i
+++ /dev/null
@@ -1,28 +0,0 @@
-/* File : example.i */
-%module example
-
-%{
-#include "example.h"
-%}
-
-/**
- * These overloaded declarations conflict with other overloads (as far as
- * SWIG's Ruby module's implementation for overloaded methods is concerned).
- * One option is use the %rename directive to rename the conflicting methods;
- * here, we're just using %ignore to avoid wrapping some of the overloaded
- * functions altogether.
- */
-
-%ignore Bar;
-
-%ignore Bar::Bar(Bar *);
-%ignore Bar::Bar(long);
-
-%ignore Bar::foo(const Bar&);
-%ignore Bar::foo(long);
-
-%ignore ::foo(const Bar&);
-%ignore ::foo(int);
-
-/* Let's just grab the original header file here */
-%include "example.h"
diff --git a/Examples/pike/overload/runme.pike b/Examples/pike/overload/runme.pike
deleted file mode 100644
index d30e947..0000000
--- a/Examples/pike/overload/runme.pike
+++ /dev/null
@@ -1,83 +0,0 @@
-// import .example;
-
-int main()
-{
- // This should invoke foo(double)
- .example.foo(3.14159);
-
- // This should invoke foo(double, char *)
- .example.foo(3.14159, "Pi");
-
- // This should invoke foo(int, int)
- .example.foo(3, 4);
-
- // This should invoke foo(char *)
- .example.foo("This is a test");
-
- // This should invoke foo(long)
- .example.foo(42);
-
- /*
- // This should invoke Bar::Bar() followed by foo(Bar *)
- foo(Bar.new);
-
- // Skip a line
- write("\n");
-
- // This should invoke Bar::Bar(double)
- Bar.new(3.14159);
-
- // This should invoke Bar::Bar(double, char *)
- Bar.new(3.14159, "Pi");
-
- // This should invoke Bar::Bar(int, int)
- Bar.new(3, 4);
-
- // This should invoke Bar::Bar(char *)
- Bar.new("This is a test");
-
- // This should invoke Bar::Bar(int)
- Bar.new(42);
-
- // This should invoke Bar::Bar() for the input argument,
- // followed by Bar::Bar(const Bar&).
- Bar.new(Bar.new);
-
- // Skip a line
- write("\n");
- */
-
- // Construct a new Bar instance (invokes Bar::Bar())
- /*
- bar = Bar.new;
-
- // This should invoke Bar::foo(double)
- bar.foo(3.14159);
-
- // This should invoke Bar::foo(double, char *)
- bar.foo(3.14159, "Pi");
-
- // This should invoke Bar::foo(int, int)
- bar.foo(3, 4);
-
- // This should invoke Bar::foo(char *)
- bar.foo("This is a test");
-
- // This should invoke Bar::foo(int)
- bar.foo(42);
-
- // This should invoke Bar::Bar() to construct the input
- // argument, followed by Bar::foo(Bar *).
- bar.foo(Example::Bar.new);
-
- // This should invoke Bar::spam(int x, int y, int z)
- bar.spam(1);
-
- // This should invoke Bar::spam(double x, int y, int z)
- bar.spam(3.14159);
- */
-
- write("Goodbye\n");
-
- return 0;
-}
diff --git a/Examples/pike/simple/Makefile b/Examples/pike/simple/Makefile
deleted file mode 100644
index 8b49b4e..0000000
--- a/Examples/pike/simple/Makefile
+++ /dev/null
@@ -1,22 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-SRCS = example.c
-TARGET = example
-INTERFACE = example.i
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_run
-
-build:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' SRCS='$(SRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' pike
-
-static:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' SRCS='$(SRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- TARGET='mypike' INTERFACE='$(INTERFACE)' pike_static
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_clean
diff --git a/Examples/pike/simple/example.c b/Examples/pike/simple/example.c
deleted file mode 100644
index 1c2af78..0000000
--- a/Examples/pike/simple/example.c
+++ /dev/null
@@ -1,18 +0,0 @@
-/* File : example.c */
-
-/* A global variable */
-double Foo = 3.0;
-
-/* 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;
-}
-
-
diff --git a/Examples/pike/simple/example.i b/Examples/pike/simple/example.i
deleted file mode 100644
index 24093b9..0000000
--- a/Examples/pike/simple/example.i
+++ /dev/null
@@ -1,7 +0,0 @@
-/* File : example.i */
-%module example
-
-%inline %{
-extern int gcd(int x, int y);
-extern double Foo;
-%}
diff --git a/Examples/pike/simple/runme.pike b/Examples/pike/simple/runme.pike
deleted file mode 100644
index a6a78e9..0000000
--- a/Examples/pike/simple/runme.pike
+++ /dev/null
@@ -1,20 +0,0 @@
-int main()
-{
- /* Call our gcd() function */
- int x = 42;
- int y = 105;
- int g = .example.gcd(x, y);
- write("The gcd of %d and %d is %d\n", x, y, g);
-
- /* Manipulate the Foo global variable */
- /* Output its current value */
- write("Foo = %f\n", .example->Foo_get());
-
- /* Change its value */
- .example->Foo_set(3.1415926);
-
- /* See if the change took effect */
- write("Foo = %f\n", .example->Foo_get());
-
- return 0;
-}
diff --git a/Examples/pike/template/Makefile b/Examples/pike/template/Makefile
deleted file mode 100644
index 513dc3b..0000000
--- a/Examples/pike/template/Makefile
+++ /dev/null
@@ -1,24 +0,0 @@
-TOP = ../..
-SWIGEXE = $(TOP)/../swig
-SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
-CXXSRCS =
-TARGET = example
-INTERFACE = example.i
-LIBS = -lm
-SWIGOPT =
-
-check: build
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_run
-
-build:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CXXSRCS='$(CXXSRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' pike_cpp
-
-static:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CXXSRCS='$(CXXSRCS)' \
- SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
- SWIGOPT='$(SWIGOPT)' TARGET='mypike' INTERFACE='$(INTERFACE)' pike_cpp_static
-
-clean:
- $(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' pike_clean
diff --git a/Examples/pike/template/example.h b/Examples/pike/template/example.h
deleted file mode 100644
index 7401df6..0000000
--- a/Examples/pike/template/example.h
+++ /dev/null
@@ -1,32 +0,0 @@
-/* File : example.h */
-
-// Some template definitions
-
-template<class T> T max(T a, T b) { return a>b ? a : b; }
-
-template<class T> class vector {
- T *v;
- int sz;
- public:
- vector(int _sz) {
- v = new T[_sz];
- sz = _sz;
- }
- T &get(int index) {
- return v[index];
- }
- void set(int index, T &val) {
- v[index] = val;
- }
-#ifdef SWIG
- %extend {
- T getitem(int index) {
- return $self->get(index);
- }
- void setitem(int index, T val) {
- $self->set(index,val);
- }
- }
-#endif
-};
-
diff --git a/Examples/pike/template/example.i b/Examples/pike/template/example.i
deleted file mode 100644
index 8f94c4d..0000000
--- a/Examples/pike/template/example.i
+++ /dev/null
@@ -1,17 +0,0 @@
-/* File : example.i */
-%module example
-
-%{
-#include "example.h"
-%}
-
-/* Let's just grab the original header file here */
-%include "example.h"
-
-/* Now instantiate some specific template declarations */
-
-%template(maxint) max<int>;
-%template(maxdouble) max<double>;
-%template(vecint) vector<int>;
-%template(vecdouble) vector<double>;
-
diff --git a/Examples/pike/template/runme.pike b/Examples/pike/template/runme.pike
deleted file mode 100644
index 36825c3..0000000
--- a/Examples/pike/template/runme.pike
+++ /dev/null
@@ -1,33 +0,0 @@
-int main()
-{
- // Call some templated functions
- write(sprintf("%d\n", .example.maxint(3, 7)));
- write(sprintf("%f\n", .example.maxdouble(3.14, 2.18)));
-
- // Create some objects
- .example.vecint iv = .example.vecint(100);
- .example.vecdouble dv = .example.vecdouble(1000);
-
- for (int i = 0; i < 100; i++) {
- iv->setitem(i, 2*i);
- }
-
- for (int i = 0; i < 1000; i++) {
- dv->setitem(i, 1.0/(i+1));
- }
-
- int isum = 0;
- for (int i = 0; i < 100; i++) {
- isum += iv->getitem(i);
- }
-
- write(sprintf("%d\n", isum));
-
- float fsum = 0.0;
- for (int i = 0; i < 1000; i++) {
- fsum += dv->getitem(i);
- }
- write(sprintf("%f\n", fsum));
-
- return 0;
-}
diff --git a/Examples/s-exp/uffi.lisp b/Examples/s-exp/uffi.lisp
deleted file mode 100644
index aea9a14..0000000
--- a/Examples/s-exp/uffi.lisp
+++ /dev/null
@@ -1,389 +0,0 @@
-;;; This is experimental code that uses the s-expression
-;;; representation of a C/C++ library interface to generate Foreign
-;;; Function Interface definitions for use with Kevin Rosenberg's
-;;; UFFI.
-;;;
-;;; Written by Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (require 'port) ; from CLOCC
- (require 'uffi))
-
-(in-package :cl-user)
-
-;; Interaction with the SWIG binary
-
-(defvar *swig-source-directory* #p"/home/mkoeppe/s/swig1.3/")
-
-(defvar *swig-program* (merge-pathnames "swig" *swig-source-directory*))
-
-(defun run-swig (swig-interface-file-name &key directory-search-list module
- ignore-errors c++)
- (let ((temp-file-name "/tmp/swig.lsp"))
- (let ((process
- (port:run-prog (namestring *swig-program*)
- :output t
- :args `(,@(and c++ '("-c++"))
- "-sexp"
- ,@(mapcar (lambda (dir)
- (concatenate 'string
- "-I" (namestring dir)))
- directory-search-list)
- ,@(and module
- `("-module" ,module))
- "-o" ,temp-file-name
- ,(namestring swig-interface-file-name)))))
- #+cmu (unless (or (zerop (ext:process-exit-code process))
- ignore-errors)
- (error "Process swig exited abnormally"))
- (with-open-file (s temp-file-name)
- (read s)))))
-
-;; Type system
-
-(defun parse-swigtype (type-string &key start end junk-ok)
- "Parse TYPE-STRING as SWIG's internal representation of C/C++
-types. Return two values: The type description (an improper list) and
-the terminating index into TYPE-STRING."
- ;; SWIG's internal representation is described in Source/Swig/stype.c
- (unless start
- (setq start 0))
- (unless end
- (setq end (length type-string)))
- (flet ((prefix-match (prefix)
- (let ((position (mismatch prefix type-string :start2 start :end2 end)))
- (or (not position)
- (= position (length prefix)))))
- (bad-type-error (reason)
- (error "Bad SWIG type (~A): ~A" reason
- (subseq type-string start end)))
- (type-char (index)
- (and (< index (length type-string))
- (char type-string index)))
- (cons-and-recurse (prefix start end)
- (multiple-value-bind (type-description index)
- (parse-swigtype type-string :start start :end end
- :junk-ok junk-ok)
- (values (cons prefix type-description)
- index))))
- (cond
- ((prefix-match "p.") ; pointer
- (cons-and-recurse '* (+ start 2) end))
- ((prefix-match "r.") ; C++ reference
- (cons-and-recurse '& (+ start 2) end))
- ((prefix-match "a(") ; array
- (let ((closing-paren (position #\) type-string
- :start (+ start 2)
- :end end)))
- (unless closing-paren
- (bad-type-error "missing right paren"))
- (unless (eql (type-char (+ closing-paren 1)) #\.)
- (bad-type-error "missing dot"))
- (cons-and-recurse (list 'ARRAY (subseq type-string (+ start 2) closing-paren))
- (+ closing-paren 2) end)))
- ((prefix-match "q(") ; qualifier (const, volatile)
- (let ((closing-paren (position #\) type-string
- :start (+ start 2)
- :end end)))
- (unless closing-paren
- (bad-type-error "missing right paren"))
- (unless (eql (type-char (+ closing-paren 1)) #\.)
- (bad-type-error "missing dot"))
- (cons-and-recurse (list 'QUALIFIER (subseq type-string (+ start 2) closing-paren))
- (+ closing-paren 2) end)))
- ((prefix-match "m(") ; C++ member pointer
- (multiple-value-bind (class-type class-end-index)
- (parse-swigtype type-string :junk-ok t
- :start (+ start 2) :end end)
- (unless (eql (type-char class-end-index) #\))
- (bad-type-error "missing right paren"))
- (unless (eql (type-char (+ class-end-index 1)) #\.)
- (bad-type-error "missing dot"))
- (cons-and-recurse (list 'MEMBER-POINTER class-type)
- (+ class-end-index 2) end)))
- ((prefix-match "f(") ; function
- (loop with index = (+ start 2)
- until (eql (type-char index) #\))
- collect (multiple-value-bind (arg-type arg-end-index)
- (parse-swigtype type-string :junk-ok t
- :start index :end end)
- (case (type-char arg-end-index)
- (#\, (setq index (+ arg-end-index 1)))
- (#\) (setq index arg-end-index))
- (otherwise (bad-type-error "comma or right paren expected")))
- arg-type)
- into arg-types
- finally (unless (eql (type-char (+ index 1)) #\.)
- (bad-type-error "missing dot"))
- (return (cons-and-recurse (cons 'FUNCTION arg-types)
- (+ index 2) end))))
- ((prefix-match "v(") ;varargs
- (let ((closing-paren (position #\) type-string
- :start (+ start 2)
- :end end)))
- (unless closing-paren
- (bad-type-error "missing right paren"))
- (values (list 'VARARGS (subseq type-string (+ start 2) closing-paren))
- (+ closing-paren 1))))
- (t (let ((junk-position (position-if (lambda (char)
- (member char '(#\, #\( #\) #\.)))
- type-string
- :start start :end end)))
- (cond (junk-position ; found junk
- (unless junk-ok
- (bad-type-error "trailing junk"))
- (values (subseq type-string start junk-position)
- junk-position))
- (t
- (values (subseq type-string start end)
- end))))))))
-
-(defun swigtype-function-p (swigtype)
- "Check whether SWIGTYPE designates a function. If so, the second
-value is the list of argument types, and the third value is the return
-type."
- (if (and (consp swigtype)
- (consp (first swigtype))
- (eql (first (first swigtype)) 'FUNCTION))
- (values t (rest (first swigtype)) (rest swigtype))
- (values nil nil nil)))
-
-
-;; UFFI
-
-(defvar *uffi-definitions* '())
-
-(defconstant *uffi-default-primitive-type-alist*
- '(("char" . :char)
- ("unsigned char" . :unsigned-byte)
- ("signed char" . :byte)
- ("short" . :short)
- ("signed short" . :short)
- ("unsigned short" . :unsigned-short)
- ("int" . :int)
- ("signed int" . :int)
- ("unsigned int" . :unsigned-int)
- ("long" . :long)
- ("signed long" . :long)
- ("unsigned long" . :unsigned-long)
- ("float" . :float)
- ("double" . :double)
- ((* . "char") . :cstring)
- ((* . "void") . :pointer-void)
- ("void" . :void)))
-
-(defvar *uffi-primitive-type-alist* *uffi-default-primitive-type-alist*)
-
-(defun uffi-type-spec (type-list)
- "Return the UFFI type spec equivalent to TYPE-LIST, or NIL if there
-is no representation."
- (let ((primitive-type-pair
- (assoc type-list *uffi-primitive-type-alist* :test 'equal)))
- (cond
- (primitive-type-pair
- (cdr primitive-type-pair))
- ((and (consp type-list)
- (eql (first type-list) '*))
- (let ((base-type-spec (uffi-type-spec (rest type-list))))
- (cond
- ((not base-type-spec)
- :pointer-void)
- (t
- (list '* base-type-spec)))))
- (t nil))))
-
-;; Parse tree
-
-(defvar *uffi-output* nil)
-
-(defun emit-uffi-definition (uffi-definition)
- (format *uffi-output* "~&~S~%" uffi-definition)
- (push uffi-definition *uffi-definitions*))
-
-(defun make-cl-symbol (c-identifier &key uninterned)
- (let ((name (substitute #\- #\_ (string-upcase c-identifier))))
- (if uninterned
- (make-symbol name)
- (intern name))))
-
-(defvar *class-scope* '() "A stack of names of nested C++ classes.")
-
-(defvar *struct-fields* '())
-
-(defvar *linkage* :C "NIL or :C")
-
-(defgeneric handle-node (node-type &key &allow-other-keys)
- (:documentation "Handle a node of SWIG's parse tree of a C/C++ program"))
-
-(defmethod handle-node ((node-type t) &key &allow-other-keys)
- ;; do nothing for unknown node types
- nil)
-
-(defmethod handle-node ((node-type (eql 'cdecl)) &key name decl storage parms type &allow-other-keys)
- (let ((swigtype (parse-swigtype (concatenate 'string decl type))))
- (let ((*print-pretty* nil) ; or FUNCTION would be printed as #' by cmucl
- (*print-circle* t))
- (format *uffi-output* "~&;; C Declaration: ~A ~A ~A ~A~%;; with-parms ~W~%;; of-type ~W~%"
- storage type name decl parms swigtype))
- (multiple-value-bind (function-p arg-swigtype-list return-swigtype)
- (swigtype-function-p swigtype)
- (declare (ignore arg-swigtype-list))
- (cond
- ((and (null *class-scope*) function-p
- (or (eql *linkage* :c)
- (string= storage "externc")))
- ;; ordinary top-level function with C linkage
- (let ((argnum 0)
- (argname-list '()))
- (flet ((unique-argname (name)
- ;; Sometimes the functions in SWIG interfaces
- ;; do not have unique names. Make them unique
- ;; by adding a suffix. Also avoid symbols
- ;; that are specially bound.
- (unless name
- (setq name (format nil "arg~D" argnum)))
- (let ((argname (make-cl-symbol name)))
- (when (boundp argname) ;specially bound
- (setq argname (make-cl-symbol name :uninterned t)))
- (push argname argname-list)
- argname)))
- (let ((uffi-arg-list
- (mapcan (lambda (param)
- (incf argnum)
- (destructuring-bind (&key name type &allow-other-keys) param
- (let ((uffi-type (uffi-type-spec (parse-swigtype type))))
- (cond
- ((not uffi-type)
- (format *uffi-output* "~&;; Warning: Cannot handle type ~S of argument `~A'~%"
- type name)
- (return-from handle-node))
- ((eq uffi-type :void)
- '())
- (t
- (let ((symbol (unique-argname name)))
- (list `(,symbol ,uffi-type))))))))
- parms))
- (uffi-return-type
- (uffi-type-spec return-swigtype)))
- (unless uffi-return-type
- (format *uffi-output* "~&;; Warning: Cannot handle return type `~S'~%"
- return-swigtype)
- (return-from handle-node))
- (emit-uffi-definition `(UFFI:DEF-FUNCTION ,name ,uffi-arg-list :RETURNING ,uffi-return-type))))))
- ((and (not (null *class-scope*)) (null (rest *class-scope*))
- (not function-p)) ; class/struct member (no nested structs)
- (let ((uffi-type (uffi-type-spec swigtype)))
- (unless uffi-type
- (format *uffi-output* "~&;; Warning: Cannot handle type ~S of struct field `~A'~%"
- type name)
- (return-from handle-node))
- (push `(,(make-cl-symbol name) ,uffi-type) *struct-fields*)))))))
-
-(defmethod handle-node ((node-type (eql 'class)) &key name children kind &allow-other-keys)
- (format *uffi-output* "~&;; Class ~A~%" name)
- (let ((*class-scope* (cons name *class-scope*))
- (*struct-fields* '()))
- (dolist (child children)
- (apply 'handle-node child))
- (emit-uffi-definition `(,(if (string= kind "union")
- 'UFFI:DEF-UNION
- 'UFFI:DEF-STRUCT)
- ,(make-cl-symbol name) ,@(nreverse *struct-fields*)))))
-
-(defmethod handle-node ((node-type (eql 'top)) &key children &allow-other-keys)
- (dolist (child children)
- (apply 'handle-node child)))
-
-(defmethod handle-node ((node-type (eql 'include)) &key name children &allow-other-keys)
- (format *uffi-output* ";; INCLUDE ~A~%" name)
- (dolist (child children)
- (apply 'handle-node child)))
-
-(defmethod handle-node ((node-type (eql 'extern)) &key name children &allow-other-keys)
- (format *uffi-output* ";; EXTERN \"C\" ~A~%" name)
- (let ((*linkage* :c))
- (dolist (child children)
- (apply 'handle-node child))))
-
-;;(defun compute-uffi-definitions (swig-interface)
-;; (let ((*uffi-definitions* '()))
-;; (handle-node swig-interface)
-;; *uffi-definitions*))
-
-;; Test instances
-
-;;; Link to SWIG itself
-
-#||
-
-(defparameter *c++-compiler* "g++")
-
-(defun stdc++-library (&key env)
- (let ((error-output (make-string-output-stream)))
- (let ((name-output (make-string-output-stream)))
- (let ((proc (ext:run-program
- *c++-compiler*
- '("-print-file-name=libstdc++.so")
- :env env
- :input nil
- :output name-output
- :error error-output)))
- (unless proc
- (error "Could not run ~A" *c++-compiler*))
- (unless (zerop (ext:process-exit-code proc))
- (system:serve-all-events 0)
- (error "~A failed:~%~A" *c++-compiler*
- (get-output-stream-string error-output))))
- (string-right-trim '(#\Newline) (get-output-stream-string name-output)))))
-
-(defvar *swig-interface* nil)
-
-(defvar *swig-uffi-pathname* #p"/tmp/swig-uffi.lisp")
-
-(defun link-swig ()
- (setq *swig-interface*
- (run-swig (merge-pathnames "Source/swig.i" *swig-source-directory*)
- :directory-search-list
- (list (merge-pathnames "Source/" *swig-source-directory*))
- :module "swig"
- :ignore-errors t
- :c++ t))
- (with-open-file (f *swig-uffi-pathname* :direction :output)
- (let ((*linkage* :c++)
- (*uffi-definitions* '())
- (*uffi-output* f)
- (*uffi-primitive-type-alist* *uffi-default-primitive-type-alist*))
- (apply 'handle-node *swig-interface*)))
- (compile-file *swig-uffi-pathname*)
- (alien:load-foreign (merge-pathnames "Source/libswig.a"
- *swig-source-directory*)
- :libraries (list (stdc++-library)))
- ;; FIXME: UFFI stuffes a "-l" in front of the passed library names
- ;; (uffi:load-foreign-library (merge-pathnames "Source/libswig.a"
- ;; *swig-source-directory*)
- ;; :supporting-libraries
- ;; (list (stdc++-library)))
- (load (compile-file-pathname *swig-uffi-pathname*)))
-
-||#
-
-;;;; TODO:
-
-;; * How to do type lookups? Is everything important that SWIG knows
-;; about the types written out? What to make of typemaps?
-;;
-;; * Wrapped functions should probably automatically COERCE their
-;; arguments (as of type DOUBLE-FLOAT), to make the functions more
-;; flexible?
-;;
-;; * Why are the functions created by FFI interpreted?
-;;
-;; * We can't deal with more complicated structs and C++ classes
-;; directly with the FFI; we have to emit SWIG wrappers that access
-;; those classes.
-;;
-;; * A CLOS layer where structure fields are mapped as slots. It
-;; looks like we need MOP functions to implement this.
-;;
-;; * Maybe modify SWIG so that key-value hashes are distinguished from
-;; value-value hashes.
diff --git a/Examples/test-suite/allegrocl/Makefile.in b/Examples/test-suite/allegrocl/Makefile.in
deleted file mode 100644
index b13d546..0000000
--- a/Examples/test-suite/allegrocl/Makefile.in
+++ /dev/null
@@ -1,126 +0,0 @@
-#######################################################################
-# Makefile for allegrocl test-suite
-#######################################################################
-
-LANGUAGE = allegrocl
-ALLEGROCL = @ALLEGROCLBIN@
-SCRIPTSUFFIX = _runme.lisp
-
-srcdir = @srcdir@
-top_srcdir = @top_srcdir@
-top_builddir = @top_builddir@
-
-
-# these cpp tests generate warnings/errors when compiling
-# the wrapper .cxx file.
-CPP_TEST_BROKEN_CXX =
-# the error is wrap:action code generated by swig. \
-# error: can't convert [std::string] 'b' to 'bool' \
-# might just need a bool overload op for std::string. \
- global_vars \
-# same as w/ global_vars but with more errors in cxx file \
- naturalvar \
-
-# these cpp tests aren't working. Fix 'em
-# need to further separate these into tests requiring
-# std libraries, or the $ldestructor problem.
-CPP_TEST_BROKEN_ACL = \
- contract \
- allprotected \
-# 'throws' typemap entries. \
- cplusplus_throw \
-# 'throws' typemap entries. \
- default_args \
-# missing typemaps. suspect module support needed \
- dynamic_cast \
- extend_variable \
-# cdata.i support needed \
- li_cdata_cpp \
-# warning generated. otherwise all good. \
- operator_overload \
-# std_common.i support \
- sizet \
-# std_vector.i support. \
- template_default \
-# *** line 31. can't copy typemap?? \
- typemap_namespace \
-
-# these aren't working due to longlong support. (low hanging fruit)
-CPP_TEST_BROKEN_LONGLONG = \
- arrays_dimensionless \
- arrays_global \
- arrays_global_twodim \
- li_typemaps \
- li_windows \
- long_long_apply \
- primitive_ref \
- reference_global_vars \
- template_default_arg
-
-# These are currently unsupported.
-CPP_TEST_CASES_ACL_UNSUPPORTED = \
-# contract support \
- aggregate \
-# directors support \
- apply_signed_char \
-# contract support \
- contract \
- director_exception \
- director_protected \
- exception_order \
-# 'throws' typemap support \
- extern_throws \
- throw_exception \
- using_pointers \
-
-C_TEST_CASES_ACL_BROKEN = \
-# 'cdate.i' module support \
- li_cdata \
-# adding an existing type defnition... \
- typedef_struct \
-# swigrun.swg support. \
- typemap_subst
-
-C_TEST_BROKEN_LONGLONG = \
- long_long
-
-
-# std lib support hasn't been done yet.
-SKIP_CPP_STD_CASES = Yes
-
-include $(srcdir)/../common.mk
-
-# Overridden variables here
-# SWIGOPT += -debug-module 4
-
-# Custom tests - tests with additional commandline options
-# none!
-
-# Rules for the different types of tests
-%.cpptest:
- $(setup)
- +$(swig_and_compile_cpp)
- $(run_testcase)
-
-%.ctest:
- $(setup)
- +$(swig_and_compile_c)
- $(run_testcase)
-
-%.multicpptest:
- $(setup)
- +$(swig_and_compile_multi_cpp)
- $(run_testcase)
-
-# Runs the testcase. A testcase is only run if
-# a file is found which has _runme.lisp appended after the testcase name.
-run_testcase = \
- if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then \
- env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(RUNTOOL) $(ALLEGROCLBIN) -batch -s $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
- fi
-
-%.clean:
- @rm -f $*.cl
-
-clean:
- $(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile SRCDIR="$(SRCDIR)" allegrocl_clean
diff --git a/Examples/test-suite/apply_strings.i b/Examples/test-suite/apply_strings.i
index 695dd06..14283bb 100644
--- a/Examples/test-suite/apply_strings.i
+++ b/Examples/test-suite/apply_strings.i
@@ -44,8 +44,6 @@
// unsigned char* as strings
#if defined(SWIGJAVA) || defined(SWIGCSHARP)
-/* Note: Chicken does not allow unsigned char * in strings */
-
%apply char [ANY] {TAscii[ANY]}
%apply char [] {TAscii []}
%apply char * {TAscii *}
diff --git a/Examples/test-suite/chicken/Makefile.in b/Examples/test-suite/chicken/Makefile.in
deleted file mode 100644
index b3dccc9..0000000
--- a/Examples/test-suite/chicken/Makefile.in
+++ /dev/null
@@ -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
diff --git a/Examples/test-suite/chicken/README b/Examples/test-suite/chicken/README
deleted file mode 100644
index aad730e..0000000
--- a/Examples/test-suite/chicken/README
+++ /dev/null
@@ -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.
diff --git a/Examples/test-suite/chicken/casts_runme.ss b/Examples/test-suite/chicken/casts_runme.ss
deleted file mode 100644
index 2eca461..0000000
--- a/Examples/test-suite/chicken/casts_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "casts.so")
-(include "../schemerunme/casts.scm")
diff --git a/Examples/test-suite/chicken/char_constant_runme.ss b/Examples/test-suite/chicken/char_constant_runme.ss
deleted file mode 100644
index 50dff30..0000000
--- a/Examples/test-suite/chicken/char_constant_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "char_constant.so")
-(include "../schemerunme/char_constant.scm")
diff --git a/Examples/test-suite/chicken/chicken_ext_test_external.cxx b/Examples/test-suite/chicken/chicken_ext_test_external.cxx
deleted file mode 100644
index 1dd6a7d..0000000
--- a/Examples/test-suite/chicken/chicken_ext_test_external.cxx
+++ /dev/null
@@ -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);
-}
diff --git a/Examples/test-suite/chicken/chicken_ext_test_runme.ss b/Examples/test-suite/chicken/chicken_ext_test_runme.ss
deleted file mode 100644
index 65fa4e0..0000000
--- a/Examples/test-suite/chicken/chicken_ext_test_runme.ss
+++ /dev/null
@@ -1,5 +0,0 @@
-(load "chicken_ext_test.so")
-
-(define a (test-create))
-
-(A-hello a)
diff --git a/Examples/test-suite/chicken/class_ignore_runme.ss b/Examples/test-suite/chicken/class_ignore_runme.ss
deleted file mode 100644
index ba84810..0000000
--- a/Examples/test-suite/chicken/class_ignore_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "class_ignore.so")
-(include "../schemerunme/class_ignore.scm")
diff --git a/Examples/test-suite/chicken/clientdata_prop_runme_proxy.ss b/Examples/test-suite/chicken/clientdata_prop_runme_proxy.ss
deleted file mode 100644
index 62f2c20..0000000
--- a/Examples/test-suite/chicken/clientdata_prop_runme_proxy.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/constover_runme.ss b/Examples/test-suite/chicken/constover_runme.ss
deleted file mode 100644
index eb39c7f..0000000
--- a/Examples/test-suite/chicken/constover_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "constover.so")
-(include "../schemerunme/constover.scm")
diff --git a/Examples/test-suite/chicken/contract_runme.ss b/Examples/test-suite/chicken/contract_runme.ss
deleted file mode 100644
index 006bcfd..0000000
--- a/Examples/test-suite/chicken/contract_runme.ss
+++ /dev/null
@@ -1,3 +0,0 @@
-(load "contract.so")
-(include "testsuite.ss")
-(include "../schemerunme/contract.scm")
diff --git a/Examples/test-suite/chicken/cpp_basic_runme_proxy.ss b/Examples/test-suite/chicken/cpp_basic_runme_proxy.ss
deleted file mode 100644
index 7b0b6d7..0000000
--- a/Examples/test-suite/chicken/cpp_basic_runme_proxy.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/cpp_enum_runme.ss b/Examples/test-suite/chicken/cpp_enum_runme.ss
deleted file mode 100644
index 4d4ec76..0000000
--- a/Examples/test-suite/chicken/cpp_enum_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "cpp_enum.so")
-(include "../schemerunme/cpp_enum.scm")
diff --git a/Examples/test-suite/chicken/cpp_namespace_runme.ss b/Examples/test-suite/chicken/cpp_namespace_runme.ss
deleted file mode 100644
index 800172e..0000000
--- a/Examples/test-suite/chicken/cpp_namespace_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "cpp_namespace.so")
-(include "../schemerunme/cpp_namespace.scm")
diff --git a/Examples/test-suite/chicken/dynamic_cast_runme.ss b/Examples/test-suite/chicken/dynamic_cast_runme.ss
deleted file mode 100644
index 1e81d55..0000000
--- a/Examples/test-suite/chicken/dynamic_cast_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "dynamic_cast.so")
-(include "../schemerunme/dynamic_cast.scm")
diff --git a/Examples/test-suite/chicken/global_vars_runme.ss b/Examples/test-suite/chicken/global_vars_runme.ss
deleted file mode 100644
index 802205b..0000000
--- a/Examples/test-suite/chicken/global_vars_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(require 'global_vars)
-(load "../schemerunme/global_vars.scm")
diff --git a/Examples/test-suite/chicken/global_vars_runme_proxy.ss b/Examples/test-suite/chicken/global_vars_runme_proxy.ss
deleted file mode 100644
index 3c4500d..0000000
--- a/Examples/test-suite/chicken/global_vars_runme_proxy.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(require 'global_vars)
-(load "../schemerunme/global_vars_proxy.scm")
diff --git a/Examples/test-suite/chicken/import_nomodule_runme.ss b/Examples/test-suite/chicken/import_nomodule_runme.ss
deleted file mode 100644
index 7e64053..0000000
--- a/Examples/test-suite/chicken/import_nomodule_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "import_nomodule.so")
-(include "../schemerunme/import_nomodule.scm")
diff --git a/Examples/test-suite/chicken/imports_runme.ss b/Examples/test-suite/chicken/imports_runme.ss
deleted file mode 100644
index ac5fb98..0000000
--- a/Examples/test-suite/chicken/imports_runme.ss
+++ /dev/null
@@ -1,3 +0,0 @@
-(load "imports_a.so")
-(load "imports_b.so")
-(include "../schemerunme/imports.scm")
diff --git a/Examples/test-suite/chicken/inherit_missing_runme.ss b/Examples/test-suite/chicken/inherit_missing_runme.ss
deleted file mode 100644
index 50a084a..0000000
--- a/Examples/test-suite/chicken/inherit_missing_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "inherit_missing.so")
-(include "../schemerunme/inherit_missing.scm")
diff --git a/Examples/test-suite/chicken/li_std_string_runme.ss b/Examples/test-suite/chicken/li_std_string_runme.ss
deleted file mode 100644
index cc64287..0000000
--- a/Examples/test-suite/chicken/li_std_string_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "li_std_string.so")
-(include "../schemerunme/li_std_string.scm")
diff --git a/Examples/test-suite/chicken/li_std_string_runme_proxy.ss b/Examples/test-suite/chicken/li_std_string_runme_proxy.ss
deleted file mode 100644
index e1e2409..0000000
--- a/Examples/test-suite/chicken/li_std_string_runme_proxy.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/li_typemaps_runme.ss b/Examples/test-suite/chicken/li_typemaps_runme.ss
deleted file mode 100644
index 1ad6e92..0000000
--- a/Examples/test-suite/chicken/li_typemaps_runme.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/li_typemaps_runme_proxy.ss b/Examples/test-suite/chicken/li_typemaps_runme_proxy.ss
deleted file mode 100644
index 52997c6..0000000
--- a/Examples/test-suite/chicken/li_typemaps_runme_proxy.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/list_vector_runme.ss b/Examples/test-suite/chicken/list_vector_runme.ss
deleted file mode 100644
index 67d52f6..0000000
--- a/Examples/test-suite/chicken/list_vector_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "list_vector.so")
-(include "../schemerunme/list_vector.scm")
diff --git a/Examples/test-suite/chicken/member_pointer_runme.ss b/Examples/test-suite/chicken/member_pointer_runme.ss
deleted file mode 100644
index f2226b2..0000000
--- a/Examples/test-suite/chicken/member_pointer_runme.ss
+++ /dev/null
@@ -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)))
diff --git a/Examples/test-suite/chicken/multiple_inheritance_runme_proxy.ss b/Examples/test-suite/chicken/multiple_inheritance_runme_proxy.ss
deleted file mode 100644
index 313157c..0000000
--- a/Examples/test-suite/chicken/multiple_inheritance_runme_proxy.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(require 'multiple_inheritance)
-(load "../schemerunme/multiple_inheritance_proxy.scm")
diff --git a/Examples/test-suite/chicken/multivalue_runme.ss b/Examples/test-suite/chicken/multivalue_runme.ss
deleted file mode 100644
index f5aafcb..0000000
--- a/Examples/test-suite/chicken/multivalue_runme.ss
+++ /dev/null
@@ -1,4 +0,0 @@
-;; this doesn't work yet :(
-(load "multivalue.so")
-(include "../schemerunme/multivalue.scm")
-(exit 0)
diff --git a/Examples/test-suite/chicken/name_runme.ss b/Examples/test-suite/chicken/name_runme.ss
deleted file mode 100644
index 938915d..0000000
--- a/Examples/test-suite/chicken/name_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "name.so")
-(include "../schemerunme/name.scm")
diff --git a/Examples/test-suite/chicken/newobject1_runme_proxy.ss b/Examples/test-suite/chicken/newobject1_runme_proxy.ss
deleted file mode 100644
index 7bc5a24..0000000
--- a/Examples/test-suite/chicken/newobject1_runme_proxy.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/newobject2_runme.ss b/Examples/test-suite/chicken/newobject2_runme.ss
deleted file mode 100644
index cc445f4..0000000
--- a/Examples/test-suite/chicken/newobject2_runme.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/newobject2_runme_proxy.ss b/Examples/test-suite/chicken/newobject2_runme_proxy.ss
deleted file mode 100644
index 36b8cda..0000000
--- a/Examples/test-suite/chicken/newobject2_runme_proxy.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/overload_complicated_runme.ss b/Examples/test-suite/chicken/overload_complicated_runme.ss
deleted file mode 100644
index f89f70b..0000000
--- a/Examples/test-suite/chicken/overload_complicated_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "overload_complicated.so")
-(include "../schemerunme/overload_complicated.scm")
diff --git a/Examples/test-suite/chicken/overload_copy_runme.ss b/Examples/test-suite/chicken/overload_copy_runme.ss
deleted file mode 100644
index 4ec5422..0000000
--- a/Examples/test-suite/chicken/overload_copy_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "overload_copy.so")
-(include "../schemerunme/overload_copy.scm")
diff --git a/Examples/test-suite/chicken/overload_copy_runme_proxy.ss b/Examples/test-suite/chicken/overload_copy_runme_proxy.ss
deleted file mode 100644
index 5f48080..0000000
--- a/Examples/test-suite/chicken/overload_copy_runme_proxy.ss
+++ /dev/null
@@ -1,6 +0,0 @@
-(load "./overload_copy.so")
-
-(define f (make <Foo>))
-(define g (make <Foo> f))
-
-(exit 0)
diff --git a/Examples/test-suite/chicken/overload_extend_c_runme.ss b/Examples/test-suite/chicken/overload_extend_c_runme.ss
deleted file mode 100644
index 75c0ea8..0000000
--- a/Examples/test-suite/chicken/overload_extend_c_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "overload_extend_c.so")
-(include "../schemerunme/overload_extend_c.scm")
diff --git a/Examples/test-suite/chicken/overload_extend_runme.ss b/Examples/test-suite/chicken/overload_extend_runme.ss
deleted file mode 100644
index a19cb29..0000000
--- a/Examples/test-suite/chicken/overload_extend_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "overload_extend.so")
-(include "../schemerunme/overload_extend.scm")
diff --git a/Examples/test-suite/chicken/overload_extend_runme_proxy.ss b/Examples/test-suite/chicken/overload_extend_runme_proxy.ss
deleted file mode 100644
index 2a6867e..0000000
--- a/Examples/test-suite/chicken/overload_extend_runme_proxy.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/overload_simple_runme.ss b/Examples/test-suite/chicken/overload_simple_runme.ss
deleted file mode 100644
index 24fa67a..0000000
--- a/Examples/test-suite/chicken/overload_simple_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "overload_simple.so")
-(include "../schemerunme/overload_simple.scm")
diff --git a/Examples/test-suite/chicken/overload_simple_runme_proxy.ss b/Examples/test-suite/chicken/overload_simple_runme_proxy.ss
deleted file mode 100644
index 0ae3e62..0000000
--- a/Examples/test-suite/chicken/overload_simple_runme_proxy.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/overload_subtype_runme.ss b/Examples/test-suite/chicken/overload_subtype_runme.ss
deleted file mode 100644
index b3663b7..0000000
--- a/Examples/test-suite/chicken/overload_subtype_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "overload_subtype.so")
-(include "../schemerunme/overload_subtype.scm")
diff --git a/Examples/test-suite/chicken/overload_subtype_runme_proxy.ss b/Examples/test-suite/chicken/overload_subtype_runme_proxy.ss
deleted file mode 100644
index d83d59a..0000000
--- a/Examples/test-suite/chicken/overload_subtype_runme_proxy.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/pointer_in_out_runme.ss b/Examples/test-suite/chicken/pointer_in_out_runme.ss
deleted file mode 100644
index 807c4eb..0000000
--- a/Examples/test-suite/chicken/pointer_in_out_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "pointer_in_out.so")
-(include "../schemerunme/pointer_in_out.scm")
diff --git a/Examples/test-suite/chicken/reference_global_vars_runme.ss b/Examples/test-suite/chicken/reference_global_vars_runme.ss
deleted file mode 100644
index 1e1914b..0000000
--- a/Examples/test-suite/chicken/reference_global_vars_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "reference_global_vars.so")
-(include "../schemerunme/reference_global_vars.scm")
diff --git a/Examples/test-suite/chicken/testsuite.ss b/Examples/test-suite/chicken/testsuite.ss
deleted file mode 100644
index e1152a6..0000000
--- a/Examples/test-suite/chicken/testsuite.ss
+++ /dev/null
@@ -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))))
diff --git a/Examples/test-suite/chicken/throw_exception_runme.ss b/Examples/test-suite/chicken/throw_exception_runme.ss
deleted file mode 100644
index 62bc7be..0000000
--- a/Examples/test-suite/chicken/throw_exception_runme.ss
+++ /dev/null
@@ -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)
diff --git a/Examples/test-suite/chicken/typedef_inherit_runme.ss b/Examples/test-suite/chicken/typedef_inherit_runme.ss
deleted file mode 100644
index 111296d..0000000
--- a/Examples/test-suite/chicken/typedef_inherit_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "typedef_inherit.so")
-(include "../schemerunme/typedef_inherit.scm")
diff --git a/Examples/test-suite/chicken/typename_runme.ss b/Examples/test-suite/chicken/typename_runme.ss
deleted file mode 100644
index 60fc320..0000000
--- a/Examples/test-suite/chicken/typename_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "typename.so")
-(include "../schemerunme/typename.scm")
diff --git a/Examples/test-suite/chicken/unions_runme.ss b/Examples/test-suite/chicken/unions_runme.ss
deleted file mode 100644
index 465784a..0000000
--- a/Examples/test-suite/chicken/unions_runme.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "unions.so")
-(include "../schemerunme/unions.scm")
diff --git a/Examples/test-suite/chicken/unions_runme_proxy.ss b/Examples/test-suite/chicken/unions_runme_proxy.ss
deleted file mode 100644
index 4dd1414..0000000
--- a/Examples/test-suite/chicken/unions_runme_proxy.ss
+++ /dev/null
@@ -1,2 +0,0 @@
-(load "unions.so")
-(include "../schemerunme/unions_proxy.scm")
diff --git a/Examples/test-suite/chicken_ext_test.i b/Examples/test-suite/chicken_ext_test.i
deleted file mode 100644
index b4f726c..0000000
--- a/Examples/test-suite/chicken_ext_test.i
+++ /dev/null
@@ -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));
- }
-%}
-
diff --git a/Examples/test-suite/clisp/Makefile.in b/Examples/test-suite/clisp/Makefile.in
deleted file mode 100644
index 3d20717..0000000
--- a/Examples/test-suite/clisp/Makefile.in
+++ /dev/null
@@ -1,51 +0,0 @@
-#######################################################################
-# Makefile for clisp test-suite
-#######################################################################
-
-LANGUAGE = clisp
-CLISP = @CLISPBIN@
-SCRIPTSUFFIX = _runme.lisp
-
-srcdir = @srcdir@
-top_srcdir = @top_srcdir@
-top_builddir = @top_builddir@
-
-include $(srcdir)/../common.mk
-
-# Overridden variables here
-# no C++ tests for now
-CPP_TEST_CASES =
-#C_TEST_CASES +=
-
-# Custom tests - tests with additional commandline options
-# none!
-
-# Rules for the different types of tests
-%.cpptest:
- $(setup)
- +$(swig_and_compile_cpp)
- $(run_testcase)
-
-%.ctest:
- $(setup)
- +$(swig_and_compile_c)
- $(run_testcase)
-
-%.multicpptest:
- $(setup)
- +$(swig_and_compile_multi_cpp)
- $(run_testcase)
-
-# Runs the testcase. A testcase is only run if
-# a file is found which has _runme.lisp appended after the testcase name.
-run_testcase = \
- if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then \
- env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(RUNTOOL) $(CLISP) -batch -s $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
- fi
-
-# Clean: (does nothing, we dont generate extra clisp code)
-%.clean:
- @exit 0
-
-clean:
- $(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile SRCDIR='$(SRCDIR)' clisp_clean
diff --git a/Examples/test-suite/cpp_basic.i b/Examples/test-suite/cpp_basic.i
index a228af2..f2537e1 100644
--- a/Examples/test-suite/cpp_basic.i
+++ b/Examples/test-suite/cpp_basic.i
@@ -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 */
diff --git a/Examples/test-suite/exception_partial_info.i b/Examples/test-suite/exception_partial_info.i
index 3ac465c..0ff6abc 100644
--- a/Examples/test-suite/exception_partial_info.i
+++ b/Examples/test-suite/exception_partial_info.i
@@ -30,8 +30,6 @@
#if !defined(SWIGUTL)
-#if !defined(SWIGCHICKEN)
-
%inline %{
class Impl
{
@@ -42,10 +40,6 @@
%}
#else
-#warning "Chicken needs fixing for partial exception information"
-#endif
-
-#else
#warning "UTL needs fixing for partial exception information"
#endif
diff --git a/Examples/test-suite/overload_arrays.i b/Examples/test-suite/overload_arrays.i
index 272c96a..e6bd09a 100644
--- a/Examples/test-suite/overload_arrays.i
+++ b/Examples/test-suite/overload_arrays.i
@@ -2,10 +2,6 @@
// Based on overload_simple testcase
%module overload_arrays
-#ifdef SWIGCHICKEN
-%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) fbool;
-#endif
-
#ifdef SWIGLUA
// lua only has one numeric type, so most of the overloads shadow each other creating warnings
%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) foo;
diff --git a/Examples/test-suite/overload_simple.i b/Examples/test-suite/overload_simple.i
index ba1900b..fa2e335 100644
--- a/Examples/test-suite/overload_simple.i
+++ b/Examples/test-suite/overload_simple.i
@@ -1,10 +1,6 @@
// Simple tests of overloaded functions
%module overload_simple
-#ifdef SWIGCHICKEN
-%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) fbool;
-#endif
-
#ifdef SWIGLUA
// lua only has one numeric type, so most of the overloads shadow each other creating warnings
%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) foo;
diff --git a/Examples/test-suite/pike/Makefile.in b/Examples/test-suite/pike/Makefile.in
deleted file mode 100644
index 6e1bdfb..0000000
--- a/Examples/test-suite/pike/Makefile.in
+++ /dev/null
@@ -1,49 +0,0 @@
-#######################################################################
-# Makefile for Pike test-suite
-#######################################################################
-
-LANGUAGE = pike
-PIKE = pike
-SCRIPTSUFFIX = _runme.pike
-
-srcdir = @srcdir@
-top_srcdir = @top_srcdir@
-top_builddir = @top_builddir@
-
-include $(srcdir)/../common.mk
-
-# Overridden variables here
-# none!
-
-# Custom tests - tests with additional commandline options
-# none!
-
-# Rules for the different types of tests
-%.cpptest:
- $(setup)
- +$(swig_and_compile_cpp)
- $(run_testcase)
-
-%.ctest:
- $(setup)
- +$(swig_and_compile_c)
- $(run_testcase)
-
-%.multicpptest:
- $(setup)
- +$(swig_and_compile_multi_cpp)
- $(run_testcase)
-
-# Runs the testcase. A testcase is only run if
-# a file is found which has _runme.pike appended after the testcase name.
-run_testcase = \
- if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then \
- env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(RUNTOOL) $(PIKE) $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
- fi
-
-# Clean: remove the generated .pike file
-%.clean:
- @rm -f $*.pike;
-
-clean:
- $(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile SRCDIR='$(SRCDIR)' pike_clean
diff --git a/Examples/test-suite/preproc.i b/Examples/test-suite/preproc.i
index 215fdd0..1bcdcf7 100644
--- a/Examples/test-suite/preproc.i
+++ b/Examples/test-suite/preproc.i
@@ -298,11 +298,6 @@
/* chiao */
#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
%rename(ddefined) defined;
#endif
diff --git a/Examples/test-suite/schemerunme/li_typemaps.scm b/Examples/test-suite/schemerunme/li_typemaps.scm
index 161e803..a24bbda 100644
--- a/Examples/test-suite/schemerunme/li_typemaps.scm
+++ b/Examples/test-suite/schemerunme/li_typemaps.scm
@@ -24,8 +24,8 @@
;(check "ulonglong" 6432 =)
;; The checking of inoutr-int2 and out-foo is done in the individual
-;; language runme scripts, since chicken returns multiple values
-;; and must be checked with call-with-values, while guile just returns a list
+;; language runme scripts, since how multiple values are returned
+;; differs between scheme variants.
;(call-with-values (lambda () (inoutr-int2 3 -2))
; (lambda (a b)
diff --git a/Examples/test-suite/schemerunme/li_typemaps_proxy.scm b/Examples/test-suite/schemerunme/li_typemaps_proxy.scm
index f61d4fe..07bb855 100644
--- a/Examples/test-suite/schemerunme/li_typemaps_proxy.scm
+++ b/Examples/test-suite/schemerunme/li_typemaps_proxy.scm
@@ -24,8 +24,8 @@
(check "ulonglong" 6432 =)
;; The checking of inoutr-int2 and out-foo is done in the individual
-;; language runme scripts, since chicken returns multiple values
-;; and must be checked with call-with-values, while guile just returns a list
+;; language runme scripts, since how multiple values are returned
+;; differs between scheme variants.
;(call-with-values (lambda () (inoutr-int2 3 -2))
; (lambda (a b)
diff --git a/Examples/test-suite/sizet.i b/Examples/test-suite/sizet.i
index 5379141..6b70f68 100644
--- a/Examples/test-suite/sizet.i
+++ b/Examples/test-suite/sizet.i
@@ -3,9 +3,7 @@
#include <vector>
%}
-#ifndef SWIGCHICKEN
%include "std_common.i"
-#endif
%inline
{
diff --git a/Examples/test-suite/template_default.i b/Examples/test-suite/template_default.i
index d771ef0..83ffd54 100644
--- a/Examples/test-suite/template_default.i
+++ b/Examples/test-suite/template_default.i
@@ -196,7 +196,6 @@
%}
-#ifndef SWIGCHICKEN
%include std_vector.i
%{
@@ -211,6 +210,3 @@
%constant void (*Bf)(std::vector<double> *p = 0) = g;
%constant void (*Cf)(double = 0) = q;
-
-
-#endif
diff --git a/Examples/test-suite/uffi/Makefile.in b/Examples/test-suite/uffi/Makefile.in
deleted file mode 100644
index 5d6dc11..0000000
--- a/Examples/test-suite/uffi/Makefile.in
+++ /dev/null
@@ -1,51 +0,0 @@
-#######################################################################
-# Makefile for uffi test-suite
-#######################################################################
-
-LANGUAGE = uffi
-UFFI = @UFFIBIN@
-SCRIPTSUFFIX = _runme.lisp
-
-srcdir = @srcdir@
-top_srcdir = @top_srcdir@
-top_builddir = @top_builddir@
-
-include $(srcdir)/../common.mk
-
-# Overridden variables here
-# no C++ tests for now
-CPP_TEST_CASES =
-#C_TEST_CASES +=
-
-# Custom tests - tests with additional commandline options
-# none!
-
-# Rules for the different types of tests
-%.cpptest:
- $(setup)
- +$(swig_and_compile_cpp)
- $(run_testcase)
-
-%.ctest:
- $(setup)
- +$(swig_and_compile_c)
- $(run_testcase)
-
-%.multicpptest:
- $(setup)
- +$(swig_and_compile_multi_cpp)
- $(run_testcase)
-
-# Runs the testcase. A testcase is only run if
-# a file is found which has _runme.lisp appended after the testcase name.
-run_testcase = \
- if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then \
- env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(RUNTOOL) $(UFFI) -batch -s $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
- fi
-
-# Clean: (does nothing, we dont generate extra uffi code)
-%.clean:
- @exit 0
-
-clean:
- $(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile SRCDIR='$(SRCDIR)' uffi_clean
diff --git a/Lib/allegrocl/allegrocl.swg b/Lib/allegrocl/allegrocl.swg
deleted file mode 100644
index 524aa7c..0000000
--- a/Lib/allegrocl/allegrocl.swg
+++ /dev/null
@@ -1,615 +0,0 @@
-/* Define a C preprocessor symbol that can be used in interface files
- to distinguish between the SWIG language modules. */
-
-#define SWIG_ALLEGRO_CL
-
-#define %ffargs(...) %feature("ffargs", "1", ##__VA_ARGS__)
-%ffargs(strings_convert="t");
-
-/* typemaps for argument and result type conversions. */
-%typemap(lin,numinputs=1) SWIGTYPE "(cl::let (($out $in))\n $body)";
-
-%typemap(lout) bool, char, unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- float, double, long double, char *, void *,
- enum SWIGTYPE "(cl::setq ACL_ffresult $body)";
-%typemap(lout) void "$body";
-#ifdef __cplusplus
-%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&
-%{ (cl:let* ((address $body)
- (new-inst (cl:make-instance '$lclass :foreign-address address)))
- (cl:when (cl:and $owner (cl:not (cl:zerop address)))
- (excl:schedule-finalization new-inst #'$ldestructor))
- (cl:setq ACL_ffresult new-inst)) %}
-
-%typemap(lout) SWIGTYPE "(cl::let* ((address $body)\n (new-inst (cl::make-instance '$lclass :foreign-address address)))\n (cl::unless (cl::zerop address)\n (excl:schedule-finalization new-inst #'$ldestructor))\n (cl::setq ACL_ffresult new-inst))";
-#else
-%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE
-%{ (cl:let* ((address $body)
- (new-inst (cl:make-instance '$lclass :foreign-address address)))
- (cl:setq ACL_ffresult new-inst)) %}
-#endif
-
-%typemap(lisptype) bool, const bool "cl:boolean";
-%typemap(lisptype) char, const char "cl:character";
-%typemap(lisptype) unsigned char, const unsigned char "cl:integer";
-%typemap(lisptype) signed char, const signed char "cl:integer";
-
-%typemap(ffitype) bool, const bool ":int";
-%typemap(ffitype) char, const char,
- signed char, const signed char ":char";
-%typemap(ffitype) unsigned char, const unsigned char ":unsigned-char";
-%typemap(ffitype) short, const short,
- signed short, const signed short ":short";
-%typemap(ffitype) unsigned short, const unsigned short ":unsigned-short";
-%typemap(ffitype) int, const int, signed int, const signed int ":int";
-%typemap(ffitype) unsigned int, const unsigned int ":unsigned-int";
-%typemap(ffitype) long, const long, signed long, const signed long ":long";
-%typemap(ffitype) unsigned long, const unsigned long ":unsigned-long";
-%typemap(ffitype) float, const float ":float";
-%typemap(ffitype) double, const double ":double";
-%typemap(ffitype) char *, const char *, signed char *,
- const signed char *, signed char &,
- const signed char & "(* :char)";
-%typemap(ffitype) unsigned char *, const unsigned char *,
- unsigned char &, const unsigned char & "(* :unsigned-char)";
-%typemap(ffitype) short *, const short *, short &,
- const short & "(* :short)";
-%typemap(ffitype) unsigned short *, const unsigned short *,
- unsigned short &, const unsigned short & "(* :unsigned-short)";
-%typemap(ffitype) int *, const int *, int &, const int & "(* :int)";
-%typemap(ffitype) unsigned int *, const unsigned int *,
- unsigned int &, const unsigned int & "(* :unsigned-int)";
-%typemap(ffitype) void * "(* :void)";
-%typemap(ffitype) void ":void";
-%typemap(ffitype) enum SWIGTYPE ":int";
-%typemap(ffitype) SWIGTYPE & "(* :void)";
-%typemap(ffitype) SWIGTYPE && "(* :void)";
-
-/* const typemaps
-idea: marshall all primitive c types to their respective lisp types
-to maintain const corretness. For pointers/references, all bets
-are off if you try to modify them.
-
-idea: add a constant-p slot to the base foreign-pointer class. For
-constant pointer/references check this value when setting (around method?)
-and error if a setf operation is performed on the address of this object.
-
-*/
-
-/*
-%exception %{
- try {
- $action
- } catch (...) {
- return $null;
- }
-%}
-
-*/
-
-// %typemap(throws) SWIGTYPE {
-// (void)$1;
-// SWIG_fail;
-// }
-
-%typemap(ctype) bool, const bool "int";
-%typemap(ctype) char, unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- float, double, long double, char *, void *, void,
- enum SWIGTYPE, SWIGTYPE *, SWIGTYPE[],
- SWIGTYPE[ANY], SWIGTYPE &, SWIGTYPE &&, const SWIGTYPE "$1_ltype";
-%typemap(ctype) SWIGTYPE "$&1_type";
-
-%typemap(in) bool "$1 = (bool)$input;";
-%typemap(in) char, unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- float, double, long double, char *, void *, void,
- enum SWIGTYPE, SWIGTYPE *, SWIGTYPE[],
- SWIGTYPE[ANY], SWIGTYPE &, SWIGTYPE && "$1 = $input;";
-%typemap(in) SWIGTYPE "$1 = *$input;";
-
-/* We don't need to do any actual C-side typechecking, but need to
- use the precedence values to choose which overloaded function
- interfaces to generate when conflicts arise. */
-
-/* predefined precedence values
-
-Symbolic Name Precedence Value
------------------------------- ------------------
-SWIG_TYPECHECK_POINTER 0
-SWIG_TYPECHECK_VOIDPTR 10
-SWIG_TYPECHECK_BOOL 15
-SWIG_TYPECHECK_UINT8 20
-SWIG_TYPECHECK_INT8 25
-SWIG_TYPECHECK_UINT16 30
-SWIG_TYPECHECK_INT16 35
-SWIG_TYPECHECK_UINT32 40
-SWIG_TYPECHECK_INT32 45
-SWIG_TYPECHECK_UINT64 50
-SWIG_TYPECHECK_INT64 55
-SWIG_TYPECHECK_UINT128 60
-SWIG_TYPECHECK_INT128 65
-SWIG_TYPECHECK_INTEGER 70
-SWIG_TYPECHECK_FLOAT 80
-SWIG_TYPECHECK_DOUBLE 90
-SWIG_TYPECHECK_COMPLEX 100
-SWIG_TYPECHECK_UNICHAR 110
-SWIG_TYPECHECK_UNISTRING 120
-SWIG_TYPECHECK_CHAR 130
-SWIG_TYPECHECK_STRING 140
-SWIG_TYPECHECK_BOOL_ARRAY 1015
-SWIG_TYPECHECK_INT8_ARRAY 1025
-SWIG_TYPECHECK_INT16_ARRAY 1035
-SWIG_TYPECHECK_INT32_ARRAY 1045
-SWIG_TYPECHECK_INT64_ARRAY 1055
-SWIG_TYPECHECK_INT128_ARRAY 1065
-SWIG_TYPECHECK_FLOAT_ARRAY 1080
-SWIG_TYPECHECK_DOUBLE_ARRAY 1090
-SWIG_TYPECHECK_CHAR_ARRAY 1130
-SWIG_TYPECHECK_STRING_ARRAY 1140
-*/
-
-%typecheck(SWIG_TYPECHECK_BOOL) bool { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_CHAR) char { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_FLOAT) float { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_DOUBLE) double { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_STRING) char * { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_INTEGER)
- unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- enum SWIGTYPE { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&,
- SWIGTYPE[], SWIGTYPE[ANY],
- SWIGTYPE { $1 = 1; };
-
-/* This maps C/C++ types to Lisp classes for overload dispatch */
-
-%typemap(lispclass) bool "t";
-%typemap(lispclass) char "cl:character";
-%typemap(lispclass) unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- enum SWIGTYPE "cl:integer";
-%typemap(lispclass) float "cl:single-float";
-%typemap(lispclass) double "cl:double-float";
-%typemap(lispclass) char * "cl:string";
-
-%typemap(out) void "";
-%typemap(out) bool "$result = (int)$1;";
-%typemap(out) char, unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- float, double, long double, char *, void *,
- enum SWIGTYPE, SWIGTYPE *,
- SWIGTYPE[ANY], SWIGTYPE &, SWIGTYPE && "$result = $1;";
-#ifdef __cplusplus
-%typemap(out) SWIGTYPE "$result = new $1_ltype($1);";
-#else
-%typemap(out) SWIGTYPE {
- $result = ($&1_ltype) malloc(sizeof($1_type));
- memmove($result, &$1, sizeof($1_type));
-}
-#endif
-
-//////////////////////////////////////////////////////////////
-// UCS-2 string conversion
-
-// should this be SWIG_TYPECHECK_CHAR?
-%typecheck(SWIG_TYPECHECK_UNICHAR) wchar_t { $1 = 1; };
-
-%typemap(in) wchar_t "$1 = $input;";
-%typemap(lin,numinputs=1) wchar_t "(cl::let (($out (cl:char-code $in)))\n $body)";
-%typemap(lin,numinputs=1) wchar_t * "(excl:with-native-string ($out $in
-:external-format #+little-endian :fat-le #-little-endian :fat)\n
-$body)"
-
-%typemap(out) wchar_t "$result = $1;";
-%typemap(lout) wchar_t "(cl::setq ACL_ffresult (cl::code-char $body))";
-%typemap(lout) wchar_t * "(cl::setq ACL_ffresult (excl:native-to-string $body
-:external-format #+little-endian :fat-le #-little-endian :fat))";
-
-%typemap(ffitype) wchar_t ":unsigned-short";
-%typemap(lisptype) wchar_t "";
-%typemap(ctype) wchar_t "wchar_t";
-%typemap(lispclass) wchar_t "cl:character";
-%typemap(lispclass) wchar_t * "cl:string";
-//////////////////////////////////////////////////////////////
-
-/* 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&) }
-
-/* name conversion for overloaded operators. */
-#ifdef __cplusplus
-%rename(__add__) *::operator+;
-%rename(__pos__) *::operator+();
-%rename(__pos__) *::operator+() const;
-
-%rename(__sub__) *::operator-;
-%rename(__neg__) *::operator-() const;
-%rename(__neg__) *::operator-();
-
-%rename(__mul__) *::operator*;
-%rename(__deref__) *::operator*();
-%rename(__deref__) *::operator*() const;
-
-%rename(__div__) *::operator/;
-%rename(__mod__) *::operator%;
-%rename(__logxor__) *::operator^;
-%rename(__logand__) *::operator&;
-%rename(__logior__) *::operator|;
-%rename(__lognot__) *::operator~();
-%rename(__lognot__) *::operator~() const;
-
-%rename(__not__) *::operator!();
-%rename(__not__) *::operator!() const;
-
-%rename(__assign__) *::operator=;
-
-%rename(__add_assign__) *::operator+=;
-%rename(__sub_assign__) *::operator-=;
-%rename(__mul_assign__) *::operator*=;
-%rename(__div_assign__) *::operator/=;
-%rename(__mod_assign__) *::operator%=;
-%rename(__logxor_assign__) *::operator^=;
-%rename(__logand_assign__) *::operator&=;
-%rename(__logior_assign__) *::operator|=;
-
-%rename(__lshift__) *::operator<<;
-%rename(__lshift_assign__) *::operator<<=;
-%rename(__rshift__) *::operator>>;
-%rename(__rshift_assign__) *::operator>>=;
-
-%rename(__eq__) *::operator==;
-%rename(__ne__) *::operator!=;
-%rename(__lt__) *::operator<;
-%rename(__gt__) *::operator>;
-%rename(__lte__) *::operator<=;
-%rename(__gte__) *::operator>=;
-
-%rename(__and__) *::operator&&;
-%rename(__or__) *::operator||;
-
-%rename(__preincr__) *::operator++();
-%rename(__postincr__) *::operator++(int);
-%rename(__predecr__) *::operator--();
-%rename(__postdecr__) *::operator--(int);
-
-%rename(__comma__) *::operator,();
-%rename(__comma__) *::operator,() const;
-
-%rename(__member_ref__) *::operator->;
-%rename(__member_func_ref__) *::operator->*;
-
-%rename(__funcall__) *::operator();
-%rename(__aref__) *::operator[];
-
-%rename(__bool__) *::operator bool();
-%rename(__bool__) *::operator bool() const;
-#endif
-
-%insert("lisphead") %{
-(eval-when (:compile-toplevel :load-toplevel :execute)
-
- ;; avoid compiling ef-templates at runtime
- (excl:find-external-format :fat)
- (excl:find-external-format :fat-le)
-
-;;; You can define your own identifier converter if you want.
-;;; Use the -identifier-converter command line argument to
-;;; specify its name.
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (cl::defparameter *swig-export-list* nil))
-
-(cl::defconstant *void* :..void..)
-
-;; parsers to aid in finding SWIG definitions in files.
-(cl::defun scm-p1 (form)
- (let* ((info (cl::second form))
- (id (car info))
- (id-args (if (eq (cl::car form) 'swig-dispatcher)
- (cl::cdr info)
- (cl::cddr info))))
- (cl::apply *swig-identifier-converter* id
- (cl::progn (cl::when (cl::eq (cl::car form) 'swig-dispatcher)
- (cl::remf id-args :arities))
- id-args))))
-
-(cl::defmacro defswig1 (name (&rest args) &body body)
- `(cl::progn (cl::defmacro ,name ,args
- ,@body)
- (excl::define-simple-parser ,name scm-p1)) )
-
-(cl::defmacro defswig2 (name (&rest args) &body body)
- `(cl::progn (cl::defmacro ,name ,args
- ,@body)
- (excl::define-simple-parser ,name second)))
-
-(defun read-symbol-from-string (string)
- (cl::multiple-value-bind (result position)
- (cl::read-from-string string nil "eof" :preserve-whitespace t)
- (cl::if (cl::and (cl::symbolp result)
- (cl::eql position (cl::length string)))
- result
- (cl::multiple-value-bind (sym)
- (cl::intern string)
- sym))))
-
-(cl::defun full-name (id type arity class)
- ; We need some kind of a hack here to handle template classes
- ; and other synonym types right. We need the original name.
- (let*( (sym (read-symbol-from-string
- (if (eq *swig-identifier-converter* 'identifier-convert-lispify)
- (string-lispify id)
- id)))
- (sym-class (find-class sym nil))
- (id (cond ( (not sym-class)
- id )
- ( (and sym-class
- (not (eq (class-name sym-class)
- sym)))
- (class-name sym-class) )
- ( t
- id ))) )
- (cl::case type
- (:getter (cl::format nil "~@[~A_~]~A" class id))
- (:constructor (cl::format nil "new_~A~@[~A~]" id arity))
- (:destructor (cl::format nil "delete_~A" id))
- (:type (cl::format nil "ff_~A" id))
- (:slot id)
- (:ff-operator (cl::format nil "ffi_~A" id))
- (otherwise (cl::format nil "~@[~A_~]~A~@[~A~]"
- class id arity)))))
-
-(cl::defun identifier-convert-null (id &key type class arity)
- (cl::if (cl::eq type :setter)
- `(cl::setf ,(identifier-convert-null
- id :type :getter :class class :arity arity))
- (read-symbol-from-string (full-name id type arity class))))
-
-(cl::defun string-lispify (str)
- (cl::let ( (cname (excl::replace-regexp str "_" "-"))
- (lastcase :other)
- newcase char res )
- (cl::dotimes (n (cl::length cname))
- (cl::setf char (cl::schar cname n))
- (excl::if* (cl::alpha-char-p char)
- then
- (cl::setf newcase (cl::if (cl::upper-case-p char) :upper :lower))
- (cl::when (cl::and (cl::eq lastcase :lower)
- (cl::eq newcase :upper))
- ;; case change... add a dash
- (cl::push #\- res)
- (cl::setf newcase :other))
- (cl::push (cl::char-downcase char) res)
- (cl::setf lastcase newcase)
- else
- (cl::push char res)
- (cl::setf lastcase :other)))
- (cl::coerce (cl::nreverse res) 'string)))
-
-(cl::defun identifier-convert-lispify (cname &key type class arity)
- (cl::assert (cl::stringp cname))
- (cl::when (cl::eq type :setter)
- (cl::return-from identifier-convert-lispify
- `(cl::setf ,(identifier-convert-lispify
- cname :type :getter :class class :arity arity))))
- (cl::setq cname (full-name cname type arity class))
- (cl::if (cl::eq type :constant)
- (cl::setf cname (cl::format nil "*~A*" cname)))
- (read-symbol-from-string (string-lispify cname)))
-
-(cl::defun id-convert-and-export (name &rest kwargs)
- (cl::multiple-value-bind (symbol package)
- (cl::apply *swig-identifier-converter* name kwargs)
- (cl::let ((args (cl::list (cl::if (cl::consp symbol)
- (cl::cadr symbol) symbol)
- (cl::or package cl::*package*))))
- (cl::apply #'cl::export args)
- (cl::pushnew args *swig-export-list*))
- symbol))
-
-(cl::defmacro swig-insert-id (name namespace &key (type :type) class)
- `(cl::let ((cl::*package* (cl::find-package ,(package-name-for-namespace namespace))))
- (id-convert-and-export ,name :type ,type :class ,class)))
-
-(defswig2 swig-defconstant (string value)
- (cl::let ((symbol (id-convert-and-export string :type :constant)))
- `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
- (cl::defconstant ,symbol ,value))))
-
-(cl::defun maybe-reorder-args (funcname arglist)
- ;; in the foreign setter function the new value will be the last argument
- ;; in Lisp it needs to be the first
- (cl::if (cl::consp funcname)
- (cl::append (cl::last arglist) (cl::butlast arglist))
- arglist))
-
-(cl::defun maybe-return-value (funcname arglist)
- ;; setf functions should return the new value
- (cl::when (cl::consp funcname)
- `(,(cl::if (cl::consp (cl::car arglist))
- (cl::caar arglist)
- (cl::car arglist)))))
-
-(cl::defun swig-anyvarargs-p (arglist)
- (cl::member :SWIG__varargs_ arglist))
-
-(defswig1 swig-defun ((name &optional (mangled-name name)
- &key (type :operator) class arity)
- arglist kwargs
- &body body)
- (cl::let* ((symbol (id-convert-and-export name :type type
- :arity arity :class class))
- (mangle (excl::if* (cl::string-equal name mangled-name)
- then (id-convert-and-export
- (cl::cond
- ((cl::eq type :setter) (cl::format nil "~A-set" name))
- ((cl::eq type :getter) (cl::format nil "~A-get" name))
- (t name))
- :type :ff-operator :arity arity :class class)
- else (cl::intern mangled-name)))
- (defun-args (maybe-reorder-args
- symbol
- (cl::mapcar #'cl::car (cl::and (cl::not (cl::equal arglist '(:void)))
- (cl::loop as i in arglist
- when (cl::eq (cl::car i) :p+)
- collect (cl::cdr i))))))
- (ffargs (cl::if (cl::equal arglist '(:void))
- arglist
- (cl::mapcar #'cl::cdr arglist)))
- )
- (cl::when (swig-anyvarargs-p ffargs)
- (cl::setq ffargs '()))
- `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
- (excl::compiler-let ((*record-xref-info* nil))
- (ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs))
- (cl::macrolet ((swig-ff-call (&rest args)
- (cl::cons ',mangle args)))
- (cl::defun ,symbol ,defun-args
- ,@body
- ,@(maybe-return-value symbol defun-args))))))
-
-(defswig1 swig-defmethod ((name &optional (mangled-name name)
- &key (type :operator) class arity)
- ffargs kwargs
- &body body)
- (cl::let* ((symbol (id-convert-and-export name :type type
- :arity arity :class class))
- (mangle (cl::intern mangled-name))
- (defmethod-args (maybe-reorder-args
- symbol
- (cl::unless (cl::equal ffargs '(:void))
- (cl::loop for (lisparg name dispatch) in ffargs
- when (eq lisparg :p+)
- collect `(,name ,dispatch)))))
- (ffargs (cl::if (cl::equal ffargs '(:void))
- ffargs
- (cl::loop for (nil name nil . ffi) in ffargs
- collect `(,name ,@ffi)))))
- `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
- (excl::compiler-let ((*record-xref-info* nil))
- (ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs))
- (cl::macrolet ((swig-ff-call (&rest args)
- (cl::cons ',mangle args)))
- (cl::defmethod ,symbol ,defmethod-args
- ,@body
- ,@(maybe-return-value symbol defmethod-args))))))
-
-(defswig1 swig-dispatcher ((name &key (type :operator) class arities))
- (cl::let ((symbol (id-convert-and-export name
- :type type :class class)))
- `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
- (cl::defun ,symbol (&rest args)
- (cl::case (cl::length args)
- ,@(cl::loop for arity in arities
- for symbol-n = (id-convert-and-export name
- :type type :class class :arity arity)
- collect `(,arity (cl::apply #',symbol-n args)))
- (t (cl::error "No applicable wrapper-methods for foreign call ~a with args ~a of classes ~a" ',symbol args (cl::mapcar #'(cl::lambda (x) (cl::class-name (cl::class-of x))) args)))
- )))))
-
-(defswig2 swig-def-foreign-stub (name)
- (cl::let ((lsymbol (id-convert-and-export name :type :class))
- (symbol (id-convert-and-export name :type :type)))
- `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
- (ff:def-foreign-type ,symbol (:class ))
- (cl::defclass ,lsymbol (ff:foreign-pointer) ()))))
-
-(defswig2 swig-def-foreign-class (name supers &rest rest)
- (cl::let ((lsymbol (id-convert-and-export name :type :class))
- (symbol (id-convert-and-export name :type :type)))
- `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
- (ff:def-foreign-type ,symbol ,@rest)
- (cl::defclass ,lsymbol ,supers
- ((foreign-type :initform ',symbol :initarg :foreign-type
- :accessor foreign-pointer-type))))))
-
-(defswig2 swig-def-foreign-type (name &rest rest)
- (cl::let ((symbol (id-convert-and-export name :type :type)))
- `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
- (ff:def-foreign-type ,symbol ,@rest))))
-
-(defswig2 swig-def-synonym-type (synonym of ff-synonym)
- `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
- (cl::setf (cl::find-class ',synonym) (cl::find-class ',of))
- (ff:def-foreign-type ,ff-synonym (:struct ))))
-
-(cl::defun package-name-for-namespace (namespace)
- (excl::list-to-delimited-string
- (cl::cons *swig-module-name*
- (cl::mapcar #'(cl::lambda (name)
- (cl::string
- (cl::funcall *swig-identifier-converter*
- name
- :type :namespace)))
- namespace))
- "."))
-
-(cl::defmacro swig-defpackage (namespace)
- (cl::let* ((parent-namespaces (cl::maplist #'cl::reverse (cl::cdr (cl::reverse namespace))))
- (parent-strings (cl::mapcar #'package-name-for-namespace
- parent-namespaces))
- (string (package-name-for-namespace namespace)))
- `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
- (cl::defpackage ,string
- (:use :swig :ff #+ignore '(:common-lisp :ff :excl)
- ,@parent-strings ,*swig-module-name*)
- (:import-from :cl :* :nil :t)))))
-
-(cl::defmacro swig-in-package (namespace)
- `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
- (cl::in-package ,(package-name-for-namespace namespace))))
-
-(defswig2 swig-defvar (name mangled-name &key type (ftype :unsigned-natural))
- (cl::let ((symbol (id-convert-and-export name :type type)))
- `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
- (ff:def-foreign-variable (,symbol ,mangled-name) :type ,ftype))))
-
-) ;; eval-when
-
-(cl::eval-when (:compile-toplevel :execute)
- (cl::flet ((starts-with-p (str prefix)
- (cl::and (cl::>= (cl::length str) (cl::length prefix))
- (cl::string= str prefix :end1 (cl::length prefix)))))
- (cl::export (cl::loop for sym being each present-symbol of cl::*package*
- when (cl::or (starts-with-p (cl::symbol-name sym) (cl::symbol-name :swig-))
- (starts-with-p (cl::symbol-name sym) (cl::symbol-name :identifier-convert-)))
- collect sym))))
-
-%}
-
-typedef void *__SWIGACL_FwdReference;
-
-%{
-
-#ifdef __cplusplus
-# define EXTERN extern "C"
-#else
-# define EXTERN extern
-#endif
-
-#define EXPORT EXTERN SWIGEXPORT
-
-typedef void *__SWIGACL_FwdReference;
-
-#include <string.h>
-#include <stdlib.h>
-%}
diff --git a/Lib/allegrocl/inout_typemaps.i b/Lib/allegrocl/inout_typemaps.i
deleted file mode 100644
index d8d61fe..0000000
--- a/Lib/allegrocl/inout_typemaps.i
+++ /dev/null
@@ -1,111 +0,0 @@
-/* inout_typemaps.i
-
- Support for INPUT, OUTPUT, and INOUT typemaps. OUTPUT variables are returned
- as multiple values.
-
-*/
-
-
-/* Note that this macro automatically adds a pointer to the type passed in.
- As a result, INOUT typemaps for char are for 'char *'. The definition
- of typemaps for 'char' takes advantage of this, believing that it's more
- likely to see an INOUT argument for strings, than a single char. */
-%define INOUT_TYPEMAP(type_, OUTresult_, INbind_)
-// OUTPUT map.
-%typemap(lin,numinputs=0) type_ *OUTPUT, type_ &OUTPUT
-%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
- $body
- OUTresult_
- (ff:free-fobject $out)) %}
-
-// INPUT map.
-%typemap(in) type_ *INPUT, type_ &INPUT
-%{ $1 = &$input; %}
-
-%typemap(ctype) type_ *INPUT, type_ &INPUT "$*1_ltype";
-
-
-// INOUT map.
-// careful here. the input string is converted to a C string
-// with length equal to the input string. This should be large
-// enough to contain whatever OUTPUT value will be stored in it.
-%typemap(lin,numinputs=1) type_ *INOUT, type_ &INOUT
-%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
- INbind_
- $body
- OUTresult_
- (ff:free-fobject $out)) %}
-
-%enddef
-
-// $in, $out, $lclass,
-// $in_fftype, $*in_fftype
-
-INOUT_TYPEMAP(int,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(short,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(long,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(unsigned int,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(unsigned short,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(unsigned long,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-// char * mapping for passing strings. didn't quite work
-// INOUT_TYPEMAP(char,
-// (cl::push (excl:native-to-string $out) ACL_result),
-// (cl::setf (ff:fslot-value-typed (cl::quote $in_fftype) :c $out)
-// (excl:string-to-native $in)))
-INOUT_TYPEMAP(float,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(double,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(bool,
- (cl::push (not (zerop (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out)))
- ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) (if $in 1 0)));
-
-%typemap(lisptype) bool *INPUT, bool &INPUT "boolean";
-
-// long long support not yet complete
-// INOUT_TYPEMAP(long long);
-// INOUT_TYPEMAP(unsigned long long);
-
-// char *OUTPUT map.
-// for this to work, swig needs to know how large an array to allocate.
-// you can fake this by
-// %typemap(ffitype) char *myarg "(:array :char 30)";
-// %apply char *OUTPUT { char *myarg };
-%typemap(lin,numinputs=0) char *OUTPUT, char &OUTPUT
-%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
- $body
- (cl::push (excl:native-to-string $out) ACL_result)
- (ff:free-fobject $out)) %}
-
-// char *INPUT map.
-%typemap(in) char *INPUT, char &INPUT
-%{ $1 = &$input; %}
-%typemap(ctype) char *INPUT, char &INPUT "$*1_ltype";
-
-// char *INOUT map.
-%typemap(lin,numinputs=1) char *INOUT, char &INOUT
-%{(cl::let (($out (excl:string-to-native $in)))
- $body
- (cl::push (excl:native-to-string $out) ACL_result)
- (ff:free-fobject $out)) %}
-
-// uncomment this if you want INOUT mappings for chars instead of strings.
-// INOUT_TYPEMAP(char,
-// (cl::push (code-char (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out))
-// ACL_result),
-// (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
diff --git a/Lib/allegrocl/longlongs.i b/Lib/allegrocl/longlongs.i
deleted file mode 100644
index a15adcd..0000000
--- a/Lib/allegrocl/longlongs.i
+++ /dev/null
@@ -1,49 +0,0 @@
-/* -----------------------------------------------------------------------------
- * longlongs.i
- *
- * Typemap addition for support of 'long long' type and 'unsigned long long
- * Makes use of swig-def-foreign-class, so this header should be loaded
- * after allegrocl.swg and after any custom user identifier-conversion
- * functions have been defined.
- * ----------------------------------------------------------------------------- */
-
-#ifdef Acl64Bit
-%typemap(ctype) long long, unsigned long long "$1_ltype";
-%typemap(out) long long, unsigned long long "$result = $1;";
-
-%typemap(ffitype) long long ":nat";
-%typemap(ffitype) unsigned long long ":unsigned-nat";
-
-%typemap(lout) long long, unsigned long long " #+64bit (cl::setq ACL_ffresult $body)";
-
-#else
-%typemap(out) long long, unsigned long long "$result = &$1;";
-%typemap(ffitype) long long "(:struct (l1 :long) (l2 :long))";
-
-%typemap(ffitype) unsigned long long "(:struct (l1 :unsigned-long) (l2 :unsigned-long))";
-
-%typemap(lout) long long
-" (cl::setq ACL_ffresult (make-instance '#.(swig-insert-id \"longlong\" () :type :class)
- :foreign-address $body))";
-
-%typemap(lout) unsigned long long
-" (cl:setq ACL_ffresult (make-instance '#.(swig-insert-id \"ulonglong\" () :type :class)
- :foreign-address $body))";
-
-#endif
-
-%typemap(in) long long, unsigned long long "$1 = $input;";
-
-
-%insert("lisphead") %{
-
-#-64bit
-(swig-def-foreign-class "longlong"
- (ff:foreign-pointer)
- (:struct (l1 :long) (l2 :long)))
-
-#-64bit
-(swig-def-foreign-class "ulonglong"
- (ff:foreign-pointer)
- (:struct (l1 :unsigned-long) (l2 :unsigned-long)))
-%}
diff --git a/Lib/allegrocl/std_list.i b/Lib/allegrocl/std_list.i
deleted file mode 100644
index a3660c9..0000000
--- a/Lib/allegrocl/std_list.i
+++ /dev/null
@@ -1,230 +0,0 @@
-/* -----------------------------------------------------------------------------
- * std_list.i
- *
- * SWIG typemaps for std::list types
- *
- * To use, add:
- *
- * %include "std_list.i"
- *
- * to your interface file. You will also need to include a template directive
- * for each instance of the list container you want to use in your application.
- * e.g.
- *
- * %template (intlist) std::list<int>;
- * %template (floatlist) std::list<float>;
- * ----------------------------------------------------------------------------- */
-
-%module std_list
-%warnfilter(468) std::list;
-
-%{
-#include <list>
-#include <stdexcept>
-%}
-
-
-namespace std{
- template<class T> class list
- {
- public:
- typedef size_t size_type;
- typedef ptrdiff_t difference_type;
- typedef T value_type;
- typedef value_type* pointer;
- typedef const value_type* const_pointer;
- typedef value_type& reference;
- typedef const value_type& const_reference;
- typedef T &iterator;
- typedef const T& const_iterator;
-
- list();
- list(unsigned int size, const T& value = T());
- list(const list& other);
-
- void assign(unsigned int n, const T& value);
- void swap(list<T> &x);
-
- const_reference front();
- const_reference back();
- const_iterator begin();
- const_iterator end();
-
- void resize(unsigned int n, T c = T());
- bool empty() const;
-
- void push_front(const T& INPUT);
- void push_back(const T& INPUT);
-
- void pop_front();
- void pop_back();
- void clear();
- unsigned int size() const;
- unsigned int max_size() const;
- void resize(unsigned int n, const T& INPUT);
-
- void remove(const T& INPUT);
- void unique();
- void reverse();
- void sort();
-
- %extend
- {
- %typemap(lout) T &__getitem__ "(cl::setq ACL_ffresult (ff:fslot-value-typed '$*out_fftype :c $body))";
- %typemap(lout) T *__getitem__ "(cl::setq ACL_ffresult (make-instance '$lclass :foreign-address $body))";
-
- const_reference __getitem__(int i) throw (std::out_of_range)
- {
- std::list<T>::iterator first = self->begin();
- int size = int(self->size());
- if (i<0) i += size;
- if (i>=0 && i<size)
- {
- for (int k=0;k<i;k++)
- {
- first++;
- }
- return *first;
- }
- else throw std::out_of_range("list index out of range");
- }
- void __setitem__(int i, const T& INPUT) throw (std::out_of_range)
- {
- std::list<T>::iterator first = self->begin();
- int size = int(self->size());
- if (i<0) i += size;
- if (i>=0 && i<size)
- {
- for (int k=0;k<i;k++)
- {
- first++;
- }
- *first = INPUT;
- }
- else throw std::out_of_range("list index out of range");
- }
- void __delitem__(int i) throw (std::out_of_range)
- {
- std::list<T>::iterator first = self->begin();
- int size = int(self->size());
- if (i<0) i += size;
- if (i>=0 && i<size)
- {
- for (int k=0;k<i;k++)
- {
- first++;
- }
- self->erase(first);
- }
- else throw std::out_of_range("list index out of range");
- }
- std::list<T> __getslice__(int i,int j)
- {
- std::list<T>::iterator first = self->begin();
- std::list<T>::iterator end = self->end();
-
- int size = int(self->size());
- if (i<0) i += size;
- if (j<0) j += size;
- if (i<0) i = 0;
- if (j>size) j = size;
- if (i>=j) i=j;
- if (i>=0 && i<size && j>=0)
- {
- for (int k=0;k<i;k++)
- {
- first++;
- }
- for (int m=0;m<j;m++)
- {
- end++;
- }
- std::list<T> tmp(j-i);
- if (j>i) std::copy(first,end,tmp.begin());
- return tmp;
- }
- else throw std::out_of_range("list index out of range");
- }
- void __delslice__(int i,int j)
- {
- std::list<T>::iterator first = self->begin();
- std::list<T>::iterator end = self->end();
-
- int size = int(self->size());
- if (i<0) i += size;
- if (j<0) j += size;
- if (i<0) i = 0;
- if (j>size) j = size;
-
- for (int k=0;k<i;k++)
- {
- first++;
- }
- for (int m=0;m<=j;m++)
- {
- end++;
- }
- self->erase(first,end);
- }
- void __setslice__(int i,int j, const std::list<T>& v)
- {
- std::list<T>::iterator first = self->begin();
- std::list<T>::iterator end = self->end();
-
- int size = int(self->size());
- if (i<0) i += size;
- if (j<0) j += size;
- if (i<0) i = 0;
- if (j>size) j = size;
-
- for (int k=0;k<i;k++)
- {
- first++;
- }
- for (int m=0;m<=j;m++)
- {
- end++;
- }
- if (int(v.size()) == j-i)
- {
- std::copy(v.begin(),v.end(),first);
- }
- else {
- self->erase(first,end);
- if (i+1 <= int(self->size()))
- {
- first = self->begin();
- for (int k=0;k<i;k++)
- {
- first++;
- }
- self->insert(first,v.begin(),v.end());
- }
- else self->insert(self->end(),v.begin(),v.end());
- }
- }
- unsigned int __len__()
- {
- return self->size();
- }
- bool __nonzero__()
- {
- return !(self->empty());
- }
- void append(const T& INPUT)
- {
- self->push_back(INPUT);
- }
- void pop()
- {
- self->pop_back();
- }
- }
- };
-}
-
-
-
-
-
-
diff --git a/Lib/allegrocl/std_string.i b/Lib/allegrocl/std_string.i
deleted file mode 100644
index cbcd250..0000000
--- a/Lib/allegrocl/std_string.i
+++ /dev/null
@@ -1,209 +0,0 @@
-/* -----------------------------------------------------------------------------
- * std_string.i
- *
- * SWIG typemaps for std::string
- * ----------------------------------------------------------------------------- */
-
-// ------------------------------------------------------------------------
-// std::string is typemapped by value
-// This can prevent exporting methods which return a string
-// in order for the user to modify it.
-// However, I think I'll wait until someone asks for it...
-// ------------------------------------------------------------------------
-
-// %include <exception.i>
-%warnfilter(404) std::string;
-%warnfilter(404) std::wstring;
-
-%{
-#include <string>
-%}
-
-// %include <std_vector.i>
-
-// %naturalvar std::string;
-// %naturalvar std::wstring;
-
-namespace std {
- typedef unsigned long size_t;
- typedef signed long ptrdiff_t;
-
- template <class charT> class basic_string {
- public:
- typedef charT *pointer;
- typedef charT &reference;
- typedef const charT &const_reference;
- typedef size_t size_type;
- typedef ptrdiff_t difference_type;
- basic_string();
- basic_string( charT *str );
- size_type size();
- charT operator []( int pos ) const;
- charT *c_str() const;
- basic_string<charT> &operator = ( const basic_string &ws );
- basic_string<charT> &operator = ( const charT *str );
- basic_string<charT> &append( const basic_string<charT> &other );
- basic_string<charT> &append( const charT *str );
- void push_back( charT c );
- void clear();
- void reserve( size_type t );
- void resize( size_type n, charT c = charT() );
- int compare( const basic_string<charT> &other ) const;
- int compare( const charT *str ) const;
- basic_string<charT> &insert( size_type pos,
- const basic_string<charT> &str );
- size_type find( const basic_string<charT> &other, int pos = 0 ) const;
- size_type find( charT c, int pos = 0 ) const;
- %extend {
- bool operator == ( const basic_string<charT> &other ) const {
- return self->compare( other ) == 0;
- }
- bool operator != ( const basic_string<charT> &other ) const {
- return self->compare( other ) != 0;
- }
- bool operator < ( const basic_string<charT> &other ) const {
- return self->compare( other ) == -1;
- }
- bool operator > ( const basic_string<charT> &other ) const {
- return self->compare( other ) == 1;
- }
- bool operator <= ( const basic_string<charT> &other ) const {
- return self->compare( other ) != 1;
- }
- bool operator >= ( const basic_string<charT> &other ) const {
- return self->compare( other ) != -1;
- }
-
- }
- };
-
- %template(string) basic_string<char>;
- %template(wstring) basic_string<wchar_t>;
-
- %apply char * { string };
- %apply wchar_t * { wstring };
-
- typedef basic_string<char> string;
- typedef basic_string<wchar_t> wstring;
-
- // automatically convert constant std::strings to cl:strings
- %typemap(ctype) string "char *";
- %typemap(in) string "$1.assign($input);";
- %typemap(out) string "$result = (char *)(&$1)->c_str();";
- %typemap(lisptype) string "cl:string";
- %typemap(lout) string "(cl::setq ACL_ffresult $body)";
-
- %typemap(ctype) const string *"char *";
- %typemap(in) const string * "$1.assign($input);";
- %typemap(out) const string * "$result = (char *)($1)->c_str();";
- %typemap(lisptype) const string * "cl:string";
- %typemap(lout) const string * "(cl::setq ACL_ffresult $body)";
-
- %typemap(ctype) wstring "wchar_t *";
- %typemap(in) wstring "$1.assign($input);";
- %typemap(out) wstring "$result = (wchar_t *)(&$1)->c_str();";
- %typemap(lisptype) wstring "cl:string";
- %typemap(lout) wstring "(cl::setq ACL_ffresult (excl:native-to-string $body
-:external-format #+little-endian :fat-le #-little-endian :fat))";
-
- %typemap(ctype) const wstring *"char *";
- %typemap(in) const wstring * "$1.assign($input);";
- %typemap(out) const wstring * "$result = (char *)($1)->c_str();";
- %typemap(lisptype) const wstring * "cl:string";
- %typemap(lout) const wstring * "(cl::setq ACL_ffresult $body)";
-
- /* Overloading check */
-// %typemap(in) string {
-// if (caml_ptr_check($input))
-// $1.assign((char *)caml_ptr_val($input,0),
-// caml_string_len($input));
-// else
-// SWIG_exception(SWIG_TypeError, "string expected");
-// }
-
-// %typemap(in) const string & ($*1_ltype temp) {
-// if (caml_ptr_check($input)) {
-// temp.assign((char *)caml_ptr_val($input,0),
-// caml_string_len($input));
-// $1 = &temp;
-// } else {
-// SWIG_exception(SWIG_TypeError, "string expected");
-// }
-// }
-
-// %typemap(in) string & ($*1_ltype temp) {
-// if (caml_ptr_check($input)) {
-// temp.assign((char *)caml_ptr_val($input,0),
-// caml_string_len($input));
-// $1 = &temp;
-// } else {
-// SWIG_exception(SWIG_TypeError, "string expected");
-// }
-// }
-
-// %typemap(in) string * ($*1_ltype *temp) {
-// if (caml_ptr_check($input)) {
-// temp = new $*1_ltype((char *)caml_ptr_val($input,0),
-// caml_string_len($input));
-// $1 = temp;
-// } else {
-// SWIG_exception(SWIG_TypeError, "string expected");
-// }
-// }
-
-// %typemap(free) string * ($*1_ltype *temp) {
-// delete temp;
-// }
-
-// %typemap(argout) string & {
-// caml_list_append(swig_result,caml_val_string_len((*$1).c_str(),
-// (*$1).size()));
-// }
-
-// %typemap(directorout) string {
-// $result.assign((char *)caml_ptr_val($input,0),
-// caml_string_len($input));
-// }
-
-// %typemap(out) string {
-// $result = caml_val_string_len($1.c_str(),$1.size());
-// }
-
-// %typemap(out) string * {
-// $result = caml_val_string_len((*$1).c_str(),(*$1).size());
-// }
-}
-
-// #ifdef ENABLE_CHARPTR_ARRAY
-// char **c_charptr_array( const std::vector <string > &str_v );
-
-// %{
-// SWIGEXT char **c_charptr_array( const std::vector <string > &str_v ) {
-// char **out = new char *[str_v.size() + 1];
-// out[str_v.size()] = 0;
-// for( int i = 0; i < str_v.size(); i++ ) {
-// out[i] = (char *)str_v[i].c_str();
-// }
-// return out;
-// }
-// %}
-// #endif
-
-// #ifdef ENABLE_STRING_VECTOR
-// %template (StringVector) std::vector<string >;
-
-// %insert(ml) %{
-// (* Some STL convenience items *)
-
-// let string_array_to_vector sa =
-// let nv = _new_StringVector C_void in
-// array_to_vector nv (fun x -> C_string x) sa ; nv
-
-// let c_string_array ar =
-// _c_charptr_array (string_array_to_vector ar)
-// %}
-
-// %insert(mli) %{
-// val c_string_array: string array -> c_obj
-// %}
-// #endif
diff --git a/Lib/allegrocl/typemaps.i b/Lib/allegrocl/typemaps.i
deleted file mode 100644
index 293d1cd..0000000
--- a/Lib/allegrocl/typemaps.i
+++ /dev/null
@@ -1,4 +0,0 @@
-/* Unused for Allegro CL module */
-
-%include "inout_typemaps.i"
-%include "longlongs.i"
diff --git a/Lib/chicken/chicken.swg b/Lib/chicken/chicken.swg
deleted file mode 100644
index f42fd27..0000000
--- a/Lib/chicken/chicken.swg
+++ /dev/null
@@ -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 {
- $<ype 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);
-
-%}
diff --git a/Lib/chicken/chickenkw.swg b/Lib/chicken/chickenkw.swg
deleted file mode 100644
index d2c26c7..0000000
--- a/Lib/chicken/chickenkw.swg
+++ /dev/null
@@ -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_
diff --git a/Lib/chicken/chickenrun.swg b/Lib/chicken/chickenrun.swg
deleted file mode 100644
index bb14b4b..0000000
--- a/Lib/chicken/chickenrun.swg
+++ /dev/null
@@ -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
diff --git a/Lib/chicken/extra-install.list b/Lib/chicken/extra-install.list
deleted file mode 100644
index 48721ce..0000000
--- a/Lib/chicken/extra-install.list
+++ /dev/null
@@ -1,3 +0,0 @@
-swigclosprefix.scm
-multi-generic.scm
-tinyclos-multi-generic.patch
diff --git a/Lib/chicken/multi-generic.scm b/Lib/chicken/multi-generic.scm
deleted file mode 100644
index 9d2e31d..0000000
--- a/Lib/chicken/multi-generic.scm
+++ /dev/null
@@ -1,152 +0,0 @@
-;; This file is no longer necessary with Chicken versions above 1.92
-;;
-;; This file overrides two functions inside TinyCLOS to provide support
-;; for multi-argument generics. There are many ways of linking this file
-;; into your code... all that needs to happen is this file must be
-;; executed after loading TinyCLOS but before any SWIG modules are loaded
-;;
-;; something like the following
-;; (require 'tinyclos)
-;; (load "multi-generic")
-;; (declare (uses swigmod))
-;;
-;; An alternative to loading this scheme code directly is to add a
-;; (declare (unit multi-generic)) to the top of this file, and then
-;; compile this into the final executable or something. Or compile
-;; this into an extension.
-
-;; Lastly, to override TinyCLOS method creation, two functions are
-;; overridden: see the end of this file for which two are overridden.
-;; You might want to remove those two lines and then exert more control over
-;; which functions are used when.
-
-;; Comments, bugs, suggestions: send either to chicken-users@nongnu.org or to
-;; Most code copied from TinyCLOS
-
-(define <multi-generic> (make <entity-class>
- 'name "multi-generic"
- 'direct-supers (list <generic>)
- 'direct-slots '()))
-
-(letrec ([applicable?
- (lambda (c arg)
- (memq c (class-cpl (class-of arg))))]
-
- [more-specific?
- (lambda (c1 c2 arg)
- (memq c2 (memq c1 (class-cpl (class-of arg)))))]
-
- [filter-in
- (lambda (f l)
- (if (null? l)
- '()
- (let ([h (##sys#slot l 0)]
- [r (##sys#slot l 1)] )
- (if (f h)
- (cons h (filter-in f r))
- (filter-in f r) ) ) ) )])
-
-(add-method compute-apply-generic
- (make-method (list <multi-generic>)
- (lambda (call-next-method generic)
- (lambda args
- (let ([cam (let ([x (compute-apply-methods generic)]
- [y ((compute-methods generic) args)] )
- (lambda (args) (x y args)) ) ] )
- (cam args) ) ) ) ) )
-
-
-
-(add-method compute-methods
- (make-method (list <multi-generic>)
- (lambda (call-next-method generic)
- (lambda (args)
- (let ([applicable
- (filter-in (lambda (method)
- (let check-applicable ([list1 (method-specializers method)]
- [list2 args])
- (cond ((null? list1) #t)
- ((null? list2) #f)
- (else
- (and (applicable? (##sys#slot list1 0) (##sys#slot list2 0))
- (check-applicable (##sys#slot list1 1) (##sys#slot list2 1)))))))
- (generic-methods generic) ) ] )
- (if (or (null? applicable) (null? (##sys#slot applicable 1)))
- applicable
- (let ([cmms (compute-method-more-specific? generic)])
- (sort applicable (lambda (m1 m2) (cmms m1 m2 args))) ) ) ) ) ) ) )
-
-(add-method compute-method-more-specific?
- (make-method (list <multi-generic>)
- (lambda (call-next-method generic)
- (lambda (m1 m2 args)
- (let loop ((specls1 (method-specializers m1))
- (specls2 (method-specializers m2))
- (args args))
- (cond-expand
- [unsafe
- (let ((c1 (##sys#slot specls1 0))
- (c2 (##sys#slot specls2 0))
- (arg (##sys#slot args 0)))
- (if (eq? c1 c2)
- (loop (##sys#slot specls1 1)
- (##sys#slot specls2 1)
- (##sys#slot args 1))
- (more-specific? c1 c2 arg))) ]
- [else
- (cond ((and (null? specls1) (null? specls2))
- (##sys#error "two methods are equally specific" generic))
- ;((or (null? specls1) (null? specls2))
- ; (##sys#error "two methods have different number of specializers" generic))
- ((null? specls1) #f)
- ((null? specls2) #t)
- ((null? args)
- (##sys#error "fewer arguments than specializers" generic))
- (else
- (let ((c1 (##sys#slot specls1 0))
- (c2 (##sys#slot specls2 0))
- (arg (##sys#slot args 0)))
- (if (eq? c1 c2)
- (loop (##sys#slot specls1 1)
- (##sys#slot specls2 1)
- (##sys#slot args 1))
- (more-specific? c1 c2 arg)))) ) ] ) ) ) ) ) )
-
-) ;; end of letrec
-
-(define multi-add-method
- (lambda (generic method)
- (slot-set!
- generic
- 'methods
- (let filter-in-method ([methods (slot-ref generic 'methods)])
- (if (null? methods)
- (list method)
- (let ([l1 (length (method-specializers method))]
- [l2 (length (method-specializers (##sys#slot methods 0)))])
- (cond ((> l1 l2)
- (cons (##sys#slot methods 0) (filter-in-method (##sys#slot methods 1))))
- ((< l1 l2)
- (cons method methods))
- (else
- (let check-method ([ms1 (method-specializers method)]
- [ms2 (method-specializers (##sys#slot methods 0))])
- (cond ((and (null? ms1) (null? ms2))
- (cons method (##sys#slot methods 1))) ;; skip the method already in the generic
- ((eq? (##sys#slot ms1 0) (##sys#slot ms2 0))
- (check-method (##sys#slot ms1 1) (##sys#slot ms2 1)))
- (else
- (cons (##sys#slot methods 0) (filter-in-method (##sys#slot methods 1))))))))))))
-
- (##sys#setslot (##sys#slot generic (- (##sys#size generic) 2)) 1 (compute-apply-generic generic)) ))
-
-(define (multi-add-global-method val sym specializers proc)
- (let ((generic (if (procedure? val) val (make <multi-generic> 'name (##sys#symbol->string sym)))))
- (multi-add-method generic (make-method specializers proc))
- generic))
-
-;; Might want to remove these, or perhaps do something like
-;; (define old-add-method ##tinyclos#add-method)
-;; and then you can switch between creating multi-generics and TinyCLOS generics.
-(set! ##tinyclos#add-method multi-add-method)
-(set! ##tinyclos#add-global-method multi-add-global-method)
diff --git a/Lib/chicken/std_string.i b/Lib/chicken/std_string.i
deleted file mode 100644
index fa77c15..0000000
--- a/Lib/chicken/std_string.i
+++ /dev/null
@@ -1,96 +0,0 @@
-/* -----------------------------------------------------------------------------
- * std_string.i
- *
- * SWIG typemaps for std::string
- * ----------------------------------------------------------------------------- */
-
-%{
-#include <string>
-%}
-
-namespace std {
- %naturalvar string;
-
-
- %insert(closprefix) %{ (declare (hide <std-string>)) %}
- %nodefault string;
- %rename("std-string") string;
- class string {
- public:
- ~string() {}
- };
- %extend string {
- char *str;
- }
- %{
- #define std_string_str_get(s) ((char *)((s)->c_str()))
- #define std_string_str_set(s,v) (s->assign((char *)(v)))
- %}
-
- %typemap(typecheck) string = char *;
- %typemap(typecheck) const string & = char *;
-
- %typemap(in) string (char * tempptr) {
- if ($input == C_SCHEME_FALSE) {
- $1.resize(0);
- } else {
- if (!C_swig_is_string ($input)) {
- swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE,
- "Argument #$argnum is not a string");
- }
- tempptr = SWIG_MakeString($input);
- $1.assign(tempptr);
- if (tempptr) SWIG_free(tempptr);
- }
- }
-
- %typemap(in) const string& ($*1_ltype temp, char *tempptr) {
-
- if ($input == C_SCHEME_FALSE) {
- temp.resize(0);
- $1 = &temp;
- } else {
- if (!C_swig_is_string ($input)) {
- swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE,
- "Argument #$argnum is not a string");
- }
- tempptr = SWIG_MakeString($input);
- temp.assign(tempptr);
- if (tempptr) SWIG_free(tempptr);
- $1 = &temp;
- }
- }
-
- %typemap(out) string {
- int size = $1.size();
- C_word *space = C_alloc (C_SIZEOF_STRING (size));
- $result = C_string (&space, size, (char *) $1.c_str());
- }
-
- %typemap(out) const string& {
- int size = $1->size();
- C_word *space = C_alloc (C_SIZEOF_STRING (size));
- $result = C_string (&space, size, (char *) $1->c_str());
- }
-
- %typemap(varin) string {
- if ($input == C_SCHEME_FALSE) {
- $1.resize(0);
- } else {
- char *tempptr;
- if (!C_swig_is_string ($input)) {
- swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE,
- "Argument #$argnum is not a string");
- }
- tempptr = SWIG_MakeString($input);
- $1.assign(tempptr);
- if (tempptr) SWIG_free(tempptr);
- }
- }
-
- %typemap(varout) string {
- int size = $1.size();
- C_word *space = C_alloc (C_SIZEOF_STRING (size));
- $result = C_string (&space, size, (char *) $1.c_str());
- }
-}
diff --git a/Lib/chicken/swigclosprefix.scm b/Lib/chicken/swigclosprefix.scm
deleted file mode 100644
index e4bd72b..0000000
--- a/Lib/chicken/swigclosprefix.scm
+++ /dev/null
@@ -1,31 +0,0 @@
-(declare (hide swig-initialize))
-
-(define (swig-initialize obj initargs create)
- (slot-set! obj 'swig-this
- (if (memq 'swig-this initargs)
- (cadr initargs)
- (let ((ret (apply create initargs)))
- (if (instance? ret)
- (slot-ref ret 'swig-this)
- ret)))))
-
-(define-class <swig-metaclass-$module> (<class>) (void))
-
-(define-method (compute-getter-and-setter (class <swig-metaclass-$module>) slot allocator)
- (if (not (memq ':swig-virtual slot))
- (call-next-method)
- (let ((getter (let search-get ((lst slot))
- (if (null? lst)
- #f
- (if (eq? (car lst) ':swig-get)
- (cadr lst)
- (search-get (cdr lst))))))
- (setter (let search-set ((lst slot))
- (if (null? lst)
- #f
- (if (eq? (car lst) ':swig-set)
- (cadr lst)
- (search-set (cdr lst)))))))
- (values
- (lambda (o) (getter (slot-ref o 'swig-this)))
- (lambda (o new) (setter (slot-ref o 'swig-this) new) new)))))
diff --git a/Lib/chicken/tinyclos-multi-generic.patch b/Lib/chicken/tinyclos-multi-generic.patch
deleted file mode 100644
index 2e58596..0000000
--- a/Lib/chicken/tinyclos-multi-generic.patch
+++ /dev/null
@@ -1,150 +0,0 @@
-# This patch is against chicken 1.92, but it should work just fine
-# with older versions of chicken. It adds support for mulit-argument
-# generics, that is, generics now correctly handle adding methods
-# with different lengths of specializer lists
-
-# This patch has been committed into the CHICKEN darcs repository,
-# so chicken versions above 1.92 work fine.
-
-# Comments, bugs, suggestions send to chicken-users@nongnu.org
-
-# Patch written by John Lenz <lenz@cs.wisc.edu>
-
---- tinyclos.scm.old 2005-04-05 01:13:56.000000000 -0500
-+++ tinyclos.scm 2005-04-11 16:37:23.746181489 -0500
-@@ -37,8 +37,10 @@
-
- (include "parameters")
-
-+(cond-expand [(not chicken-compile-shared) (declare (unit tinyclos))]
-+ [else] )
-+
- (declare
-- (unit tinyclos)
- (uses extras)
- (usual-integrations)
- (fixnum)
-@@ -234,7 +236,10 @@
- y = C_block_item(y, 1);
- }
- }
-- return(C_block_item(v, i + 1));
-+ if (x == C_SCHEME_END_OF_LIST && y == C_SCHEME_END_OF_LIST)
-+ return(C_block_item(v, i + 1));
-+ else
-+ goto mismatch;
- }
- else if(free_index == -1) free_index = i;
- mismatch:
-@@ -438,7 +443,7 @@
- (define hash-arg-list
- (foreign-lambda* unsigned-int ((scheme-object args) (scheme-object svector)) "
- C_word tag, h, x;
-- int n, i, j;
-+ int n, i, j, len = 0;
- for(i = 0; args != C_SCHEME_END_OF_LIST; args = C_block_item(args, 1)) {
- x = C_block_item(args, 0);
- if(C_immediatep(x)) {
-@@ -481,8 +486,9 @@
- default: i += 255;
- }
- }
-+ ++len;
- }
-- return(i & (C_METHOD_CACHE_SIZE - 1));") )
-+ return((i + len) & (C_METHOD_CACHE_SIZE - 1));") )
-
-
- ;
-@@ -868,13 +874,27 @@
- (##tinyclos#slot-set!
- generic
- 'methods
-- (cons method
-- (filter-in
-- (lambda (m)
-- (let ([ms1 (method-specializers m)]
-- [ms2 (method-specializers method)] )
-- (not (every2 (lambda (x y) (eq? x y)) ms1 ms2) ) ) )
-- (##tinyclos#slot-ref generic 'methods))))
-+ (let* ([ms1 (method-specializers method)]
-+ [l1 (length ms1)] )
-+ (let filter-in-method ([methods (##tinyclos#slot-ref generic 'methods)])
-+ (if (null? methods)
-+ (list method)
-+ (let* ([mm (##sys#slot methods 0)]
-+ [ms2 (method-specializers mm)]
-+ [l2 (length ms2)])
-+ (cond ((> l1 l2)
-+ (cons mm (filter-in-method (##sys#slot methods 1))))
-+ ((< l1 l2)
-+ (cons method methods))
-+ (else
-+ (let check-method ([ms1 ms1]
-+ [ms2 ms2])
-+ (cond ((and (null? ms1) (null? ms2))
-+ (cons method (##sys#slot methods 1))) ;; skip the method already in the generic
-+ ((eq? (##sys#slot ms1 0) (##sys#slot ms2 0))
-+ (check-method (##sys#slot ms1 1) (##sys#slot ms2 1)))
-+ (else
-+ (cons mm (filter-in-method (##sys#slot methods 1)))))))))))))
- (if (memq generic generic-invocation-generics)
- (set! method-cache-tag (vector))
- (%entity-cache-set! generic #f) )
-@@ -925,11 +945,13 @@
- (memq (car args) generic-invocation-generics))
- (let ([proc
- (method-procedure
-+ ; select the first method of one argument
- (let lp ([lis (generic-methods generic)])
-- (let ([tail (##sys#slot lis 1)])
-- (if (null? tail)
-- (##sys#slot lis 0)
-- (lp tail)) ) ) ) ] )
-+ (if (null? lis)
-+ (##sys#error "Unable to find original compute-apply-generic")
-+ (if (= (length (method-specializers (##sys#slot lis 0))) 1)
-+ (##sys#slot lis 0)
-+ (lp (##sys#slot lis 1)))))) ] )
- (lambda (args) (apply proc #f args)) )
- (let ([x (compute-apply-methods generic)]
- [y ((compute-methods generic) args)] )
-@@ -946,9 +968,13 @@
- (lambda (args)
- (let ([applicable
- (filter-in (lambda (method)
-- (every2 applicable?
-- (method-specializers method)
-- args))
-+ (let check-applicable ([list1 (method-specializers method)]
-+ [list2 args])
-+ (cond ((null? list1) #t)
-+ ((null? list2) #f)
-+ (else
-+ (and (applicable? (##sys#slot list1 0) (##sys#slot list2 0))
-+ (check-applicable (##sys#slot list1 1) (##sys#slot list2 1)))))))
- (generic-methods generic) ) ] )
- (if (or (null? applicable) (null? (##sys#slot applicable 1)))
- applicable
-@@ -975,8 +1001,10 @@
- [else
- (cond ((and (null? specls1) (null? specls2))
- (##sys#error "two methods are equally specific" generic))
-- ((or (null? specls1) (null? specls2))
-- (##sys#error "two methods have different number of specializers" generic))
-+ ;((or (null? specls1) (null? specls2))
-+ ; (##sys#error "two methods have different number of specializers" generic))
-+ ((null? specls1) #f)
-+ ((null? specls2) #t)
- ((null? args)
- (##sys#error "fewer arguments than specializers" generic))
- (else
-@@ -1210,7 +1238,7 @@
- (define <structure> (make-primitive-class "structure"))
- (define <procedure> (make-primitive-class "procedure" <procedure-class>))
- (define <end-of-file> (make-primitive-class "end-of-file"))
--(define <environment> (make-primitive-class "environment" <structure>)) ; (Benedikt insisted on this)
-+(define <environment> (make-primitive-class "environment" <structure>))
- (define <hash-table> (make-primitive-class "hash-table" <structure>))
- (define <promise> (make-primitive-class "promise" <structure>))
- (define <queue> (make-primitive-class "queue" <structure>))
diff --git a/Lib/chicken/typemaps.i b/Lib/chicken/typemaps.i
deleted file mode 100644
index fd587fd..0000000
--- a/Lib/chicken/typemaps.i
+++ /dev/null
@@ -1,314 +0,0 @@
-/* -----------------------------------------------------------------------------
- * typemaps.i
- *
- * Pointer handling
- *
- * These mappings provide support for input/output arguments and
- * common uses for C/C++ pointers. INOUT mappings allow for C/C++
- * pointer variables in addition to input/output arguments.
- * ----------------------------------------------------------------------------- */
-
-// INPUT typemaps.
-// These remap a C pointer to be an "INPUT" value which is passed by value
-// instead of reference.
-
-/*
-The following methods can be applied to turn a pointer into a simple
-"input" value. That is, instead of passing a pointer to an object,
-you would use a real value instead.
-
- int *INPUT
- short *INPUT
- long *INPUT
- long long *INPUT
- unsigned int *INPUT
- unsigned short *INPUT
- unsigned long *INPUT
- unsigned long long *INPUT
- unsigned char *INPUT
- char *INPUT
- bool *INPUT
- float *INPUT
- double *INPUT
-
-To use these, suppose you had a C function like this :
-
- double fadd(double *a, double *b) {
- return *a+*b;
- }
-
-You could wrap it with SWIG as follows :
-
- %include <typemaps.i>
- double fadd(double *INPUT, double *INPUT);
-
-or you can use the %apply directive :
-
- %include <typemaps.i>
- %apply double *INPUT { double *a, double *b };
- double fadd(double *a, double *b);
-
-*/
-
-// OUTPUT typemaps. These typemaps are used for parameters that
-// are output only. The output value is appended to the result as
-// a list element.
-
-/*
-The following methods can be applied to turn a pointer into an "output"
-value. When calling a function, no input value would be given for
-a parameter, but an output value would be returned. In the case of
-multiple output values, they are returned in the form of a Scheme list.
-
- int *OUTPUT
- short *OUTPUT
- long *OUTPUT
- long long *OUTPUT
- unsigned int *OUTPUT
- unsigned short *OUTPUT
- unsigned long *OUTPUT
- unsigned long long *OUTPUT
- unsigned char *OUTPUT
- char *OUTPUT
- bool *OUTPUT
- float *OUTPUT
- double *OUTPUT
-
-For example, suppose you were trying to wrap the modf() function in the
-C math library which splits x into integral and fractional parts (and
-returns the integer part in one of its parameters).K:
-
- double modf(double x, double *ip);
-
-You could wrap it with SWIG as follows :
-
- %include <typemaps.i>
- double modf(double x, double *OUTPUT);
-
-or you can use the %apply directive :
-
- %include <typemaps.i>
- %apply double *OUTPUT { double *ip };
- double modf(double x, double *ip);
-
-*/
-
-//----------------------------------------------------------------------
-//
-// T_OUTPUT typemap (and helper function) to return multiple argouts as
-// a tuple instead of a list.
-//
-//----------------------------------------------------------------------
-
-// Simple types
-
-%define INOUT_TYPEMAP(type_, from_scheme, to_scheme, checker, convtype, storage_)
-
-%typemap(in) type_ *INPUT($*1_ltype temp), type_ &INPUT($*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; %}
-
-%typemap(typecheck) type_ *INPUT = type_;
-%typemap(typecheck) type_ &INPUT = type_;
-
-%typemap(in, numinputs=0) type_ *OUTPUT($*1_ltype temp), type_ &OUTPUT($*1_ltype temp)
-" $1 = &temp;"
-
-#if "storage_" == "0"
-
-%typemap(argout) type_ *OUTPUT, type_ &OUTPUT
-%{
- if ($1 == NULL) {
- swig_barf (SWIG_BARF1_ARGUMENT_NULL, "Argument #$argnum must be non-null");
- }
- SWIG_APPEND_VALUE(to_scheme (convtype (*$1)));
-%}
-
-#else
-
-%typemap(argout) type_ *OUTPUT, type_ &OUTPUT
-%{
- {
- C_word *known_space = C_alloc(storage_);
- if ($1 == NULL) {
- swig_barf (SWIG_BARF1_ARGUMENT_NULL, "Variable '$1' must be non-null");
- }
- SWIG_APPEND_VALUE(to_scheme (&known_space, convtype (*$1)));
- }
-%}
-
-#endif
-
-%enddef
-
-INOUT_TYPEMAP(int, C_num_to_int, C_fix, C_swig_is_number, (int), 0);
-INOUT_TYPEMAP(enum SWIGTYPE, C_num_to_int, C_fix, C_swig_is_number, (int), 0);
-INOUT_TYPEMAP(short, C_num_to_int, C_fix, C_swig_is_number, (int), 0);
-INOUT_TYPEMAP(long, C_num_to_long, C_long_to_num, C_swig_is_long, (long), C_SIZEOF_FLONUM);
-INOUT_TYPEMAP(long long, C_num_to_long, C_long_to_num, C_swig_is_long, (long), C_SIZEOF_FLONUM);
-INOUT_TYPEMAP(unsigned int, C_num_to_unsigned_int, C_unsigned_int_to_num, C_swig_is_number, (int), C_SIZEOF_FLONUM);
-INOUT_TYPEMAP(unsigned short, C_num_to_unsigned_int, C_fix, C_swig_is_number, (unsigned int), 0);
-INOUT_TYPEMAP(unsigned long, C_num_to_unsigned_long, C_unsigned_long_to_num, C_swig_is_long, (unsigned long), C_SIZEOF_FLONUM);
-INOUT_TYPEMAP(unsigned long long, C_num_to_unsigned_long, C_unsigned_long_to_num, C_swig_is_long, (unsigned long), C_SIZEOF_FLONUM);
-INOUT_TYPEMAP(unsigned char, C_character_code, C_make_character, C_swig_is_char, (unsigned int), 0);
-INOUT_TYPEMAP(signed char, C_character_code, C_make_character, C_swig_is_char, (int), 0);
-INOUT_TYPEMAP(char, C_character_code, C_make_character, C_swig_is_char, (char), 0);
-INOUT_TYPEMAP(bool, C_truep, C_mk_bool, C_swig_is_bool, (bool), 0);
-INOUT_TYPEMAP(float, C_c_double, C_flonum, C_swig_is_number, (double), C_SIZEOF_FLONUM);
-INOUT_TYPEMAP(double, C_c_double, C_flonum, C_swig_is_number, (double), C_SIZEOF_FLONUM);
-
-// INOUT
-// Mappings for an argument that is both an input and output
-// parameter
-
-/*
-The following methods can be applied to make a function parameter both
-an input and output value. This combines the behavior of both the
-"INPUT" and "OUTPUT" methods described earlier. Output values are
-returned in the form of a CHICKEN tuple.
-
- int *INOUT
- short *INOUT
- long *INOUT
- long long *INOUT
- unsigned int *INOUT
- unsigned short *INOUT
- unsigned long *INOUT
- unsigned long long *INOUT
- unsigned char *INOUT
- char *INOUT
- bool *INOUT
- float *INOUT
- double *INOUT
-
-For example, suppose you were trying to wrap the following function :
-
- void neg(double *x) {
- *x = -(*x);
- }
-
-You could wrap it with SWIG as follows :
-
- %include <typemaps.i>
- void neg(double *INOUT);
-
-or you can use the %apply directive :
-
- %include <typemaps.i>
- %apply double *INOUT { double *x };
- void neg(double *x);
-
-As well, you can wrap variables with :
-
- %include <typemaps.i>
- %apply double *INOUT { double *y };
- extern double *y;
-
-Unlike C, this mapping does not directly modify the input value (since
-this makes no sense in CHICKEN). Rather, the modified input value shows
-up as the return value of the function. Thus, to apply this function
-to a CHICKEN variable you might do this :
-
- x = neg(x)
-
-Note : previous versions of SWIG used the symbol 'BOTH' to mark
-input/output arguments. This is still supported, but will be slowly
-phased out in future releases.
-
-*/
-
-%typemap(in) int *INOUT = int *INPUT;
-%typemap(in) enum SWIGTYPE *INOUT = enum SWIGTYPE *INPUT;
-%typemap(in) short *INOUT = short *INPUT;
-%typemap(in) long *INOUT = long *INPUT;
-%typemap(in) long long *INOUT = long long *INPUT;
-%typemap(in) unsigned *INOUT = unsigned *INPUT;
-%typemap(in) unsigned short *INOUT = unsigned short *INPUT;
-%typemap(in) unsigned long *INOUT = unsigned long *INPUT;
-%typemap(in) unsigned long long *INOUT = unsigned long long *INPUT;
-%typemap(in) unsigned char *INOUT = unsigned char *INPUT;
-%typemap(in) char *INOUT = char *INPUT;
-%typemap(in) bool *INOUT = bool *INPUT;
-%typemap(in) float *INOUT = float *INPUT;
-%typemap(in) double *INOUT = double *INPUT;
-
-%typemap(in) int &INOUT = int &INPUT;
-%typemap(in) enum SWIGTYPE &INOUT = enum SWIGTYPE &INPUT;
-%typemap(in) short &INOUT = short &INPUT;
-%typemap(in) long &INOUT = long &INPUT;
-%typemap(in) long long &INOUT = long long &INPUT;
-%typemap(in) unsigned &INOUT = unsigned &INPUT;
-%typemap(in) unsigned short &INOUT = unsigned short &INPUT;
-%typemap(in) unsigned long &INOUT = unsigned long &INPUT;
-%typemap(in) unsigned long long &INOUT = unsigned long long &INPUT;
-%typemap(in) unsigned char &INOUT = unsigned char &INPUT;
-%typemap(in) char &INOUT = char &INPUT;
-%typemap(in) bool &INOUT = bool &INPUT;
-%typemap(in) float &INOUT = float &INPUT;
-%typemap(in) double &INOUT = double &INPUT;
-
-%typemap(argout) int *INOUT = int *OUTPUT;
-%typemap(argout) enum SWIGTYPE *INOUT = enum SWIGTYPE *OUTPUT;
-%typemap(argout) short *INOUT = short *OUTPUT;
-%typemap(argout) long *INOUT = long *OUTPUT;
-%typemap(argout) long long *INOUT = long long *OUTPUT;
-%typemap(argout) unsigned *INOUT = unsigned *OUTPUT;
-%typemap(argout) unsigned short *INOUT = unsigned short *OUTPUT;
-%typemap(argout) unsigned long *INOUT = unsigned long *OUTPUT;
-%typemap(argout) unsigned long long *INOUT = unsigned long long *OUTPUT;
-%typemap(argout) unsigned char *INOUT = unsigned char *OUTPUT;
-%typemap(argout) bool *INOUT = bool *OUTPUT;
-%typemap(argout) float *INOUT = float *OUTPUT;
-%typemap(argout) double *INOUT = double *OUTPUT;
-
-%typemap(argout) int &INOUT = int &OUTPUT;
-%typemap(argout) enum SWIGTYPE &INOUT = enum SWIGTYPE &OUTPUT;
-%typemap(argout) short &INOUT = short &OUTPUT;
-%typemap(argout) long &INOUT = long &OUTPUT;
-%typemap(argout) long long &INOUT = long long &OUTPUT;
-%typemap(argout) unsigned &INOUT = unsigned &OUTPUT;
-%typemap(argout) unsigned short &INOUT = unsigned short &OUTPUT;
-%typemap(argout) unsigned long &INOUT = unsigned long &OUTPUT;
-%typemap(argout) unsigned long long &INOUT = unsigned long long &OUTPUT;
-%typemap(argout) unsigned char &INOUT = unsigned char &OUTPUT;
-%typemap(argout) char &INOUT = char &OUTPUT;
-%typemap(argout) bool &INOUT = bool &OUTPUT;
-%typemap(argout) float &INOUT = float &OUTPUT;
-%typemap(argout) double &INOUT = double &OUTPUT;
-
-/* Overloading information */
-
-%typemap(typecheck) double *INOUT = double;
-%typemap(typecheck) bool *INOUT = bool;
-%typemap(typecheck) char *INOUT = char;
-%typemap(typecheck) signed char *INOUT = signed char;
-%typemap(typecheck) unsigned char *INOUT = unsigned char;
-%typemap(typecheck) unsigned long *INOUT = unsigned long;
-%typemap(typecheck) unsigned long long *INOUT = unsigned long long;
-%typemap(typecheck) unsigned short *INOUT = unsigned short;
-%typemap(typecheck) unsigned int *INOUT = unsigned int;
-%typemap(typecheck) long *INOUT = long;
-%typemap(typecheck) long long *INOUT = long long;
-%typemap(typecheck) short *INOUT = short;
-%typemap(typecheck) int *INOUT = int;
-%typemap(typecheck) enum SWIGTYPE *INOUT = enum SWIGTYPE;
-%typemap(typecheck) float *INOUT = float;
-
-%typemap(typecheck) double &INOUT = double;
-%typemap(typecheck) bool &INOUT = bool;
-%typemap(typecheck) char &INOUT = char;
-%typemap(typecheck) signed char &INOUT = signed char;
-%typemap(typecheck) unsigned char &INOUT = unsigned char;
-%typemap(typecheck) unsigned long &INOUT = unsigned long;
-%typemap(typecheck) unsigned long long &INOUT = unsigned long long;
-%typemap(typecheck) unsigned short &INOUT = unsigned short;
-%typemap(typecheck) unsigned int &INOUT = unsigned int;
-%typemap(typecheck) long &INOUT = long;
-%typemap(typecheck) long long &INOUT = long long;
-%typemap(typecheck) short &INOUT = short;
-%typemap(typecheck) int &INOUT = int;
-%typemap(typecheck) enum SWIGTYPE &INOUT = enum SWIGTYPE;
-%typemap(typecheck) float &INOUT = float;
diff --git a/Lib/clisp/clisp.swg b/Lib/clisp/clisp.swg
deleted file mode 100644
index e1d330c..0000000
--- a/Lib/clisp/clisp.swg
+++ /dev/null
@@ -1,32 +0,0 @@
-/* -----------------------------------------------------------------------------
- * clisp.swg
- * ----------------------------------------------------------------------------- */
-
-/* Define a C preprocessor symbol that can be used in interface files
- to distinguish between the SWIG language modules. */
-
-#define SWIG_CLISP
-
-/* Typespecs for basic types. */
-
-%typemap(in) void "NIL";
-
-%typemap(in) char "character";
-%typemap(in) char * "ffi:c-string";
-%typemap(in) unsigned char "ffi:uchar";
-%typemap(in) signed char "ffi:char";
-
-%typemap(in) short "ffi:short";
-%typemap(in) signed short "ffi:short";
-%typemap(in) unsigned short "ffi:ushort";
-
-%typemap(in) int "ffi:int";
-%typemap(in) signed int "ffi:int";
-%typemap(in) unsigned int "ffi:uint";
-
-%typemap(in) long "ffi:long";
-%typemap(in) signed long "ffi:long";
-%typemap(in) unsigned long "ffi:ulong";
-
-%typemap(in) float "SINGLE-FLOAT";
-%typemap(in) double "DOUBLE-FLOAT";
diff --git a/Lib/modula3/modula3.swg b/Lib/modula3/modula3.swg
deleted file mode 100644
index 13d06e9..0000000
--- a/Lib/modula3/modula3.swg
+++ /dev/null
@@ -1,787 +0,0 @@
-/* -----------------------------------------------------------------------------
- * modula3.swg
- *
- * Modula3 typemaps
- * ----------------------------------------------------------------------------- */
-
-%include <modula3head.swg>
-
-/* The ctype, m3rawtype and m3wraptype typemaps work together and so there should be one of each.
- * The ctype typemap contains the C type used in the signature of C wrappers for C++ functions.
- * The m3rawtype typemap contains the M3 type used in the raw interface.
- * The m3rawintype typemap contains the M3 type used as function argument.
- * The m3rawrettype typemap contains the M3 type used as return value.
- * The m3wraptype typemap contains the M3 type used in the M3 type wrapper classes and module class. */
-
-/* Primitive types */
-%typemap(ctype) bool, const bool & "bool"
-%typemap(ctype) char, const char & "char"
-%typemap(ctype) signed char, const signed char & "signed char"
-%typemap(ctype) unsigned char, const unsigned char & "unsigned short"
-%typemap(ctype) short, const short & "short"
-%typemap(ctype) unsigned short, const unsigned short & "unsigned short"
-%typemap(ctype) int, const int & "int"
-%typemap(ctype) unsigned int, const unsigned int & "unsigned int"
-%typemap(ctype) long, const long & "long"
-%typemap(ctype) unsigned long, const unsigned long & "unsigned long"
-%typemap(ctype) long long, const long long & "long long"
-%typemap(ctype) unsigned long long, const unsigned long long & "unsigned long long"
-%typemap(ctype) float, const float & "float"
-%typemap(ctype) double, const double & "double"
-%typemap(ctype) char * "char *"
-%typemap(ctype) void "void"
-
-%typemap(m3rawtype) bool, const bool & "BOOLEAN"
-%typemap(m3rawtype) char, const char & "C.char"
-%typemap(m3rawtype) signed char, const signed char & "C.signed_char"
-%typemap(m3rawtype) unsigned char, const unsigned char & "C.unsigned_char"
-%typemap(m3rawtype) short, const short & "C.short"
-%typemap(m3rawtype) unsigned short, const unsigned short & "C.unsigned_short"
-%typemap(m3rawtype) int, const int & "C.int"
-%typemap(m3rawtype) unsigned int, const unsigned int & "C.unsigned_int"
-%typemap(m3rawtype) long, const long & "C.long"
-%typemap(m3rawtype) unsigned long, const unsigned long & "C.unsigned_long"
-%typemap(m3rawtype) long long, const long long & "C.long_long"
-%typemap(m3rawtype) unsigned long long, const unsigned long long & "C.unsigned_long_long"
-%typemap(m3rawtype) float, const float & "C.float"
-%typemap(m3rawtype) double, const double & "C.double"
-%typemap(m3rawtype) long double, const long double & "C.long_double"
-%typemap(m3rawtype) char * "C.char_star"
-%typemap(m3rawtype) void ""
-%typemap(m3rawtype) FILE "Cstdio.FILE";
-%typemap(m3rawtype) FILE * "Cstdio.FILE_star";
-
-
-%typemap(m3rawintype) bool *, bool &, bool "BOOLEAN"
-%typemap(m3rawintype) char *, char &, char "C.char"
-%typemap(m3rawintype) signed char *, signed char &, signed char "C.signed_char"
-%typemap(m3rawintype) unsigned char *, unsigned char &, unsigned char "C.unsigned_char"
-%typemap(m3rawintype) short *, short &, short "C.short"
-%typemap(m3rawintype) unsigned short *, unsigned short &, unsigned short "C.unsigned_short"
-%typemap(m3rawintype) int *, int &, int "C.int"
-%typemap(m3rawintype) unsigned int *, unsigned int &, unsigned int "C.unsigned_int"
-%typemap(m3rawintype) long *, long &, long "C.long"
-%typemap(m3rawintype) unsigned long *, unsigned long &, unsigned long "C.unsigned_long"
-%typemap(m3rawintype) long long *, long long &, long long "C.long_long"
-%typemap(m3rawintype) unsigned long long *, unsigned long long &, unsigned long long "C.unsigned_long_long"
-%typemap(m3rawintype) float *, float &, float "C.float"
-%typemap(m3rawintype) double *, double &, double "C.double"
-%typemap(m3rawintype) long double *, long double &, long double "C.long_double"
-%typemap(m3rawintype) char * "C.char_star"
-%typemap(m3rawintype) void ""
-%typemap(m3rawintype) void * "ADDRESS"
-%typemap(m3rawintype) FILE "Cstdio.FILE";
-%typemap(m3rawintype) FILE * "Cstdio.FILE_star";
-
-%typemap(m3rawinmode) char *, void *, FILE * ""
-
-
-%typemap(m3rawrettype) bool, const bool & "BOOLEAN"
-%typemap(m3rawrettype) char, const char & "C.char"
-%typemap(m3rawrettype) signed char, const signed char & "C.signed_char"
-%typemap(m3rawrettype) unsigned char, const unsigned char & "C.unsigned_char"
-%typemap(m3rawrettype) short, const short & "C.short"
-%typemap(m3rawrettype) unsigned short, const unsigned short & "C.unsigned_short"
-%typemap(m3rawrettype) int, const int & "C.int"
-%typemap(m3rawrettype) unsigned int, const unsigned int & "C.unsigned_int"
-%typemap(m3rawrettype) long, const long & "C.long"
-%typemap(m3rawrettype) unsigned long, const unsigned long & "C.unsigned_long"
-%typemap(m3rawrettype) long long, const long long & "C.long_long"
-%typemap(m3rawrettype) unsigned long long, const unsigned long long & "C.unsigned_long_long"
-%typemap(m3rawrettype) float, const float & "C.float"
-%typemap(m3rawrettype) double, const double & "C.double"
-%typemap(m3rawrettype) long double, const long double & "C.long_double"
-%typemap(m3rawrettype) char * "C.char_star"
-%typemap(m3rawrettype) void ""
-%typemap(m3rawrettype) void * "ADDRESS"
-%typemap(m3rawrettype) FILE "Cstdio.FILE";
-%typemap(m3rawrettype) FILE * "Cstdio.FILE_star";
-
-
-%typemap("m3rawtype:import")
- char, const char &,
- signed char, const signed char &,
- unsigned char, const unsigned char &,
- short, const short &,
- unsigned short, const unsigned short &,
- int, const int &,
- unsigned int, const unsigned int &,
- long, const long &,
- unsigned long, const unsigned long &,
- long long, const long long &,
- unsigned long long, const unsigned long long &,
- float, const float &,
- double, const double &,
- long double, const long double &,
- char *
- "Ctypes AS C"
-
-%typemap("m3rawintype:import")
- char, const char &,
- signed char, const signed char &,
- unsigned char, const unsigned char &,
- short, const short &,
- unsigned short, const unsigned short &,
- int, const int &,
- unsigned int, const unsigned int &,
- long, const long &,
- unsigned long, const unsigned long &,
- long long, const long long &,
- unsigned long long, const unsigned long long &,
- float, const float &,
- double, const double &,
- long double, const long double &,
- char *
- "Ctypes AS C"
-
-%typemap("m3rawrettype:import")
- char, const char &,
- signed char, const signed char &,
- unsigned char, const unsigned char &,
- short, const short &,
- unsigned short, const unsigned short &,
- int, const int &,
- unsigned int, const unsigned int &,
- long, const long &,
- unsigned long, const unsigned long &,
- long long, const long long &,
- unsigned long long, const unsigned long long &,
- float, const float &,
- double, const double &,
- long double, const long double &,
- char *
- "Ctypes AS C"
-
-%typemap("m3rawtype:import")
- FILE, FILE *
- "Cstdio";
-
-%typemap("m3rawintype:import")
- FILE, FILE *
- "Cstdio";
-
-%typemap("m3rawrettype:import")
- FILE, FILE *
- "Cstdio";
-
-%typemap(m3wraptype) bool, const bool & "BOOLEAN"
-%typemap(m3wraptype) char, const char & "CHAR"
-%typemap(m3wraptype) signed char, const signed char & "CHAR"
-%typemap(m3wraptype) unsigned char, const unsigned char & "CHAR"
-%typemap(m3wraptype) short, const short & "Integer16.T"
-%typemap(m3wraptype) unsigned short, const unsigned short & "Cardinal16.T"
-%typemap(m3wraptype) int, const int & "INTEGER"
-%typemap(m3wraptype) unsigned int, const unsigned int & "CARDINAL"
-%typemap(m3wraptype) long, const long & "Integer32.T"
-%typemap(m3wraptype) unsigned long, const unsigned long & "Cardinal32.T"
-%typemap(m3wraptype) long long, const long long & "Integer64.T"
-%typemap(m3wraptype) unsigned long long, const unsigned long long & "Cardinal64.T"
-%typemap(m3wraptype) float, const float & "REAL"
-%typemap(m3wraptype) double, const double & "LONGREAL"
-%typemap(m3wraptype) long double, const long double & "EXTENDED"
-%typemap(m3wraptype) char * "TEXT"
-%typemap(m3wraptype) void ""
-%typemap(m3wraptype) FILE "Cstdio.FILE";
-%typemap(m3wraptype) FILE * "Cstdio.FILE_star";
-
-%typemap(m3wrapintype) bool, const bool *, const bool & "BOOLEAN"
-%typemap(m3wrapintype) char, const char *, const char & "CHAR"
-%typemap(m3wrapintype) signed char, const signed char *, const signed char & "CHAR"
-%typemap(m3wrapintype) unsigned char, const unsigned char *, const unsigned char & "CHAR"
-%typemap(m3wrapintype) short, const short *, const short & "INTEGER"
-%typemap(m3wrapintype) unsigned short, const unsigned short *, const unsigned short & "CARDINAL"
-%typemap(m3wrapintype) int, const int *, const int & "INTEGER"
-%typemap(m3wrapintype) unsigned int, const unsigned int *, const unsigned int & "CARDINAL"
-%typemap(m3wrapintype) long, const long *, const long & "INTEGER"
-%typemap(m3wrapintype) unsigned long, const unsigned long *, const unsigned long & "CARDINAL"
-%typemap(m3wrapintype) long long, const long long *, const long long & "INTEGER"
-%typemap(m3wrapintype) unsigned long long, const unsigned long long *, const unsigned long long & "CARDINAL"
-%typemap(m3wrapintype) float, const float *, const float & "REAL"
-%typemap(m3wrapintype) double, const double *, const double & "LONGREAL"
-%typemap(m3wrapintype) long double, const long double *, const long double & "EXTENDED"
-%typemap(m3wrapintype) const char *, const char [] "TEXT"
-%typemap(m3wrapintype,numinputs=0) void ""
-%typemap(m3wrapintype) FILE "Cstdio.FILE";
-%typemap(m3wrapintype) FILE * "Cstdio.FILE_star";
-
-
-%typemap(m3wrapouttype) bool, bool *, bool & "BOOLEAN"
-%typemap(m3wrapouttype) char, char *, char & "CHAR"
-%typemap(m3wrapouttype) signed char, signed char *, signed char & "CHAR"
-%typemap(m3wrapouttype) unsigned char, unsigned char *, unsigned char & "CHAR"
-%typemap(m3wrapouttype) short, short *, short & "INTEGER"
-%typemap(m3wrapouttype) unsigned short, unsigned short *, unsigned short & "CARDINAL"
-%typemap(m3wrapouttype) int, int *, int & "INTEGER"
-%typemap(m3wrapouttype) unsigned int, unsigned int *, unsigned int & "CARDINAL"
-%typemap(m3wrapouttype) long, long *, long & "INTEGER"
-%typemap(m3wrapouttype) unsigned long, unsigned long *, unsigned long & "CARDINAL"
-%typemap(m3wrapouttype) long long, long long *, long long & "INTEGER"
-%typemap(m3wrapouttype) unsigned long long, unsigned long long *, unsigned long long & "CARDINAL"
-%typemap(m3wrapouttype) float, float *, float & "REAL"
-%typemap(m3wrapouttype) double, double *, double & "LONGREAL"
-%typemap(m3wrapouttype) long double, long double *, long double & "EXTENDED"
-%typemap(m3wrapouttype) char *, char [] "TEXT"
-%typemap(m3wrapouttype,numinputs=0) void ""
-
-%typemap(m3wraprettype) bool, const bool & "BOOLEAN"
-%typemap(m3wraprettype) char, const char & "CHAR"
-%typemap(m3wraprettype) signed char, const signed char & "CHAR"
-%typemap(m3wraprettype) unsigned char, const unsigned char & "CHAR"
-%typemap(m3wraprettype) short, const short & "INTEGER"
-%typemap(m3wraprettype) unsigned short, const unsigned short & "CARDINAL"
-%typemap(m3wraprettype) int, const int & "INTEGER"
-%typemap(m3wraprettype) unsigned int, const unsigned int & "CARDINAL"
-%typemap(m3wraprettype) long, const long & "INTEGER"
-%typemap(m3wraprettype) unsigned long, const unsigned long & "CARDINAL"
-%typemap(m3wraprettype) long long, const long long & "INTEGER"
-%typemap(m3wraprettype) unsigned long long, const unsigned long long & "CARDINAL"
-%typemap(m3wraprettype) float, const float & "REAL"
-%typemap(m3wraprettype) double, const double & "LONGREAL"
-%typemap(m3wraprettype) long double, const long double & "EXTENDED"
-%typemap(m3wraprettype) char * "TEXT"
-%typemap(m3wraprettype) void ""
-%typemap(m3wraprettype) FILE "Cstdio.FILE";
-%typemap(m3wraprettype) FILE * "Cstdio.FILE_star";
-
-
-%typemap(ctype) char[ANY] "char *"
-%typemap(m3rawtype) char[ANY] "C.char_star"
-%typemap(m3rawintype) char[ANY] "C.char_star"
-%typemap(m3rawrettype) char[ANY] "C.char_star"
-%typemap(m3wraptype) char[ANY] "TEXT"
-%typemap(m3wrapintype) char[ANY] "TEXT"
-%typemap(m3wrapouttype) char[ANY] "TEXT"
-%typemap(m3wraprettype) char[ANY] "TEXT"
-
-%typemap(m3wrapinmode) const char * %{%}
-%typemap(m3wrapargvar) const char * %{$1 : C.char_star;%}
-%typemap(m3wrapinconv) const char * %{$1 := M3toC.SharedTtoS($1_name);%}
-%typemap(m3wrapfreearg) const char * %{M3toC.FreeSharedS($1_name,$1);%}
-%typemap(m3wrapargraw) const char * %{$1%}
-%typemap("m3wrapargvar:import") const char * "Ctypes AS C"
-%typemap("m3wrapinconv:import") const char * "M3toC"
-%typemap("m3wrapfreearg:import") const char * "M3toC"
-
-%typemap(m3wrapretvar) char * %{result : C.char_star;%}
-%typemap(m3wrapretraw) char * %{result%}
-%typemap(m3wrapretconv) char * %{M3toC.CopyStoT(result)%}
-%typemap("m3wrapretvar:import") char * "Ctypes AS C"
-%typemap("m3wrapretconv:import") char * "M3toC"
-
-%typemap(m3wrapinmode) FILE * %{%}
-
-
-%typemap("m3wraptype:import")
- FILE, FILE *
- "Cstdio";
-
-%typemap("m3wrapintype:import")
- FILE, FILE *
- "Cstdio";
-
-%typemap("m3wraprettype:import")
- FILE, FILE *
- "Cstdio";
-
-
-/* Composed types */
-%typemap(ctype) SWIGTYPE "$1_type"
-%typemap(m3rawtype) SWIGTYPE "$1_basetype"
-%typemap(m3rawrettype) SWIGTYPE "UNTRACED REF $1_basetype"
-%typemap(m3wraptype) SWIGTYPE "$1_basetype"
-%typemap(m3wrapintype) SWIGTYPE "$1_basetype"
-%typemap(m3wrapouttype) SWIGTYPE "$1_basetype"
-%typemap(m3wraprettype) SWIGTYPE "$1_basetype"
-
-%typemap(ctype) SWIGTYPE [] "$1_type"
-%typemap(m3rawtype) const SWIGTYPE [] "UNTRACED REF ARRAY INTEGER OF $1_basetype"
-%typemap(m3rawtype) SWIGTYPE [] "UNTRACED REF ARRAY INTEGER OF $1_basetype"
-%typemap(m3rawintype) const SWIGTYPE [] "(*ARRAY OF*) $1_basetype"
-%typemap(m3rawinmode) const SWIGTYPE [] "READONLY"
-%typemap(m3rawintype) SWIGTYPE [] "(*ARRAY OF*) $1_basetype"
-%typemap(m3rawinmode) SWIGTYPE [] "VAR"
-%typemap(m3rawrettype) const SWIGTYPE [] "UNTRACED REF ARRAY INTEGER OF $1_basetype"
-%typemap(m3rawrettype) SWIGTYPE [] "UNTRACED REF ARRAY INTEGER OF $1_basetype"
-%typemap(m3wraptype) SWIGTYPE [] "$1_basetype"
-%typemap(m3wrapintype) const SWIGTYPE [] "ARRAY OF $1_basetype"
-%typemap(m3wrapinmode) const SWIGTYPE [] "READONLY"
-%typemap(m3wrapintype) SWIGTYPE [] "ARRAY OF $1_basetype"
-%typemap(m3wrapinmode) SWIGTYPE [] "VAR"
-%typemap(m3wrapouttype) SWIGTYPE [] "ARRAY OF $1_basetype"
-%typemap(m3wraprettype) SWIGTYPE [] "REF ARRAY OF $1_basetype"
-
-%typemap(ctype) SWIGTYPE * "$1_type"
-%typemap(m3rawtype) const SWIGTYPE * "UNTRACED REF $1_basetype"
-%typemap(m3rawtype) SWIGTYPE * "UNTRACED REF $1_basetype"
-%typemap(m3rawintype) const SWIGTYPE * "$1_basetype"
-%typemap(m3rawinmode) const SWIGTYPE * "READONLY"
-%typemap(m3rawintype) SWIGTYPE * "$1_basetype"
-%typemap(m3rawinmode) SWIGTYPE * "VAR"
-%typemap(m3rawrettype) const SWIGTYPE * "UNTRACED REF $1_basetype"
-%typemap(m3rawrettype) SWIGTYPE * "UNTRACED REF $1_basetype"
-%typemap(m3wraptype) SWIGTYPE * "$1_basetype"
-%typemap(m3wrapintype) const SWIGTYPE * "$1_basetype"
-%typemap(m3wrapinmode) const SWIGTYPE * "READONLY"
-%typemap(m3wrapintype) SWIGTYPE * "$1_basetype"
-%typemap(m3wrapinmode) SWIGTYPE * "VAR"
-%typemap(m3wrapouttype) SWIGTYPE * "$1_basetype"
-%typemap(m3wraprettype) SWIGTYPE * "UNTRACED REF $1_basetype"
-
-%typemap(ctype) SWIGTYPE & "$1_type"
-%typemap(m3rawtype) const SWIGTYPE & "UNTRACED REF $1_basetype"
-%typemap(m3rawtype) SWIGTYPE & "UNTRACED REF $1_basetype"
-%typemap(m3rawintype) const SWIGTYPE & "$1_basetype"
-%typemap(m3rawinmode) const SWIGTYPE & "READONLY"
-%typemap(m3rawintype) SWIGTYPE & "$1_basetype"
-%typemap(m3rawinmode) SWIGTYPE & "VAR"
-%typemap(m3rawrettype) const SWIGTYPE & "UNTRACED REF $1_basetype"
-%typemap(m3rawrettype) SWIGTYPE & "UNTRACED REF $1_basetype"
-%typemap(m3wraptype) SWIGTYPE & "$1_basetype"
-%typemap(m3wrapintype) const SWIGTYPE & "$1_basetype"
-%typemap(m3wrapinmode) const SWIGTYPE & "READONLY"
-%typemap(m3wrapintype) SWIGTYPE & "$1_basetype"
-%typemap(m3wrapinmode) SWIGTYPE & "VAR"
-%typemap(m3wrapouttype) SWIGTYPE & "$1_basetype"
-%typemap(m3wraprettype) SWIGTYPE & "UNTRACED REF $1_basetype"
-
-%typemap(ctype) SWIGTYPE && "$1_type"
-%typemap(m3rawtype) const SWIGTYPE && "UNTRACED REF $1_basetype"
-%typemap(m3rawtype) SWIGTYPE && "UNTRACED REF $1_basetype"
-%typemap(m3rawintype) const SWIGTYPE && "$1_basetype"
-%typemap(m3rawinmode) const SWIGTYPE && "READONLY"
-%typemap(m3rawintype) SWIGTYPE && "$1_basetype"
-%typemap(m3rawinmode) SWIGTYPE && "VAR"
-%typemap(m3rawrettype) const SWIGTYPE && "UNTRACED REF $1_basetype"
-%typemap(m3rawrettype) SWIGTYPE && "UNTRACED REF $1_basetype"
-%typemap(m3wraptype) SWIGTYPE && "$1_basetype"
-%typemap(m3wrapintype) const SWIGTYPE && "$1_basetype"
-%typemap(m3wrapinmode) const SWIGTYPE && "READONLY"
-%typemap(m3wrapintype) SWIGTYPE && "$1_basetype"
-%typemap(m3wrapinmode) SWIGTYPE && "VAR"
-%typemap(m3wrapouttype) SWIGTYPE && "$1_basetype"
-%typemap(m3wraprettype) SWIGTYPE && "UNTRACED REF $1_basetype"
-
-%typemap(ctype) enum SWIGTYPE "$1_type"
-%typemap(m3rawtype) enum SWIGTYPE "C.int"
-%typemap(m3rawintype) enum SWIGTYPE "C.int (* $1_type *)"
-%typemap(m3rawrettype) enum SWIGTYPE "C.int"
-%typemap(m3wraptype) enum SWIGTYPE "$*1_type"
-%typemap(m3wrapintype) enum SWIGTYPE "$1_type"
-%typemap(m3wrapouttype) enum SWIGTYPE "$1_type"
-%typemap(m3wraprettype) enum SWIGTYPE "$*1_type"
-
-/* pointer to a class member */
-%typemap(ctype) SWIGTYPE (CLASS::*) "$1_type"
-%typemap(m3rawtype) SWIGTYPE (CLASS::*) "REFANY"
-%typemap(m3wraptype) SWIGTYPE (CLASS::*) "$1_basetype"
-
-/* The following are the in, out, freearg, argout typemaps.
- These are the PInvoke code generating typemaps for converting from C# to C and visa versa. */
-
-/* primitive types */
-%typemap(in) bool
-%{ $1 = $input ? true : false; %}
-
-%typemap(in) char,
- signed char,
- unsigned char,
- short,
- unsigned short,
- int,
- unsigned int,
- long,
- unsigned long,
- long long,
- unsigned long long,
- float,
- double,
- enum SWIGTYPE
-%{ $1 = ($1_ltype)$input; %}
-
-%typemap(out) bool %{ $result = $1; %}
-%typemap(out) char %{ $result = $1; %}
-%typemap(out) signed char %{ $result = $1; %}
-%typemap(out) unsigned char %{ $result = $1; %}
-%typemap(out) short %{ $result = $1; %}
-%typemap(out) unsigned short %{ $result = $1; %}
-%typemap(out) int %{ $result = $1; %}
-%typemap(out) unsigned int %{ $result = $1; %}
-%typemap(out) long %{ $result = $1; %}
-%typemap(out) unsigned long %{ $result = $1; %}
-%typemap(out) long long %{ $result = $1; %}
-%typemap(out) unsigned long long %{ $result = $1; %}
-%typemap(out) float %{ $result = $1; %}
-%typemap(out) double %{ $result = $1; %}
-%typemap(out) enum SWIGTYPE %{ $result = $1; %}
-
-/* char * - treat as String */
-%typemap(in) char * {
- $1 = $input;
-}
-//%typemap(freearg) char * { if ($1) JCALL2(ReleaseStringUTFChars, jenv, $input, $1); }
-//%typemap(out) char * { if($1) $result = JCALL1(NewStringUTF, jenv, $1); }
-
-%typemap(out) void ""
-
-/* primitive types by const reference */
-%typemap(in) const bool & (bool temp)
-%{ temp = $input ? true : false;
- $1 = &temp; %}
-
-%typemap(in) const char & (char temp),
- const signed char & (signed char temp),
- const unsigned char & (unsigned char temp),
- const short & (short temp),
- const unsigned short & (unsigned short temp),
- const int & (int temp),
- const unsigned int & (unsigned int temp),
- const long & (long temp),
- const unsigned long & (unsigned long temp),
- const long long & ($*1_ltype temp),
- const unsigned long long & ($*1_ltype temp),
- const float & (float temp),
- const double & (double temp)
-%{ temp = ($*1_ltype)$input;
-$1 = &temp; %}
-
-%typemap(out) const bool & %{ $result = *$1; %}
-%typemap(out) const char & %{ $result = *$1; %}
-%typemap(out) const signed char & %{ $result = *$1; %}
-%typemap(out) const unsigned char & %{ $result = *$1; %}
-%typemap(out) const short & %{ $result = *$1; %}
-%typemap(out) const unsigned short & %{ $result = *$1; %}
-%typemap(out) const int & %{ $result = *$1; %}
-%typemap(out) const unsigned int & %{ $result = *$1; %}
-%typemap(out) const long & %{ $result = *$1; %}
-%typemap(out) const unsigned long & %{ $result = *$1; %}
-%typemap(out) const long long & %{ $result = *$1; %}
-%typemap(out) const unsigned long long & %{ $result = *$1; %}
-%typemap(out) const float & %{ $result = *$1; %}
-%typemap(out) const double & %{ $result = *$1; %}
-
-/* Default handling. Object passed by value. Convert to a pointer */
-%typemap(in) SWIGTYPE ($&1_type argp)
-%{ argp = *($&1_ltype*)&$input;
- if (!argp) {
-// SWIG_JavaThrowException(jenv, SWIG_JavaNullPointerException, "Attempt to dereference null $1_type");
- RETURN $null;
- }
- $1 = *argp; %}
-%typemap(out) SWIGTYPE
-#ifdef __cplusplus
-%{*($&1_ltype*)&$result = new $1_ltype((const $1_ltype &)$1); %}
-#else
-{
- $&1_ltype $1ptr = ($&1_ltype) malloc(sizeof($1_ltype));
- memmove($1ptr, &$1, sizeof($1_type));
- *($&1_ltype*)&$result = $1ptr;
-}
-#endif
-
-/* Generic pointers and references */
-%typemap(in) SWIGTYPE *, SWIGTYPE (CLASS::*) %{ $1 = *($&1_ltype)&$input; %}
-%typemap(in) SWIGTYPE & %{ $1 = *($&1_ltype)&$input;
- if(!$1) {
- //SWIG_JavaThrowException(jenv, SWIG_JavaNullPointerException, "$1_type reference is null");
- RETURN $null;
- } %}
-%typemap(in) SWIGTYPE && %{ $1 = *($&1_ltype)&$input;
- if(!$1) {
- //SWIG_JavaThrowException(jenv, SWIG_JavaNullPointerException, "$1_type reference is null");
- RETURN $null;
- } %}
-%typemap(out) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE (CLASS::*) %{ *($&1_ltype)&$result = $1; %}
-
-
-/* Default array handling */
-%typemap(in) SWIGTYPE [] %{ $1 = *($&1_ltype)&$input; %}
-%typemap(out) SWIGTYPE [] %{ *($&1_ltype)&$result = $1; %}
-
-/* char[ANY] - treat as String */
-%typemap(in) char[ANY] {
- $1 = $input;
-}
-
-%typemap(argout) char[ANY] ""
-%typemap(freearg) char[ANY] ""//{ if ($1) JCALL2(ReleaseStringUTFChars, jenv, $input, $1); }
-%typemap(out) char[ANY] { if($1) $result = $1; }
-
-
-/* Typecheck typemaps - The purpose of these is merely to issue a warning for overloaded C++ functions
- * that cannot be overloaded in C# as more than one C++ type maps to a single C# type */
-
-%typecheck(SWIG_TYPECHECK_BOOL) /* Java boolean */
- bool,
- const bool &
- ""
-
-%typecheck(SWIG_TYPECHECK_CHAR) /* Java char */
- char,
- const char &
- ""
-
-%typecheck(SWIG_TYPECHECK_INT8) /* Java byte */
- signed char,
- const signed char &
- ""
-
-%typecheck(SWIG_TYPECHECK_INT16) /* Java short */
- unsigned char,
- short,
- const unsigned char &,
- const short &
- ""
-
-%typecheck(SWIG_TYPECHECK_INT32) /* Java int */
- unsigned short,
- int,
- long,
- const unsigned short &,
- const int &,
- const long &,
- enum SWIGTYPE
- ""
-
-%typecheck(SWIG_TYPECHECK_INT64) /* Java long */
- unsigned int,
- unsigned long,
- long long,
- const unsigned int &,
- const unsigned long &,
- const long long &
- ""
-
-%typecheck(SWIG_TYPECHECK_INT128) /* Java BigInteger */
- unsigned long long
- ""
-
-%typecheck(SWIG_TYPECHECK_FLOAT) /* Java float */
- float,
- const float &
- ""
-
-%typecheck(SWIG_TYPECHECK_DOUBLE) /* Java double */
- double,
- const double &
- ""
-
-%typecheck(SWIG_TYPECHECK_STRING) /* Java String */
- char *,
- char[ANY]
- ""
-
-%typecheck(SWIG_TYPECHECK_POINTER) /* Default */
- SWIGTYPE,
- SWIGTYPE *,
- SWIGTYPE &,
- SWIGTYPE &&,
- SWIGTYPE [],
- SWIGTYPE (CLASS::*)
- ""
-
-/* Exception handling */
-
-%typemap(throws) int,
- long,
- short,
- unsigned int,
- unsigned long,
- unsigned short {
- char error_msg[256];
- sprintf(error_msg, "C++ $1_type exception thrown, value: %d", $1);
- SWIG_JavaThrowException(jenv, SWIG_JavaRuntimeException, error_msg);
- RETURN $null;
-}
-
-%typemap(throws) SWIGTYPE {
- (void)$1;
- SWIG_JavaThrowException(jenv, SWIG_JavaRuntimeException, "C++ $1_type exception thrown");
- RETURN $null;
-}
-
-%typemap(throws) char * {
- SWIG_JavaThrowException(jenv, SWIG_JavaRuntimeException, $1);
- RETURN $null;
-}
-
-
-/* Typemaps for code generation in proxy classes and C# type wrapper classes */
-
-/* The in typemap is used for converting function parameter types from the type
- * used in the proxy, module or type wrapper class to the type used in the PInvoke class. */
-%typemap(m3in) bool, const bool &,
- char, const char &,
- signed char, const signed char &,
- unsigned char, const unsigned char &,
- short, const short &,
- unsigned short, const unsigned short &,
- int, const int &,
- unsigned int, const unsigned int &,
- long, const long &,
- unsigned long, const unsigned long &,
- long long, const long long &,
- unsigned long long, const unsigned long long &,
- float, const float &,
- double, const double &,
- char *,
- char[ANY],
- enum SWIGTYPE
- "$input"
-%typemap(m3in) SWIGTYPE "$&*1_type.getCPtr($input)"
-%typemap(m3in) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) "$1_basetype.getCPtr($input)"
-
-/* The m3out typemap is used for converting function return types from the return type
- * used in the PInvoke class to the type returned by the proxy, module or type wrapper class. */
-%typemap(m3out) bool, const bool &,
- char, const char &,
- signed char, const signed char &,
- unsigned char, const unsigned char &,
- short, const short &,
- unsigned short, const unsigned short &,
- int, const int &,
- unsigned int, const unsigned int &,
- long, const long &,
- unsigned long, const unsigned long &,
- long long, const long long &,
- unsigned long long, const unsigned long long &,
- float, const float &,
- double, const double &,
- char *,
- char[ANY],
- enum SWIGTYPE
-%{$imcall%}
-
-%typemap(m3out) void %{$imcall%}
-
-%typemap(m3out) SWIGTYPE %{
- RETURN NEW(REF $1_basetype, $imcall);
-%}
-%typemap(m3out) SWIGTYPE & %{
- RETURN NEW($1_basetype, $imcall, $owner);
-%}
-%typemap(m3out) SWIGTYPE && %{
- RETURN NEW($1_basetype, $imcall, $owner);
-%}
-%typemap(m3out) SWIGTYPE *, SWIGTYPE [], SWIGTYPE (CLASS::*) %{
- cPtr := $imcall;
- RETURN (cPtr = IntPtr.Zero) ? null : NEW($1_basetype, cPtr, $owner);
-%}
-
-/* Properties */
-%typemap(m3varin) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) %{
-PROCEDURE Set$var (value: $vartype) =
- BEGIN
- $imcall;
- END Set$var;
-%}
-
-%typemap(m3varout) bool, const bool &,
- char, const char &,
- signed char, const signed char &,
- unsigned char, const unsigned char &,
- short, const short &,
- unsigned short, const unsigned short &,
- int, const int &,
- unsigned int, const unsigned int &,
- long, const long &,
- unsigned long, const unsigned long &,
- long long, const long long &,
- unsigned long long, const unsigned long long &,
- float, const float &,
- double, const double &,
- char *,
- char[ANY],
- enum SWIGTYPE %{
-PROCEDURE Get$var (): $vartype =
- BEGIN
- RETURN $imcall;
- END Get$var;
-%}
-
-%typemap(m3varout) void %{
- get {
- $imcall;
- } %}
-%typemap(m3varout) SWIGTYPE %{
- get {
- RETURN new $&*1_mangle($imcall, true);
- } %}
-%typemap(m3varout) SWIGTYPE & %{
- get {
- RETURN new $1_basetype($imcall, $owner);
- } %}
-%typemap(m3varout) SWIGTYPE && %{
- get {
- RETURN new $1_basetype($imcall, $owner);
- } %}
-%typemap(m3varout) SWIGTYPE *, SWIGTYPE [], SWIGTYPE (CLASS::*) %{
- get {
- IntPtr cPtr = $imcall;
- RETURN (cPtr == IntPtr.Zero) ? null : new $1_basetype(cPtr, $owner);
- } %}
-
-/* Typemaps used for the generation of proxy and type wrapper class code */
-%typemap(m3base) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) ""
-%typemap(m3classmodifiers) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) "public"
-%typemap(m3code) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) ""
-%typemap(m3imports) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) "using System;"
-%typemap(m3interfaces) SWIGTYPE "IDisposable"
-%typemap(m3interfaces_derived) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) ""
-%typemap(m3ptrconstructormodifiers) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) "internal"
-
-%typemap(m3finalize) SWIGTYPE %{
- ~$1_basetype() {
- Dispose();
- }
-%}
-
-%typemap(m3destruct, methodname="Dispose") SWIGTYPE {
- if(swigCPtr != IntPtr.Zero && swigCMemOwn) {
- $imcall;
- swigCMemOwn = false;
- }
- swigCPtr = IntPtr.Zero;
- GC.SuppressFinalize(this);
- }
-
-%typemap(m3destruct_derived, methodname="Dispose") SWIGTYPE {
- if(swigCPtr != IntPtr.Zero && swigCMemOwn) {
- $imcall;
- swigCMemOwn = false;
- }
- swigCPtr = IntPtr.Zero;
- GC.SuppressFinalize(this);
- base.Dispose();
- }
-
-%typemap(m3getcptr) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) %{
- internal static IntPtr getCPtr($1_basetype obj) {
- RETURN (obj == null) ? IntPtr.Zero : obj.swigCPtr;
- }
-%}
-
-/* M3 specific directives */
-#define %m3multiretval %feature("modula3:multiretval")
-#define %constnumeric(num) %feature("constnumeric","num")
-
-%pragma(modula3) moduleimports=%{
-IMPORT BlaBla;
-%}
-
-%pragma(modula3) imclassimports=%{
-FROM BlaBla IMPORT Bla;
-%}
-
-/* Some ANSI C typemaps */
-
-%apply unsigned long { size_t };
-
-/* 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&) }
-
diff --git a/Lib/modula3/modula3head.swg b/Lib/modula3/modula3head.swg
deleted file mode 100644
index af96a78..0000000
--- a/Lib/modula3/modula3head.swg
+++ /dev/null
@@ -1,64 +0,0 @@
-/* -----------------------------------------------------------------------------
- * modula3head.swg
- *
- * Modula3 support code
- * ----------------------------------------------------------------------------- */
-
-%insert(runtime) %{
-
-#include <stdlib.h>
-#include <string.h>
-#include <stdio.h>
-%}
-
-#if 0
-%insert(runtime) %{
-/* Support for throwing Modula3 exceptions */
-typedef enum {
- SWIG_JavaOutOfMemoryError = 1,
- SWIG_JavaIOException,
- SWIG_JavaRuntimeException,
- SWIG_JavaIndexOutOfBoundsException,
- SWIG_JavaArithmeticException,
- SWIG_JavaIllegalArgumentException,
- SWIG_JavaNullPointerException,
- SWIG_JavaUnknownError
-} SWIG_JavaExceptionCodes;
-
-typedef struct {
- SWIG_JavaExceptionCodes code;
- const char *java_exception;
-} SWIG_JavaExceptions_t;
-
-#if defined(SWIG_NOINCLUDE)
-void SWIG_JavaThrowException(JNIEnv *jenv, SWIG_JavaExceptionCodes code, const char *msg);
-#else
-%}
-%insert(runtime) {
-void SWIG_JavaThrowException(JNIEnv *jenv, SWIG_JavaExceptionCodes code, const char *msg) {
- jclass excep;
- static const SWIG_JavaExceptions_t java_exceptions[] = {
- { SWIG_JavaOutOfMemoryError, "java/lang/OutOfMemoryError" },
- { SWIG_JavaIOException, "java/io/IOException" },
- { SWIG_JavaRuntimeException, "java/lang/RuntimeException" },
- { SWIG_JavaIndexOutOfBoundsException, "java/lang/IndexOutOfBoundsException" },
- { SWIG_JavaArithmeticException, "java/lang/ArithmeticException" },
- { SWIG_JavaIllegalArgumentException, "java/lang/IllegalArgumentException" },
- { SWIG_JavaNullPointerException, "java/lang/NullPointerException" },
- { SWIG_JavaUnknownError, "java/lang/UnknownError" },
- { (SWIG_JavaExceptionCodes)0, "java/lang/UnknownError" } };
- const SWIG_JavaExceptions_t *except_ptr = java_exceptions;
-
- while (except_ptr->code != code && except_ptr->code)
- except_ptr++;
-
- JCALL0(ExceptionClear, jenv);
- excep = JCALL1(FindClass, jenv, except_ptr->java_exception);
- if (excep)
- JCALL2(ThrowNew, jenv, excep, msg);
-}
-}
-%insert(runtime) %{
-#endif
-%}
-#endif
diff --git a/Lib/modula3/typemaps.i b/Lib/modula3/typemaps.i
deleted file mode 100644
index 1d76ab5..0000000
--- a/Lib/modula3/typemaps.i
+++ /dev/null
@@ -1,74 +0,0 @@
-/* -----------------------------------------------------------------------------
- * typemaps.i
- *
- * Pointer and reference handling typemap library
- *
- * These mappings provide support for input/output arguments and common
- * uses for C/C++ pointers and C++ references.
- * ----------------------------------------------------------------------------- */
-
-/* These typemaps will eventually probably maybe make their way into named typemaps
- * OUTPUT * and OUTPUT & as they currently break functions that return a pointer or
- * reference. */
-
-%typemap(ctype) bool *, bool & "bool *"
-%typemap(ctype) char & "char *"
-%typemap(ctype) signed char *, signed char & "signed char *"
-%typemap(ctype) unsigned char *, unsigned char & "unsigned short *"
-%typemap(ctype) short *, short & "short *"
-%typemap(ctype) unsigned short *, unsigned short & "unsigned short *"
-%typemap(ctype) int *, int & "int *"
-%typemap(ctype) unsigned int *, unsigned int & "unsigned int *"
-%typemap(ctype) long *, long & "long *"
-%typemap(ctype) unsigned long *, unsigned long & "unsigned long *"
-%typemap(ctype) long long *, long long & "long long *"
-%typemap(ctype) unsigned long long *, unsigned long long & "unsigned long long *"
-%typemap(ctype) float *, float & "float *"
-%typemap(ctype) double *, double & "double *"
-
-%typemap(imtype) bool *, bool & "ref bool"
-%typemap(imtype) char & "ref char"
-%typemap(imtype) signed char *, signed char & "ref sbyte"
-%typemap(imtype) unsigned char *, unsigned char & "ref byte"
-%typemap(imtype) short *, short & "ref short"
-%typemap(imtype) unsigned short *, unsigned short & "ref ushort"
-%typemap(imtype) int *, int & "ref int"
-%typemap(imtype) unsigned int *, unsigned int & "ref uint"
-%typemap(imtype) long *, long & "ref int"
-%typemap(imtype) unsigned long *, unsigned long & "ref uint"
-%typemap(imtype) long long *, long long & "ref long"
-%typemap(imtype) unsigned long long *, unsigned long long & "ref ulong"
-%typemap(imtype) float *, float & "ref float"
-%typemap(imtype) double *, double & "ref double"
-
-%typemap(cstype) bool *, bool & "ref bool"
-%typemap(cstype) char & "ref char"
-%typemap(cstype) signed char *, signed char & "ref sbyte"
-%typemap(cstype) unsigned char *, unsigned char & "ref byte"
-%typemap(cstype) short *, short & "ref short"
-%typemap(cstype) unsigned short *, unsigned short & "ref ushort"
-%typemap(cstype) int *, int & "ref int"
-%typemap(cstype) unsigned int *, unsigned int & "ref uint"
-%typemap(cstype) long *, long & "ref int"
-%typemap(cstype) unsigned long *, unsigned long & "ref uint"
-%typemap(cstype) long long *, long long & "ref long"
-%typemap(cstype) unsigned long long *, unsigned long long & "ref ulong"
-%typemap(cstype) float *, float & "ref float"
-%typemap(cstype) double *, double & "ref double"
-
-%typemap(csin) bool *, bool &,
- char &,
- signed char *, signed char &,
- unsigned char *, unsigned char &,
- short *, short &,
- unsigned short *, unsigned short &,
- int *, int &,
- unsigned int *, unsigned int &,
- long *, long &,
- unsigned long *, unsigned long &,
- long long *, long long &,
- unsigned long long *, unsigned long long &,
- float *, float &,
- double *, double &
- "ref $csinput"
-
diff --git a/Lib/pike/pike.swg b/Lib/pike/pike.swg
deleted file mode 100644
index a36bf3a..0000000
--- a/Lib/pike/pike.swg
+++ /dev/null
@@ -1,326 +0,0 @@
-/* -----------------------------------------------------------------------------
- * pike.swg
- *
- * Pike configuration module.
- * ----------------------------------------------------------------------------- */
-
-%insert(runtime) "swigrun.swg"; // Common C API type-checking code
-%insert(runtime) "pikerun.swg"; // Pike run-time code
-
-%insert(runtime) %{
-#ifdef __cplusplus
-extern "C" {
-#endif
-#include <pike/global.h>
-#include <pike/module.h>
-#include <pike/interpret.h>
-#ifdef __cplusplus
-}
-#endif
-%}
-
-/* -----------------------------------------------------------------------------
- * standard typemaps
- * ----------------------------------------------------------------------------- */
-
-/* --- Input arguments --- */
-
-/* Primitive datatypes. */
-
-%typemap(in, pikedesc="tInt")
- int, unsigned int, short, unsigned short,
- long, unsigned long, char, signed char, unsigned char,
- bool, enum SWIGTYPE, long long, unsigned long long
-{
- if ($input.type != T_INT)
- Pike_error("Bad argument: Expected an integer.\n");
- $1 = ($1_ltype) $input.u.integer;
-}
-
-%typemap(in, pikedesc="tFloat") float, double {
- if ($input.type != T_FLOAT)
- Pike_error("Bad argument: Expected a float.\n");
- $1 = ($1_ltype) $input.u.float_number;
-}
-
-%typemap(in, pikedesc="tStr") char *, char [ANY] {
- if ($input.type != T_STRING)
- Pike_error("Bad argument: Expected a string.\n");
- $1 = ($1_ltype) STR0($input.u.string);
-}
-
-/* Pointers, references and arrays */
-
-%typemap(in) SWIGTYPE *,
- SWIGTYPE &,
- SWIGTYPE &&,
- SWIGTYPE []
- "SWIG_ConvertPtr($input.u.object, (void **) &$1, $1_descriptor, 1);"
-
-/* Void pointer. Accepts any kind of pointer */
-%typemap(in) void * "/* FIXME */";
-
-/* Object passed by value. Convert to a pointer */
-%typemap(in) SWIGTYPE ($&1_ltype argp) "/* FIXME */";
-
-/* Pointer to a class member */
-%typemap(in) SWIGTYPE (CLASS::*) "/* FIXME */";
-
-/* Const primitive references. Passed by value */
-
-%typemap(in, pikedesc="tInt") const int & (int temp),
- const short & (short temp),
- const long & (long temp),
- const unsigned int & (unsigned int temp),
- const unsigned short & (unsigned short temp),
- const unsigned long & (unsigned long temp),
- const char & (char temp),
- const signed char & (signed char temp),
- const unsigned char & (unsigned char temp),
- const bool & (bool temp),
- const long long & ($*1_ltype temp),
- const unsigned long long & ($*1_ltype temp),
- const enum SWIGTYPE & ($*1_ltype temp),
- const enum SWIGTYPE && ($*1_ltype temp)
-{
- if ($input.type != T_INT)
- Pike_error("Bad argument: Expected an integer.\n");
- temp = ($*1_ltype) $input.u.integer;
- $1 = &temp;
-}
-
-%typemap(in, pikedesc="tFloat") const float & (float temp),
- const double & (double temp)
-{
- if ($input.type != T_FLOAT)
- Pike_error("Bad argument: Expected a float.\n");
- temp = ($*1_ltype) $input.u.float_number;
- $1 = &temp;
-}
-
-/* -----------------------------------------------------------------------------
- * Output Typemaps
- * ----------------------------------------------------------------------------- */
-%typemap(out, pikedesc="tInt")
- int, unsigned int,
- short, unsigned short,
- long, unsigned long,
- char, signed char, unsigned char,
- bool, enum SWIGTYPE
- "push_int($1);";
-
-%typemap(out, pikedesc="tInt") long long "push_int64($1);";
-%typemap(out, pikedesc="tInt") unsigned long long "push_int64($1);";
-%typemap(out, pikedesc="tFloat") float, double "push_float($1);";
-%typemap(out, pikedesc="tStr") char * "push_text($1);";
-
-/* Pointers, references, and arrays */
-%typemap(out, pikedesc="tObj") SWIGTYPE*, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [] "push_object(SWIG_NewPointerObj((void *) $1, $1_descriptor, $owner));";
-
-/* Void return value; don't push anything */
-%typemap(out, pikedesc="tVoid") void "";
-
-/* Dynamic casts */
-
-%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC "/* FIXME */";
-
-/* Member pointer */
-%typemap(out) SWIGTYPE (CLASS::*) "/* FIXME */";
-
-/* Special typemap for character array return values */
-%typemap(out, pikedesc="tStr") char [ANY], const char [ANY] "push_text($1);";
-
-/* Primitive types--return by value */
-%typemap(out, pikedesc="tObj") SWIGTYPE
-#ifdef __cplusplus
-{
- $&1_ltype resultptr;
- resultptr = new $1_ltype((const $1_ltype &) $1);
- push_object(SWIG_NewPointerObj((void *) resultptr, $&1_descriptor, 1));
-}
-#else
-{
- $&1_ltype resultptr;
- resultptr = ($&1_ltype) malloc(sizeof($1_type));
- memmove(resultptr, &$1, sizeof($1_type));
- push_object(SWIG_NewPointerObj((void *) resultptr, $&1_descriptor, 1));
-}
-#endif
-
-/* References to primitive types. Return by value */
-
-%typemap(out, pikedesc="tInt") const int &, const unsigned int &,
- const short &, const unsigned short &,
- const long &, const unsigned long &,
- const char &, const signed char &, const unsigned char &,
- const bool &,
- const long long &, const unsigned long long &,
- const enum SWIGTYPE & ($*1_ltype temp),
- const enum SWIGTYPE && ($*1_ltype temp)
- "push_int(*($1));";
-
-%typemap(out, pikedesc="tFloat") const float &, const double & "push_float(*($1));";
-
-/************************ Constant Typemaps *****************************/
-
-%typemap(constant)
- int, unsigned int,
- short, unsigned short,
- long, unsigned long,
- signed char, unsigned char,
- bool, enum SWIGTYPE,
- long long, unsigned long long
- "add_integer_constant(\"$symname\", $1, 0);";
-
-%typemap(constant) char
- "add_integer_constant(\"$symname\", '$1', 0);";
-
-%typemap(constant) long long, unsigned long long
- "add_integer_constant(\"$symname\", $1, 0);";
-
-%typemap(constant) float, double
- "add_float_constant(\"$symname\", $1, 0);";
-
-%typemap(constant) char *
- "add_string_constant(\"$symname\", \"$1\", 0);";
-
-/* ------------------------------------------------------------
- * String & length
- * ------------------------------------------------------------ */
-
-%typemap(in) (char *STRING, int LENGTH), (char *STRING, size_t LENGTH) {
- if ($input.type != T_STRING)
- Pike_error("Bad argument: Expected a string.\n");
- $1 = ($1_ltype) STR0($input.u.string);
- $2 = ($2_ltype) $input.u.string->length;
-}
-
-/* ------------------------------------------------------------
- * ANSI C typemaps
- * ------------------------------------------------------------ */
-
-%typemap(in, pikedesc="tInt") size_t {
- if ($input.type != T_INT)
- Pike_error("Bad argument: Expected an integer.\n");
- $1 = ($1_ltype) $input.u.integer;
-}
-
-%typemap(out) size_t = long;
-
-/* ------------------------------------------------------------
- * Typechecking rules
- * ------------------------------------------------------------ */
-
-%typecheck(SWIG_TYPECHECK_INTEGER)
- int, short, long,
- unsigned int, unsigned short, unsigned long,
- signed char, unsigned char,
- long long, unsigned long long,
- const int &, const short &, const long &,
- const unsigned int &, const unsigned short &, const unsigned long &,
- const long long &, const unsigned long long &,
- enum SWIGTYPE, enum SWIGTYPE &, SWIGTYPE &&,
- bool, const bool &
-{
- $1 = ($input.type == T_INT) ? 1 : 0;
-}
-
-%typecheck(SWIG_TYPECHECK_DOUBLE)
- float, double,
- const float &, const double &
-{
- $1 = (($input.type == T_FLOAT) || ($input.type == T_INT)) ? 1 : 0;
-}
-
-%typecheck(SWIG_TYPECHECK_CHAR) char {
- $1 = ($input.type == T_INT) ? 1 : 0;
-}
-
-%typecheck(SWIG_TYPECHECK_STRING) char * {
- $1 = ($input.type == T_STRING) ? 1 : 0;
-}
-
-%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [] {
- void *ptr;
- if (SWIG_ConvertPtr($input.u.object, (void **) &ptr, $1_descriptor, 0) == -1) {
- $1 = 0;
- } else {
- $1 = 1;
- }
-}
-
-%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE {
- void *ptr;
- if (SWIG_ConvertPtr($input.u.object, (void **) &ptr, $&1_descriptor, 0) == -1) {
- $1 = 0;
- } else {
- $1 = 1;
- }
-}
-
-%typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
- void *ptr;
- if (SWIG_ConvertPtr($input.u.object, (void **) &ptr, 0, 0) == -1) {
- $1 = 0;
- } else {
- $1 = 1;
- }
-}
-
-/* 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("`+") *::operator+;
-%rename("`-") *::operator-;
-%rename("`*") *::operator*;
-%rename("`/") *::operator/;
-%rename("`%") *::operator%;
-%rename("`<<") *::operator<<;
-%rename("`>>") *::operator>>;
-%rename("`&") *::operator&;
-%rename("`|") *::operator|;
-%rename("`^") *::operator^;
-%rename("`~") *::operator~;
-%rename("`<") *::operator<;
-%rename("`>") *::operator>;
-%rename("`==") *::operator==;
-
-/* Special cases */
-%rename("`()") *::operator();
-
-#endif
-
-/* ------------------------------------------------------------
- * The start of the Pike initialization function
- * ------------------------------------------------------------ */
-
-%init "swiginit.swg"
-
-%init %{
-#ifdef __cplusplus
-extern "C"
-#endif
-PIKE_MODULE_EXIT {}
-
-#ifdef __cplusplus
-extern "C"
-#endif
-PIKE_MODULE_INIT
-{
- struct program *pr;
- SWIG_InitializeModule(0);
-%}
-
-/* pike keywords */
-%include <pikekw.swg>
diff --git a/Lib/pike/pikekw.swg b/Lib/pike/pikekw.swg
deleted file mode 100644
index 844b1f1..0000000
--- a/Lib/pike/pikekw.swg
+++ /dev/null
@@ -1,55 +0,0 @@
-#ifndef PIKE_PIKEKW_SWG_
-#define PIKE_PIKEKW_SWG_
-
-/* Warnings for Pike keywords */
-#define PIKEKW(x) %namewarn("314: '" #x "' is a pike keyword") #x
-
-/*
- from
- http://www.http://docs.linux.cz/pike/tutorial_C.html
-
-*/
-
-
-PIKEKW(array);
-PIKEKW(break);
-PIKEKW(case);
-PIKEKW(catch);
-PIKEKW(continue);
-PIKEKW(default);
-PIKEKW(do);
-PIKEKW(else);
-PIKEKW(float);
-PIKEKW(for);
-PIKEKW(foreach);
-PIKEKW(function);
-PIKEKW(gauge);
-PIKEKW(if);
-PIKEKW(inherit);
-PIKEKW(inline);
-PIKEKW(int);
-PIKEKW(lambda);
-PIKEKW(mapping);
-PIKEKW(mixed);
-PIKEKW(multiset);
-PIKEKW(nomask);
-PIKEKW(object);
-PIKEKW(predef);
-PIKEKW(private);
-PIKEKW(program);
-PIKEKW(protected);
-PIKEKW(public);
-PIKEKW(return);
-PIKEKW(sscanf);
-PIKEKW(static);
-PIKEKW(string);
-PIKEKW(switch);
-PIKEKW(typeof);
-PIKEKW(varargs);
-PIKEKW(void);
-PIKEKW(while);
-
-
-#undef PIKEKW
-
-#endif //PIKE_PIKEKW_SWG_
diff --git a/Lib/pike/pikerun.swg b/Lib/pike/pikerun.swg
deleted file mode 100644
index 6ec1143..0000000
--- a/Lib/pike/pikerun.swg
+++ /dev/null
@@ -1,71 +0,0 @@
-/* -----------------------------------------------------------------------------
- * pikerun.swg
- *
- * This file contains the runtime support for Pike modules
- * and includes code for managing global variables and pointer
- * type checking.
- * ----------------------------------------------------------------------------- */
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-#include "pike/object.h"
-#include "pike/program.h"
-#ifdef __cplusplus
-}
-#endif
-#include <assert.h>
-
-/* Stores information about a wrapped object */
-typedef struct swig_object_wrapper {
- void *self;
- swig_type_info *type;
-} swig_object_wrapper;
-
-#ifdef THIS
-#undef THIS
-#endif
-#define THIS (((swig_object_wrapper *) Pike_fp->current_storage)->self)
-
-#define SWIG_ConvertPtr SWIG_Pike_ConvertPtr
-#define SWIG_NewPointerObj SWIG_Pike_NewPointerObj
-#define SWIG_GetModule(clientdata) SWIG_Pike_GetModule(clientdata)
-#define SWIG_SetModule(clientdata, pointer) SWIG_Pike_SetModule(pointer)
-
-/* These need to be filled in before type sharing between modules will work */
-static swig_module_info *SWIG_Pike_GetModule(void *SWIGUNUSEDPARM(clientdata)) {
- return 0;
-}
-
-static void SWIG_Pike_SetModule(swig_module_info *pointer) {
-
-}
-
-/* Convert a pointer value */
-static int
-SWIG_Pike_ConvertPtr(struct object *obj, void **ptr, swig_type_info *ty, int flags) {
- struct program *pr;
- swig_cast_info *tc;
- swig_object_wrapper *obj_wrapper;
-
- if (ty) {
- pr = (struct program *) ty->clientdata;
- obj_wrapper = (swig_object_wrapper *) get_storage(obj, pr);
- if (obj_wrapper && obj_wrapper->type) {
- tc = SWIG_TypeCheckStruct(obj_wrapper->type, ty);
- if (tc) {
- int newmemory = 0;
- *ptr = SWIG_TypeCast(tc, obj_wrapper->self, &newmemory);
- assert(!newmemory); /* newmemory handling not yet implemented */
- return 0;
- }
- }
- }
- return -1;
-}
-
-/* Create a new pointer object */
-static struct object *
-SWIG_Pike_NewPointerObj(void *ptr, swig_type_info *type, int own) {
- return 0;
-}
diff --git a/Lib/pike/std_string.i b/Lib/pike/std_string.i
deleted file mode 100644
index b32b3c1..0000000
--- a/Lib/pike/std_string.i
+++ /dev/null
@@ -1,60 +0,0 @@
-/* -----------------------------------------------------------------------------
- * std_string.i
- *
- * SWIG typemaps for std::string
- * ----------------------------------------------------------------------------- */
-
-%{
-#include <string>
-%}
-
-namespace std {
-
- %naturalvar string;
-
- class string;
-
- /* Overloading check */
-
- %typemap(typecheck) string = char *;
- %typemap(typecheck) const string & = char *;
-
- %typemap(in, pikedesc="tStr") string {
- if ($input.type != T_STRING)
- Pike_error("Bad argument: Expected a string.\n");
- $1.assign(STR0($input.u.string));
- }
-
- %typemap(in, pikedesc="tStr") const string & ($*1_ltype temp) {
- if ($input.type != T_STRING)
- Pike_error("Bad argument: Expected a string.\n");
- temp.assign(STR0($input.u.string));
- $1 = &temp;
- }
-
- %typemap(out, pikedesc="tStr") string "push_text($1.c_str());";
-
- %typemap(out, pikedesc="tStr") const string & "push_text($1->c_str());";
-
- %typemap(directorin) string, const string &, string & "$1.c_str()";
-
- %typemap(directorin) string *, const string * "$1->c_str()";
-
- %typemap(directorout) string {
- if ($input.type == T_STRING)
- $result.assign(STR0($input.u.string));
- else
- throw Swig::DirectorTypeMismatchException("string expected");
- }
-
- %typemap(directorout) const string & ($*1_ltype temp) {
- if ($input.type == T_STRING) {
- temp.assign(STR0($input.u.string));
- $result = &temp;
- } else {
- throw Swig::DirectorTypeMismatchException("string expected");
- }
- }
-
-}
-
diff --git a/Lib/uffi/uffi.swg b/Lib/uffi/uffi.swg
deleted file mode 100644
index 41b0859..0000000
--- a/Lib/uffi/uffi.swg
+++ /dev/null
@@ -1,101 +0,0 @@
-/* Define a C preprocessor symbol that can be used in interface files
- to distinguish between the SWIG language modules. */
-
-#define SWIG_UFFI
-
-/* Typespecs for basic types. */
-
-%typemap(ffitype) char ":char";
-%typemap(ffitype) unsigned char ":unsigned-char";
-%typemap(ffitype) signed char ":char";
-%typemap(ffitype) short ":short";
-%typemap(ffitype) signed short ":short";
-%typemap(ffitype) unsigned short ":unsigned-short";
-%typemap(ffitype) int ":int";
-%typemap(ffitype) signed int ":int";
-%typemap(ffitype) unsigned int ":unsigned-int";
-%typemap(ffitype) long ":long";
-%typemap(ffitype) signed long ":long";
-%typemap(ffitype) unsigned long ":unsigned-long";
-%typemap(ffitype) float ":float";
-%typemap(ffitype) double ":double";
-%typemap(ffitype) char * ":cstring";
-%typemap(ffitype) void * ":pointer-void";
-%typemap(ffitype) void ":void";
-
-// FIXME: This is guesswork
-typedef long size_t;
-
-%wrapper %{
-(eval-when (compile eval)
-
-;;; You can define your own identifier converter if you want.
-;;; Use the -identifier-converter command line argument to
-;;; specify its name.
-
-(defun identifier-convert-null (id &key type)
- (declare (ignore type))
- (read-from-string id))
-
-(defun identifier-convert-lispify (cname &key type)
- (assert (stringp cname))
- (if (eq type :constant)
- (setf cname (format nil "*~A*" cname)))
- (setf cname (replace-regexp cname "_" "-"))
- (let ((lastcase :other)
- newcase char res)
- (dotimes (n (length cname))
- (setf char (schar cname n))
- (if* (alpha-char-p char)
- then
- (setf newcase (if (upper-case-p char) :upper :lower))
-
- (when (or (and (eq lastcase :upper) (eq newcase :lower))
- (and (eq lastcase :lower) (eq newcase :upper)))
- ;; case change... add a dash
- (push #\- res)
- (setf newcase :other))
-
- (push (char-downcase char) res)
-
- (setf lastcase newcase)
-
- else
- (push char res)
- (setf lastcase :other)))
- (read-from-string (coerce (nreverse res) 'string))))
-
-(defun identifier-convert-low-level (cname &key type)
- (assert (stringp cname))
- (if (eq type :constant)
- (setf cname (format nil "+~A+" cname)))
- (setf cname (substitute #\- #\_ cname))
- (if (eq type :operator)
- (setf cname (format nil "%~A" cname)))
- (if (eq type :constant-function)
- nil)
- (read-from-string cname))
-
-
-
-(defmacro swig-defconstant (string value &key (export T))
- (let ((symbol (funcall *swig-identifier-converter* string :type :constant)))
- `(eval-when (compile load eval)
- (uffi:def-constant ,symbol ,value ,export))))
-
-(defmacro swig-defun (name &rest rest)
- (let ((symbol (funcall *swig-identifier-converter* name :type :operator)))
- `(eval-when (compile load eval)
- (uffi:def-function (,name ,symbol) ,@rest)
- (export (quote ,symbol)))))
-
-(defmacro swig-def-struct (name &rest fields)
- "Declare a struct object"
- (let ((symbol (funcall *swig-identifier-converter* name :type :type)))
- `(eval-when (compile load eval)
- (uffi:def-struct ,symbol ,@fields)
- (export (quote ,symbol)))))
-
-
-) ;; eval-when
-%}
diff --git a/Source/Include/swigwarn.h b/Source/Include/swigwarn.h
index 48b98d4..955a877 100644
--- a/Source/Include/swigwarn.h
+++ b/Source/Include/swigwarn.h
@@ -302,19 +302,7 @@
/* please leave 830-849 free for C# */
-#define WARN_MODULA3_TYPEMAP_TYPE_UNDEF 850
-#define WARN_MODULA3_TYPEMAP_GETCPTR_UNDEF 851
-#define WARN_MODULA3_TYPEMAP_CLASSMOD_UNDEF 852
-#define WARN_MODULA3_TYPEMAP_PTRCONSTMOD_UNDEF 853
-#define WARN_MODULA3_TYPEMAP_MULTIPLE_RETURN 854
-#define WARN_MODULA3_MULTIPLE_INHERITANCE 855
-#define WARN_MODULA3_TYPECONSTRUCTOR_UNKNOWN 856
-#define WARN_MODULA3_UNKNOWN_PRAGMA 857
-#define WARN_MODULA3_BAD_ENUMERATION 858
-#define WARN_MODULA3_DOUBLE_ID 859
-#define WARN_MODULA3_BAD_IMPORT 860
-
-/* please leave 850-869 free for Modula 3 */
+/* 850-860 were used by Modula 3 (removed in SWIG 4.1.0) - avoid reusing for now */
#define WARN_PHP_MULTIPLE_INHERITANCE 870
#define WARN_PHP_UNKNOWN_PRAGMA 871
diff --git a/Source/Modules/allegrocl.cxx b/Source/Modules/allegrocl.cxx
deleted file mode 100644
index e39abed..0000000
--- a/Source/Modules/allegrocl.cxx
+++ /dev/null
@@ -1,2962 +0,0 @@
-/* -----------------------------------------------------------------------------
- * This file is part of SWIG, which is licensed as a whole under version 3
- * (or any later version) of the GNU General Public License. Some additional
- * terms also apply to certain portions of SWIG. The full details of the SWIG
- * license and copyrights can be found in the LICENSE and COPYRIGHT files
- * included with the SWIG source code as distributed by the SWIG developers
- * and at http://www.swig.org/legal.html.
- *
- * allegrocl.cxx
- *
- * ALLEGROCL language module for SWIG.
- * ----------------------------------------------------------------------------- */
-
-#include "swigmod.h"
-#include "cparse.h"
-#include <ctype.h>
-
-// #define ALLEGROCL_DEBUG
-// #define ALLEGROCL_WRAP_DEBUG
-// #define ALLEGROCL_TYPE_DEBUG
-// #define ALLEGROCL_CLASS_DEBUG
-
-static const char *usage = "\
-Allegro CL Options (available with -allegrocl)\n\
- -identifier-converter <type or funcname> - \n\
- Specifies the type of conversion to do on C identifiers to convert\n\
- them to symbols. There are two built-in converters: 'null' and\n\
- 'lispify'. The default is 'null'. If you supply a name other\n\
- than one of the built-ins, then a function by that name will be\n\
- called to convert identifiers to symbols.\n\
- -[no]cwrap - Turn on or turn off generation of an intermediate C file when\n\
- creating a C interface. By default this is only done for C++ code.\n\
- -isolate - Define all SWIG helper functions in a package unique to this\n\
- module. Avoids redefinition warnings when loading multiple\n\
- SWIGged modules into the same running Allegro CL image.\n\
-";
-
-static File *f_cl = 0;
-String *f_clhead = NewString("");
-String *f_clwrap = NewString("(swig-in-package ())\n\n");
-static File *f_begin;
-static File *f_runtime;
-static File *f_cxx_header = 0;
-static File *f_cxx_wrapper = 0;
-
-static String *module_name = 0;
-static String *swig_package = 0;
-
-static String *identifier_converter = NewString("identifier-convert-null");
-
-static bool CWrap = true; // generate wrapper file for C code by default. most correct.
-static bool Generate_Wrapper = false;
-static bool unique_swig_package = false;
-
-static SwigType *fwdref_ffi_type = NewString("__SWIGACL_FwdReference");
-
-static String *current_namespace = NewString("");
-static String *current_package = NewString("");
-static Hash *defined_namespace_packages = NewHash();
-static Node *in_class = 0;
-
-static Node *first_linked_type = 0;
-static Hash *defined_foreign_types = NewHash();
-static Hash *defined_foreign_ltypes = NewHash();
-
-static String *anon_type_name = NewString("anontype");
-static int anon_type_count = 0;
-
-// stub
-String *convert_literal(String *num_param, String *type, bool try_to_split = true);
-
-class ALLEGROCL:public Language {
-public:
- virtual void main(int argc, char *argv[]);
- virtual int top(Node *n);
- virtual int functionWrapper(Node *n);
- virtual int namespaceDeclaration(Node *n);
- virtual int constructorHandler(Node *n);
- virtual int destructorHandler(Node *n);
- virtual int globalvariableHandler(Node *n);
- virtual int variableWrapper(Node *n);
- virtual int constantWrapper(Node *n);
- virtual int memberfunctionHandler(Node *n);
- virtual int membervariableHandler(Node *n);
- virtual int classHandler(Node *n);
- virtual int emit_one(Node *n);
- virtual int enumDeclaration(Node *n);
- virtual int enumvalueDeclaration(Node *n);
- virtual int typedefHandler(Node *n);
- virtual int classforwardDeclaration(Node *n);
- virtual int templateDeclaration(Node *n);
- virtual int validIdentifier(String *s);
-private:
- int emit_defun(Node *n, File *f_cl);
- int emit_dispatch_defun(Node *n);
- int emit_buffered_defuns(Node *n);
- int cClassHandler(Node *n);
- int cppClassHandler(Node *n);
-};
-static ALLEGROCL *allegrocl = 0;
-
-static String *trim(String *str) {
- char *c = Char(str);
- while (*c != '\0' && isspace((int) *c))
- ++c;
- String *result = NewString(c);
- Chop(result);
- return result;
-}
-
-int is_integer(String *s) {
- char *c = Char(s);
- if (c[0] == '#' && (c[1] == 'x' || c[1] == 'o'))
- c += 2;
-
- while (*c) {
- if (!isdigit(*c))
- return 0;
- c++;
- }
- return 1;
-}
-
-String *class_from_class_or_class_ref(String *type) {
- SwigType *stripped = SwigType_strip_qualifiers(type);
- if (SwigType_isclass(stripped))
- return stripped;
-
- if (SwigType_ispointer(stripped) || SwigType_isreference(stripped)) {
- // Printf(stderr,"It is a pointer/reference. Is it a class?\n");
- SwigType_pop(stripped);
- if (SwigType_isclass(stripped)) {
- return stripped;
- }
- }
- return 0;
-}
-
-String *lookup_defined_foreign_type(String *k) {
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "Looking up defined type '%s'.\n Found: '%s'\n", k, Getattr(defined_foreign_types, k));
-#endif
-
- return Getattr(defined_foreign_types, k);
-}
-
-String *listify_namespace(String *namespaze) {
- if (Len(namespaze) == 0)
- return NewString("()");
- String *result = NewStringf("(\"%s\")", namespaze);
- Replaceall(result, "::", "\" \"");
- return result;
-}
-
-String *namespaced_name(Node *n, String *ns = current_namespace) {
-
- return NewStringf("%s%s%s", ns, (Len(ns) != 0) ? "::" : "", Getattr(n, "sym:name"));
-}
-
-// "Namespace::Nested::Class2::Baz" -> "Baz"
-static String *strip_namespaces(String *str) {
- return Swig_scopename_last(str);
-}
-
-void add_linked_type(Node *n) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Adding linked node of type: %s(%s) %s(%p)\n\n", nodeType(n), Getattr(n, "storage"), Getattr(n, "name"), n);
- // Swig_print_node(n);
-#endif
- if (!first_linked_type) {
- first_linked_type = n;
- Setattr(n, "allegrocl:last_linked_type", n);
- } else {
- Node *t = Getattr(first_linked_type, "allegrocl:last_linked_type");
- Setattr(t, "allegrocl:next_linked_type", n);
- Setattr(first_linked_type, "allegrocl:last_linked_type", n);
- }
-}
-
-void replace_linked_type(Node *old, Node *new_node) {
- Node *prev = Getattr(old, "allegrocl:prev_linked_type");
-
- Setattr(new_node, "allegrocl:next_linked_type", Getattr(old, "allegrocl:next_linked_type"));
- if (prev)
- Setattr(prev, "allegrocl:next_linked_type", new_node);
- Delattr(old, "allegrocl:next_linked_type");
- Delattr(old, "allegrocl:prev_linked_type");
-
- // check if we're replacing the first link.
- if (first_linked_type == old) {
- first_linked_type = new_node;
- Setattr(first_linked_type, "allegrocl:last_linked_type", Getattr(old, "allegrocl:last_linked_type"));
- }
- // check if we're replacing the last link.
- if (Getattr(first_linked_type, "allegrocl:last_linked_type") == old)
- Setattr(first_linked_type, "allegrocl:last_linked_type", new_node);
-}
-
-void insert_linked_type_at(Node *old, Node *new_node, int before = 1) {
- Node *p = 0;
-
- if (!first_linked_type) {
- add_linked_type(new_node);
- return;
- }
-
- if (!before) {
- Setattr(new_node, "allegrocl:next_linked_type", Getattr(old, "allegrocl:next_linked_type"));
- Setattr(old, "allegrocl:next_linked_type", new_node);
- if (Getattr(first_linked_type, "allegrocl:last_linked_type") == old)
- Setattr(first_linked_type, "allegrocl:last_linked_type", new_node);
- } else {
- Node *c = first_linked_type;
- while (c) {
- if (c == old) {
- break;
- } else {
- p = c;
- c = Getattr(c, "allegrocl:next_linked_type");
- }
- }
- if (c == old) {
- Setattr(new_node, "allegrocl:next_linked_type", c);
- if (first_linked_type == c) {
- first_linked_type = new_node;
- Setattr(first_linked_type, "allegrocl:last_linked_type", Getattr(c, "allegrocl:last_linked_type"));
- Delattr(c, "allegrocl:last_linked_type");
- }
- if (p)
- Setattr(p, "allegrocl:next_linked_type", new_node);
- }
- }
-}
-
-Node *find_linked_type_by_name(String *name) {
- Node *p = 0;
- Node *c = first_linked_type;
-
- // Printf(stderr,"in find_linked_type_by_name '%s'...", name);
- while (c) {
- String *key = Getattr(c, "name");
- if (!Strcmp(key, name)) {
- break;
- } else {
- p = c;
- c = Getattr(c, "allegrocl:next_linked_type");
- }
- }
- // Printf(stderr,"exit find_linked_type_by_name.\n");
-
- if (p && c)
- Setattr(c, "allegrocl:prev_linked_type", p);
- // Printf(stderr,"find_linked_type_by_name: DONE\n");
- return c;
-}
-
-Node *get_primary_synonym_of(Node *n) {
- Node *p = Getattr(n, "allegrocl:synonym-of");
- Node *prim = n;
-
- // Printf(stderr, "getting primary synonym of %p\n", n);
- while (p) {
- // Printf(stderr, " found one! %p\n", p);
- prim = p;
- p = Getattr(p, "allegrocl:synonym-of");
- }
- // Printf(stderr,"get_primary_syn: DONE. returning %s(%p)\n", Getattr(prim,"name"),prim);
- return prim;
-}
-
-void add_forward_referenced_type(Node *n, int overwrite = 0) {
- String *k = Getattr(n, "name");
- String *name = Getattr(n, "sym:name");
- String *ns = listify_namespace(current_namespace);
-
- String *val = Getattr(defined_foreign_types, k);
-
- if (!val || overwrite) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "Adding forward reference for %s (overwrite=%d)\n", k, overwrite);
-#endif
- Setattr(defined_foreign_types, Copy(k), NewString("forward-reference"));
-
- String *mangled_lname_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", name, ns);
-
- Setattr(defined_foreign_ltypes, Copy(k), mangled_lname_gen);
- // Printf(f_cl, ";; forward reference stub\n"
- // "(swig-def-foreign-class \"%s\" (ff:foreign-pointer) (:class ))\n\n"
- // , name);
-
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Linking forward reference type = %s(%p)\n", k, n);
-#endif
- add_linked_type(n);
- }
-}
-
-void add_defined_foreign_type(Node *n, int overwrite = 0, String *k = 0,
- String *name = 0, String *ns = current_namespace) {
-
- String *val;
- String *ns_list = listify_namespace(ns);
- String *templated = n ? Getattr(n, "template") : 0;
- String *cDeclName = n ? Getattr(n, "name") : 0;
-
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "IN A-D-F-T. (n=%p, ow=%d, k=%s, name=%s, ns=%s\n", n, overwrite, k, name, ns);
- Printf(stderr, " templated = '%p', classDecl = '%p'\n", templated, cDeclName);
-#endif
- if (n) {
- if (!name)
- name = Getattr(n, "sym:name");
- if (!name)
- name = strip_namespaces(Getattr(n, "name"));
- if (templated) {
- k = namespaced_name(n);
- } else {
- String *kind_of_type = Getattr(n, "kind");
-
- /*
- For typedefs of the form:
-
- typedef struct __xxx { ... } xxx;
-
- behavior differs between C mode and C++ mode.
-
- C Mode:
- add_defined_foreign_type will be called once via classHandler
- to define the type for 'struct __xxx' and add the mapping from
- 'struct __xxx' -> 'xxx'
-
- It will also be called once via typedefHandler to add the
- mapping 'xxx' -> 'xxx'
-
- C++ Mode:
- add_defined_foreign_type will be called once via classHandler
- to define the type for 'xxx'. it also adds the mapping from
- 'xxx' -> 'xxx' and also for 'struct xxx' -> 'xxx'
-
- In typedefHandler, we again try to add the mapping from
- 'xxx' -> 'xxx', which already exists. This second mapping
- is ignored.
-
- Both modes:
-
- All references to this typedef'd struct will appear in
- generated lisp code as an objectd of type 'xxx'. For
- non-typedef'd structs, the classHand mapping will be
-
- struct __xxx -> (swig-insert-id "__xxx")
- */
- // Swig_print_node(n);
- String *unnamed = Getattr(n, "unnamed");
- if (kind_of_type && (!Strcmp(kind_of_type, "struct")
- || !Strcmp(kind_of_type, "union")) && cDeclName && !unnamed) {
- k = NewStringf("%s %s", kind_of_type, cDeclName);
- } else {
- if (!Strcmp(nodeType(n), "enum") && unnamed) {
- name = NewStringf("%s%d", anon_type_name, anon_type_count++);
- k = NewStringf("enum %s", name);
- Setattr(n, "allegrocl:name", name);
-
- } else {
- k = k ? k : Getattr(n, "name");
- }
- }
- }
- // Swig_print_node(n);
- }
-
- String *tname = SwigType_istemplate_templateprefix(name);
- if (tname) {
- String *temp = strip_namespaces(tname);
- name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name));
- Delete(temp);
- Delete(tname);
- }
-
- val = lookup_defined_foreign_type(k);
-
- int is_fwd_ref = 0;
- if (val)
- is_fwd_ref = !Strcmp(val, "forward-reference");
-
- if (!val || overwrite || is_fwd_ref) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Adding defined type '%s' = '%s' '%s' (overwrite=%d, in-class=%d)\n", k, ns, name, overwrite, in_class);
-#endif
- String *mangled_name_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :type)", name, ns_list);
- String *mangled_lname_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", name, ns_list);
-
- Setattr(defined_foreign_types, Copy(k), Copy(mangled_name_gen));
- Setattr(defined_foreign_ltypes, Copy(k), Copy(mangled_lname_gen));
-
- if (CPlusPlus) {
- bool cpp_struct = Strstr(k, "struct ") ? true : false;
- bool cpp_union = Strstr(k, "union ") ? true : false;
-
- String *cpp_type = 0;
- if (cpp_struct) {
- cpp_type = Copy(k);
- Replaceall(cpp_type, "struct ", "");
- } else if (cpp_union) {
- cpp_type = Copy(k);
- Replaceall(cpp_type, "union ", "");
- }
-
- if (cpp_struct || cpp_union) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " Also adding defined type '%s' = '%s' '%s' (overwrite=%d)\n", cpp_type, ns, name, overwrite);
-#endif
- Setattr(defined_foreign_types, Copy(cpp_type), Copy(mangled_name_gen));
- Setattr(defined_foreign_ltypes, Copy(cpp_type), Copy(mangled_lname_gen));
- }
- }
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "looking to add %s/%s(%p) to linked_type_list...\n", k, name, n);
-#endif
- if (is_fwd_ref) {
- // Printf(stderr,"*** 1\n");
- if (n)
- add_linked_type(n);
- } else {
- // Printf(stderr,"*** 1-a\n");
- if (SwigType_istemplate(k)) {
- SwigType *resolved = SwigType_typedef_resolve_all(k);
- // Printf(stderr,"*** 1-b\n");
- Node *match = find_linked_type_by_name(resolved);
- Node *new_node = 0;
- // Printf(stderr, "*** temp-1\n");
- if (n) {
- new_node = n;
- } else {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Creating a new templateInst:\n");
- Printf(stderr, " name = %s\n", resolved);
- Printf(stderr, " sym:name = %s\n", name);
- Printf(stderr, " real-name = %s\n", k);
- Printf(stderr, " type = %s\n", resolved);
- Printf(stderr, " ns = %s\n\n", ns);
-#endif
- new_node = NewHash();
- Setattr(new_node, "nodeType", "templateInst");
- Setattr(new_node, "name", Copy(resolved));
- Setattr(new_node, "sym:name", Copy(name));
- Setattr(new_node, "real-name", Copy(k));
- Setattr(new_node, "type", Copy(resolved));
- Setattr(new_node, "allegrocl:namespace", ns);
- Setattr(new_node, "allegrocl:package", ns);
- }
-
- if (!match) {
- if (!Strcmp(nodeType(new_node), "templateInst") && in_class) {
- /* this is an implicit template instantiation found while
- walking a class. need to insert this into the
- linked_type list before the current class definition */
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "trying to insert a templateInst before a class\n");
-#endif
- insert_linked_type_at(in_class, new_node);
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "DID IT!\n");
-#endif
- } else {
- // Printf(stderr,"*** 3\n");
- add_linked_type(new_node);
- }
- Setattr(new_node, "allegrocl:synonym:is-primary", "1");
- } else {
- // a synonym type was found (held in variable 'match')
- // Printf(stderr, "setting primary synonym of %p to %p\n", new_node, match);
- if (new_node == match)
- Printf(stderr, "Hey-4 * - '%s' is a synonym of itself!\n", Getattr(new_node, "name"));
- Setattr(new_node, "allegrocl:synonym-of", match);
- // Printf(stderr,"*** 4\n");
- add_linked_type(new_node);
- }
- } else {
- Node *match;
-
- if (!Strcmp(nodeType(n), "cdecl") && !Strcmp(Getattr(n, "storage"), "typedef")) {
- SwigType *type = SwigType_strip_qualifiers(Getattr(n, "type"));
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Examining typedef '%s' for class references. (%d)\n", type, SwigType_isclass(type));
-#endif
- if (SwigType_isclass(type)) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Found typedef of a class '%s'\n", type);
-#endif
- /*
- For the following parsed expression:
-
- typedef struct __xxx { ... } xxx;
-
- if n is of kind "class" (defining the class 'struct __xxx'
- then we add n to the linked type list.
-
- if n is "cdecl" node of storage "typedef" (to note
- that xxx is equivalent to 'struct __xxx' then we don't
- want to add this node to the linked type list.
- */
- String *defined_type = lookup_defined_foreign_type(type);
- String *defined_key_type = lookup_defined_foreign_type(k);
-
- if ((Strstr(type, "struct ") || Strstr(type, "union "))
- && defined_type && !Strcmp(defined_type, defined_key_type)) {
- // mark as a synonym but don't add to linked_type list
- // Printf(stderr,"*** 4.8\n");
- Setattr(n, "allegrocl:synonym", "1");
- } else {
- SwigType *lookup_type = SwigType_istemplate(type) ? SwigType_typedef_resolve_all(type) : Copy(type);
- match = find_linked_type_by_name(lookup_type);
- if (match) {
- Setattr(n, "allegrocl:synonym", "1");
- Setattr(n, "allegrocl:synonym-of", match);
- Setattr(n, "real-name", Copy(lookup_type));
-
- // Printf(stderr, "*** pre-5: found match of '%s'(%p)\n", Getattr(match,"name"),match);
- // if(n == match) Printf(stderr, "Hey-5 *** setting synonym of %p to %p\n", n, match);
- // Printf(stderr,"*** 5\n");
- add_linked_type(n);
- } else {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Creating classfoward node for struct stub in typedef.\n");
-#endif
- Node *new_node = NewHash();
- String *symname = Copy(type);
- Replaceall(symname, "struct ", "");
- Setattr(new_node, "nodeType", "classforward");
- Setattr(new_node, "name", Copy(type));
- Setattr(new_node, "sym:name", symname);
- Setattr(new_node, "allegrocl:namespace", ns);
- Setattr(new_node, "allegrocl:package", ns);
-
- String *mangled_new_name = NewStringf("#.(swig-insert-id \"%s\" %s)", symname, ns_list);
- String *mangled_new_lname = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", symname, ns_list);
- Setattr(defined_foreign_types, Copy(symname), Copy(mangled_new_name));
- Setattr(defined_foreign_ltypes, Copy(symname), Copy(mangled_new_lname));
-
- // Printf(stderr,"Weird! Can't find the type!\n");
- add_forward_referenced_type(new_node);
- add_linked_type(new_node);
-
- Setattr(n, "allegrocl:synonym", "1");
- Setattr(n, "allegrocl:synonym-of", new_node);
-
- add_linked_type(n);
- }
- Delete(lookup_type);
- }
- } else {
- // check if it's a pointer or reference to a class.
- // Printf(stderr,"Checking if '%s' is a p. or r. to a class\n", type);
- String *class_ref = class_from_class_or_class_ref(type);
- if (class_ref) {
- match = find_linked_type_by_name(class_ref);
- Setattr(n, "allegrocl:synonym", "1");
- Setattr(n, "allegrocl:synonym-of", match);
- add_linked_type(n);
- }
- }
- Delete(type);
- // synonym types have already been added.
- // Printf(stderr,"*** 10\n");
- if (!Getattr(n, "allegrocl:synonym"))
- add_linked_type(n);
- } else if (Getattr(n, "template")) {
- // Printf(stderr, "this is a class template node(%s)\n", nodeType(n));
- String *resolved = SwigType_typedef_resolve_all(Getattr(n, "name"));
-
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " looking up %s for linked type match with %s...\n", Getattr(n, "sym:name"), resolved);
-#endif
- match = find_linked_type_by_name(resolved);
- if (!match) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "found no implicit instantiation of %%template node %s(%p)\n", Getattr(n, "name"), n);
-#endif
- add_linked_type(n);
- } else {
- Node *primary = get_primary_synonym_of(match);
-
- Setattr(n, "allegrocl:synonym:is-primary", "1");
- Delattr(primary, "allegrocl:synonym:is-primary");
- if (n == match)
- Printf(stderr, "Hey-7 * setting synonym of %p to %p\n (match = %p)", primary, n, match);
- Setattr(primary, "allegrocl:synonym-of", n);
- // Printf(stderr,"*** 7\n");
- add_linked_type(n);
- }
- } else {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "linking type '%s'(%p)\n", k, n);
-#endif
- // Printf(stderr,"*** 8\n");
- add_linked_type(n);
- }
- }
- }
- Delete(mangled_name_gen);
- Delete(mangled_lname_gen);
- } else {
- if (!CPlusPlus || Strcmp(Getattr(n,"kind"),"typedef")) {
- Swig_warning(WARN_TYPE_REDEFINED, Getfile(n), Getline(n),
- "Attempting to store a foreign type that exists: %s (%s)\n",
- k, val);
- }
- }
-
- Delete(ns_list);
-
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "OUT A-D-F-T\n");
-#endif
-}
-
-void note_implicit_template_instantiation(SwigType *t) {
- // the namespace of the implicit instantiation is not necessarily
- // current_namespace. Attempt to cull this from the type.
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "culling namespace of '%s' from '%s'\n", t, SwigType_templateprefix(t));
-#endif
- SwigType *type = Copy(t);
- SwigType *tok = SwigType_pop(type);
- String *implicit_ns = SwigType_istemplate(tok) ? Swig_scopename_prefix(SwigType_templateprefix(tok)) : 0;
- add_defined_foreign_type(0, 0, t, t, implicit_ns ? implicit_ns : current_namespace);
-
- Delete(type);
-}
-
-String *get_ffi_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
- /* lookup defined foreign type.
- if it exists, it will return a form suitable for placing
- into lisp code to generate the def-foreign-type name */
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "inside g_f_t: looking up '%s' '%s'\n", ty, name);
-#endif
-
- String *found_type = lookup_defined_foreign_type(ty);
-
- if (found_type) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "found_type '%s'\n", found_type);
-#endif
- return (Strcmp(found_type, "forward-reference") ? Copy(found_type) : get_ffi_type(n, fwdref_ffi_type, ""));
- } else {
- Node *node = NewHash();
- Setattr(node, "type", ty);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *tm = Swig_typemap_lookup("ffitype", node, name, 0);
- Delete(node);
-
- if (tm) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "g-f-t: found ffitype typemap '%s'\n", tm);
-#endif
- return NewString(tm);
- }
-
- if (SwigType_istemplate(ty)) {
- note_implicit_template_instantiation(ty);
- return Copy(lookup_defined_foreign_type(ty));
- }
- }
- return 0;
-}
-
-String *lookup_defined_foreign_ltype(String *l) {
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "Looking up defined ltype '%s'.\n Found: '%s'\n", l, Getattr(defined_foreign_ltypes, l));
-#endif
- return Getattr(defined_foreign_ltypes, l);
-}
-
-/* walk type and return string containing lisp version.
- recursive. */
-String *internal_compose_foreign_type(Node *n, SwigType *ty) {
-
- SwigType *tok;
- String *ffiType = NewString("");
-
- // for a function type, need to walk the parm list.
- while (Len(ty) != 0) {
- tok = SwigType_pop(ty);
-
- if (SwigType_isfunction(tok)) {
- // Generate Function wrapper
- Printf(ffiType, "(:function ");
- // walk parm list
- List *pl = SwigType_parmlist(tok);
-
- Printf(ffiType, "("); // start parm list
- for (Iterator i = First(pl); i.item; i = Next(i)) {
- SwigType *f_arg = SwigType_strip_qualifiers(i.item);
- Printf(ffiType, "%s ", internal_compose_foreign_type(n, f_arg));
- Delete(f_arg);
- }
- Printf(ffiType, ")"); // end parm list.
-
- // do function return type.
- Printf(ffiType, " %s)", internal_compose_foreign_type(n, ty));
- break;
- } else if (SwigType_ispointer(tok) || SwigType_isreference(tok)) {
- Printf(ffiType, "(* %s)", internal_compose_foreign_type(n, ty));
- } else if (SwigType_isarray(tok)) {
- Printf(ffiType, "(:array %s", internal_compose_foreign_type(n, ty));
- String *atype = NewString("int");
- String *dim = convert_literal(SwigType_array_getdim(tok, 0), atype);
- Delete(atype);
- if (is_integer(dim)) {
- Printf(ffiType, " %s)", dim);
- } else {
- Printf(ffiType, " #| %s |#)", SwigType_array_getdim(tok, 0));
- }
- } else if (SwigType_ismemberpointer(tok)) {
- // temp
- Printf(ffiType, "(* %s)", internal_compose_foreign_type(n, ty));
- } else {
- String *res = get_ffi_type(n, tok, "");
- if (res) {
- Printf(ffiType, "%s", res);
- } else {
- SwigType *resolved_type = SwigType_typedef_resolve_all(tok);
- if (Cmp(resolved_type, tok) != 0) {
- res = get_ffi_type(n, resolved_type, "");
- if (res) {
- } else {
- res = internal_compose_foreign_type(n, resolved_type);
- }
- if (res)
- Printf(ffiType, "%s", res);
- }
-
- if (!res) {
- String *is_struct = 0;
- String *tok_remove_text = 0;
- String *tok_name = Copy(tok);
- String *tok_key = SwigType_str(tok,0);
- if ((is_struct = Strstr(tok_key, "struct ")) || Strstr(tok_key, "union ")) {
- tok_remove_text = NewString(is_struct ? "struct " : "union ");
- }
-
- /* be more permissive of opaque types. This is the swig way.
- compiles will notice if these types are ultimately not
- present. */
-
- if(tok_remove_text) {
- Replaceall(tok_name,tok_remove_text,"");
- }
- tok_name = strip_namespaces(tok_name);
- Delete(tok_remove_text);
- // Swig_warning(WARN_TYPE_UNDEFINED_CLASS, Getfile(tok), Getline(tok), "Unable to find definition of '%s', assuming forward reference.\n", tok);
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "i-c-f-t: adding forward reference for unknown type '%s'. mapping: %s -> %s\n", tok, tok_key, tok_name);
-#endif
- Node *nn = NewHash();
- Setattr(nn,"nodeType","classforward");
- Setattr(nn,"kind","class");
- Setattr(nn,"sym:name",tok_name);
- Setattr(nn,"name",tok_key);
- Setattr(nn,"allegrocl:package",current_namespace);
-
- add_forward_referenced_type(nn, 0);
- // tok_name is dangling here, unused. ouch. why?
- Printf(ffiType, "%s", get_ffi_type(n, tok, ""), tok_name);
- }
- }
- }
- }
- return ffiType;
-}
-
-String *compose_foreign_type(Node *n, SwigType *ty, String * /*id*/ = 0) {
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "compose_foreign_type: ENTER (%s)...\n ", ty);
- // Printf(stderr, "compose_foreign_type: ENTER (%s)(%s)...\n ", ty, (id ? id : 0));
- /* String *id_ref = SwigType_str(ty, id);
- Printf(stderr, "looking up typemap for %s, found '%s'(%p)\n",
- id_ref, lookup_res ? Getattr(lookup_res, "code") : 0, lookup_res);
- if (lookup_res) Swig_print_node(lookup_res);
- */
-#endif
-
- /* should we allow named lookups in the typemap here? YES! */
- /* unnamed lookups should be found in get_ffi_type, called
- by internal_compose_foreign_type(), below. */
-
- /* I'm reverting to 'no' for the question above. I can no longer
- remember why I needed it. If a user needed it, I'll find out
- as soon as they upgrade. Sigh. -mutandiz 9/16/2008. */
-
-/*
- if(id && lookup_res) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "compose_foreign_type: EXIT-1 (%s)\n ", Getattr(lookup_res, "code"));
-#endif
- return NewString(Getattr(lookup_res, "code"));
- }
-*/
-
- SwigType *temp = SwigType_strip_qualifiers(ty);
- String *res = internal_compose_foreign_type(n, temp);
- Delete(temp);
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "compose_foreign_type: EXIT (%s)\n ", res);
-#endif
-
- return res;
-}
-
-void update_package_if_needed(Node *n, File *f = f_clwrap) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "update_package: ENTER... \n");
- Printf(stderr, " current_package = '%s'\n", current_package);
- Printf(stderr, " node_package = '%s'\n", Getattr(n, "allegrocl:package"));
- Printf(stderr, " node(%p) = '%s'\n", n, Getattr(n, "name"));
-#endif
- String *node_package = Getattr(n, "allegrocl:package");
- if (Strcmp(current_package, node_package)) {
- String *lispy_package = listify_namespace(node_package);
-
- Delete(current_package);
- current_package = Copy(node_package);
- Printf(f, "\n(swig-in-package %s)\n", lispy_package);
- Delete(lispy_package);
- }
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "update_package: EXIT.\n");
-#endif
-}
-
-static String *mangle_name(Node *n, char const *prefix = "ACL", String *ns = current_namespace) {
- String *suffix = Getattr(n, "sym:overname");
- String *pre_mangled_name = NewStringf("%s_%s__%s%s", prefix, ns, Getattr(n, "sym:name"), suffix);
- String *mangled_name = Swig_name_mangle(pre_mangled_name);
- Delete(pre_mangled_name);
- return mangled_name;
-}
-
-/* utilities */
-
-/* remove a pointer from ffitype. non-destructive.
- (* :char) ==> :char
- (* (:array :int 30)) ==> (:array :int 30) */
-String *dereference_ffitype(String *ffitype) {
- char *start;
- char *temp = Char(ffitype);
- String *reduced_type = 0;
-
- if(temp && temp[0] == '(' && temp[1] == '*') {
- temp += 2;
-
- // walk past start of pointer references
- while(*temp == ' ') temp++;
- start = temp;
- // temp = Char(reduced_type);
- reduced_type = NewString(start);
- temp = Char(reduced_type);
- // walk to end of string. remove closing paren
- while(*temp != '\0') temp++;
- *(--temp) = '\0';
- }
-
- return reduced_type ? reduced_type : Copy(ffitype);
-}
-
-/* returns new string w/ parens stripped */
-String *strip_parens(String *string) {
- string = Copy(string);
- Replaceall(string, "(", "");
- Replaceall(string, ")", "");
- return string;
-}
-
-int ALLEGROCL::validIdentifier(String *s) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "validIdentifier %s\n", s);
-#endif
-
- char *c = Char(s);
-
- bool got_dot = false;
- bool only_dots = true;
-
- /* Check that s is a valid common lisp symbol. There's a lot of leeway here.
- A common lisp symbol is essentially any token that's not a number and
- does not consist of only dots.
-
- We are expressly not allowing spaces in identifiers here, but spaces
- could be added via the identifier converter. */
- while (*c) {
- if (*c == '.') {
- got_dot = true;
- } else {
- only_dots = false;
- }
- if (!isgraph(*c))
- return 0;
- c++;
- }
-
- return (got_dot && only_dots) ? 0 : 1;
-}
-
-String *infix_to_prefix(String *val, char split_op, const String *op, String *type) {
- List *ored = Split(val, split_op, -1);
-
- // some float hackery
- if (((split_op == '+') || (split_op == '-')) && Len(ored) == 2 &&
- (SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE || SwigType_type(type) == T_LONGDOUBLE)) {
- // check that we're not splitting a float
- String *possible_result = convert_literal(val, type, false);
- if (possible_result)
- return possible_result;
-
- }
- // try parsing the split results. if any part fails, kick out.
- bool part_failed = false;
- if (Len(ored) > 1) {
- String *result = NewStringf("(%s", op);
- for (Iterator i = First(ored); i.item; i = Next(i)) {
- String *converted = convert_literal(i.item, type);
- if (converted) {
- Printf(result, " %s", converted);
- Delete(converted);
- } else {
- part_failed = true;
- break;
- }
- }
- Printf(result, ")");
- Delete(ored);
- return part_failed ? 0 : result;
- }
- Delete(ored);
- return 0;
-}
-
-/* To be called by code generating the lisp interface
- Will return a containing the literal based on type.
- Will return null if there are problems.
-
- try_to_split defaults to true (see stub above).
- */
-String *convert_literal(String *literal, String *type, bool try_to_split) {
- String *num_param = Copy(literal);
- String *trimmed = trim(num_param);
- String *num = strip_parens(trimmed), *res = 0;
- char *s = Char(num);
-
- String *ns = listify_namespace(current_namespace);
-
- // very basic parsing of infix expressions.
- if (try_to_split && SwigType_type(type) != T_STRING) {
- if ((res = infix_to_prefix(num, '|', "logior", type)))
- return res;
- if ((res = infix_to_prefix(num, '&', "logand", type)))
- return res;
- if ((res = infix_to_prefix(num, '^', "logxor", type)))
- return res;
- if ((res = infix_to_prefix(num, '*', "*", type)))
- return res;
- if ((res = infix_to_prefix(num, '/', "/", type)))
- return res;
- if ((res = infix_to_prefix(num, '+', "+", type)))
- return res;
- if ((res = infix_to_prefix(num, '-', "-", type)))
- return res;
- // if ((res = infix_to_prefix(num, '~', "lognot", type))) return res;
- // if( (res = infix_to_prefix(num, '<<', "ash", type)) ) return res;
- }
-
- // unary complement...
- if (s[0] == '~' && Len(num) >= 2) {
- String *id = NewString(++s);
- String *id_conv = convert_literal(id, type, false);
- Delete(id);
- if (id_conv)
- return NewStringf("(lognot %s)", id_conv);
- s--;
- }
-
- if (SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE || SwigType_type(type) == T_LONGDOUBLE) {
- // Use CL syntax for float literals
- String *oldnum = Copy(num);
-
- // careful. may be a float identifier or float constant.
- char *num_start = Char(num);
- char *num_end = num_start + strlen(num_start) - 1;
-
- bool is_literal = isdigit(*num_start) || (*num_start == '.');
-
- String *lisp_exp = 0;
- if (is_literal) {
- if (*num_end == 'f' || *num_end == 'F') {
- lisp_exp = NewString("f");
- } else {
- lisp_exp = NewString("d");
- }
-
- if (*num_end == 'l' || *num_end == 'L' || *num_end == 'f' || *num_end == 'F') {
- *num_end = '\0';
- num_end--;
- }
-
- int exponents = Replaceall(num, "e", lisp_exp) + Replaceall(num, "E", lisp_exp);
-
- if (!exponents)
- Printf(num, "%s0", lisp_exp);
-
- if (exponents > 1 || (exponents + Replaceall(num, ".", ".") == 0)) {
- // Printf(stderr, "Can't parse '%s' as type '%s'.\n", oldnum, type);
- Delete(num);
- num = 0;
- }
- Delete(lisp_exp);
- } else {
- String *id = NewStringf("#.(swig-insert-id \"%s\" %s :type :constant)",
- num, ns);
- Delete(num);
- num = id;
- }
-
- Delete(oldnum);
- Delete(trimmed);
- Delete(ns);
- return num;
- } else if (SwigType_type(type) == T_CHAR) {
- /* Use CL syntax for character literals */
- Delete(num);
- Delete(trimmed);
- return NewStringf("#\\%s", num_param);
- } else if (SwigType_type(type) == T_STRING) {
- /* Use CL syntax for string literals */
- Delete(num);
- Delete(trimmed);
- return NewStringf("\"%s\"", num_param);
- } else if (Len(num) >= 1 && (isdigit(s[0]) || s[0] == '+' || s[0] == '-')) {
- /* use CL syntax for numbers */
- String *oldnum = Copy(num);
- int usuffixes = Replaceall(num, "u", "") + Replaceall(num, "U", "");
- int lsuffixes = Replaceall(num, "l", "") + Replaceall(num, "L", "");
- if (usuffixes > 1 || lsuffixes > 1) {
- Printf(stderr, "Weird!! number %s looks invalid.\n", oldnum);
- SWIG_exit(EXIT_FAILURE);
- }
- s = Char(num);
- if (s[0] == '0' && Len(num) >= 2) {
- /*octal or hex */
- res = NewStringf("#%c%s", tolower(s[1]) == 'x' ? 'x' : 'o', s + 2);
- Delete(num);
- } else {
- res = num;
- }
- Delete(oldnum);
- Delete(trimmed);
- return res;
- } else if (allegrocl->validIdentifier(num)) {
- /* convert C/C++ identifiers to CL symbols */
- res = NewStringf("#.(swig-insert-id \"%s\" %s :type :constant)", num, ns);
- Delete(num);
- Delete(trimmed);
- Delete(ns);
- return res;
- } else {
- Delete(trimmed);
- return num;
- }
-}
-
-
-void emit_stub_class(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_stub_class: ENTER... '%s'(%p)\n", Getattr(n, "sym:name"), n);
- Swig_print_node(n);
-#endif
-
-
- String *name = Getattr(n, "sym:name");
-
- if (Getattr(n, "allegrocl:synonym:already-been-stubbed"))
- return;
-
- String *tname = SwigType_istemplate_templateprefix(name);
- if (tname) {
- String *temp = strip_namespaces(tname);
- name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name));
- Delete(temp);
- Delete(tname);
- } else {
- name = strip_namespaces(name);
- }
-
- // Printf(f_clhead, ";; from emit-stub-class\n");
- update_package_if_needed(n, f_clhead);
- Printf(f_clhead, ";; class template stub.\n");
- Printf(f_clhead, "(swig-def-foreign-stub \"%s\")\n", name);
-
- Setattr(n, "allegrocl:synonym:already-been-stubbed", "1");
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_stub_class: EXIT\n");
-#endif
-}
-
-void emit_synonym(Node *synonym) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_synonym: ENTER... \n");
-#endif
-
- // Printf(stderr,"in emit_synonym for %s(%p)\n", Getattr(synonym,"name"),synonym);
- int is_tempInst = !Strcmp(nodeType(synonym), "templateInst");
- String *synonym_type;
-
- Node *of = get_primary_synonym_of(synonym);
-
- if (is_tempInst) {
- // Printf(stderr, "*** using real-name '%s'\n", Getattr(synonym,"real-name"));
- synonym_type = Getattr(synonym, "real-name");
- } else {
- // Printf(stderr, "*** using name '%s'\n", Getattr(synonym,"name"));
- synonym_type = Getattr(synonym, "name");
- }
-
- String *synonym_ns = listify_namespace(Getattr(synonym, "allegrocl:namespace"));
- String *syn_ltype, *syn_type, *of_ltype;
- // String *of_cdeclname = Getattr(of,"allegrocl:classDeclarationName");
- String *of_ns = Getattr(of, "allegrocl:namespace");
- String *of_ns_list = listify_namespace(of_ns);
- // String *of_name = of_cdeclname ? NewStringf("struct %s", Getattr(of,"name")) : NewStringf("%s::%s", of_ns, Getattr(of,"sym:name"));
- // String *of_name = NewStringf("%s::%s", of_ns, Getattr(of,"sym:name"));
- String *of_name = namespaced_name(of, of_ns);
-
- if (CPlusPlus && !Strcmp(nodeType(synonym), "cdecl")) {
- String *real_name = Getattr(synonym, "real-name");
- if (!real_name)
- real_name = NewString("Unknown"); // TODO: fix
- syn_ltype = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", strip_namespaces(real_name), synonym_ns);
- syn_type = NewStringf("#.(swig-insert-id \"%s\" %s :type :type)", strip_namespaces(real_name), synonym_ns);
- } else {
- syn_ltype = lookup_defined_foreign_ltype(synonym_type);
- syn_type = lookup_defined_foreign_type(synonym_type);
- }
-
- of_ltype = lookup_defined_foreign_ltype(of_name);
-
- // Printf(stderr,";; from emit-synonym syn='%s' of_ltype='%s'\n", syn_ltype, of_ltype);
- if( of_ltype )
- Printf(f_clhead, "(swig-def-synonym-type %s\n %s\n %s)\n", syn_ltype, of_ltype, syn_type);
-
- Delete(synonym_ns);
- Delete(of_ns_list);
- Delete(of_name);
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_synonym: EXIT\n");
-#endif
-}
-
-void emit_full_class(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_full_class: ENTER... \n");
-#endif
-
- String *name = Getattr(n, "sym:name");
- String *kind = Getattr(n, "kind");
-
- // Printf(stderr,"in emit_full_class: '%s'(%p).", Getattr(n,"name"),n);
- if (Getattr(n, "allegrocl:synonym-of")) {
- // Printf(stderr,"but it's a synonym of something.\n");
- update_package_if_needed(n, f_clhead);
- emit_synonym(n);
- return;
- }
- // collect superclasses
- String *bases = Getattr(n, "bases");
- String *supers = NewString("(");
- if (bases) {
- int first = 1;
- for (Iterator i = First(bases); i.item; i = Next(i)) {
- if (!first)
- Printf(supers, " ");
- String *s = lookup_defined_foreign_ltype(Getattr(i.item, "name"));
- // String *name = Getattr(i.item,"name");
- if (s) {
- Printf(supers, "%s", s);
- } else {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "emit_templ_inst: did not find ltype for base class %s (%s)", Getattr(i.item, "name"), Getattr(n, "allegrocl:namespace"));
-#endif
- }
- }
- } else {
- Printf(supers, "ff:foreign-pointer");
- }
-
- // check for "feature:aclmixins" and add those as well.
- Printf(supers, " %s)", Getattr(n,"feature:aclmixins"));
-
- // Walk children to generate type definition.
- String *slotdefs = NewString(" ");
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, " walking children...\n");
-#endif
-
- Node *c;
- for (c = firstChild(n); c; c = nextSibling(c)) {
- String *storage_type = Getattr(c, "storage");
- if ((!Strcmp(nodeType(c), "cdecl") && (!storage_type || Strcmp(storage_type, "typedef")))) {
- String *access = Getattr(c, "access");
-
- // hack. why would decl have a value of "variableHandler" and now "0"?
- String *childDecl = Getattr(c, "decl");
- // Printf(stderr,"childDecl = '%s' (%s)\n", childDecl, Getattr(c,"view"));
- if (!childDecl || !Strcmp(childDecl, "0"))
- childDecl = NewString("");
-
- SwigType *childType;
- String *cname;
-
- // don't include types for private slots (yet). spr33959.
- if(access && Strcmp(access,"public")) {
- childType = NewStringf("int");
- cname = NewString("nil");
- } else {
- childType = NewStringf("%s%s", childDecl, Getattr(c, "type"));
- cname = Copy(Getattr(c, "name"));
- }
-
- if (!SwigType_isfunction(childType)) {
- // Printf(slotdefs, ";;; member functions don't appear as slots.\n ");
- // Printf(slotdefs, ";; ");
- String *ns = listify_namespace(Getattr(n, "allegrocl:package"));
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "slot name = '%s' ns = '%s' class-of '%s' and type = '%s'\n", cname, ns, name, childType);
-#endif
- Printf(slotdefs, "(#.(swig-insert-id \"%s\" %s :type :slot :class \"%s\") %s)", cname, ns, name, compose_foreign_type(n, childType));
- Delete(ns);
- if (access && Strcmp(access, "public"))
- Printf(slotdefs, " ;; %s member", access);
-
- Printf(slotdefs, "\n ");
- }
- Delete(childType);
- Delete(cname);
- }
- }
-
- String *ns_list = listify_namespace(Getattr(n, "allegrocl:namespace"));
- update_package_if_needed(n, f_clhead);
- Printf(f_clhead, "(swig-def-foreign-class \"%s\"\n %s\n (:%s\n%s))\n\n", name, supers, kind, slotdefs);
-
- Delete(supers);
- Delete(ns_list);
-
- Setattr(n, "allegrocl:synonym:already-been-stubbed", "1");
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_full_class: EXIT\n");
-#endif
-
-}
-
-void emit_class(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_class: ENTER... '%s'(%p)\n", Getattr(n, "sym:name"), n);
-#endif
-
- int is_tempInst = !Strcmp(nodeType(n), "templateInst");
-
- String *ns_list = listify_namespace(Getattr(n, "allegrocl:namespace"));
- String *name = Getattr(n, is_tempInst ? "real-name" : "name");
-
- String *tname = SwigType_istemplate_templateprefix(name);
- if (tname) {
- String *temp = strip_namespaces(tname);
- name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name));
- Delete(temp);
- Delete(tname);
- } else {
- name = strip_namespaces(name);
- }
-
- if (Getattr(n, "allegrocl:synonym:is-primary")) {
- // Printf(stderr," is primary... ");
- if (is_tempInst) {
- emit_stub_class(n);
- } else {
- emit_full_class(n);
- }
- } else {
- // Node *primary = Getattr(n,"allegrocl:synonym-of");
- Node *primary = get_primary_synonym_of(n);
- if (primary && (primary != n)) {
- // Printf(stderr," emitting synonym... ");
- emit_stub_class(primary);
- update_package_if_needed(n, f_clhead);
- emit_synonym(n);
- } else {
- emit_full_class(n);
- }
- }
- // Printf(stderr,"DONE\n");
- Delete(name);
- Delete(ns_list);
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_class: EXIT\n");
-#endif
-}
-
-void emit_typedef(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_typedef: ENTER... \n");
-#endif
-
- String *name;
- String *sym_name = Getattr(n, "sym:name");
- String *type = NewStringf("%s%s", Getattr(n, "decl"), Getattr(n, "type"));
- String *lisp_type = compose_foreign_type(n, type);
- Delete(type);
- Node *in_class = Getattr(n, "allegrocl:typedef:in-class");
-
- // Printf(stderr,"in emit_typedef: '%s'(%p).",Getattr(n,"name"),n);
- if (Getattr(n, "allegrocl:synonym-of")) {
- // Printf(stderr," but it's a synonym of something.\n");
- emit_synonym(n);
- return;
- }
-
- if (in_class) {
- String *class_name = Getattr(in_class, "name");
- String *tname = SwigType_istemplate_templateprefix(class_name);
- if (tname) {
- String *temp = strip_namespaces(tname);
- class_name = NewStringf("%s%s%s", temp, SwigType_templateargs(class_name), SwigType_templatesuffix(class_name));
- Delete(temp);
- Delete(tname);
- }
-
- name = NewStringf("%s__%s", class_name, sym_name);
- Setattr(n, "allegrocl:in-class", in_class);
- } else {
- name = sym_name ? Copy(sym_name) : Copy(Getattr(n, "name"));
- }
-
- // leave these in for now. might want to change these to def-foreign-class at some point.
-// Printf(f_clhead, ";; %s\n", SwigType_typedef_resolve_all(lisp_type));
- Printf(f_clhead, "(swig-def-foreign-type \"%s\"\n %s)\n", name, lisp_type);
-
- Delete(name);
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_typedef: EXIT\n");
-#endif
-}
-
-void emit_enum_type_no_wrap(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_enum_type_no_wrap: ENTER... \n");
-#endif
-
- String *unnamed = Getattr(n, "unnamed");
- String *name;
- // SwigType *enumtype;
-
- name = unnamed ? Getattr(n, "allegrocl:name") : Getattr(n, "sym:name");
- SwigType *tmp = NewStringf("enum %s", unnamed ? unnamed : name);
-
- Node *node = NewHash();
- Setattr(node, "type", tmp);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *enumtype = Swig_typemap_lookup("ffitype", node, "", 0);
- Delete(node);
-
- Delete(tmp);
-
- if (name) {
- String *ns = listify_namespace(current_namespace);
-
- Printf(f_clhead, "(swig-def-foreign-type \"%s\" %s)\n", name, enumtype);
- Delete(ns);
-
- // walk children.
- Node *c;
- for (c = firstChild(n); c; c = nextSibling(c)) {
- if (!Getattr(c, "error")) {
- String *val = Getattr(c, "enumvalue");
- if (!val)
- val = Getattr(c, "enumvalueex");
- String *converted_val = convert_literal(val, Getattr(c, "type"));
- String *valname = Getattr(c, "sym:name");
-
- if (converted_val) {
- Printf(f_clhead, "(swig-defconstant \"%s\" %s)\n", valname, converted_val);
- Delete(converted_val);
- } else {
- Swig_warning(WARN_LANG_DISCARD_CONST, Getfile(n), Getline(n), "Unable to parse enum value '%s'. Setting to NIL\n", val);
- Printf(f_clhead, "(swig-defconstant \"%s\" nil #| %s |#)\n", valname, val);
- }
- }
- }
- }
- Printf(f_clhead, "\n");
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_enum_type_no_wrap: EXIT\n");
-#endif
-
-}
-
-void emit_enum_type(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_enum_type: ENTER... \n");
-#endif
-
- if (!Generate_Wrapper) {
- emit_enum_type_no_wrap(n);
- return;
- }
-
- String *unnamed = Getattr(n, "unnamed");
- String *name;
- // SwigType *enumtype;
-
- name = unnamed ? Getattr(n, "allegrocl:name") : Getattr(n, "sym:name");
- SwigType *tmp = NewStringf("enum %s", unnamed ? unnamed : name);
-
- Node *node = NewHash();
- Setattr(node, "type", tmp);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *enumtype = Swig_typemap_lookup("ffitype", node, "", 0);
- Delete(node);
-
- Delete(tmp);
-
- if (name) {
- String *ns = listify_namespace(current_namespace);
-
- Printf(f_clhead, "(swig-def-foreign-type \"%s\" %s)\n", name, enumtype);
- Delete(ns);
-
- // walk children.
- Node *c;
- for(c = firstChild(n); c; c=nextSibling(c)) {
- String *mangled_name = mangle_name(c, "ACL_ENUM", Getattr(c,"allegrocl:package"));
- Printf(f_clhead, "(swig-defvar \"%s\" \"%s\" :type :constant :ftype :signed-long)\n", Getattr(c, "sym:name"), mangled_name);
- Delete(mangled_name);
- }
- }
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_enum_type: EXIT\n");
-#endif
-
-}
-
-void emit_default_linked_type(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_default_linked_type: ENTER... \n");
-#endif
-
- // catchall for non class types.
- if (!Strcmp(nodeType(n), "classforward")) {
- Printf(f_clhead, ";; forward referenced stub.\n");
- Printf(f_clhead, "(swig-def-foreign-class \"%s\" (ff:foreign-pointer) (:class ))\n\n", Getattr(n, "sym:name"));
- } else if (!Strcmp(nodeType(n), "enum")) {
- emit_enum_type(n);
- } else {
- Printf(stderr, "Don't know how to emit node type '%s' named '%s'\n", nodeType(n), Getattr(n, "name"));
- }
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_default_linked_type: EXIT\n");
-#endif
-
-}
-
-void dump_linked_types(File *f) {
- Node *n = first_linked_type;
- int i = 0;
- while (n) {
- Printf(f, "%d: (%p) node '%s' name '%s'\n", i++, n, nodeType(n), Getattr(n, "sym:name"));
-
- Node *t = Getattr(n, "allegrocl:synonym-of");
- if (t)
- Printf(f, " synonym-of %s(%p)\n", Getattr(t, "name"), t);
- n = Getattr(n, "allegrocl:next_linked_type");
- }
-}
-
-void emit_linked_types() {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_linked_types: ENTER... ");
-#endif
-
- Node *n = first_linked_type;
-
- while (n) {
- String *node_type = nodeType(n);
-
- // Printf(stderr,"emitting node %s(%p) of type %s.", Getattr(n,"name"),n, nodeType(n));
- if (!Strcmp(node_type, "class") || !Strcmp(node_type, "templateInst")) {
- // may need to emit a stub, so it will update the package itself.
- // Printf(stderr," Passing to emit_class.");
- emit_class(n);
- } else if (!Strcmp(nodeType(n), "cdecl")) {
- // Printf(stderr," Passing to emit_typedef.");
- update_package_if_needed(n, f_clhead);
- emit_typedef(n);
- } else {
- // Printf(stderr," Passing to default_emitter.");
- update_package_if_needed(n, f_clhead);
- emit_default_linked_type(n);
- }
-
- n = Getattr(n, "allegrocl:next_linked_type");
- // Printf(stderr,"returned.\n");
- }
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_linked_types: EXIT\n");
-#endif
-}
-
-extern "C" Language *swig_allegrocl(void) {
- return (allegrocl = new ALLEGROCL());
-}
-
-void ALLEGROCL::main(int argc, char *argv[]) {
- int i;
-
- Preprocessor_define("SWIGALLEGROCL 1", 0);
- SWIG_library_directory("allegrocl");
- SWIG_config_file("allegrocl.swg");
-
- for (i = 1; i < argc; i++) {
- if (!strcmp(argv[i], "-identifier-converter")) {
- char *conv = argv[i + 1];
-
- if (!conv)
- Swig_arg_error();
-
- Swig_mark_arg(i);
- Swig_mark_arg(i + 1);
- i++;
-
- /* check for built-ins */
- if (!strcmp(conv, "lispify")) {
- Delete(identifier_converter);
- identifier_converter = NewString("identifier-convert-lispify");
- } else if (!strcmp(conv, "null")) {
- Delete(identifier_converter);
- identifier_converter = NewString("identifier-convert-null");
- } else {
- /* Must be user defined */
- Delete(identifier_converter);
- identifier_converter = NewString(conv);
- }
- } else if (!strcmp(argv[i], "-cwrap")) {
- CWrap = true;
- Swig_mark_arg(i);
- } else if (!strcmp(argv[i], "-nocwrap")) {
- CWrap = false;
- Swig_mark_arg(i);
- } else if (!strcmp(argv[i], "-isolate")) {
- unique_swig_package = true;
- Swig_mark_arg(i);
- }
-
- if (!strcmp(argv[i], "-help")) {
- Printf(stdout, "%s\n", usage);
- }
-
- }
-
- allow_overloading();
-}
-
-int ALLEGROCL::top(Node *n) {
- module_name = Getattr(n, "name");
- String *cxx_filename = Getattr(n, "outfile");
- String *cl_filename = NewString("");
-
- swig_package = unique_swig_package ? NewStringf("swig.%s", module_name) : NewString("swig");
-
- Printf(cl_filename, "%s%s.cl", SWIG_output_directory(), module_name);
-
- f_cl = NewFile(cl_filename, "w", SWIG_output_files());
- if (!f_cl) {
- Printf(stderr, "Unable to open %s for writing\n", cl_filename);
- SWIG_exit(EXIT_FAILURE);
- }
-
- Generate_Wrapper = CPlusPlus || CWrap;
-
- if (Generate_Wrapper) {
- f_begin = NewFile(cxx_filename, "w", SWIG_output_files());
- if (!f_begin) {
- Delete(f_cl);
- Printf(stderr, "Unable to open %s for writing\n", cxx_filename);
- SWIG_exit(EXIT_FAILURE);
- }
- } else
- f_begin = NewString("");
-
- f_runtime = NewString("");
- f_cxx_header = f_runtime;
- f_cxx_wrapper = NewString("");
-
- Swig_register_filebyname("header", f_cxx_header);
- Swig_register_filebyname("wrapper", f_cxx_wrapper);
- Swig_register_filebyname("begin", f_begin);
- Swig_register_filebyname("runtime", f_runtime);
- Swig_register_filebyname("lisp", f_clwrap);
- Swig_register_filebyname("lisphead", f_cl);
-
- Swig_banner(f_begin);
-
- Printf(f_runtime, "\n\n#ifndef SWIGALLEGROCL\n#define SWIGALLEGROCL\n#endif\n\n");
-
- Swig_banner_target_lang(f_cl, ";;");
-
- Printf(f_cl, "\n"
- "(defpackage :%s\n"
- " (:use :common-lisp :ff :excl)\n"
- " (:export #:*swig-identifier-converter* #:*swig-module-name*\n"
- " #:*void* #:*swig-export-list*))\n"
- "(in-package :%s)\n\n"
- "(eval-when (:compile-toplevel :load-toplevel :execute)\n"
- " (defparameter *swig-identifier-converter* '%s)\n"
- " (defparameter *swig-module-name* :%s))\n\n", swig_package, swig_package, identifier_converter, module_name);
- Printf(f_cl, "(defpackage :%s\n" " (:use :common-lisp :%s :ff :excl))\n\n", module_name, swig_package);
-
- Printf(f_clhead, "(in-package :%s)\n", module_name);
-
- Language::top(n);
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- dump_linked_types(stderr);
-#endif
- emit_linked_types();
-
- Printf(f_clwrap, "\n(cl::in-package :%s)\n", swig_package);
- Printf(f_clwrap, "\n(macrolet ((swig-do-export ()\n");
- Printf(f_clwrap, " `(dolist (s ',*swig-export-list*)\n");
- Printf(f_clwrap, " (apply #'export s))))\n");
- Printf(f_clwrap, " (swig-do-export))\n");
- Printf(f_clwrap, "\n(setq *swig-export-list* nil)\n");
-
- Printf(f_cl, "%s\n", f_clhead);
- Printf(f_cl, "%s\n", f_clwrap);
-
- Delete(f_cl);
- Delete(f_clhead);
- Delete(f_clwrap);
-
- Dump(f_runtime, f_begin);
- Printf(f_begin, "%s\n", f_cxx_wrapper);
-
- Delete(f_runtime);
- Delete(f_begin);
- Delete(f_cxx_wrapper);
-
- // Swig_print_tree(n);
-
- return SWIG_OK;
-}
-
-int any_varargs(ParmList *pl) {
- Parm *p;
-
- for (p = pl; p; p = nextSibling(p)) {
- if (SwigType_isvarargs(Getattr(p, "type")))
- return 1;
- }
-
- return 0;
-}
-
-String *get_lisp_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
- Node *node = NewHash();
- Setattr(node, "type", ty);
- Setattr(node, "name", name);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *tm = Swig_typemap_lookup("lisptype", node, "", 0);
- Delete(node);
-
- return tm ? NewString(tm) : NewString("");
-}
-
-Node *parent_node_skipping_extends(Node *n) {
- Node *result = n;
- do {
- result = parentNode(result);
- }
- while (Cmp("extend", nodeType(result)) == 0);
- return result;
-}
-
-/* -----------------------------------------------------------------------------
- * emit_num_lin_arguments()
- *
- * Calculate the total number of arguments. This function is safe for use
- * with multi-argument typemaps which may change the number of arguments in
- * strange ways.
- * ----------------------------------------------------------------------------- */
-
-int emit_num_lin_arguments(ParmList *parms) {
- Parm *p = parms;
- int nargs = 0;
-
- while (p) {
- // Printf(stderr,"enla: '%s' lin='%p' numinputs='%s'\n", Getattr(p,"name"), Getattr(p,"tmap:lin"), Getattr(p,"tmap:lin:numinputs"));
- if (Getattr(p, "tmap:lin")) {
- nargs += GetInt(p, "tmap:lin:numinputs");
- p = Getattr(p, "tmap:lin:next");
- } else {
- p = nextSibling(p);
- }
- }
-
- /* DB 04/02/2003: Not sure this is necessary with tmap:in:numinputs */
- /*
- if (parms && (p = Getattr(parms,"emit:varargs"))) {
- if (!nextSibling(p)) {
- nargs--;
- }
- }
- */
- return nargs;
-}
-
-String *id_converter_type(SwigType const *type) {
- SwigType *t = Copy(type);
- String *result = 0;
-
- if (SwigType_ispointer(t)) {
- SwigType_pop(t);
- String *pointee = id_converter_type(t);
- result = NewStringf("(:* %s)", pointee);
- Delete(pointee);
- } else if (SwigType_ismemberpointer(t)) {
- String *klass = SwigType_parm(t);
- SwigType_pop(t);
- String *member = id_converter_type(t);
- result = NewStringf("(:member \"%s\" %s)", klass, member);
- Delete(klass);
- Delete(member);
- } else if (SwigType_isreference(t)) {
- SwigType_pop(t);
- String *referencee = id_converter_type(t);
- result = NewStringf("(:& %s)", referencee);
- Delete(referencee);
- } else if (SwigType_isarray(t)) {
- String *size = SwigType_parm(t);
- SwigType_pop(t);
- String *element_type = id_converter_type(t);
- result = NewStringf("(:array %s \"%s\")", element_type, size);
- Delete(size);
- Delete(element_type);
- } else if (SwigType_isfunction(t)) {
- result = NewString("(:function (");
- String *parmlist_str = SwigType_parm(t);
- List *parms = SwigType_parmlist(parmlist_str);
-
- for (Iterator i = First(parms); i.item;) {
- String *parm = id_converter_type((SwigType *) i.item);
- Printf(result, "%s", parm);
- i = Next(i);
- if (i.item)
- Printf(result, " ");
- Delete(parm);
- }
- SwigType_pop(t);
- String *ret = id_converter_type(t);
- Printf(result, ") %s)", ret);
-
- Delete(parmlist_str);
- Delete(parms);
- Delete(ret);
- } else if (SwigType_isqualifier(t)) {
- result = NewString("(:qualified (");
- String *qualifiers_str = Copy(SwigType_parm(t)); // ?!
- // Replaceall below SEGVs if we don't put the Copy here...
- SwigType_pop(t);
- String *qualifiee = id_converter_type(t);
-
- Replaceall(qualifiers_str, " ", " :");
- if (Len(qualifiers_str) > 0)
- Printf(result, ":");
- Printf(result, "%s) %s)", qualifiers_str, qualifiee);
-
- Delete(qualifiers_str);
- Delete(qualifiee);
- } else if (SwigType_istemplate(t)) {
- result = NewStringf("(:template \"%s\")", t);
- } else { /* if (SwigType_issimple(t)) */
-
- if (Strstr(Char(t), "::")) {
- result = listify_namespace(t);
- } else {
- result = NewStringf("\"%s\"", t);
- }
- }
-
- Delete(t);
- return result;
-}
-
-static ParmList *parmlist_with_names(ParmList *pl) {
- ParmList *pl2 = CopyParmList(pl);
- for (Parm *p = pl, *p2 = pl2; p2; p = nextSibling(p), p2 = nextSibling(p2)) {
- if (!Getattr(p2, "name"))
- Setattr(p2, "name", Getattr(p2, "lname"));
- Setattr(p2, "name", strip_namespaces(Getattr(p2, "name")));
- Setattr(p2, "tmap:ctype", Getattr(p, "tmap:ctype"));
-
- String *temp = Getattr(p, "tmap:lin");
- if (temp) {
- Setattr(p2, "tmap:lin", temp);
- Setattr(p2, "tmap:lin:next", Getattr(p, "tmap:lin:next"));
- }
- }
- return pl2;
-}
-
-static String *parmlist_str_id_converter(ParmList *pl) {
- String *result = NewString("");
- for (Parm *p = pl; p;) {
- String *lispy_type = id_converter_type(Getattr(p, "type"));
- Printf(result, "(\"%s\" %s)", Getattr(p, "name"), lispy_type);
- Delete(lispy_type);
- if ((p = nextSibling(p)))
- Printf(result, " ");
- }
- return result;
-}
-
-String *collect_others_args(Node *overload) {
- String *overloaded_from = Getattr(overload, "sym:overloaded");
- String *others_args = NewString("");
- int first_overload = 1;
-
- for (Node *overload2 = overloaded_from; overload2; overload2 = Getattr(overload2, "sym:nextSibling")) {
- if (overload2 == overload || GetInt(overload2, "overload:ignore"))
- continue;
-
- ParmList *opl = parmlist_with_names(Getattr(overload2, "wrap:parms"));
- String *args = parmlist_str_id_converter(opl);
- if (!first_overload)
- Printf(others_args, "\n ");
- Printf(others_args, "(%s)", args);
- Delete(args);
- Delete(opl);
- first_overload = 0;
- }
- return others_args;
-}
-
-struct IDargs {
- String *name;
- String *type;
- String *klass;
- String *arity;
-
- IDargs():name(0), type(0), klass(0), arity(0) {
- }
-
- String *full_quoted_str() {
- String *result = no_others_quoted_str();
- if (arity)
- Printf(result, " :arity %s", arity);
- return result;
- }
-
- String *no_others_quoted_str() {
- String *result = NewString("");
- Printf(result, "\"%s\" :type :%s", name, type);
- if (klass)
- Printf(result, " :class \"%s\"", klass);
- return result;
- }
-
- String *noname_str(bool include_class = true) {
- String *result = NewString("");
- Printf(result, " :type :%s", type);
- if (klass && include_class)
- Printf(result, " :class \"%s\"", klass);
- if (arity)
- Printf(result, " :arity %s", arity);
- return result;
- }
-
- String *noname_no_others_str(bool include_class = true) {
- String *result = NewString("");
- Printf(result, " :type :%s", type);
- if (klass && include_class)
- Printf(result, " :class \"%s\"", klass);
- return result;
- }
-};
-IDargs *id_converter_arguments(Node *n) {
- IDargs *result = (IDargs *) GetVoid(n, "allegrocl:id-converter-args");
- if (!result)
- result = new IDargs;
-
- // Base name
- if (!result->name) {
- result->name = Getattr(n, "allegrocl:old-sym:name");
- if (!result->name)
- result->name = Getattr(n, "sym:name");
- result->name = Copy(result->name);
- }
- // :type
- if (result->type)
- Delete(result->type);
- if (!Getattr(n, "allegrocl:kind"))
- Setattr(n, "allegrocl:kind", "function");
- if (Strstr(Getattr(n, "name"), "operator "))
- Replaceall(Getattr(n, "allegrocl:kind"), "function", "operator");
- if (Strstr(Getattr(n, "allegrocl:kind"), "variable")) {
- int name_end = Len(Getattr(n, "sym:name")) - 4;
- char *str = Char(Getattr(n, "sym:name"));
- String *get_set = NewString(str + name_end + 1);
- result->type = Copy(Getattr(n, "allegrocl:kind"));
- Replaceall(result->type, "variable", "");
- Printf(result->type, "%ster", get_set);
- Delete(get_set);
- } else {
- result->type = Copy(Getattr(n, "allegrocl:kind"));
- }
-
- // :class
- if (Strstr(result->type, "member ")) {
- Replaceall(result->type, "member ", "");
- if (!result->klass) {
- result->klass = Copy(Getattr(parent_node_skipping_extends(n), "sym:name"));
- }
- }
- // :arity
- if (Getattr(n, "sym:overloaded")) {
- if (result->arity)
- Delete(result->arity);
- result->arity = NewStringf("%d",
- // emit_num_arguments(Getattr(n, "wrap:parms")));
- emit_num_lin_arguments(Getattr(n, "wrap:parms")));
- // Printf(stderr, "got arity of '%s' node '%s' '%p'\n", result->arity, Getattr(n,"name"), Getattr(n,"wrap:parms"));
- }
-
- SetVoid(n, "allegrocl:id-converter-args", result);
- return result;
-}
-
-int ALLEGROCL::emit_buffered_defuns(Node *n) {
-
- Node *overloaded_from = Getattr(n, "sym:overloaded");
-
- String *wrap;
-
- if (!overloaded_from) {
- wrap = Getattr(n, "allegrocl:lisp-wrap");
-
- Printf(f_clwrap, "%s\n", wrap);
- Delattr(n, "allegrocl:lisp-wrap");
- Delete(wrap);
- } else {
- for (Node *overload = overloaded_from; overload; overload = Getattr(overload, "sym:nextSibling")) {
- String *others_args = collect_others_args(overload);
- wrap = Getattr(overload, "allegrocl:lisp-wrap");
-
- Replaceall(wrap, "@@OTHERS-ARGS-GO-HERE@@", others_args);
-// IDargs* id_args = id_converter_arguments(overload);
-// Replaceall(id_args->others_args, "@@OTHERS-ARGS-GO-HERE@@", others_args);
-
- if (!GetInt(overload, "overload:ignore"))
- Printf(f_clwrap, "%s", wrap);
-
- Delattr(overload, "allegrocl:lisp-wrap");
- Delete(wrap);
- }
- }
- return SWIG_OK;
-}
-
-String *dispatching_type(Node *n, Parm *p) {
- String *result = 0;
-
- String *parsed = Getattr(p, "type"); //Swig_cparse_type(Getattr(p,"tmap:ctype"));
- String *cl_t = SwigType_typedef_resolve_all(parsed);
-
- Node *node = NewHash();
- Setattr(node, "type", parsed);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *tm = Swig_typemap_lookup("lispclass", node, Getattr(p, "name"), 0);
- Delete(node);
-
- if (tm) {
- result = Copy(tm);
- } else {
- String *lookup_type = class_from_class_or_class_ref(parsed);
- if (lookup_type)
- result = lookup_defined_foreign_ltype(lookup_type);
- }
-
- // if (!result && SwigType_ispointer(cl_t)) {
- // SwigType_pop(cl_t);
- // result = lookup_defined_foreign_ltype(cl_t);
- // }
-
- if (!result)
- result = NewStringf("ff:foreign-pointer");
-
- // Delete(parsed);
- Delete(cl_t);
- return result;
-}
-
-int ALLEGROCL::emit_dispatch_defun(Node *n) {
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_dispatch_defun: ENTER... ");
-#endif
- List *overloads = Swig_overload_rank(n, true);
-
- // Printf(stderr,"\ndispatch node=%p\n\n", n);
- // Swig_print_node(n);
-
- Node *overloaded_from = Getattr(n,"sym:overloaded");
- bool include_class = Getattr(overloaded_from, "allegrocl:dispatcher:include-class") ? true : false;
- String *id_args = id_converter_arguments(n)->noname_no_others_str(include_class);
- Printf(f_clwrap, "(swig-dispatcher (\"%s\" %s :arities (", Getattr(overloaded_from, "allegrocl:dispatcher:name"), id_args);
-
- Delattr(overloaded_from, "allegrocl:dispatcher:include-class");
- Delattr(overloaded_from, "allegrocl:dispatcher:name");
-
- int last_arity = -1;
- for (Iterator i = First(overloads); i.item; i = Next(i)) {
- int arity = emit_num_lin_arguments(Getattr(i.item, "wrap:parms"));
- if (arity == last_arity)
- continue;
-
- Printf(f_clwrap, "%s%d", last_arity == -1 ? "" : " ", arity);
-
- last_arity = arity;
- }
- Printf(f_clwrap, ")))\n");
-
- Delete(id_args);
- Delete(overloads);
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_dispatch_defun: EXIT\n");
-#endif
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::emit_defun(Node *n, File *fcl) {
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_defun: ENTER... ");
-#endif
-
- // avoid name conflicts between smart pointer wrappers and the wrappers for the
- // actual class.
- bool smartmemberwrapper = (!Cmp(Getattr(n, "view"), "memberfunctionHandler") &&
- Getattr(n,"allocate:smartpointeraccess"));
-
-#ifdef ALLEGROCL_DEBUG
- int auto_generated = Cmp(Getattr(n, "view"), "globalfunctionHandler");
- Printf(stderr, "%s%sfunction %s%s%s\n", auto_generated ? "> " : "", Getattr(n, "sym:overloaded")
- ? "overloaded " : "", current_namespace, (current_namespace) > 0 ? "::" : "", Getattr(n, "sym:name"));
- Printf(stderr, " (view: %s)\n", Getattr(n, "view"));
- Swig_print_node(n);
-#endif
-
-
- String *funcname = Getattr(n, "allegrocl:old-sym:name");
- if (smartmemberwrapper || !funcname)
- funcname = Getattr(n, "sym:name");
-
- String *mangled_name = Getattr(n, "wrap:name");
- ParmList *pl = parmlist_with_names(Getattr(n, "wrap:parms"));
-
- // attach typemap info.
- Wrapper *wrap = NewWrapper();
- Swig_typemap_attach_parms("lin", pl, wrap);
- // Swig_typemap_attach_parms("ffitype", pl, wrap);
- Swig_typemap_lookup("lout", n, Swig_cresult_name(), 0);
-
- SwigType *result_type = Swig_cparse_type(Getattr(n, "tmap:ctype"));
- // prime the pump, with support for OUTPUT, INOUT typemaps.
- Printf(wrap->code,
- "(cl::let ((ACL_ffresult %s:*void*)\n ACL_result)\n $body\n (cl::if (cl::eq ACL_ffresult %s:*void*)\n (cl::values-list ACL_result)\n (cl::values-list (cl::cons ACL_ffresult ACL_result))))",
- swig_package, swig_package);
-
- Parm *p;
- int largnum = 0, argnum = 0, first = 1;
- // int varargs=0;
- if (Generate_Wrapper) {
- String *extra_parms = id_converter_arguments(n)->noname_str(smartmemberwrapper ? false : true);
- Node *overloaded_from = Getattr(n,"sym:overloaded");
- if (overloaded_from) {
- if(!GetFlag(overloaded_from,"allegrocl:dispatcher:name")) {
- Setattr(overloaded_from,"allegrocl:dispatcher:name",funcname);
- Setattr(overloaded_from,"allegrocl:dispatcher:include-class", smartmemberwrapper ? 0 : "1");
- // Printf(stderr, " set a:d:name='%s', a:d:i-c='%s'\n", Getattr(n,"allegrocl:dispatcher:name"), Getattr(n,"allegrocl:dispatcher:include-class"));
- }
- Printf(fcl, "(swig-defmethod (\"%s\" \"%s\"%s)\n", funcname, mangled_name, extra_parms);
- } else
- Printf(fcl, "(swig-defun (\"%s\" \"%s\"%s)\n", funcname, mangled_name, extra_parms);
- Delete(extra_parms);
- }
- // Just C
- else {
- Printf(fcl, "(swig-defun (\"%s\" \"%s\")\n", funcname, Generate_Wrapper ? mangled_name : funcname);
- }
-
- //////////////////////////////////////
- // Lisp foreign call parameter list //
- //////////////////////////////////////
- Printf(fcl, " (");
-
- /* Special cases */
-
- if (ParmList_len(pl) == 0) {
- Printf(fcl, ":void");
-/* } else if (any_varargs(pl)) {
- Printf(fcl, "#| varargs |#");
- varargs=1; */
- } else {
- String *largs = NewString("");
-
- for (p = pl; p; p = nextSibling(p), argnum++, largnum++) {
- // SwigType *argtype=Getattr(p, "type");
- SwigType *argtype = Swig_cparse_type(Getattr(p, "tmap:ctype"));
- SwigType *parmtype = Getattr(p,"type");
-
- if (!first) {
- Printf(fcl, "\n ");
- }
-
- /* by default, skip varargs */
- if (!SwigType_isvarargs(parmtype)) {
- String *argname = NewStringf("PARM%d_%s", largnum, Getattr(p, "name"));
-
- // Printf(stderr,"%s\n", Getattr(p,"tmap:lin"));
- String *ffitype = compose_foreign_type(n, argtype, Getattr(p,"name"));
- String *deref_ffitype = dereference_ffitype(ffitype);
- String *lisptype = get_lisp_type(n, parmtype, Getattr(p, "name"));
-
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "lisptype of '%s' '%s' = '%s'\n", parmtype,
- Getattr(p, "name"), lisptype);
-#endif
-
- // while we're walking the parameters, generating LIN
- // wrapper code...
- Setattr(p, "lname", NewStringf("SWIG_arg%d", largnum));
-
- String *parm_code = Getattr(p, "tmap:lin");
- if (parm_code) {
- String *lname = Getattr(p, "lname");
-
- Printf(largs, " %s", lname);
- Replaceall(parm_code, "$in_fftype", ffitype); // must come before $in
- Replaceall(parm_code, "$in", argname);
- Replaceall(parm_code, "$out", lname);
- Replaceall(parm_code, "$*in_fftype", deref_ffitype);
- Replaceall(wrap->code, "$body", parm_code);
- }
-
- String *dispatchtype = Getattr(n, "sym:overloaded") ? dispatching_type(n, p) : NewString("");
-
- // if this parameter has been removed from the C/++ wrapper
- // it shouldn't be in the lisp wrapper either.
- if (!checkAttribute(p, "tmap:in:numinputs", "0")) {
- Printf(fcl, "(%s %s %s %s %s)",
- // parms in the ff wrapper, but not in the lisp wrapper.
- (checkAttribute(p, "tmap:lin:numinputs", "0") ? ":p-" : ":p+"), argname, dispatchtype, ffitype, lisptype);
-
- first = 0;
- }
-
- Delete(argname);
- Delete(ffitype);
- Delete(deref_ffitype);
- Delete(lisptype);
- }
- }
-
- Printf(wrap->locals, "%s", largs);
- }
-
- String *lout = Getattr(n, "tmap:lout");
- Replaceall(lout, "$owner", GetFlag(n, "feature:new") ? "t" : "nil");
-
- Replaceall(wrap->code, "$body", lout);
- // $lclass handling.
- String *lclass = (String *) 0;
- SwigType *parsed = Swig_cparse_type(Getattr(n, "tmap:ctype"));
- // SwigType *cl_t = SwigType_typedef_resolve_all(parsed);
- SwigType *cl_t = class_from_class_or_class_ref(parsed);
- String *out_ffitype = compose_foreign_type(n, parsed);
- String *deref_out_ffitype;
- String *out_temp = Copy(parsed);
-
- if (SwigType_ispointer(out_temp)) {
- SwigType_pop(out_temp);
- deref_out_ffitype = compose_foreign_type(n, out_temp);
- } else {
- deref_out_ffitype = Copy(out_ffitype);
- }
-
- Delete(out_temp);
-
- Delete(parsed);
-
- if (cl_t) {
- lclass = lookup_defined_foreign_ltype(cl_t);
- }
-
- int ff_foreign_ptr = 0;
- if (!lclass) {
- ff_foreign_ptr = 1;
- lclass = NewStringf("ff:foreign-pointer");
- }
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "for output wrapping %s: type=%s, ctype=%s\n", Getattr(n, "name"),
- Getattr(n, "type"), Swig_cparse_type(Getattr(n, "tmap:ctype")));
-#endif
-
- if (lclass)
- Replaceall(wrap->code, "$lclass", lclass);
- if (out_ffitype)
- Replaceall(wrap->code, "$out_fftype", out_ffitype);
- if (deref_out_ffitype)
- Replaceall(wrap->code, "$*out_fftype", deref_out_ffitype);
-
- Replaceall(wrap->code, "$body", NewStringf("(swig-ff-call%s)", wrap->locals));
- String *ldestructor = Copy(lclass);
- if (ff_foreign_ptr)
- Replaceall(ldestructor, ldestructor, "cl::identity");
- else
- Replaceall(ldestructor, ":type :class", ":type :destructor");
- Replaceall(wrap->code, "$ldestructor", ldestructor);
- Delete(ldestructor);
-
- Printf(fcl, ")\n"); /* finish arg list */
-
- /////////////////////////////////////////////////////
- // Lisp foreign call return type and optimizations //
- /////////////////////////////////////////////////////
- Printf(fcl, " (:returning (%s %s)", compose_foreign_type(n, result_type), get_lisp_type(n, Getattr(n, "type"), Swig_cresult_name()));
-
- for (Iterator option = First(n); option.item; option = Next(option)) {
- if (Strncmp("feature:ffargs:", option.key, 15))
- continue;
- String *option_val = option.item;
- String *option_name = NewString(Char(option.key) + 14);
- Replaceall(option_name, "_", "-");
-
- // TODO: varargs vs call-direct ?
- Printf(fcl, "\n %s %s", option_name, option_val);
-
- Delete(option_name);
- }
-
- Printf(fcl, ")\n %s)\n\n", wrap->code);
- // Wrapper_print(wrap, stderr);
-
- Delete(result_type);
- Delete(mangled_name);
- Delete(pl);
- DelWrapper(wrap);
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_defun: EXIT\n");
-#endif
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::functionWrapper(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "functionWrapper %s\n", Getattr(n,"name"));
-#endif
-
-
- ParmList *parms = CopyParmList(Getattr(n, "parms"));
- Wrapper *f = NewWrapper();
- SwigType *t = Getattr(n, "type");
- String *name = Getattr(n, "name");
-
- String *raw_return_type = Swig_typemap_lookup("ctype", n, "", 0);
- SwigType *return_type = Swig_cparse_type(raw_return_type);
- SwigType *resolved = SwigType_typedef_resolve_all(return_type);
- int is_void_return = (Cmp(resolved, "void") == 0);
-
- Delete(resolved);
-
- if (!is_void_return) {
- String *lresult_init =
- NewStringf("= (%s)0",
- SwigType_str(SwigType_strip_qualifiers(return_type),0));
- Wrapper_add_localv(f, "lresult",
- SwigType_lstr(SwigType_ltype(return_type), "lresult"),
- lresult_init, NIL);
- Delete(lresult_init);
- }
- // Emit all of the local variables for holding arguments.
- emit_parameter_variables(parms, f);
-
- // Attach the standard typemaps
- Swig_typemap_attach_parms("ctype", parms, f);
- Swig_typemap_attach_parms("lin", parms, f);
- emit_attach_parmmaps(parms, f);
-
- String *mangled = mangle_name(n);
- Node *overloaded = Getattr(n, "sym:overloaded");
-
- // Parameter overloading
- Setattr(n, "wrap:parms", parms);
- Setattr(n, "wrap:name", mangled);
-
- if (overloaded) {
- // emit warnings when overloading is impossible on the lisp side.
- // basically Swig_overload_check(n), but with script_lang_wrapping
- // set to true.
- Delete(Swig_overload_rank(n, true));
- if (Getattr(n, "overload:ignore")) {
- // if we're the last overload, make sure to force the emit
- // of the rest of the overloads before we leave.
- // Printf(stderr, "ignored overload %s(%p)\n", name, Getattr(n, "sym:nextSibling"));
- if (!Getattr(n, "sym:nextSibling")) {
- update_package_if_needed(n);
- emit_buffered_defuns(n);
- emit_dispatch_defun(n);
- }
- DelWrapper(f);
- return SWIG_OK;
- }
- }
- // Get number of required and total arguments
- int num_arguments = emit_num_arguments(parms);
- int gencomma = 0;
-
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "Walking parameters for %s '%s'\n", Getattr(n, "allegrocl:kind"), name);
-#endif
- // Now walk the function parameter list and generate code to get arguments
- String *name_and_parms = NewStringf("%s (", mangled);
- int i;
- Parm *p;
- for (i = 0, p = parms; i < num_arguments; i++) {
-
-#ifdef ALLEGROCL_DEBUG
- String *temp1 = Getattr(p,"tmap:in");
- String *temp2 = Getattr(p,"tmap:in:numinputs");
- Printf(stderr," parm %d: %s, tmap:in='%s', tmap:in:numinputs='%s'\n", i, Getattr(p,"name"), temp1 ? temp1 : "", temp2 ? temp2 : "");
-#endif
-
- while (p && checkAttribute(p, "tmap:in:numinputs", "0")) {
- p = Getattr(p, "tmap:in:next");
- }
-
- if (!p)
- break;
-
- SwigType *c_parm_type = Swig_cparse_type(Getattr(p, "tmap:ctype"));
- String *arg = NewStringf("l%s", Getattr(p, "lname"));
-
- // Emit parameter declaration
- if (gencomma)
- Printf(name_and_parms, ", ");
- String *parm_decl = SwigType_str(c_parm_type, arg);
- Printf(name_and_parms, "%s", parm_decl);
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, " param: %s\n", parm_decl);
-#endif
- Delete(parm_decl);
- gencomma = 1;
-
- // Emit parameter conversion code
- String *parm_code = Getattr(p, "tmap:in");
- //if (!parm_code) {
- // Swig_warning(...);
- // p = nextSibling(p);
- /*} else */ {
- // canThrow(n, "in", p);
- Replaceall(parm_code, "$input", arg);
- Setattr(p, "emit:input", arg);
- Printf(f->code, "%s\n", parm_code);
- p = Getattr(p, "tmap:in:next");
- }
-
- Delete(arg);
- }
- Printf(name_and_parms, ")");
-
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, " arity = %d(%d)\n", emit_num_lin_arguments(parms), emit_num_lin_arguments(Getattr(n,"wrap:parms")));
-#endif
-
- // Emit the function definition
- String *signature = SwigType_str(return_type, name_and_parms);
- Printf(f->def, "EXPORT %s {", signature);
- if (CPlusPlus)
- Printf(f->code, " try {\n");
-
- String *actioncode = emit_action(n);
-
- String *tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode);
- if (!is_void_return) {
- if (tm) {
- Replaceall(tm, "$result", "lresult");
- Printf(f->code, "%s\n", tm);
- Printf(f->code, " return lresult;\n");
- Delete(tm);
- } else {
- Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number,
- "Unable to use return type %s in function %s.\n",
- SwigType_str(t, 0), name);
- }
- }
-
- /* See if there is any return cleanup code */
- if ((tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0))) {
- Printf(f->code, "%s\n", tm);
- Delete(tm);
- }
-
- emit_return_variable(n, t, f);
-
- if (CPlusPlus) {
- Printf(f->code, " } catch (...) {\n");
- if (!is_void_return)
- Printf(f->code, " return (%s)0;\n",
- SwigType_str(SwigType_strip_qualifiers(return_type),0));
- Printf(f->code, " }\n");
- }
- Printf(f->code, "}\n");
-
- /* print this when in C mode? make this a command-line arg? */
- if (Generate_Wrapper)
- Wrapper_print(f, f_cxx_wrapper);
-
- String *f_buffer = NewString("");
-
- emit_defun(n, f_buffer);
- Setattr(n, "allegrocl:lisp-wrap", f_buffer);
-
- if (!overloaded || !Getattr(n, "sym:nextSibling")) {
- update_package_if_needed(n);
- emit_buffered_defuns(n);
- // this is the last overload.
- if (overloaded) {
- emit_dispatch_defun(n);
- }
- }
-
- DelWrapper(f);
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::namespaceDeclaration(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "namespaceDecl: '%s'(%p) (fc=%p)\n", Getattr(n, "sym:name"), n, firstChild(n));
-#endif
-
- /* don't wrap a namespace with no contents. package bloat.
- also, test-suite/namespace_class.i claims an unnamed namespace
- is 'private' and should not be wrapped. Complying...
- */
- if (Getattr(n,"unnamed") || !firstChild(n))
- return SWIG_OK;
-
- String *name = Getattr(n, "sym:name");
-
- String *old_namespace = current_namespace;
- if (Cmp(current_namespace, "") == 0)
- current_namespace = NewStringf("%s", name);
- else
- current_namespace = NewStringf("%s::%s", current_namespace, name);
-
- if (!GetInt(defined_namespace_packages, current_namespace)) {
- SetInt(defined_namespace_packages, current_namespace, 1);
- String *lispy_namespace = listify_namespace(current_namespace);
- Printf(f_clhead, "(swig-defpackage %s)\n", lispy_namespace);
- Delete(lispy_namespace);
- }
-
- emit_children(n);
-
- Delete(current_namespace);
- current_namespace = old_namespace;
- return SWIG_OK;
-}
-
-int ALLEGROCL::constructorHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "constructorHandler %s\n", Getattr(n, "name"));
-#endif
- // Swig_print_node(n);
- Setattr(n, "allegrocl:kind", "constructor");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
- // Let SWIG generate a global forwarding function.
- return Language::constructorHandler(n);
-}
-
-int ALLEGROCL::destructorHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "destructorHandler %s\n", Getattr(n, "name"));
-#endif
-
- Setattr(n, "allegrocl:kind", "destructor");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
- // Let SWIG generate a global forwarding function.
- return Language::destructorHandler(n);
-}
-
-int ALLEGROCL::constantWrapper(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "constantWrapper %s\n", Getattr(n, "name"));
-#endif
-
- if (Generate_Wrapper) {
- // Setattr(n,"wrap:name",mangle_name(n, "ACLPP"));
- String *const_type = Getattr(n, "type");
-
- String *const_val = 0;
- String *raw_const = Getattr(n, "value");
-
- if (SwigType_type(const_type) == T_STRING) {
- const_val = NewStringf("\"%s\"", raw_const);
- } else if (SwigType_type(const_type) == T_CHAR) {
- const_val = NewStringf("'%s'", raw_const);
- } else {
- const_val = Copy(raw_const);
- }
-
- SwigType_add_qualifier(const_type, "const");
-
- String *ppcname = NewStringf("ACLppc_%s", Getattr(n, "sym:name"));
- // Printf(f_runtime, "static const %s = %s;\n", SwigType_lstr(const_type, ppcname), const_val);
- Printf(f_runtime, "static %s = %s;\n", SwigType_lstr(const_type, ppcname), const_val);
-
- Setattr(n, "name", ppcname);
- SetFlag(n, "feature:immutable");
-
- Delete(const_val);
- return variableWrapper(n);
- }
-
- String *type = Getattr(n, "type");
- String *value = Getattr(n, "value");
- String *converted_value = convert_literal(value, type);
- String *name = Getattr(n, "sym:name");
-
- Setattr(n, "allegrocl:kind", "constant");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
-#if 0
- Printf(stdout, "constant %s is of type %s. value: %s\n", name, type, converted_value);
-#endif
-
- if (converted_value) {
- Printf(f_clwrap, "(swig-defconstant \"%s\" %s)\n", name, converted_value);
- } else {
- Swig_warning(WARN_LANG_DISCARD_CONST, Getfile(n), Getline(n), "Unable to parse constant value '%s'. Setting to NIL\n", value);
- Printf(f_clwrap, "(swig-defconstant \"%s\" nil #| %s |#)\n", name, value);
- }
-
- Delete(converted_value);
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::globalvariableHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "globalvariableHandler %s\n", Getattr(n, "name"));
-#endif
-
- if (Generate_Wrapper)
- return Language::globalvariableHandler(n);
-
- // String *name = Getattr(n, "name");
- SwigType *type = Getattr(n, "type");
- SwigType *rtype = SwigType_typedef_resolve_all(type);
-
- if (SwigType_isclass(rtype)) {
- SwigType_add_pointer(type);
- SwigType_add_pointer(rtype);
- }
-
- Printf(f_clwrap, "(swig-defvar \"%s\" \"%s\" :type %s)\n",
- Getattr(n, "sym:name"), Getattr(n, "sym:name"), ((SwigType_isconst(type)) ? ":constant" : ":variable"));
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::variableWrapper(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "variableWrapper %s\n", Getattr(n, "name"));
-#endif
- Setattr(n, "allegrocl:kind", "variable");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
- // Let SWIG generate a get/set function pair.
- if (Generate_Wrapper)
- return Language::variableWrapper(n);
-
- String *name = Getattr(n, "name");
- SwigType *type = Getattr(n, "type");
- SwigType *ctype;
- SwigType *rtype = SwigType_typedef_resolve_all(type);
-
- String *mangled_name = mangle_name(n);
-
- int pointer_added = 0;
-
- if (SwigType_isclass(rtype)) {
- SwigType_add_pointer(type);
- SwigType_add_pointer(rtype);
- pointer_added = 1;
- }
-
- ctype = SwigType_str(type, 0);
-
- // EXPORT <SwigType_str> <mangled_name>;
- // <SwigType_str> <mangled_name> = <name>;
- Printf(f_runtime, "EXPORT %s %s;\n%s %s = %s%s;\n", ctype, mangled_name, ctype, mangled_name, (pointer_added ? "&" : ""), name);
-
- Printf(f_cl, "(swig-defvar \"%s\" :type %s)\n", mangled_name, ((SwigType_isconst(type)) ? ":constant" : ":variable"));
-
- Printf(stderr,"***\n");
- Delete(mangled_name);
-
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "DONE variable %s\n", Getattr(n, "name"));
-#endif
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::memberfunctionHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "memberfunctionHandler %s::%s\n", Getattr(parent_node_skipping_extends(n), "name"), Getattr(n, "name"));
- Swig_print_node(n);
-#endif
- Setattr(n, "allegrocl:kind", "member function");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
- // Let SWIG generate a global forwarding function.
- return Language::memberfunctionHandler(n);
-}
-
-int ALLEGROCL::membervariableHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "membervariableHandler %s::%s\n", Getattr(parent_node_skipping_extends(n), "name"), Getattr(n, "name"));
-#endif
- Setattr(n, "allegrocl:kind", "member variable");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
- // Let SWIG generate a get/set function pair.
- return Language::membervariableHandler(n);
-}
-
-int ALLEGROCL::typedefHandler(Node *n) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "In typedefHandler\n");
-#endif
-
- SwigType *typedef_type = Getattr(n,"type");
- // has the side-effect of noting any implicit
- // template instantiations in type.
- String *ff_type = compose_foreign_type(n, typedef_type);
-
- String *sym_name = Getattr(n, "sym:name");
-
- String *name;
- String *type_ref;
-
- if (in_class) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, " typedef in class '%s'(%p)\n", Getattr(in_class, "sym:name"), in_class);
-#endif
- Setattr(n, "allegrocl:typedef:in-class", in_class);
-
- String *class_name = Getattr(in_class, "name");
- name = NewStringf("%s__%s", class_name, sym_name);
- type_ref = NewStringf("%s::%s", class_name, sym_name);
- Setattr(n, "allegrocl:in-class", in_class);
- } else {
- name = Copy(sym_name);
- type_ref = Copy(Getattr(n, "name"));
- }
-
- Setattr(n, "allegrocl:namespace", current_namespace);
-
- String *lookup = lookup_defined_foreign_type(typedef_type);
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "** lookup='%s'(%p), typedef_type='%s', strcmp = '%d' strstr = '%d'\n", lookup, lookup, typedef_type, Strcmp(typedef_type,"void"), Strstr(ff_type,"__SWIGACL_FwdReference"));
-#endif
-
- if(lookup || (!lookup && Strcmp(typedef_type,"void")) ||
- (!lookup && Strstr(ff_type,"__SWIGACL_FwdReference"))) {
- add_defined_foreign_type(n, 0, type_ref, name);
- } else {
- add_forward_referenced_type(n);
- }
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "Out typedefHandler\n");
-#endif
-
- Delete(ff_type);
-
- return SWIG_OK;
-}
-
-// forward referenced classes are added specially to defined_foreign_types
-int ALLEGROCL::classforwardDeclaration(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "classforwardDeclaration %s\n", Getattr(n, "name"));
-#endif
-
- add_forward_referenced_type(n);
- return SWIG_OK;
-}
-
-int ALLEGROCL::classHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "classHandler %s::%s\n", current_namespace, Getattr(n, "sym:name"));
-#endif
-
- int result;
-
- if (Generate_Wrapper)
- result = cppClassHandler(n);
- else
- result = cClassHandler(n);
-
- return result;
-}
-
-int ALLEGROCL::cClassHandler(Node *n) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "In cClassHandler\n");
-#endif
- /* Add this structure to the known lisp types */
- // Printf(stderr, "Adding %s foreign type\n", name);
- String *ns = listify_namespace(current_namespace);
-
- add_defined_foreign_type(n);
-
- Delete(ns);
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "Out cClassHandler\n");
-#endif
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::cppClassHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "cppClassHandler %s\n", Getattr(n, "name"));
-#endif
-
- // String *name=Getattr(n, "sym:name");
- // String *kind = Getattr(n,"kind");
-
- /* Template instantiation.
- Careful.
- SWIG does not create instantiations of templated classes whenever
- it sees a templated class reference (say, as a return type, or
- in a parameter list).
-
- The %template directive results in a templated class instantiation
- that will actually be seen by <LANG> :: classHandler().
-
- In this case, we don't want to error if the type already exists;
- the point is to force the creation of wrappers for the templated
- class.
- */
- String *templated = Getattr(n, "template");
- String *t_name;
- // String *ns = listify_namespace(current_namespace);
-
- if (templated) {
- t_name = namespaced_name(n);
- } else {
- t_name = Getattr(n, "name");
- }
-
- Setattr(n, "allegrocl:namespace", current_namespace);
-
- /* Add this structure to the known lisp types.
- Class may contain references to the type currently being
- defined */
- if (!templated || !lookup_defined_foreign_type(t_name)) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Adding %s foreign type\n", Getattr(n, "sym:name"));
-#endif
- add_defined_foreign_type(n);
- } else {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "cppClassHand: type %s already exists. Assuming %%template instantiation for wrapping purposes.\n", Getattr(n, "sym:name"));
-#endif
- add_defined_foreign_type(n, 1);
- }
-
- // Generate slot accessors, constructor, and destructor.
- Node *prev_class = in_class;
- in_class = n;
-
- Node *c;
- // walk all member variables.
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " MANUALLY walking class members... \n");
-#endif
- for (c = firstChild(n); c; c = nextSibling(c)) {
- // ping the types of all children--even protected and private
- // so their types can be added to the linked_type_list.
- SwigType *childType = NewStringf("%s%s", Getattr(c, "decl"),
- Getattr(c, "type"));
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "looking at child '%p' of type '%s' '%d'\n", c, childType, SwigType_isfunction(childType));
- // Swig_print_node(c);
-#endif
- if (!SwigType_isfunction(childType))
- Delete(compose_foreign_type(n, childType));
-
- Delete(childType);
- }
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " MANUAL walk DONE.\n");
-#endif
-
- // this will walk all necessary methods.
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " LANGUAGE walk of children...\n");
-#endif
- Language::classHandler(n);
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " LANGUAGE walk DONE\n");
-#endif
- in_class = prev_class;
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::emit_one(Node *n) {
- // When the current package does not correspond with the current
- // namespace we need to generate an IN-PACKAGE form, unless the
- // current node is another namespace node.
- if (Cmp(nodeType(n), "namespace") != 0 && Cmp(current_package, current_namespace) != 0) {
- String *lispy_namespace = listify_namespace(current_namespace);
- Printf(f_clwrap, "(swig-in-package %s)\n", lispy_namespace);
- Delete(lispy_namespace);
- Delete(current_package);
- current_package = NewStringf("%s", current_namespace);
- }
-
- Setattr(n, "allegrocl:package", current_package);
-
- return Language::emit_one(n);
-}
-
-int ALLEGROCL::enumDeclaration(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "enumDeclaration %s\n", Getattr(n, "name"));
-#endif
-
- if (getCurrentClass() && (cplus_mode != PUBLIC))
- return SWIG_NOWRAP;
-
- if (Getattr(n, "sym:name")) {
- add_defined_foreign_type(n);
- }
- Node *c;
- for (c = firstChild(n); c; c = nextSibling(c)) {
- ALLEGROCL::enumvalueDeclaration(c);
- // since we walk our own children, we need to add
- // the current package ourselves.
- Setattr(c, "allegrocl:package", current_package);
- }
- return SWIG_OK;
-}
-
-
-int ALLEGROCL::enumvalueDeclaration(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "enumvalueDeclaration %s\n", Getattr(n, "name"));
-#endif
- /* print this when in C mode? make this a command-line arg? */
- if (Generate_Wrapper) {
- SwigType *enum_type = Copy(Getattr(n,"type"));
- String *mangled_name =
- mangle_name(n, "ACL_ENUM",
- in_class ? Getattr(in_class,"name") :
- current_namespace);
-
- SwigType_add_qualifier(enum_type,"const");
-
- String *enum_decl = SwigType_str(enum_type, mangled_name);
- Printf(f_cxx_wrapper, "EXPORT %s;\n", enum_decl);
- Printf(f_cxx_wrapper, "%s = %s;\n", enum_decl, Getattr(n, "value"));
-
- Delete(mangled_name);
- Delete(enum_type);
- Delete(enum_decl);
- }
- return SWIG_OK;
-}
-
-int ALLEGROCL::templateDeclaration(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "templateDeclaration %s\n", Getattr(n, "name"));
-#endif
-
- String *type = Getattr(n, "templatetype");
-
- // Printf(stderr, "tempDecl: %s %s\n", Getattr(n,"name"),
- // type);
- // Swig_print_node(n);
-
- if (!Strcmp(type, "cdecl")) {
- SwigType *ty = NewStringf("%s%s", Getattr(n, "decl"),
- Getattr(n, "type"));
- Delete(ty);
- }
-
- Delete(type);
-
- return SWIG_OK;
-}
-
diff --git a/Source/Modules/cffi.cxx b/Source/Modules/cffi.cxx
index 7f584db..6333fa1 100644
--- a/Source/Modules/cffi.cxx
+++ b/Source/Modules/cffi.cxx
@@ -227,7 +227,7 @@
int CFFI::constructorHandler(Node *n) {
#ifdef CFFI_DEBUG
Printf(stderr, "constructor %s\n", Getattr(n, "name"));
- Printf(stderr, "constructor %s\n and %s and %s", Getattr(n, "kind"), Getattr(n, "sym:name"), Getattr(n, "allegrocl:old-sym:name"));
+ Printf(stderr, "constructor %s\n and %s", Getattr(n, "kind"), Getattr(n, "sym:name"));
#endif
Setattr(n, "cffi:constructorfunction", "1");
// Let SWIG generate a global forwarding function.
diff --git a/Source/Modules/chicken.cxx b/Source/Modules/chicken.cxx
deleted file mode 100644
index 3f4bff3..0000000
--- a/Source/Modules/chicken.cxx
+++ /dev/null
@@ -1,1516 +0,0 @@
-/* -----------------------------------------------------------------------------
- * This file is part of SWIG, which is licensed as a whole under version 3
- * (or any later version) of the GNU General Public License. Some additional
- * terms also apply to certain portions of SWIG. The full details of the SWIG
- * license and copyrights can be found in the LICENSE and COPYRIGHT files
- * included with the SWIG source code as distributed by the SWIG developers
- * and at http://www.swig.org/legal.html.
- *
- * chicken.cxx
- *
- * CHICKEN language module for SWIG.
- * ----------------------------------------------------------------------------- */
-
-#include "swigmod.h"
-
-#include <ctype.h>
-
-static const char *usage = "\
-\
-CHICKEN Options (available with -chicken)\n\
- -closprefix <prefix> - Prepend <prefix> to all clos identifiers\n\
- -noclosuses - Do not (declare (uses ...)) in scheme file\n\
- -nocollection - Do not register pointers with chicken garbage\n\
- collector and export destructors\n\
- -nounit - Do not (declare (unit ...)) in scheme file\n\
- -proxy - Export TinyCLOS class definitions\n\
- -unhideprimitive - Unhide the primitive: symbols\n\
- -useclassprefix - Prepend the class name to all clos identifiers\n\
-\n";
-
-static char *module = 0;
-static const char *chicken_path = "chicken";
-static int num_methods = 0;
-
-static File *f_begin = 0;
-static File *f_runtime = 0;
-static File *f_header = 0;
-static File *f_wrappers = 0;
-static File *f_init = 0;
-static String *chickentext = 0;
-static String *closprefix = 0;
-static String *swigtype_ptr = 0;
-
-
-static String *f_sym_size = 0;
-
-/* some options */
-static int declare_unit = 1;
-static int no_collection = 0;
-static int clos_uses = 1;
-
-/* C++ Support + Clos Classes */
-static int clos = 0;
-static String *c_class_name = 0;
-static String *class_name = 0;
-static String *short_class_name = 0;
-
-static int in_class = 0;
-static int have_constructor = 0;
-static bool exporting_destructor = false;
-static bool exporting_constructor = false;
-static String *constructor_name = 0;
-static String *member_name = 0;
-
-/* sections of the .scm code */
-static String *scm_const_defs = 0;
-static String *clos_class_defines = 0;
-static String *clos_methods = 0;
-
-/* Some clos options */
-static int useclassprefix = 0;
-static String *clossymnameprefix = 0;
-static int hide_primitive = 1;
-static Hash *primitive_names = 0;
-
-/* Used for overloading constructors */
-static int has_constructor_args = 0;
-static List *constructor_arg_types = 0;
-static String *constructor_dispatch = 0;
-
-static Hash *overload_parameter_lists = 0;
-
-class CHICKEN:public Language {
-public:
-
- virtual void main(int argc, char *argv[]);
- virtual int top(Node *n);
- virtual int functionWrapper(Node *n);
- virtual int variableWrapper(Node *n);
- virtual int constantWrapper(Node *n);
- virtual int classHandler(Node *n);
- virtual int memberfunctionHandler(Node *n);
- virtual int membervariableHandler(Node *n);
- virtual int constructorHandler(Node *n);
- virtual int destructorHandler(Node *n);
- virtual int validIdentifier(String *s);
- virtual int staticmembervariableHandler(Node *n);
- virtual int staticmemberfunctionHandler(Node *n);
- virtual int importDirective(Node *n);
-
-protected:
- void addMethod(String *scheme_name, String *function);
- /* Return true iff T is a pointer type */
- int isPointer(SwigType *t);
- void dispatchFunction(Node *n);
-
- String *chickenNameMapping(String *, const_String_or_char_ptr );
- String *chickenPrimitiveName(String *);
-
- String *runtimeCode();
- String *defaultExternalRuntimeFilename();
- String *buildClosFunctionCall(List *types, const_String_or_char_ptr closname, const_String_or_char_ptr funcname);
-};
-
-/* -----------------------------------------------------------------------
- * swig_chicken() - Instantiate module
- * ----------------------------------------------------------------------- */
-
-static Language *new_swig_chicken() {
- return new CHICKEN();
-}
-
-extern "C" {
- Language *swig_chicken(void) {
- return new_swig_chicken();
- }
-}
-
-void CHICKEN::main(int argc, char *argv[]) {
- int i;
-
- SWIG_library_directory(chicken_path);
-
- // Look for certain command line options
- for (i = 1; i < argc; i++) {
- if (argv[i]) {
- if (strcmp(argv[i], "-help") == 0) {
- fputs(usage, stdout);
- SWIG_exit(0);
- } else if (strcmp(argv[i], "-proxy") == 0) {
- clos = 1;
- Swig_mark_arg(i);
- } else if (strcmp(argv[i], "-closprefix") == 0) {
- if (argv[i + 1]) {
- clossymnameprefix = NewString(argv[i + 1]);
- Swig_mark_arg(i);
- Swig_mark_arg(i + 1);
- i++;
- } else {
- Swig_arg_error();
- }
- } else if (strcmp(argv[i], "-useclassprefix") == 0) {
- useclassprefix = 1;
- Swig_mark_arg(i);
- } else if (strcmp(argv[i], "-unhideprimitive") == 0) {
- hide_primitive = 0;
- Swig_mark_arg(i);
- } else if (strcmp(argv[i], "-nounit") == 0) {
- declare_unit = 0;
- Swig_mark_arg(i);
- } else if (strcmp(argv[i], "-noclosuses") == 0) {
- clos_uses = 0;
- Swig_mark_arg(i);
- } else if (strcmp(argv[i], "-nocollection") == 0) {
- no_collection = 1;
- Swig_mark_arg(i);
- }
- }
- }
-
- if (!clos)
- hide_primitive = 0;
-
- // Add a symbol for this module
- Preprocessor_define("SWIGCHICKEN 1", 0);
-
- // Set name of typemaps
-
- SWIG_typemap_lang("chicken");
-
- // Read in default typemaps */
- SWIG_config_file("chicken.swg");
- allow_overloading();
-}
-
-int CHICKEN::top(Node *n) {
- String *chicken_filename = NewString("");
- File *f_scm;
- String *scmmodule;
-
- /* Initialize all of the output files */
- String *outfile = Getattr(n, "outfile");
-
- f_begin = NewFile(outfile, "w", SWIG_output_files());
- if (!f_begin) {
- FileErrorDisplay(outfile);
- SWIG_exit(EXIT_FAILURE);
- }
- f_runtime = NewString("");
- f_init = NewString("");
- f_header = NewString("");
- f_wrappers = NewString("");
- chickentext = NewString("");
- closprefix = NewString("");
- f_sym_size = NewString("");
- primitive_names = NewHash();
- overload_parameter_lists = NewHash();
-
- /* Register file targets with the SWIG file handler */
- Swig_register_filebyname("header", f_header);
- Swig_register_filebyname("wrapper", f_wrappers);
- Swig_register_filebyname("begin", f_begin);
- Swig_register_filebyname("runtime", f_runtime);
- Swig_register_filebyname("init", f_init);
-
- Swig_register_filebyname("chicken", chickentext);
- Swig_register_filebyname("closprefix", closprefix);
-
- clos_class_defines = NewString("");
- clos_methods = NewString("");
- scm_const_defs = NewString("");
-
- Swig_banner(f_begin);
-
- Printf(f_runtime, "\n\n#ifndef SWIGCHICKEN\n#define SWIGCHICKEN\n#endif\n\n");
-
- if (no_collection)
- Printf(f_runtime, "#define SWIG_CHICKEN_NO_COLLECTION 1\n");
-
- Printf(f_runtime, "\n");
-
- /* Set module name */
- module = Swig_copy_string(Char(Getattr(n, "name")));
- scmmodule = NewString(module);
- Replaceall(scmmodule, "_", "-");
-
- Printf(f_header, "#define SWIG_init swig_%s_init\n", module);
- Printf(f_header, "#define SWIG_name \"%s\"\n", scmmodule);
-
- Printf(f_wrappers, "#ifdef __cplusplus\n");
- Printf(f_wrappers, "extern \"C\" {\n");
- Printf(f_wrappers, "#endif\n\n");
-
- Language::top(n);
-
- SwigType_emit_type_table(f_runtime, f_wrappers);
-
- Printf(f_wrappers, "#ifdef __cplusplus\n");
- Printf(f_wrappers, "}\n");
- Printf(f_wrappers, "#endif\n");
-
- Printf(f_init, "C_kontinue (continuation, ret);\n");
- Printf(f_init, "}\n\n");
-
- Printf(f_init, "#ifdef __cplusplus\n");
- Printf(f_init, "}\n");
- Printf(f_init, "#endif\n");
-
- Printf(chicken_filename, "%s%s.scm", SWIG_output_directory(), module);
- if ((f_scm = NewFile(chicken_filename, "w", SWIG_output_files())) == 0) {
- FileErrorDisplay(chicken_filename);
- SWIG_exit(EXIT_FAILURE);
- }
-
- Swig_banner_target_lang(f_scm, ";;");
- Printf(f_scm, "\n");
-
- if (declare_unit)
- Printv(f_scm, "(declare (unit ", scmmodule, "))\n\n", NIL);
- Printv(f_scm, "(declare \n",
- tab4, "(hide swig-init swig-init-return)\n",
- tab4, "(foreign-declare \"C_extern void swig_", module, "_init(C_word,C_word,C_word) C_noret;\"))\n", NIL);
- Printv(f_scm, "(define swig-init (##core#primitive \"swig_", module, "_init\"))\n", NIL);
- Printv(f_scm, "(define swig-init-return (swig-init))\n\n", NIL);
-
- if (clos) {
- //Printf (f_scm, "(declare (uses tinyclos))\n");
- //New chicken versions have tinyclos as an egg
- Printf(f_scm, "(require-extension tinyclos)\n");
- Replaceall(closprefix, "$module", scmmodule);
- Printf(f_scm, "%s\n", closprefix);
- Printf(f_scm, "%s\n", clos_class_defines);
- Printf(f_scm, "%s\n", clos_methods);
- } else {
- Printf(f_scm, "%s\n", scm_const_defs);
- }
-
- Printf(f_scm, "%s\n", chickentext);
-
- Delete(f_scm);
-
- char buftmp[20];
- sprintf(buftmp, "%d", num_methods);
- Replaceall(f_init, "$nummethods", buftmp);
- Replaceall(f_init, "$symsize", f_sym_size);
-
- if (hide_primitive)
- Replaceall(f_init, "$veclength", buftmp);
- else
- Replaceall(f_init, "$veclength", "0");
-
- Delete(chicken_filename);
- Delete(chickentext);
- Delete(closprefix);
- Delete(overload_parameter_lists);
-
- Delete(clos_class_defines);
- Delete(clos_methods);
- Delete(scm_const_defs);
-
- /* Close all of the files */
- Delete(primitive_names);
- Delete(scmmodule);
- Dump(f_runtime, f_begin);
- Dump(f_header, f_begin);
- Dump(f_wrappers, f_begin);
- Wrapper_pretty_print(f_init, f_begin);
- Delete(f_header);
- Delete(f_wrappers);
- Delete(f_sym_size);
- Delete(f_init);
- Delete(f_runtime);
- Delete(f_begin);
- return SWIG_OK;
-}
-
-int CHICKEN::functionWrapper(Node *n) {
-
- String *name = Getattr(n, "name");
- String *iname = Getattr(n, "sym:name");
- SwigType *d = Getattr(n, "type");
- ParmList *l = Getattr(n, "parms");
-
- Parm *p;
- int i;
- String *wname;
- Wrapper *f;
- String *mangle = NewString("");
- String *get_pointers;
- String *cleanup;
- String *argout;
- String *tm;
- String *overname = 0;
- String *declfunc = 0;
- String *scmname;
- bool any_specialized_arg = false;
- List *function_arg_types = NewList();
-
- int num_required;
- int num_arguments;
- int have_argout;
-
- Printf(mangle, "\"%s\"", SwigType_manglestr(d));
-
- if (Getattr(n, "sym:overloaded")) {
- overname = Getattr(n, "sym:overname");
- } else {
- if (!addSymbol(iname, n))
- return SWIG_ERROR;
- }
-
- f = NewWrapper();
- wname = NewString("");
- get_pointers = NewString("");
- cleanup = NewString("");
- argout = NewString("");
- declfunc = NewString("");
- scmname = NewString(iname);
- Replaceall(scmname, "_", "-");
-
- /* Local vars */
- Wrapper_add_local(f, "resultobj", "C_word resultobj");
-
- /* Write code to extract function parameters. */
- emit_parameter_variables(l, f);
-
- /* Attach the standard typemaps */
- emit_attach_parmmaps(l, f);
- Setattr(n, "wrap:parms", l);
-
- /* Get number of required and total arguments */
- num_arguments = emit_num_arguments(l);
- num_required = emit_num_required(l);
-
- Append(wname, Swig_name_wrapper(iname));
- if (overname) {
- Append(wname, overname);
- }
- // Check for interrupts
- Printv(f->code, "C_trace(\"", scmname, "\");\n", NIL);
-
- Printv(f->def, "static ", "void ", wname, " (C_word argc, C_word closure, C_word continuation", NIL);
- Printv(declfunc, "void ", wname, "(C_word,C_word,C_word", NIL);
-
- /* Generate code for argument marshalling */
- for (i = 0, p = l; i < num_arguments; i++) {
-
- while (checkAttribute(p, "tmap:in:numinputs", "0")) {
- p = Getattr(p, "tmap:in:next");
- }
-
- SwigType *pt = Getattr(p, "type");
-
- Printf(f->def, ", C_word scm%d", i + 1);
- Printf(declfunc, ",C_word");
-
- /* Look for an input typemap */
- if ((tm = Getattr(p, "tmap:in"))) {
- String *parse = Getattr(p, "tmap:in:parse");
- if (!parse) {
- String *source = NewStringf("scm%d", i + 1);
- Replaceall(tm, "$input", source);
- Setattr(p, "emit:input", source); /* Save the location of
- the object */
-
- if (Getattr(p, "wrap:disown") || (Getattr(p, "tmap:in:disown"))) {
- Replaceall(tm, "$disown", "SWIG_POINTER_DISOWN");
- } else {
- Replaceall(tm, "$disown", "0");
- }
-
- if (i >= num_required)
- Printf(get_pointers, "if (argc-2>%i && (%s)) {\n", i, source);
- Printv(get_pointers, tm, "\n", NIL);
- if (i >= num_required)
- Printv(get_pointers, "}\n", NIL);
-
- if (clos) {
- if (i < num_required) {
- if (strcmp("void", Char(pt)) != 0) {
- Node *class_node = 0;
- String *clos_code = Getattr(p, "tmap:in:closcode");
- class_node = classLookup(pt);
- if (clos_code && class_node) {
- String *class_name = NewStringf("<%s>", Getattr(class_node, "sym:name"));
- Replaceall(class_name, "_", "-");
- Append(function_arg_types, class_name);
- Append(function_arg_types, Copy(clos_code));
- any_specialized_arg = true;
- Delete(class_name);
- } else {
- Append(function_arg_types, "<top>");
- Append(function_arg_types, "$input");
- }
- }
- }
- }
- Delete(source);
- }
-
- p = Getattr(p, "tmap:in:next");
- continue;
- } else {
- Swig_warning(WARN_TYPEMAP_IN_UNDEF, input_file, line_number, "Unable to use type %s as a function argument.\n", SwigType_str(pt, 0));
- break;
- }
- }
-
- /* finish argument marshalling */
-
- Printf(f->def, ") {");
- Printf(declfunc, ")");
-
- if (num_required != num_arguments) {
- Append(function_arg_types, "^^##optional$$");
- }
-
- /* First check the number of arguments is correct */
- if (num_arguments != num_required)
- Printf(f->code, "if (argc-2<%i || argc-2>%i) C_bad_argc(argc,%i);\n", num_required, num_arguments, num_required + 2);
- else
- Printf(f->code, "if (argc!=%i) C_bad_argc(argc,%i);\n", num_arguments + 2, num_arguments + 2);
-
- /* Now piece together the first part of the wrapper function */
- Printv(f->code, get_pointers, NIL);
-
- /* Insert constraint checking code */
- for (p = l; p;) {
- if ((tm = Getattr(p, "tmap:check"))) {
- Printv(f->code, tm, "\n", NIL);
- p = Getattr(p, "tmap:check:next");
- } else {
- p = nextSibling(p);
- }
- }
-
- /* Insert cleanup code */
- for (p = l; p;) {
- if ((tm = Getattr(p, "tmap:freearg"))) {
- Printv(cleanup, tm, "\n", NIL);
- p = Getattr(p, "tmap:freearg:next");
- } else {
- p = nextSibling(p);
- }
- }
-
- /* Insert argument output code */
- have_argout = 0;
- for (p = l; p;) {
- if ((tm = Getattr(p, "tmap:argout"))) {
-
- if (!have_argout) {
- have_argout = 1;
- // Print initial argument output code
- Printf(argout, "SWIG_Chicken_SetupArgout\n");
- }
-
- Replaceall(tm, "$arg", Getattr(p, "emit:input"));
- Replaceall(tm, "$input", Getattr(p, "emit:input"));
- Printf(argout, "%s", tm);
- p = Getattr(p, "tmap:argout:next");
- } else {
- p = nextSibling(p);
- }
- }
-
- Setattr(n, "wrap:name", wname);
-
- /* Emit the function call */
- String *actioncode = emit_action(n);
-
- /* Return the function value */
- if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) {
- Replaceall(tm, "$result", "resultobj");
- if (GetFlag(n, "feature:new")) {
- Replaceall(tm, "$owner", "1");
- } else {
- Replaceall(tm, "$owner", "0");
- }
-
- Printf(f->code, "%s", tm);
-
- if (have_argout)
- Printf(f->code, "\nSWIG_APPEND_VALUE(resultobj);\n");
-
- } else {
- Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number, "Unable to use return type %s in function %s.\n", SwigType_str(d, 0), name);
- }
- emit_return_variable(n, d, f);
-
- /* Insert the argument output code */
- Printv(f->code, argout, NIL);
-
- /* Output cleanup code */
- Printv(f->code, cleanup, NIL);
-
- /* Look to see if there is any newfree cleanup code */
- if (GetFlag(n, "feature:new")) {
- if ((tm = Swig_typemap_lookup("newfree", n, Swig_cresult_name(), 0))) {
- Printf(f->code, "%s\n", tm);
- }
- }
-
- /* See if there is any return cleanup code */
- if ((tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0))) {
- Printf(f->code, "%s\n", tm);
- }
-
-
- if (have_argout) {
- Printf(f->code, "C_kontinue(continuation,C_SCHEME_END_OF_LIST);\n");
- } else {
- if (exporting_constructor && clos && hide_primitive) {
- /* Don't return a proxy, the wrapped CLOS class is the proxy */
- Printf(f->code, "C_kontinue(continuation,resultobj);\n");
- } else {
- // make the continuation the proxy creation function, if one exists
- Printv(f->code, "{\n",
- "C_word func;\n",
- "SWIG_Chicken_FindCreateProxy(func, resultobj)\n",
- "if (C_swig_is_closurep(func))\n",
- " ((C_proc4)(void *)C_block_item(func, 0))(4,func,continuation,resultobj,C_SCHEME_FALSE);\n",
- "else\n", " C_kontinue(continuation, resultobj);\n", "}\n", NIL);
- }
- }
-
- /* Error handling code */
-#ifdef USE_FAIL
- Printf(f->code, "fail:\n");
- Printv(f->code, cleanup, NIL);
- Printf(f->code, "swig_panic (\"failure in " "'$symname' SWIG function wrapper\");\n");
-#endif
- Printf(f->code, "}\n");
-
- /* Substitute the cleanup code */
- Replaceall(f->code, "$cleanup", cleanup);
-
- /* Substitute the function name */
- Replaceall(f->code, "$symname", iname);
- Replaceall(f->code, "$result", "resultobj");
-
- /* Dump the function out */
- Printv(f_wrappers, "static ", declfunc, " C_noret;\n", NIL);
- Wrapper_print(f, f_wrappers);
-
- /* Now register the function with the interpreter. */
- if (!Getattr(n, "sym:overloaded")) {
- if (exporting_destructor && !no_collection) {
- Printf(f_init, "((swig_chicken_clientdata *)(SWIGTYPE%s->clientdata))->destroy = (swig_chicken_destructor) %s;\n", swigtype_ptr, wname);
- } else {
- addMethod(scmname, wname);
- }
-
- /* Only export if we are not in a class, or if in a class memberfunction */
- if (!in_class || member_name) {
- String *method_def;
- String *clos_name;
- if (in_class)
- clos_name = NewString(member_name);
- else
- clos_name = chickenNameMapping(scmname, "");
-
- if (!any_specialized_arg) {
- method_def = NewString("");
- Printv(method_def, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")", NIL);
- } else {
- method_def = buildClosFunctionCall(function_arg_types, clos_name, chickenPrimitiveName(scmname));
- }
- Printv(clos_methods, method_def, "\n", NIL);
- Delete(clos_name);
- Delete(method_def);
- }
-
- if (have_constructor && !has_constructor_args && any_specialized_arg) {
- has_constructor_args = 1;
- constructor_arg_types = Copy(function_arg_types);
- }
- } else {
- /* add function_arg_types to overload hash */
- List *flist = Getattr(overload_parameter_lists, scmname);
- if (!flist) {
- flist = NewList();
- Setattr(overload_parameter_lists, scmname, flist);
- }
-
- Append(flist, Copy(function_arg_types));
-
- if (!Getattr(n, "sym:nextSibling")) {
- dispatchFunction(n);
- }
- }
-
-
- Delete(wname);
- Delete(get_pointers);
- Delete(cleanup);
- Delete(declfunc);
- Delete(mangle);
- Delete(function_arg_types);
- DelWrapper(f);
- return SWIG_OK;
-}
-
-int CHICKEN::variableWrapper(Node *n) {
- char *name = GetChar(n, "name");
- char *iname = GetChar(n, "sym:name");
- SwigType *t = Getattr(n, "type");
- ParmList *l = Getattr(n, "parms");
-
- String *wname = NewString("");
- String *mangle = NewString("");
- String *tm;
- String *tm2 = NewString("");
- String *argnum = NewString("0");
- String *arg = NewString("argv[0]");
- Wrapper *f;
- String *overname = 0;
- String *scmname;
-
- scmname = NewString(iname);
- Replaceall(scmname, "_", "-");
-
- Printf(mangle, "\"%s\"", SwigType_manglestr(t));
-
- if (Getattr(n, "sym:overloaded")) {
- overname = Getattr(n, "sym:overname");
- } else {
- if (!addSymbol(iname, n))
- return SWIG_ERROR;
- }
-
- f = NewWrapper();
-
- /* Attach the standard typemaps */
- emit_attach_parmmaps(l, f);
- Setattr(n, "wrap:parms", l);
-
- // evaluation function names
- Append(wname, Swig_name_wrapper(iname));
- if (overname) {
- Append(wname, overname);
- }
- Setattr(n, "wrap:name", wname);
-
- // Check for interrupts
- Printv(f->code, "C_trace(\"", scmname, "\");\n", NIL);
-
- if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) {
-
- Printv(f->def, "static ", "void ", wname, "(C_word, C_word, C_word, C_word) C_noret;\n", NIL);
- Printv(f->def, "static " "void ", wname, "(C_word argc, C_word closure, " "C_word continuation, C_word value) {\n", NIL);
-
- Wrapper_add_local(f, "resultobj", "C_word resultobj");
-
- Printf(f->code, "if (argc!=2 && argc!=3) C_bad_argc(argc,2);\n");
-
- /* Check for a setting of the variable value */
- if (!GetFlag(n, "feature:immutable")) {
- Printf(f->code, "if (argc > 2) {\n");
- if ((tm = Swig_typemap_lookup("varin", n, name, 0))) {
- Replaceall(tm, "$input", "value");
- /* Printv(f->code, tm, "\n",NIL); */
- emit_action_code(n, f->code, tm);
- } else {
- Swig_warning(WARN_TYPEMAP_VARIN_UNDEF, input_file, line_number, "Unable to set variable of type %s.\n", SwigType_str(t, 0));
- }
- Printf(f->code, "}\n");
- }
-
- String *varname;
- if (SwigType_istemplate((char *) name)) {
- varname = SwigType_namestr((char *) name);
- } else {
- varname = name;
- }
-
- // Now return the value of the variable - regardless
- // of evaluating or setting.
- if ((tm = Swig_typemap_lookup("varout", n, name, 0))) {
- Replaceall(tm, "$varname", varname);
- Replaceall(tm, "$result", "resultobj");
- /* Printf(f->code, "%s\n", tm); */
- emit_action_code(n, f->code, tm);
- } else {
- Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number, "Unable to read variable of type %s\n", SwigType_str(t, 0));
- }
-
- Printv(f->code, "{\n",
- "C_word func;\n",
- "SWIG_Chicken_FindCreateProxy(func, resultobj)\n",
- "if (C_swig_is_closurep(func))\n",
- " ((C_proc4)(void *)C_block_item(func, 0))(4,func,continuation,resultobj,C_SCHEME_FALSE);\n",
- "else\n", " C_kontinue(continuation, resultobj);\n", "}\n", NIL);
-
- /* Error handling code */
-#ifdef USE_FAIL
- Printf(f->code, "fail:\n");
- Printf(f->code, "swig_panic (\"failure in " "'%s' SWIG wrapper\");\n", proc_name);
-#endif
- Printf(f->code, "}\n");
-
- Wrapper_print(f, f_wrappers);
-
- /* Now register the variable with the interpreter. */
- addMethod(scmname, wname);
-
- if (!in_class || member_name) {
- String *clos_name;
- if (in_class)
- clos_name = NewString(member_name);
- else
- clos_name = chickenNameMapping(scmname, "");
-
- Node *class_node = classLookup(t);
- String *clos_code = Getattr(n, "tmap:varin:closcode");
- if (class_node && clos_code && !GetFlag(n, "feature:immutable")) {
- Replaceall(clos_code, "$input", "(car lst)");
- Printv(clos_methods, "(define (", clos_name, " . lst) (if (null? lst) (", chickenPrimitiveName(scmname), ") (",
- chickenPrimitiveName(scmname), " ", clos_code, ")))\n", NIL);
- } else {
- /* Simply re-export the procedure */
- if (GetFlag(n, "feature:immutable") && GetFlag(n, "feature:constasvar")) {
- Printv(clos_methods, "(define ", clos_name, " (", chickenPrimitiveName(scmname), "))\n", NIL);
- Printv(scm_const_defs, "(set! ", scmname, " (", scmname, "))\n", NIL);
- } else {
- Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
- }
- }
- Delete(clos_name);
- }
- } else {
- Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number, "Unsupported variable type %s (ignored).\n", SwigType_str(t, 0));
- }
-
- Delete(wname);
- Delete(argnum);
- Delete(arg);
- Delete(tm2);
- Delete(mangle);
- DelWrapper(f);
- return SWIG_OK;
-}
-
-/* ------------------------------------------------------------
- * constantWrapper()
- * ------------------------------------------------------------ */
-
-int CHICKEN::constantWrapper(Node *n) {
-
- char *name = GetChar(n, "name");
- char *iname = GetChar(n, "sym:name");
- SwigType *t = Getattr(n, "type");
- ParmList *l = Getattr(n, "parms");
- String *value = Getattr(n, "value");
-
- String *proc_name = NewString("");
- String *wname = NewString("");
- String *mangle = NewString("");
- String *tm;
- String *tm2 = NewString("");
- String *source = NewString("");
- String *argnum = NewString("0");
- String *arg = NewString("argv[0]");
- Wrapper *f;
- String *overname = 0;
- String *scmname;
- String *rvalue;
- SwigType *nctype;
-
- scmname = NewString(iname);
- Replaceall(scmname, "_", "-");
-
- Printf(source, "swig_const_%s", iname);
- Replaceall(source, "::", "__");
-
- Printf(mangle, "\"%s\"", SwigType_manglestr(t));
-
- if (Getattr(n, "sym:overloaded")) {
- overname = Getattr(n, "sym:overname");
- } else {
- if (!addSymbol(iname, n))
- return SWIG_ERROR;
- }
-
- Append(wname, Swig_name_wrapper(iname));
- if (overname) {
- Append(wname, overname);
- }
-
- nctype = NewString(t);
- if (SwigType_isconst(nctype)) {
- Delete(SwigType_pop(nctype));
- }
-
- bool is_enum_item = (Cmp(nodeType(n), "enumitem") == 0);
- if (SwigType_type(nctype) == T_STRING) {
- rvalue = NewStringf("\"%s\"", value);
- } else if (SwigType_type(nctype) == T_CHAR && !is_enum_item) {
- rvalue = NewStringf("\'%s\'", value);
- } else {
- rvalue = NewString(value);
- }
-
- /* Special hook for member pointer */
- if (SwigType_type(t) == T_MPOINTER) {
- Printf(f_header, "static %s = %s;\n", SwigType_str(t, source), rvalue);
- } else {
- if ((tm = Swig_typemap_lookup("constcode", n, name, 0))) {
- Replaceall(tm, "$result", source);
- Replaceall(tm, "$value", rvalue);
- Printf(f_header, "%s\n", tm);
- } else {
- Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number, "Unsupported constant value.\n");
- return SWIG_NOWRAP;
- }
- }
-
- f = NewWrapper();
-
- /* Attach the standard typemaps */
- emit_attach_parmmaps(l, f);
- Setattr(n, "wrap:parms", l);
-
- // evaluation function names
-
- // Check for interrupts
- Printv(f->code, "C_trace(\"", scmname, "\");\n", NIL);
-
- if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) {
-
- Setattr(n, "wrap:name", wname);
- Printv(f->def, "static ", "void ", wname, "(C_word, C_word, C_word) C_noret;\n", NIL);
-
- Printv(f->def, "static ", "void ", wname, "(C_word argc, C_word closure, " "C_word continuation) {\n", NIL);
-
- Wrapper_add_local(f, "resultobj", "C_word resultobj");
-
- Printf(f->code, "if (argc!=2) C_bad_argc(argc,2);\n");
-
- // Return the value of the variable
- if ((tm = Swig_typemap_lookup("varout", n, name, 0))) {
-
- Replaceall(tm, "$varname", source);
- Replaceall(tm, "$result", "resultobj");
- /* Printf(f->code, "%s\n", tm); */
- emit_action_code(n, f->code, tm);
- } else {
- Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number, "Unable to read variable of type %s\n", SwigType_str(t, 0));
- }
-
- Printv(f->code, "{\n",
- "C_word func;\n",
- "SWIG_Chicken_FindCreateProxy(func, resultobj)\n",
- "if (C_swig_is_closurep(func))\n",
- " ((C_proc4)(void *)C_block_item(func, 0))(4,func,continuation,resultobj,C_SCHEME_FALSE);\n",
- "else\n", " C_kontinue(continuation, resultobj);\n", "}\n", NIL);
-
- /* Error handling code */
-#ifdef USE_FAIL
- Printf(f->code, "fail:\n");
- Printf(f->code, "swig_panic (\"failure in " "'%s' SWIG wrapper\");\n", proc_name);
-#endif
- Printf(f->code, "}\n");
-
- Wrapper_print(f, f_wrappers);
-
- /* Now register the variable with the interpreter. */
- addMethod(scmname, wname);
-
- if (!in_class || member_name) {
- String *clos_name;
- if (in_class)
- clos_name = NewString(member_name);
- else
- clos_name = chickenNameMapping(scmname, "");
- if (GetFlag(n, "feature:constasvar")) {
- Printv(clos_methods, "(define ", clos_name, " (", chickenPrimitiveName(scmname), "))\n", NIL);
- Printv(scm_const_defs, "(set! ", scmname, " (", scmname, "))\n", NIL);
- } else {
- Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
- }
- Delete(clos_name);
- }
-
- } else {
- Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number, "Unsupported variable type %s (ignored).\n", SwigType_str(t, 0));
- }
-
- Delete(wname);
- Delete(nctype);
- Delete(proc_name);
- Delete(argnum);
- Delete(arg);
- Delete(tm2);
- Delete(mangle);
- Delete(source);
- Delete(rvalue);
- DelWrapper(f);
- return SWIG_OK;
-}
-
-int CHICKEN::classHandler(Node *n) {
- /* Create new strings for building up a wrapper function */
- have_constructor = 0;
- constructor_dispatch = 0;
- constructor_name = 0;
-
- c_class_name = NewString(Getattr(n, "sym:name"));
- class_name = NewString("");
- short_class_name = NewString("");
- Printv(class_name, "<", c_class_name, ">", NIL);
- Printv(short_class_name, c_class_name, NIL);
- Replaceall(class_name, "_", "-");
- Replaceall(short_class_name, "_", "-");
-
- if (!addSymbol(class_name, n))
- return SWIG_ERROR;
-
- /* Handle inheritance */
- String *base_class = NewString("");
- List *baselist = Getattr(n, "bases");
- if (baselist && Len(baselist)) {
- Iterator base = First(baselist);
- while (base.item) {
- if (!Getattr(base.item, "feature:ignore"))
- Printv(base_class, "<", Getattr(base.item, "sym:name"), "> ", NIL);
- base = Next(base);
- }
- }
-
- Replaceall(base_class, "_", "-");
-
- String *scmmod = NewString(module);
- Replaceall(scmmod, "_", "-");
-
- Printv(clos_class_defines, "(define ", class_name, "\n", " (make <swig-metaclass-", scmmod, "> 'name \"", short_class_name, "\"\n", NIL);
- Delete(scmmod);
-
- if (Len(base_class)) {
- Printv(clos_class_defines, " 'direct-supers (list ", base_class, ")\n", NIL);
- } else {
- Printv(clos_class_defines, " 'direct-supers (list <object>)\n", NIL);
- }
-
- Printf(clos_class_defines, " 'direct-slots (list 'swig-this\n");
-
- String *mangled_classname = Swig_name_mangle(Getattr(n, "sym:name"));
-
- SwigType *ct = NewStringf("p.%s", Getattr(n, "name"));
- swigtype_ptr = SwigType_manglestr(ct);
-
- Printf(f_runtime, "static swig_chicken_clientdata _swig_chicken_clientdata%s = { 0 };\n", mangled_classname);
- Printv(f_init, "SWIG_TypeClientData(SWIGTYPE", swigtype_ptr, ", (void *) &_swig_chicken_clientdata", mangled_classname, ");\n", NIL);
- SwigType_remember(ct);
-
- /* Emit all of the members */
-
- in_class = 1;
- Language::classHandler(n);
- in_class = 0;
-
- Printf(clos_class_defines, ")))\n\n");
-
- if (have_constructor) {
- Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n", " (swig-initialize obj initargs ", NIL);
- if (constructor_arg_types) {
- String *initfunc_name = NewStringf("%s@@SWIG@initmethod", class_name);
- String *func_call = buildClosFunctionCall(constructor_arg_types, initfunc_name, chickenPrimitiveName(constructor_name));
- Printf(clos_methods, "%s)\n)\n", initfunc_name);
- Printf(clos_methods, "(declare (hide %s))\n", initfunc_name);
- Printf(clos_methods, "%s\n", func_call);
- Delete(func_call);
- Delete(initfunc_name);
- Delete(constructor_arg_types);
- constructor_arg_types = 0;
- } else if (constructor_dispatch) {
- Printf(clos_methods, "%s)\n)\n", constructor_dispatch);
- Delete(constructor_dispatch);
- constructor_dispatch = 0;
- } else {
- Printf(clos_methods, "%s)\n)\n", chickenPrimitiveName(constructor_name));
- }
- Delete(constructor_name);
- constructor_name = 0;
- } else {
- Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n", " (swig-initialize obj initargs (lambda x #f)))\n", NIL);
- }
-
- /* export class initialization function */
- if (clos) {
- String *funcname = NewString(mangled_classname);
- Printf(funcname, "_swig_chicken_setclosclass");
- String *closfuncname = NewString(funcname);
- Replaceall(closfuncname, "_", "-");
-
- Printv(f_wrappers, "static void ", funcname, "(C_word,C_word,C_word,C_word) C_noret;\n",
- "static void ", funcname, "(C_word argc, C_word closure, C_word continuation, C_word cl) {\n",
- " C_trace(\"", funcname, "\");\n",
- " if (argc!=3) C_bad_argc(argc,3);\n",
- " swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) SWIGTYPE", swigtype_ptr, "->clientdata;\n",
- " cdata->gc_proxy_create = CHICKEN_new_gc_root();\n",
- " CHICKEN_gc_root_set(cdata->gc_proxy_create, cl);\n", " C_kontinue(continuation, C_SCHEME_UNDEFINED);\n", "}\n", NIL);
- addMethod(closfuncname, funcname);
-
- Printv(clos_methods, "(", chickenPrimitiveName(closfuncname), " (lambda (x lst) (if lst ",
- "(cons (make ", class_name, " 'swig-this x) lst) ", "(make ", class_name, " 'swig-this x))))\n\n", NIL);
- Delete(closfuncname);
- Delete(funcname);
- }
-
- Delete(mangled_classname);
- Delete(swigtype_ptr);
- swigtype_ptr = 0;
-
- Delete(class_name);
- Delete(short_class_name);
- Delete(c_class_name);
- class_name = 0;
- short_class_name = 0;
- c_class_name = 0;
-
- return SWIG_OK;
-}
-
-int CHICKEN::memberfunctionHandler(Node *n) {
- String *iname = Getattr(n, "sym:name");
- String *proc = NewString(iname);
- Replaceall(proc, "_", "-");
-
- member_name = chickenNameMapping(proc, short_class_name);
- Language::memberfunctionHandler(n);
- Delete(member_name);
- member_name = NULL;
- Delete(proc);
-
- return SWIG_OK;
-}
-
-int CHICKEN::staticmemberfunctionHandler(Node *n) {
- String *iname = Getattr(n, "sym:name");
- String *proc = NewString(iname);
- Replaceall(proc, "_", "-");
-
- member_name = NewStringf("%s-%s", short_class_name, proc);
- Language::staticmemberfunctionHandler(n);
- Delete(member_name);
- member_name = NULL;
- Delete(proc);
-
- return SWIG_OK;
-}
-
-int CHICKEN::membervariableHandler(Node *n) {
- String *iname = Getattr(n, "sym:name");
- //String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type")));
-
- Language::membervariableHandler(n);
-
- String *proc = NewString(iname);
- Replaceall(proc, "_", "-");
-
- //Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab"));
- Node *class_node = classLookup(Getattr(n, "type"));
-
- //String *getfunc = NewStringf("%s-%s-get", short_class_name, proc);
- //String *setfunc = NewStringf("%s-%s-set", short_class_name, proc);
- String *getfunc = Swig_name_get(NSPACE_TODO, Swig_name_member(NSPACE_TODO, c_class_name, iname));
- Replaceall(getfunc, "_", "-");
- String *setfunc = Swig_name_set(NSPACE_TODO, Swig_name_member(NSPACE_TODO, c_class_name, iname));
- Replaceall(setfunc, "_", "-");
-
- Printv(clos_class_defines, " (list '", proc, " ':swig-virtual ':swig-get ", chickenPrimitiveName(getfunc), NIL);
-
- if (!GetFlag(n, "feature:immutable")) {
- if (class_node) {
- Printv(clos_class_defines, " ':swig-set (lambda (x y) (", chickenPrimitiveName(setfunc), " x (slot-ref y 'swig-this))))\n", NIL);
- } else {
- Printv(clos_class_defines, " ':swig-set ", chickenPrimitiveName(setfunc), ")\n", NIL);
- }
- } else {
- Printf(clos_class_defines, ")\n");
- }
-
- Delete(proc);
- Delete(setfunc);
- Delete(getfunc);
- return SWIG_OK;
-}
-
-int CHICKEN::staticmembervariableHandler(Node *n) {
- String *iname = Getattr(n, "sym:name");
- String *proc = NewString(iname);
- Replaceall(proc, "_", "-");
-
- member_name = NewStringf("%s-%s", short_class_name, proc);
- Language::staticmembervariableHandler(n);
- Delete(member_name);
- member_name = NULL;
- Delete(proc);
-
- return SWIG_OK;
-}
-
-int CHICKEN::constructorHandler(Node *n) {
- have_constructor = 1;
- has_constructor_args = 0;
-
-
- exporting_constructor = true;
- Language::constructorHandler(n);
- exporting_constructor = false;
-
- has_constructor_args = 1;
-
- String *iname = Getattr(n, "sym:name");
- constructor_name = Swig_name_construct(NSPACE_TODO, iname);
- Replaceall(constructor_name, "_", "-");
- return SWIG_OK;
-}
-
-int CHICKEN::destructorHandler(Node *n) {
-
- if (no_collection)
- member_name = NewStringf("delete-%s", short_class_name);
-
- exporting_destructor = true;
- Language::destructorHandler(n);
- exporting_destructor = false;
-
- if (no_collection) {
- Delete(member_name);
- member_name = NULL;
- }
-
- return SWIG_OK;
-}
-
-int CHICKEN::importDirective(Node *n) {
- String *modname = Getattr(n, "module");
- if (modname && clos_uses) {
-
- // Find the module node for this imported module. It should be the
- // first child but search just in case.
- Node *mod = firstChild(n);
- while (mod && Strcmp(nodeType(mod), "module") != 0)
- mod = nextSibling(mod);
-
- if (mod) {
- String *name = Getattr(mod, "name");
- if (name) {
- Printf(closprefix, "(declare (uses %s))\n", name);
- }
- }
- }
-
- return Language::importDirective(n);
-}
-
-String *CHICKEN::buildClosFunctionCall(List *types, const_String_or_char_ptr closname, const_String_or_char_ptr funcname) {
- String *method_signature = NewString("");
- String *func_args = NewString("");
- String *func_call = NewString("");
-
- Iterator arg_type;
- int arg_count = 0;
- int optional_arguments = 0;
-
- for (arg_type = First(types); arg_type.item; arg_type = Next(arg_type)) {
- if (Strcmp(arg_type.item, "^^##optional$$") == 0) {
- optional_arguments = 1;
- } else {
- Printf(method_signature, " (arg%i %s)", arg_count, arg_type.item);
- arg_type = Next(arg_type);
- if (!arg_type.item)
- break;
-
- String *arg = NewStringf("arg%i", arg_count);
- String *access_arg = Copy(arg_type.item);
-
- Replaceall(access_arg, "$input", arg);
- Printf(func_args, " %s", access_arg);
-
- Delete(arg);
- Delete(access_arg);
- }
- arg_count++;
- }
-
- if (optional_arguments) {
- Printf(func_call, "(define-method (%s %s . args) (apply %s %s args))", closname, method_signature, funcname, func_args);
- } else {
- Printf(func_call, "(define-method (%s %s) (%s %s))", closname, method_signature, funcname, func_args);
- }
-
- Delete(method_signature);
- Delete(func_args);
-
- return func_call;
-}
-
-extern "C" {
-
- /* compares based on non-primitive names */
- static int compareTypeListsHelper(const DOH *a, const DOH *b, int opt_equal) {
- List *la = (List *) a;
- List *lb = (List *) b;
-
- Iterator ia = First(la);
- Iterator ib = First(lb);
-
- while (ia.item && ib.item) {
- int ret = Strcmp(ia.item, ib.item);
- if (ret)
- return ret;
- ia = Next(Next(ia));
- ib = Next(Next(ib));
- } if (opt_equal && ia.item && Strcmp(ia.item, "^^##optional$$") == 0)
- return 0;
- if (ia.item)
- return -1;
- if (opt_equal && ib.item && Strcmp(ib.item, "^^##optional$$") == 0)
- return 0;
- if (ib.item)
- return 1;
-
- return 0;
- }
-
- static int compareTypeLists(const DOH *a, const DOH *b) {
- return compareTypeListsHelper(a, b, 0);
- }
-}
-
-void CHICKEN::dispatchFunction(Node *n) {
- /* Last node in overloaded chain */
-
- int maxargs;
- String *tmp = NewString("");
- String *dispatch = Swig_overload_dispatch(n, "%s (2+$numargs,closure," "continuation$commaargs);", &maxargs);
-
- /* Generate a dispatch wrapper for all overloaded functions */
-
- Wrapper *f = NewWrapper();
- String *iname = Getattr(n, "sym:name");
- String *wname = NewString("");
- String *scmname = NewString(iname);
- Replaceall(scmname, "_", "-");
-
- Append(wname, Swig_name_wrapper(iname));
-
- Printv(f->def, "static void real_", wname, "(C_word, C_word, C_word, C_word) C_noret;\n", NIL);
-
- Printv(f->def, "static void real_", wname, "(C_word oldargc, C_word closure, C_word continuation, C_word args) {", NIL);
-
- Wrapper_add_local(f, "argc", "int argc");
- Printf(tmp, "C_word argv[%d]", maxargs + 1);
- Wrapper_add_local(f, "argv", tmp);
- Wrapper_add_local(f, "ii", "int ii");
- Wrapper_add_local(f, "t", "C_word t = args");
- Printf(f->code, "if (!C_swig_is_list (args)) {\n");
- Printf(f->code, " swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, " "\"Argument #1 must be a list of overloaded arguments\");\n");
- Printf(f->code, "}\n");
- Printf(f->code, "argc = C_unfix (C_i_length (args));\n");
- Printf(f->code, "for (ii = 0; (ii < argc) && (ii < %d); ii++, t = C_block_item (t, 1)) {\n", maxargs);
- Printf(f->code, "argv[ii] = C_block_item (t, 0);\n");
- Printf(f->code, "}\n");
-
- Printv(f->code, dispatch, "\n", NIL);
- Printf(f->code, "swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE," "\"No matching function for overloaded '%s'\");\n", iname);
- Printv(f->code, "}\n", NIL);
- Wrapper_print(f, f_wrappers);
- addMethod(scmname, wname);
-
- DelWrapper(f);
- f = NewWrapper();
-
- /* varargs */
- Printv(f->def, "void ", wname, "(C_word, C_word, C_word, ...) C_noret;\n", NIL);
- Printv(f->def, "void ", wname, "(C_word c, C_word t0, C_word t1, ...) {", NIL);
- Printv(f->code,
- "C_word t2;\n",
- "va_list v;\n",
- "C_word *a, c2 = c;\n",
- "C_save_rest (t1, c2, 2);\n", "a = C_alloc((c-2)*3);\n", "t2 = C_restore_rest (a, C_rest_count (0));\n", "real_", wname, " (3, t0, t1, t2);\n", NIL);
- Printv(f->code, "}\n", NIL);
- Wrapper_print(f, f_wrappers);
-
- /* Now deal with overloaded function when exporting clos */
- if (clos) {
- List *flist = Getattr(overload_parameter_lists, scmname);
- if (flist) {
- Delattr(overload_parameter_lists, scmname);
-
- SortList(flist, compareTypeLists);
-
- String *clos_name;
- if (have_constructor && !has_constructor_args) {
- has_constructor_args = 1;
- constructor_dispatch = NewStringf("%s@SWIG@new@dispatch", short_class_name);
- clos_name = Copy(constructor_dispatch);
- Printf(clos_methods, "(declare (hide %s))\n", clos_name);
- } else if (in_class)
- clos_name = NewString(member_name);
- else
- clos_name = chickenNameMapping(scmname, "");
-
- Iterator f;
- List *prev = 0;
- int all_primitive = 1;
-
- /* first check for duplicates and an empty call */
- String *newlist = NewList();
- for (f = First(flist); f.item; f = Next(f)) {
- /* check if cur is a duplicate of prev */
- if (prev && compareTypeListsHelper(f.item, prev, 1) == 0) {
- Delete(f.item);
- } else {
- Append(newlist, f.item);
- prev = f.item;
- Iterator j;
- for (j = First(f.item); j.item; j = Next(j)) {
- if (Strcmp(j.item, "^^##optional$$") != 0 && Strcmp(j.item, "<top>") != 0)
- all_primitive = 0;
- }
- }
- }
- Delete(flist);
- flist = newlist;
-
- if (all_primitive) {
- Printf(clos_methods, "(define %s %s)\n", clos_name, chickenPrimitiveName(scmname));
- } else {
- for (f = First(flist); f.item; f = Next(f)) {
- /* now export clos code for argument */
- String *func_call = buildClosFunctionCall(f.item, clos_name, chickenPrimitiveName(scmname));
- Printf(clos_methods, "%s\n", func_call);
- Delete(f.item);
- Delete(func_call);
- }
- }
-
- Delete(clos_name);
- Delete(flist);
- }
- }
-
- DelWrapper(f);
- Delete(dispatch);
- Delete(tmp);
- Delete(wname);
-}
-
-int CHICKEN::isPointer(SwigType *t) {
- return SwigType_ispointer(SwigType_typedef_resolve_all(t));
-}
-
-void CHICKEN::addMethod(String *scheme_name, String *function) {
- String *sym = NewString("");
- if (clos) {
- Append(sym, "primitive:");
- }
- Append(sym, scheme_name);
-
- /* add symbol to Chicken internal symbol table */
- if (hide_primitive) {
- Printv(f_init, "{\n",
- " C_word *p0 = a;\n", " *(a++)=C_CLOSURE_TYPE|1;\n", " *(a++)=(C_word)", function, ";\n", " C_mutate(return_vec++, (C_word)p0);\n", "}\n", NIL);
- } else {
- Printf(f_sym_size, "+C_SIZEOF_INTERNED_SYMBOL(%d)", Len(sym));
- Printf(f_init, "sym = C_intern (&a, %d, \"%s\");\n", Len(sym), sym);
- Printv(f_init, "C_mutate ((C_word*)sym+1, (*a=C_CLOSURE_TYPE|1, a[1]=(C_word)", function, ", tmp=(C_word)a, a+=2, tmp));\n", NIL);
- }
-
- if (hide_primitive) {
- Setattr(primitive_names, scheme_name, NewStringf("(vector-ref swig-init-return %i)", num_methods));
- } else {
- Setattr(primitive_names, scheme_name, Copy(sym));
- }
-
- num_methods++;
-
- Delete(sym);
-}
-
-String *CHICKEN::chickenPrimitiveName(String *name) {
- String *value = Getattr(primitive_names, name);
- if (value)
- return value;
- else {
- Swig_error(input_file, line_number, "Internal Error: attempting to reference non-existent primitive name %s\n", name);
- return NewString("#f");
- }
-}
-
-int CHICKEN::validIdentifier(String *s) {
- char *c = Char(s);
- /* Check whether we have an R5RS identifier. */
- /* <identifier> --> <initial> <subsequent>* | <peculiar identifier> */
- /* <initial> --> <letter> | <special initial> */
- if (!(isalpha(*c) || (*c == '!') || (*c == '$') || (*c == '%')
- || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
- || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
- || (*c == '^') || (*c == '_') || (*c == '~'))) {
- /* <peculiar identifier> --> + | - | ... */
- if ((strcmp(c, "+") == 0)
- || strcmp(c, "-") == 0 || strcmp(c, "...") == 0)
- return 1;
- else
- return 0;
- }
- /* <subsequent> --> <initial> | <digit> | <special subsequent> */
- while (*c) {
- if (!(isalnum(*c) || (*c == '!') || (*c == '$') || (*c == '%')
- || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
- || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
- || (*c == '^') || (*c == '_') || (*c == '~') || (*c == '+')
- || (*c == '-') || (*c == '.') || (*c == '@')))
- return 0;
- c++;
- }
- return 1;
-}
-
- /* ------------------------------------------------------------
- * closNameMapping()
- * Maps the identifier from C++ to the CLOS based on command
- * line parameters and such.
- * If class_name = "" that means the mapping is for a function or
- * variable not attached to any class.
- * ------------------------------------------------------------ */
-String *CHICKEN::chickenNameMapping(String *name, const_String_or_char_ptr class_name) {
- String *n = NewString("");
-
- if (Strcmp(class_name, "") == 0) {
- // not part of a class, so no class name to prefix
- if (clossymnameprefix) {
- Printf(n, "%s%s", clossymnameprefix, name);
- } else {
- Printf(n, "%s", name);
- }
- } else {
- if (useclassprefix) {
- Printf(n, "%s-%s", class_name, name);
- } else {
- if (clossymnameprefix) {
- Printf(n, "%s%s", clossymnameprefix, name);
- } else {
- Printf(n, "%s", name);
- }
- }
- }
- return n;
-}
-
-String *CHICKEN::runtimeCode() {
- String *s = Swig_include_sys("chickenrun.swg");
- if (!s) {
- Printf(stderr, "*** Unable to open 'chickenrun.swg'\n");
- s = NewString("");
- }
- return s;
-}
-
-String *CHICKEN::defaultExternalRuntimeFilename() {
- return NewString("swigchickenrun.h");
-}
diff --git a/Source/Modules/clisp.cxx b/Source/Modules/clisp.cxx
deleted file mode 100644
index d7f1971..0000000
--- a/Source/Modules/clisp.cxx
+++ /dev/null
@@ -1,515 +0,0 @@
-/* -----------------------------------------------------------------------------
- * This file is part of SWIG, which is licensed as a whole under version 3
- * (or any later version) of the GNU General Public License. Some additional
- * terms also apply to certain portions of SWIG. The full details of the SWIG
- * license and copyrights can be found in the LICENSE and COPYRIGHT files
- * included with the SWIG source code as distributed by the SWIG developers
- * and at http://www.swig.org/legal.html.
- *
- * clisp.cxx
- *
- * clisp language module for SWIG.
- * ----------------------------------------------------------------------------- */
-
-#include "swigmod.h"
-
-static const char *usage = "\
-CLISP Options (available with -clisp)\n\
- -extern-all - Create clisp definitions for all the functions and\n\
- global variables otherwise only definitions for\n\
- externed functions and variables are created.\n\
- -generate-typedef - Use def-c-type to generate shortcuts according to the\n\
- typedefs in the input.\n\
-";
-
-class CLISP:public Language {
-public:
- File *f_cl;
- String *module;
- virtual void main(int argc, char *argv[]);
- virtual int top(Node *n);
- virtual int functionWrapper(Node *n);
- virtual int variableWrapper(Node *n);
- virtual int constantWrapper(Node *n);
- virtual int classDeclaration(Node *n);
- virtual int enumDeclaration(Node *n);
- virtual int typedefHandler(Node *n);
- List *entries;
-private:
- String *get_ffi_type(Node *n, SwigType *ty);
- String *convert_literal(String *num_param, String *type);
- String *strip_parens(String *string);
- int extern_all_flag;
- int generate_typedef_flag;
- int is_function;
-};
-
-void CLISP::main(int argc, char *argv[]) {
- int i;
-
- Preprocessor_define("SWIGCLISP 1", 0);
- SWIG_library_directory("clisp");
- SWIG_config_file("clisp.swg");
- generate_typedef_flag = 0;
- extern_all_flag = 0;
-
- for (i = 1; i < argc; i++) {
- if (!strcmp(argv[i], "-help")) {
- Printf(stdout, "%s\n", usage);
- } else if ((Strcmp(argv[i], "-extern-all") == 0)) {
- extern_all_flag = 1;
- Swig_mark_arg(i);
- } else if ((Strcmp(argv[i], "-generate-typedef") == 0)) {
- generate_typedef_flag = 1;
- Swig_mark_arg(i);
- }
- }
-}
-
-int CLISP::top(Node *n) {
-
- File *f_null = NewString("");
- module = Getattr(n, "name");
- String *output_filename;
- entries = NewList();
-
- /* Get the output file name */
- String *outfile = Getattr(n, "outfile");
-
- if (!outfile) {
- Printf(stderr, "Unable to determine outfile\n");
- SWIG_exit(EXIT_FAILURE);
- }
-
- output_filename = NewStringf("%s%s.lisp", SWIG_output_directory(), module);
-
- f_cl = NewFile(output_filename, "w+", SWIG_output_files());
- if (!f_cl) {
- FileErrorDisplay(output_filename);
- SWIG_exit(EXIT_FAILURE);
- }
-
- Swig_register_filebyname("header", f_null);
- Swig_register_filebyname("begin", f_null);
- Swig_register_filebyname("runtime", f_null);
- Swig_register_filebyname("wrapper", f_null);
-
- String *header = NewString("");
-
- Swig_banner_target_lang(header, ";;");
-
- Printf(header, "\n(defpackage :%s\n (:use :common-lisp :ffi)", module);
-
- Language::top(n);
-
- Iterator i;
-
- long len = Len(entries);
- if (len > 0) {
- Printf(header, "\n (:export");
- }
- //else nothing to export
-
- for (i = First(entries); i.item; i = Next(i)) {
- Printf(header, "\n\t:%s", i.item);
- }
-
- if (len > 0) {
- Printf(header, ")");
- }
-
- Printf(header, ")\n");
- Printf(header, "\n(in-package :%s)\n", module);
- Printf(header, "\n(default-foreign-language :stdc)\n");
-
- len = Tell(f_cl);
-
- Printf(f_cl, "%s", header);
-
- long end = Tell(f_cl);
-
- for (len--; len >= 0; len--) {
- end--;
- (void)Seek(f_cl, len, SEEK_SET);
- int ch = Getc(f_cl);
- (void)Seek(f_cl, end, SEEK_SET);
- Putc(ch, f_cl);
- }
-
- Seek(f_cl, 0, SEEK_SET);
- Write(f_cl, Char(header), Len(header));
-
- Delete(f_cl);
-
- return SWIG_OK;
-}
-
-
-int CLISP::functionWrapper(Node *n) {
- is_function = 1;
- String *storage = Getattr(n, "storage");
- if (!extern_all_flag && (!storage || (!Swig_storage_isextern(n) && !Swig_storage_isexternc(n))))
- return SWIG_OK;
-
- String *func_name = Getattr(n, "sym:name");
-
- ParmList *pl = Getattr(n, "parms");
-
- int argnum = 0, first = 1;
-
- Printf(f_cl, "\n(ffi:def-call-out %s\n\t(:name \"%s\")\n", func_name, func_name);
-
- Append(entries, func_name);
-
- if (ParmList_len(pl) != 0) {
- Printf(f_cl, "\t(:arguments ");
- }
- for (Parm *p = pl; p; p = nextSibling(p), argnum++) {
-
- String *argname = Getattr(p, "name");
- // SwigType *argtype;
-
- String *ffitype = get_ffi_type(n, Getattr(p, "type"));
-
- int tempargname = 0;
-
- if (!argname) {
- argname = NewStringf("arg%d", argnum);
- tempargname = 1;
- }
-
- if (!first) {
- Printf(f_cl, "\n\t\t");
- }
- Printf(f_cl, "(%s %s)", argname, ffitype);
- first = 0;
-
- Delete(ffitype);
-
- if (tempargname)
- Delete(argname);
- }
- if (ParmList_len(pl) != 0) {
- Printf(f_cl, ")\n"); /* finish arg list */
- }
- String *ffitype = get_ffi_type(n, Getattr(n, "type"));
- if (Strcmp(ffitype, "NIL")) { //when return type is not nil
- Printf(f_cl, "\t(:return-type %s)\n", ffitype);
- }
- Printf(f_cl, "\t(:library +library-name+))\n");
-
- return SWIG_OK;
-}
-
-
-int CLISP::constantWrapper(Node *n) {
- is_function = 0;
- String *type = Getattr(n, "type");
- String *converted_value = convert_literal(Getattr(n, "value"), type);
- String *name = Getattr(n, "sym:name");
-
- Printf(f_cl, "\n(defconstant %s %s)\n", name, converted_value);
- Append(entries, name);
- Delete(converted_value);
-
- return SWIG_OK;
-}
-
-int CLISP::variableWrapper(Node *n) {
- is_function = 0;
- String *storage = Getattr(n, "storage");
-
- if (!extern_all_flag && (!storage || (!Swig_storage_isextern(n) && !Swig_storage_isexternc(n))))
- return SWIG_OK;
-
- String *var_name = Getattr(n, "sym:name");
- String *lisp_type = get_ffi_type(n, Getattr(n, "type"));
- Printf(f_cl, "\n(ffi:def-c-var %s\n (:name \"%s\")\n (:type %s)\n", var_name, var_name, lisp_type);
- Printf(f_cl, "\t(:library +library-name+))\n");
- Append(entries, var_name);
-
- Delete(lisp_type);
- return SWIG_OK;
-}
-
-int CLISP::typedefHandler(Node *n) {
- if (generate_typedef_flag) {
- is_function = 0;
- Printf(f_cl, "\n(ffi:def-c-type %s %s)\n", Getattr(n, "name"), get_ffi_type(n, Getattr(n, "type")));
- }
-
- return Language::typedefHandler(n);
-}
-
-int CLISP::enumDeclaration(Node *n) {
- if (getCurrentClass() && (cplus_mode != PUBLIC))
- return SWIG_NOWRAP;
-
- is_function = 0;
- String *name = Getattr(n, "sym:name");
-
- Printf(f_cl, "\n(ffi:def-c-enum %s ", name);
-
- for (Node *c = firstChild(n); c; c = nextSibling(c)) {
-
- String *slot_name = Getattr(c, "name");
- String *value = Getattr(c, "enumvalue");
-
- Printf(f_cl, "(%s %s)", slot_name, value);
-
- Append(entries, slot_name);
-
- Delete(value);
- }
-
- Printf(f_cl, ")\n");
- return SWIG_OK;
-}
-
-
-// Includes structs
-int CLISP::classDeclaration(Node *n) {
- is_function = 0;
- String *name = Getattr(n, "sym:name");
- String *kind = Getattr(n, "kind");
-
- if (Strcmp(kind, "struct")) {
- Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
- Printf(stderr, " (name: %s)\n", name);
- SWIG_exit(EXIT_FAILURE);
- }
-
-
- Printf(f_cl, "\n(ffi:def-c-struct %s", name);
-
- Append(entries, NewStringf("make-%s", name));
-
- for (Node *c = firstChild(n); c; c = nextSibling(c)) {
-
- if (Strcmp(nodeType(c), "cdecl")) {
- Printf(stderr, "Structure %s has a slot that we can't deal with.\n", name);
- Printf(stderr, "nodeType: %s, name: %s, type: %s\n", nodeType(c), Getattr(c, "name"), Getattr(c, "type"));
- SWIG_exit(EXIT_FAILURE);
- }
-
- String *temp = Copy(Getattr(c, "decl"));
- if (temp) {
- Append(temp, Getattr(c, "type")); //appending type to the end, otherwise wrong type
- String *lisp_type = get_ffi_type(n, temp);
- Delete(temp);
-
- String *slot_name = Getattr(c, "sym:name");
- Printf(f_cl, "\n\t(%s %s)", slot_name, lisp_type);
-
- Append(entries, NewStringf("%s-%s", name, slot_name));
-
- Delete(lisp_type);
- }
- }
-
- Printf(f_cl, ")\n");
-
- /* Add this structure to the known lisp types */
- //Printf(stdout, "Adding %s foreign type\n", name);
- // add_defined_foreign_type(name);
-
- return SWIG_OK;
-}
-
-/* utilities */
-/* returns new string w/ parens stripped */
-String *CLISP::strip_parens(String *string) {
- char *s = Char(string), *p;
- int len = Len(string);
- String *res;
-
- if (len == 0 || s[0] != '(' || s[len - 1] != ')') {
- return NewString(string);
- }
-
- p = (char *) malloc(len - 2 + 1);
- if (!p) {
- Printf(stderr, "Malloc failed\n");
- SWIG_exit(EXIT_FAILURE);
- }
-
- strncpy(p, s + 1, len - 1);
- p[len - 2] = 0; /* null terminate */
-
- res = NewString(p);
- free(p);
-
- return res;
-}
-
-String *CLISP::convert_literal(String *num_param, String *type) {
- String *num = strip_parens(num_param), *res;
- char *s = Char(num);
-
- /* Make sure doubles use 'd' instead of 'e' */
- if (!Strcmp(type, "double")) {
- String *updated = Copy(num);
- if (Replace(updated, "e", "d", DOH_REPLACE_ANY) > 1) {
- Printf(stderr, "Weird!! number %s looks invalid.\n", num);
- SWIG_exit(EXIT_FAILURE);
- }
- Delete(num);
- return updated;
- }
-
- if (SwigType_type(type) == T_CHAR) {
- /* Use CL syntax for character literals */
- return NewStringf("#\\%s", num_param);
- } else if (SwigType_type(type) == T_STRING) {
- /* Use CL syntax for string literals */
- return NewStringf("\"%s\"", num_param);
- }
-
- if (Len(num) < 2 || s[0] != '0') {
- return num;
- }
-
- /* octal or hex */
-
- res = NewStringf("#%c%s", s[1] == 'x' ? 'x' : 'o', s + 2);
- Delete(num);
-
- return res;
-}
-
-String *CLISP::get_ffi_type(Node *n, SwigType *ty) {
- Node *node = NewHash();
- Setattr(node, "type", ty);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *tm = Swig_typemap_lookup("in", node, "", 0);
- Delete(node);
-
- if (tm) {
- return NewString(tm);
- } else if (SwigType_ispointer(ty)) {
- SwigType *cp = Copy(ty);
- SwigType_del_pointer(cp);
- String *inner_type = get_ffi_type(n, cp);
-
- if (SwigType_isfunction(cp)) {
- return inner_type;
- }
-
- SwigType *base = SwigType_base(ty);
- String *base_name = SwigType_str(base, 0);
-
- String *str;
- if (!Strcmp(base_name, "int") || !Strcmp(base_name, "float") || !Strcmp(base_name, "short")
- || !Strcmp(base_name, "double") || !Strcmp(base_name, "long") || !Strcmp(base_name, "char")) {
-
- str = NewStringf("(ffi:c-ptr %s)", inner_type);
- } else {
- str = NewStringf("(ffi:c-pointer %s)", inner_type);
- }
- Delete(base_name);
- Delete(base);
- Delete(cp);
- Delete(inner_type);
- return str;
- } else if (SwigType_isarray(ty)) {
- SwigType *cp = Copy(ty);
- String *array_dim = SwigType_array_getdim(ty, 0);
-
- if (!Strcmp(array_dim, "")) { //dimension less array convert to pointer
- Delete(array_dim);
- SwigType_del_array(cp);
- SwigType_add_pointer(cp);
- String *str = get_ffi_type(n, cp);
- Delete(cp);
- return str;
- } else {
- SwigType_pop_arrays(cp);
- String *inner_type = get_ffi_type(n, cp);
- Delete(cp);
-
- int ndim = SwigType_array_ndim(ty);
- String *dimension;
- if (ndim == 1) {
- dimension = array_dim;
- } else {
- dimension = array_dim;
- for (int i = 1; i < ndim; i++) {
- array_dim = SwigType_array_getdim(ty, i);
- Append(dimension, " ");
- Append(dimension, array_dim);
- Delete(array_dim);
- }
- String *temp = dimension;
- dimension = NewStringf("(%s)", dimension);
- Delete(temp);
- }
- String *str;
- if (is_function)
- str = NewStringf("(ffi:c-ptr (ffi:c-array %s %s))", inner_type, dimension);
- else
- str = NewStringf("(ffi:c-array %s %s)", inner_type, dimension);
-
- Delete(inner_type);
- Delete(dimension);
- return str;
- }
- } else if (SwigType_isfunction(ty)) {
- SwigType *cp = Copy(ty);
- SwigType *fn = SwigType_pop_function(cp);
- String *args = NewString("");
- ParmList *pl = SwigType_function_parms(fn, n);
- if (ParmList_len(pl) != 0) {
- Printf(args, "(:arguments ");
- }
- int argnum = 0, first = 1;
- for (Parm *p = pl; p; p = nextSibling(p), argnum++) {
- String *argname = Getattr(p, "name");
- SwigType *argtype = Getattr(p, "type");
- String *ffitype = get_ffi_type(n, argtype);
-
- int tempargname = 0;
-
- if (!argname) {
- argname = NewStringf("arg%d", argnum);
- tempargname = 1;
- }
- if (!first) {
- Printf(args, "\n\t\t");
- }
- Printf(args, "(%s %s)", argname, ffitype);
- first = 0;
- Delete(ffitype);
- if (tempargname)
- Delete(argname);
- }
- if (ParmList_len(pl) != 0) {
- Printf(args, ")\n"); /* finish arg list */
- }
- String *ffitype = get_ffi_type(n, cp);
- String *str = NewStringf("(ffi:c-function %s \t\t\t\t(:return-type %s))", args, ffitype);
- Delete(fn);
- Delete(args);
- Delete(cp);
- Delete(ffitype);
- return str;
- }
- String *str = SwigType_str(ty, 0);
- if (str) {
- char *st = Strstr(str, "struct");
- if (st) {
- st += 7;
- return NewString(st);
- }
- char *cl = Strstr(str, "class");
- if (cl) {
- cl += 6;
- return NewString(cl);
- }
- }
- return str;
-}
-
-extern "C" Language *swig_clisp(void) {
- return new CLISP();
-}
diff --git a/Source/Modules/modula3.cxx b/Source/Modules/modula3.cxx
deleted file mode 100644
index 555d026..0000000
--- a/Source/Modules/modula3.cxx
+++ /dev/null
@@ -1,3923 +0,0 @@
-/* -----------------------------------------------------------------------------
- * This file is part of SWIG, which is licensed as a whole under version 3
- * (or any later version) of the GNU General Public License. Some additional
- * terms also apply to certain portions of SWIG. The full details of the SWIG
- * license and copyrights can be found in the LICENSE and COPYRIGHT files
- * included with the SWIG source code as distributed by the SWIG developers
- * and at http://www.swig.org/legal.html.
- *
- * modula3.cxx
- *
- * Modula3 language module for SWIG.
- * ----------------------------------------------------------------------------- */
-
-/*
- Text formatted with
- indent -sob -br -ce -nut -npsl
-*/
-
-/*
- Report:
- - It's not a good concept to use member variables or global variables
- for passing parameters to functions.
- It's not a good concept to use functions of superclasses for specific services.
- E.g. For SWIG this means: Generating accessor functions for member variables
- is the most common but no general task to be processed in membervariableHandler.
- Better provide a service function which generates accessor function code
- and equip this service function with all parameters needed for input (parse node)
- and output (generated code).
- - How can I make globalvariableHandler not to generate
- interface functions to two accessor functions
- (that don't exist) ?
- - How can I generate a typemap that turns every C reference argument into
- its Modula 3 counterpart, that is
- void test(Complex &z);
- PROCEDURE test(VAR z:Complex);
- - neither $*n_mangle nor $*n_type nor $*n_ltype return the type without
- pointer converted to Modula3 equivalent,
- $*n_mangle is the variant closest to what I expect
- - using a typemap like
- typemap(m3wrapintype) int * %{VAR $1_name: INTEGER%}
- has the advantages:
- - one C parameter can be turned into multiple M3 parameters
- - the argument can be renamed
- - using typemaps like
- typemap(m3wrapinmode) int * "VAR"
- typemap(m3wrapintype) int * "INTEGER"
- has the advantages:
- - multiple parameters with same type and default value can be bundled
- - more conform to the other language modules
- - Where takes the reduction of multi-typemaps place?
- How can I preserve all parameters for functions of the intermediary class?
- The answer is Getattrs(n,"tmap:m3rawintype:next")
- - Char() can be used to transform a String to (char *)
- which can be used for output with printf
- - What is the while (checkAttribute()) loop in functionWrapper good for?
- Appearently for skipping (numinputs=0) typemaps.
- - SWIGTYPE const * - typemap is ignored, whereas
- SWIGTYPE * - typemap is invoked, why?
- Had it been (const SWIGTYPE *) instead?
- - enumeration items should definitely be equipped
- with its plain numerical value
- One could add tag 'numvalue' in CParse/parser.y,
- but it is still possible that someone declares an
- enumeration using a symbolic constant.
- I have quickly hacked
- that the successive number is assigned
- if "enumvalue" has suffix "+1".
- The ultimate solution would be to generate a C program
- which includes the header and outputs all constants.
- This program might be compiled and run
- by 'make' or by SWIG and the resulting output is fed back to SWIG.
- - It's a bad idea to interpret feature value ""
- 'disable feature' because the value ""
- might be sensible in case of feature:modula3:oldprefix.
- - What's the difference between "sym:name" and "name" ?
- "name" is the original name and
- "sym:name" is probably modified by the user using %rename
- - Is it possible for 'configure' to find out if m3pp is installed
- and to invoke it for generated Modula3 files?
- - It would be better to separate an arguments purpose and its name,
- because an output variable with name "OUTPUT" is not very descriptive.
- In case of PLPlot this could be solved by typedefs
- that assign special purposes to the array types.
- - Can one interpret $n_basetype as the identifier matched with SWIGTYPE ?
-
- SWIG's odds:
- - arguments of type (Node *) for SWIG functions
- should be most often better (const Node *):
- Swig_symbol_qualified, Getattr, nodeType, parentNode
- - unique identifier style instead of
- NewString, Getattr, firstChild
- - 'class'.name is qualified,
- 'enum'.name and 'enumitem'.name is not
- - Swig_symbol_qualified() returns NIL for enumeration nodes
-
- - Is there a function that creates a C representation of a SWIG type string?
-
- ToDo:
- - create WeakRefs only for resources returned by function marked with %newobject
- -> part of output conversion
- - clean typemap conception
- - should a multi-typemap for m3wrapouttype skip the corresponding input parameters?
- when yes - How to handle inout-arguments? In this case like in-argument.
- - C++ classes
- - C++ exceptions
- - allow for moving RECORD and OBJECT definitions
- to separate files, with the main type called T
- - call-back functions
- - special option: fast access to class members by pointer arithmetic,
- member offsets can be determined by a C++ program that print them.
- - emit enumeration definitions when its first item is declared,
- currently enumerations are emitted at the beginning of the file
-
- Done:
- - addThrow should convert the typemap by itself
- - not possible because routine for attaching mapped types to parameter nodes
- won't work for the function node
- - turning error codes into exceptions
- -> part of output value checking
- - create WeakRefs for resources allocated by the library
- -> part of output conversion
- - TRY..FINALLY..END; can be omitted
- - if there is no m3wrapfreearg
- - no exception can be raised in the body (empty RAISES) list
-*/
-
-#include "swigmod.h"
-
-#include <limits.h> // for INT_MAX
-#include <ctype.h>
-
-#define USAGE_ARG_DIR "m3wrapargdir typemap expect values: in, out, inout\n"
-
-class MODULA3:public Language {
-public:
- enum block_type { no_block, constant, variable, blocktype, revelation };
-
-private:
- struct M3File {
- String *f;
- Hash *import;
- block_type bt;
- /* VC++ 6 doesn't allow the access to 'no_block'
- if it is a private member of MODULA3 class */
- M3File():f(NewString("")), import(NewHash()), bt(no_block) {
- }
- ~M3File() {
- Delete(f);
- Delete(import);
- }
-
- /* -----------------------------------------------------------------------------
- * enterBlock()
- *
- * Make sure that a given declaration is written to the right declaration block,
- * that is constants are written after "CONST" and so on ...
- * ----------------------------------------------------------------------------- */
- void enterBlock(block_type newbt) {
- static const char *ident[] = { "", "\nCONST\n", "\nVAR\n", "\nTYPE\n", "\nREVEAL\n" };
-#ifdef DEBUG
- if ((bt < 0) || (4 < bt)) {
- printf("bt %d out of range\n", bt);
- }
-#endif
- if (newbt != bt) {
- Append(f, ident[newbt]);
- bt = newbt;
- }
- }
-
- };
-
- static const char *usage;
- const String *empty_string;
-
- Hash *swig_types_hash;
- File *f_begin;
- File *f_runtime;
- File *f_header;
- File *f_wrappers;
- File *f_init;
-
- bool proxy_flag; // Flag for generating proxy classes
- bool have_default_constructor_flag;
- bool native_function_flag; // Flag for when wrapping a native function
- bool enum_constant_flag; // Flag for when wrapping an enum or constant
- bool static_flag; // Flag for when wrapping a static functions or member variables
- bool variable_wrapper_flag; // Flag for when wrapping a nonstatic member variable
- bool wrapping_member_flag; // Flag for when wrapping a member variable/enum/const
- bool global_variable_flag; // Flag for when wrapping a global variable
- bool old_variable_names; // Flag for old style variable names in the intermediary class
- bool unsafe_module;
-
- String *m3raw_name; // raw interface name
- M3File m3raw_intf; // raw interface
- M3File m3raw_impl; // raw implementation (usually empty)
- String *m3wrap_name; // wrapper module
- M3File m3wrap_intf;
- M3File m3wrap_impl;
- String *m3makefile;
- String *targetlibrary;
- String *proxy_class_def;
- String *proxy_class_code;
- String *proxy_class_name;
- String *variable_name; //Name of a variable being wrapped
- String *variable_type; //Type of this variable
- Hash *enumeration_coll; //Collection of all enumerations.
- /* The items are nodes with members:
- "items" - hash of with key 'itemname' and content 'itemvalue'
- "max" - maximum value in item list
- */
- String *constant_values;
- String *constantfilename;
- String *renamefilename;
- String *typemapfilename;
- String *m3raw_imports; //intermediary class imports from %pragma
- String *module_imports; //module imports from %pragma
- String *m3raw_baseclass; //inheritance for intermediary class class from %pragma
- String *module_baseclass; //inheritance for module class from %pragma
- String *m3raw_interfaces; //interfaces for intermediary class class from %pragma
- String *module_interfaces; //interfaces for module class from %pragma
- String *m3raw_class_modifiers; //class modifiers for intermediary class overridden by %pragma
- String *m3wrap_modifiers; //class modifiers for module class overridden by %pragma
- String *upcasts_code; //C++ casts for inheritance hierarchies C++ code
- String *m3raw_cppcasts_code; //C++ casts up inheritance hierarchies intermediary class code
- String *destructor_call; //C++ destructor call if any
- String *outfile;
-
- enum type_additions { none, pointer, reference };
-
-public:
-
- /* -----------------------------------------------------------------------------
- * MODULA3()
- * ----------------------------------------------------------------------------- */
-
-MODULA3():
- empty_string(NewString("")),
- swig_types_hash(NULL),
- f_begin(NULL),
- f_runtime(NULL),
- f_header(NULL),
- f_wrappers(NULL),
- f_init(NULL),
- proxy_flag(true),
- have_default_constructor_flag(false),
- native_function_flag(false),
- enum_constant_flag(false),
- static_flag(false),
- variable_wrapper_flag(false),
- wrapping_member_flag(false),
- global_variable_flag(false),
- old_variable_names(false),
- unsafe_module(false),
- m3raw_name(NULL),
- m3raw_intf(),
- m3raw_impl(),
- m3wrap_name(NULL),
- m3wrap_intf(),
- m3wrap_impl(),
- m3makefile(NULL),
- targetlibrary(NULL),
- proxy_class_def(NULL),
- proxy_class_code(NULL),
- proxy_class_name(NULL),
- variable_name(NULL),
- variable_type(NULL),
- enumeration_coll(NULL),
- constant_values(NULL),
- constantfilename(NULL),
- renamefilename(NULL),
- typemapfilename(NULL),
- m3raw_imports(NULL),
- module_imports(NULL),
- m3raw_baseclass(NULL),
- module_baseclass(NULL),
- m3raw_interfaces(NULL),
- module_interfaces(NULL),
- m3raw_class_modifiers(NULL),
- m3wrap_modifiers(NULL),
- upcasts_code(NULL),
- m3raw_cppcasts_code(NULL),
- destructor_call(NULL),
- outfile(NULL) {
- }
-
- /************** some utility functions ***************/
-
- /* -----------------------------------------------------------------------------
- * getMappedType()
- *
- * Return the type of 'p' mapped by 'map'.
- * Print a standard warning if 'p' can't be mapped.
- * ----------------------------------------------------------------------------- */
-
- String *getMappedType(Node *p, const char *map) {
- String *mapattr = NewString("tmap:");
- Append(mapattr, map);
-
- String *tm = Getattr(p, mapattr);
- if (tm == NIL) {
- Swig_warning(WARN_MODULA3_TYPEMAP_TYPE_UNDEF, input_file, line_number,
- "No '%s' typemap defined for type '%s'\n", map, SwigType_str(Getattr(p, "type"), 0));
- }
- Delete(mapattr);
- return tm;
- }
-
- /* -----------------------------------------------------------------------------
- * getMappedTypeNew()
- *
- * Similar to getMappedType but uses Swig_type_lookup_new.
- * ----------------------------------------------------------------------------- */
-
- String *getMappedTypeNew(Node *n, const char *map, const char *lname = "", bool warn = true) {
- String *tm = Swig_typemap_lookup(map, n, lname, 0);
- if ((tm == NIL) && warn) {
- Swig_warning(WARN_MODULA3_TYPEMAP_TYPE_UNDEF, input_file, line_number,
- "No '%s' typemap defined for type '%s'\n", map, SwigType_str(Getattr(n, "type"), 0));
- }
- return tm;
- }
-
- /* -----------------------------------------------------------------------------
- * attachMappedType()
- *
- * Obtain the type mapped by 'map' and attach it to the node
- * ----------------------------------------------------------------------------- */
-
- void attachMappedType(Node *n, const char *map, const char *lname = "") {
- String *tm = Swig_typemap_lookup(map, n, lname, 0);
- if (tm != NIL) {
- String *attr = NewStringf("tmap:%s", map);
- Setattr(n, attr, tm);
- Delete(attr);
- }
- }
-
- /* -----------------------------------------------------------------------------
- * skipIgnored()
- *
- * Skip all parameters that have 'numinputs=0'
- * with respect to a given typemap.
- * ----------------------------------------------------------------------------- */
-
- Node *skipIgnored(Node *p, const char *map) {
- String *niattr = NewStringf("tmap:%s:numinputs", map);
- String *nextattr = NewStringf("tmap:%s:next", map);
-
- while ((p != NIL) && checkAttribute(p, niattr, "0")) {
- p = Getattr(p, nextattr);
- }
-
- Delete(nextattr);
- Delete(niattr);
- return p;
- }
-
- /* -----------------------------------------------------------------------------
- * isInParam()
- * isOutParam()
- *
- * Check if the parameter is intended for input or for output.
- * ----------------------------------------------------------------------------- */
-
- bool isInParam(Node *p) {
- String *dir = Getattr(p, "tmap:m3wrapargdir");
-//printf("dir for %s: %s\n", Char(Getattr(p,"name")), Char(dir));
- if ((dir == NIL) || (Strcmp(dir, "in") == 0)
- || (Strcmp(dir, "inout") == 0)) {
- return true;
- } else if (Strcmp(dir, "out") == 0) {
- return false;
- } else {
- printf("%s", USAGE_ARG_DIR);
- return false;
- }
- }
-
- bool isOutParam(Node *p) {
- String *dir = Getattr(p, "tmap:m3wrapargdir");
- if ((dir == NIL) || (Strcmp(dir, "in") == 0)) {
- return false;
- } else if ((Strcmp(dir, "out") == 0) || (Strcmp(dir, "inout") == 0)) {
- return true;
- } else {
- printf("%s", USAGE_ARG_DIR);
- return false;
- }
- }
-
- /* -----------------------------------------------------------------------------
- * printAttrs()
- *
- * For debugging: Show all attributes of a node and their values.
- * ----------------------------------------------------------------------------- */
- void printAttrs(Node *n) {
- Iterator it;
- for (it = First(n); it.key != NIL; it = Next(it)) {
- printf("%s = %s\n", Char(it.key), Char(Getattr(n, it.key)));
- }
- }
-
- /* -----------------------------------------------------------------------------
- * hasPrefix()
- *
- * Check if a string have a given prefix.
- * ----------------------------------------------------------------------------- */
- bool hasPrefix(const String *str, const String *prefix) {
- int len_prefix = Len(prefix);
- return (Len(str) > len_prefix)
- && (Strncmp(str, prefix, len_prefix) == 0);
- }
-
- /* -----------------------------------------------------------------------------
- * getQualifiedName()
- *
- * Return fully qualified identifier of n.
- * ----------------------------------------------------------------------------- */
-#if 0
- // Swig_symbol_qualified returns NIL for enumeration nodes
- String *getQualifiedName(Node *n) {
- String *qual = Swig_symbol_qualified(n);
- String *name = Getattr(n, "name");
- if (hasContent(qual)) {
- return NewStringf("%s::%s", qual, name);
- } else {
- return name;
- }
- }
-#else
- String *getQualifiedName(Node *n) {
- String *name = Copy(Getattr(n, "name"));
- n = parentNode(n);
- while (n != NIL) {
- const String *type = nodeType(n);
- if ((Strcmp(type, "class") == 0) || (Strcmp(type, "struct") == 0) || (Strcmp(type, "namespace") == 0)) {
- String *newname = NewStringf("%s::%s", Getattr(n, "name"), name);
- Delete(name);
- //name = newname;
- // Hmpf, the class name is already qualified.
- return newname;
- }
- n = parentNode(n);
- }
- //printf("qualified name: %s\n", Char(name));
- return name;
- }
-#endif
-
- /* -----------------------------------------------------------------------------
- * nameToModula3()
- *
- * Turn usual C identifiers like "this_is_an_identifier"
- * into usual Modula 3 identifier like "thisIsAnIdentifier"
- * ----------------------------------------------------------------------------- */
- String *nameToModula3(const String *sym, bool leadingCap) {
- int len_sym = Len(sym);
- char *csym = Char(sym);
- char *m3sym = new char[len_sym + 1];
- int i, j;
- bool cap = leadingCap;
- for (i = 0, j = 0; j < len_sym; j++) {
- char c = csym[j];
- if ((c == '_') || (c == ':')) {
- cap = true;
- } else {
- if (isdigit(c)) {
- m3sym[i] = c;
- cap = true;
- } else {
- if (cap) {
- m3sym[i] = (char)toupper(c);
- } else {
- m3sym[i] = (char)tolower(c);
- }
- cap = false;
- }
- i++;
- }
- }
- m3sym[i] = 0;
- String *result = NewString(m3sym);
- delete[]m3sym;
- return result;
- }
-
- /* -----------------------------------------------------------------------------
- * capitalizeFirst()
- *
- * Make the first character upper case.
- * ----------------------------------------------------------------------------- */
- String *capitalizeFirst(const String *str) {
- return NewStringf("%c%s", toupper(*Char(str)), Char(str) + 1);
- }
-
- /* -----------------------------------------------------------------------------
- * prefixedNameToModula3()
- *
- * If feature modula3:oldprefix and modula3:newprefix is present
- * and the C identifier has leading 'oldprefix'
- * then it is replaced by the 'newprefix'.
- * The rest is converted to Modula style.
- * ----------------------------------------------------------------------------- */
- String *prefixedNameToModula3(Node *n, const String *sym, bool leadingCap) {
- String *oldPrefix = Getattr(n, "feature:modula3:oldprefix");
- String *newPrefix = Getattr(n, "feature:modula3:newprefix");
- String *result = NewString("");
- char *short_sym = Char(sym);
- // if at least one prefix feature is present
- // the replacement takes place
- if ((oldPrefix != NIL) || (newPrefix != NIL)) {
- if ((oldPrefix == NIL) || hasPrefix(sym, oldPrefix)) {
- short_sym += Len(oldPrefix);
- if (newPrefix != NIL) {
- Append(result, newPrefix);
- }
- }
- }
- String *suffix = nameToModula3(short_sym, leadingCap || hasContent(newPrefix));
- Append(result, suffix);
- Delete(suffix);
- return result;
- }
-
- /* -----------------------------------------------------------------------------
- * hasContent()
- *
- * Check if the string exists and contains something.
- * ----------------------------------------------------------------------------- */
- bool hasContent(const String *str) {
- return (str != NIL) && (Strcmp(str, "") != 0);
- }
-
- /* -----------------------------------------------------------------------------
- * openWriteFile()
- *
- * Caution: The file must be freshly allocated and will be destroyed
- * by this routine.
- * ----------------------------------------------------------------------------- */
-
- File *openWriteFile(String *name) {
- File *file = NewFile(name, "w", SWIG_output_files());
- if (!file) {
- FileErrorDisplay(name);
- SWIG_exit(EXIT_FAILURE);
- }
- Delete(name);
- return file;
- }
-
- /* -----------------------------------------------------------------------------
- * aToL()
- *
- * like atol but with additional user warning
- * ----------------------------------------------------------------------------- */
-
- long aToL(const String *value) {
- char *endptr;
- long numvalue = strtol(Char(value), &endptr, 0);
- if (*endptr != 0) {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "The string <%s> does not denote a numeric value.\n", value);
- }
- return numvalue;
- }
-
- /* -----------------------------------------------------------------------------
- * strToL()
- *
- * like strtol but returns if the conversion was successful
- * ----------------------------------------------------------------------------- */
-
- bool strToL(const String *value, long &numvalue) {
- char *endptr;
- numvalue = strtol(Char(value), &endptr, 0);
- return (*endptr == 0);
- }
-
- /* -----------------------------------------------------------------------------
- * evalExpr()
- *
- * Evaluate simple expression as they may occur in "enumvalue" attributes.
- * ----------------------------------------------------------------------------- */
-
- bool evalExpr(String *value, long &numvalue) {
- // Split changes file status of String and thus cannot receive 'const' strings
-//printf("evaluate <%s>\n", Char(value));
- List *summands = Split(value, '+', INT_MAX);
- Iterator sm = First(summands);
- numvalue = 0;
- for (; sm.item != NIL; sm = Next(sm)) {
- String *smvalue = Getattr(constant_values, sm.item);
- long smnumvalue;
- if (smvalue != NIL) {
- if (!strToL(smvalue, smnumvalue)) {
-//printf("evaluation: abort 0 <%s>\n", Char(smvalue));
- return false;
- }
- } else {
- if (!strToL(sm.item, smnumvalue)) {
-//printf("evaluation: abort 1 <%s>\n", Char(sm));
- return false;
- }
- }
- numvalue += smnumvalue;
- }
-//printf("evaluation: return %ld\n", numvalue);
- return true;
- }
-
- /* -----------------------------------------------------------------------------
- * log2()
- *
- * Determine the position of the single bit of a power of two.
- * Returns true if the given number is a power of two.
- * ----------------------------------------------------------------------------- */
-
- bool log2(long n, long &exp) {
- exp = 0;
- while (n > 0) {
- if ((n & 1) != 0) {
- return n == 1;
- }
- exp++;
- n >>= 1;
- }
- return false;
- }
-
- /* -----------------------------------------------------------------------------
- * writeArg
- *
- * Write a function argument or RECORD entry definition.
- * Bundles arguments of same type and default value.
- * 'name.next==NIL' denotes the end of the entry or argument list.
- * ----------------------------------------------------------------------------- */
-
- bool equalNilStr(const String *str0, const String *str1) {
- if (str0 == NIL) {
- return (str1 == NIL);
- //return (str0==NIL) == (str1==NIL);
- } else {
- return (str1 != NIL) && (Cmp(str0, str1) == 0);
- //return Cmp(str0,str1)==0;
- }
- }
-
- struct writeArgState {
- String *mode, *name, *type, *value;
- bool hold;
- writeArgState():mode(NIL), name(NIL), type(NIL), value(NIL), hold(false) {
- }
- };
-
- void writeArg(File *f, writeArgState & state, String *mode, String *name, String *type, String *value) {
- /* skip the first argument,
- only store the information for the next call in this case */
- if (state.name != NIL) {
- if ((!state.hold) && (state.mode != NIL)) {
- Printf(f, "%s ", state.mode);
- }
- if ((name != NIL) && equalNilStr(state.mode, mode) && equalNilStr(state.type, type) && (state.value == NIL) && (value == NIL)
- /* the same expression may have different values
- due to side effects of the called function */
- /*equalNilStr(state.value,value) */
- ) {
- Printf(f, "%s, ", state.name);
- state.hold = true;
- } else {
- Append(f, state.name);
- if (state.type != NIL) {
- Printf(f, ": %s", state.type);
- }
- if (state.value != NIL) {
- Printf(f, ":= %s", state.value);
- }
- Append(f, ";\n");
- state.hold = false;
- }
- }
- /* at the next call the current argument will be the previous one */
- state.mode = mode;
- state.name = name;
- state.type = type;
- state.value = value;
- }
-
- /* -----------------------------------------------------------------------------
- * getProxyName()
- *
- * Test to see if a type corresponds to something wrapped with a proxy class
- * Return NULL if not otherwise the proxy class name
- * ----------------------------------------------------------------------------- */
-
- String *getProxyName(SwigType *t) {
- if (proxy_flag) {
- Node *n = classLookup(t);
- if (n) {
- return Getattr(n, "sym:name");
- }
- }
- return NULL;
- }
-
- /*************** language processing ********************/
-
- /* ------------------------------------------------------------
- * main()
- * ------------------------------------------------------------ */
-
- virtual void main(int argc, char *argv[]) {
-
- SWIG_library_directory("modula3");
-
- // Look for certain command line options
- for (int i = 1; i < argc; i++) {
- if (argv[i]) {
- if (strcmp(argv[i], "-generateconst") == 0) {
- if (argv[i + 1]) {
- constantfilename = NewString(argv[i + 1]);
- Swig_mark_arg(i);
- Swig_mark_arg(i + 1);
- i++;
- } else {
- Swig_arg_error();
- }
- } else if (strcmp(argv[i], "-generaterename") == 0) {
- if (argv[i + 1]) {
- renamefilename = NewString(argv[i + 1]);
- Swig_mark_arg(i);
- Swig_mark_arg(i + 1);
- i++;
- } else {
- Swig_arg_error();
- }
- } else if (strcmp(argv[i], "-generatetypemap") == 0) {
- if (argv[i + 1]) {
- typemapfilename = NewString(argv[i + 1]);
- Swig_mark_arg(i);
- Swig_mark_arg(i + 1);
- i++;
- } else {
- Swig_arg_error();
- }
- } else if (strcmp(argv[i], "-noproxy") == 0) {
- Swig_mark_arg(i);
- proxy_flag = false;
- } else if (strcmp(argv[i], "-oldvarnames") == 0) {
- Swig_mark_arg(i);
- old_variable_names = true;
- } else if (strcmp(argv[i], "-help") == 0) {
- Printf(stdout, "%s\n", usage);
- }
- }
- }
-
- // Add a symbol to the parser for conditional compilation
- Preprocessor_define("SWIGMODULA3 1", 0);
-
- // Add typemap definitions
- SWIG_typemap_lang("modula3");
- SWIG_config_file("modula3.swg");
-
- allow_overloading();
- }
-
- /* ---------------------------------------------------------------------
- * top()
- * --------------------------------------------------------------------- */
-
- virtual int top(Node *n) {
- if (hasContent(constantfilename) || hasContent(renamefilename) || hasContent(typemapfilename)) {
- int result = SWIG_OK;
- if (hasContent(constantfilename)) {
- result = generateConstantTop(n) && result;
- }
- if (hasContent(renamefilename)) {
- result = generateRenameTop(n) && result;
- }
- if (hasContent(typemapfilename)) {
- result = generateTypemapTop(n) && result;
- }
- return result;
- } else {
- return generateM3Top(n);
- }
- }
-
- void scanConstant(File *file, Node *n) {
- Node *child = firstChild(n);
- while (child != NIL) {
- String *constname = NIL;
- String *type = nodeType(child);
- if ((Strcmp(type, "enumitem") == 0)
- || (Strcmp(type, "constant") == 0)) {
-#if 1
- constname = getQualifiedName(child);
-#else
- constname = Getattr(child, "value");
- if ((!hasContent(constname))
- || (('0' <= *Char(constname)) && (*Char(constname) <= '9'))) {
- constname = Getattr(child, "name");
- }
-#endif
- }
- if (constname != NIL) {
- Printf(file, " printf(\"%%%%constnumeric(%%Lg) %s;\\n\", (long double)%s);\n", constname, constname);
- }
- scanConstant(file, child);
- child = nextSibling(child);
- }
- }
-
- int generateConstantTop(Node *n) {
- File *file = openWriteFile(NewStringf("%s.c", constantfilename));
- if (CPlusPlus) {
- Printf(file, "#include <cstdio>\n");
- } else {
- Printf(file, "#include <stdio.h>\n");
- }
- Printf(file, "#include \"%s\"\n", input_file);
- Printf(file, "\n");
- Printf(file, "int main (int argc, char *argv[]) {\n");
- Printf(file, "\
-/*This program must work for floating point numbers and integers.\n\
- Thus all numbers are converted to double precision floating point format.*/\n");
- scanConstant(file, n);
- Printf(file, " return 0;\n");
- Printf(file, "}\n");
- Delete(file);
- return SWIG_OK;
- }
-
- void scanRename(File *file, Node *n) {
- Node *child = firstChild(n);
- while (child != NIL) {
- String *type = nodeType(child);
- if (Strcmp(type, "cdecl") == 0) {
- ParmList *p = Getattr(child, "parms");
- if (p != NIL) {
- String *name = getQualifiedName(child);
- String *m3name = nameToModula3(name, true);
- /*don't know how to get the original C type identifiers */
- //String *arguments = createCSignature (child);
- Printf(file, "%%rename(\"%s\") %s;\n", m3name, name);
- /*Printf(file, "%%rename(\"%s\") %s %s(%s);\n",
- m3name, Getattr(n,"type"), name, arguments); */
- Delete(name);
- Delete(m3name);
- //Delete (arguments);
- }
- }
- scanRename(file, child);
- child = nextSibling(child);
- }
- }
-
- int generateRenameTop(Node *n) {
- File *file = openWriteFile(NewStringf("%s.i", renamefilename));
- Printf(file, "\
-/* This file was generated from %s\n\
- by SWIG with option -generaterename. */\n\
-\n", input_file);
- scanRename(file, n);
- Delete(file);
- return SWIG_OK;
- }
-
- void scanTypemap(File *file, Node *n) {
- Node *child = firstChild(n);
- while (child != NIL) {
- String *type = nodeType(child);
- //printf("nodetype %s\n", Char(type));
- String *storage = Getattr(child, "storage");
- if ((Strcmp(type, "class") == 0) || ((Strcmp(type, "cdecl") == 0) && (storage != NIL)
- && (Strcmp(storage, "typedef") == 0))) {
- String *name = getQualifiedName(child);
- String *m3name = nameToModula3(name, true);
- Printf(file, "%%typemap(\"m3wrapintype\") %s %%{%s%%}\n", name, m3name);
- Printf(file, "%%typemap(\"m3rawintype\") %s %%{%s%%}\n", name, m3name);
- Printf(file, "\n");
- }
- scanTypemap(file, child);
- child = nextSibling(child);
- }
- }
-
- int generateTypemapTop(Node *n) {
- File *file = openWriteFile(NewStringf("%s.i", typemapfilename));
- Printf(file, "\
-/* This file was generated from %s\n\
- by SWIG with option -generatetypemap. */\n\
-\n", input_file);
- scanTypemap(file, n);
- Delete(file);
- return SWIG_OK;
- }
-
- int generateM3Top(Node *n) {
- /* Initialize all of the output files */
- outfile = Getattr(n, "outfile");
-
- f_begin = NewFile(outfile, "w", SWIG_output_files());
- if (!f_begin) {
- FileErrorDisplay(outfile);
- SWIG_exit(EXIT_FAILURE);
- }
- f_runtime = NewString("");
- f_init = NewString("");
- f_header = NewString("");
- f_wrappers = NewString("");
-
- m3makefile = NewString("");
-
- /* Register file targets with the SWIG file handler */
- Swig_register_filebyname("header", f_header);
- Swig_register_filebyname("wrapper", f_wrappers);
- Swig_register_filebyname("begin", f_begin);
- Swig_register_filebyname("runtime", f_runtime);
- Swig_register_filebyname("init", f_init);
-
- Swig_register_filebyname("m3rawintf", m3raw_intf.f);
- Swig_register_filebyname("m3rawimpl", m3raw_impl.f);
- Swig_register_filebyname("m3wrapintf", m3wrap_intf.f);
- Swig_register_filebyname("m3wrapimpl", m3wrap_impl.f);
- Swig_register_filebyname("m3makefile", m3makefile);
-
- swig_types_hash = NewHash();
-
- String *name = Getattr(n, "name");
- // Make the intermediary class and module class names. The intermediary class name can be set in the module directive.
- Node *optionsnode = Getattr(Getattr(n, "module"), "options");
- if (optionsnode != NIL) {
- String *m3raw_name_tmp = Getattr(optionsnode, "m3rawname");
- if (m3raw_name_tmp != NIL) {
- m3raw_name = Copy(m3raw_name_tmp);
- }
- }
- if (m3raw_name == NIL) {
- m3raw_name = NewStringf("%sRaw", name);
- }
- Setattr(m3wrap_impl.import, m3raw_name, "");
-
- m3wrap_name = Copy(name);
-
- proxy_class_def = NewString("");
- proxy_class_code = NewString("");
- m3raw_baseclass = NewString("");
- m3raw_interfaces = NewString("");
- m3raw_class_modifiers = NewString(""); // package access only to the intermediary class by default
- m3raw_imports = NewString("");
- m3raw_cppcasts_code = NewString("");
- m3wrap_modifiers = NewString("public");
- module_baseclass = NewString("");
- module_interfaces = NewString("");
- module_imports = NewString("");
- upcasts_code = NewString("");
-
- Swig_banner(f_begin);
-
- Printf(f_runtime, "\n\n#ifndef SWIGMODULA3\n#define SWIGMODULA3\n#endif\n\n");
-
- Swig_name_register("wrapper", "Modula3_%f");
- if (old_variable_names) {
- Swig_name_register("set", "set_%n%v");
- Swig_name_register("get", "get_%n%v");
- }
-
- Printf(f_wrappers, "\n#ifdef __cplusplus\n");
- Printf(f_wrappers, "extern \"C\" {\n");
- Printf(f_wrappers, "#endif\n\n");
-
- constant_values = NewHash();
- scanForConstPragmas(n);
- enumeration_coll = NewHash();
- collectEnumerations(enumeration_coll, n);
-
- /* Emit code */
- Language::top(n);
-
- // Generate m3makefile
- // This will be unnecessary if SWIG is invoked from Quake.
- {
- File *file = openWriteFile(NewStringf("%sm3makefile", SWIG_output_directory()));
-
- Printf(file, "%% automatically generated quake file for %s\n\n", name);
-
- /* Write the fragments written by '%insert'
- collected while 'top' processed the parse tree */
- Printv(file, m3makefile, NIL);
-
- Printf(file, "import(\"libm3\")\n");
- //Printf(file, "import_lib(\"%s\",\"/usr/lib\")\n", name);
- Printf(file, "module(\"%s\")\n", m3raw_name);
- Printf(file, "module(\"%s\")\n\n", m3wrap_name);
-
- if (targetlibrary != NIL) {
- Printf(file, "library(\"%s\")\n", targetlibrary);
- } else {
- Printf(file, "library(\"m3%s\")\n", name);
- }
- Delete(file);
- }
-
- // Generate the raw interface
- {
- File *file = openWriteFile(NewStringf("%s%s.i3", SWIG_output_directory(), m3raw_name));
-
- emitBanner(file);
-
- Printf(file, "INTERFACE %s;\n\n", m3raw_name);
-
- emitImportStatements(m3raw_intf.import, file);
- Printf(file, "\n");
-
- // Write the interface generated within 'top'
- Printv(file, m3raw_intf.f, NIL);
-
- Printf(file, "\nEND %s.\n", m3raw_name);
- Delete(file);
- }
-
- // Generate the raw module
- {
- File *file = openWriteFile(NewStringf("%s%s.m3", SWIG_output_directory(), m3raw_name));
-
- emitBanner(file);
-
- Printf(file, "MODULE %s;\n\n", m3raw_name);
-
- emitImportStatements(m3raw_impl.import, file);
- Printf(file, "\n");
-
- // will be empty usually
- Printv(file, m3raw_impl.f, NIL);
-
- Printf(file, "BEGIN\nEND %s.\n", m3raw_name);
- Delete(file);
- }
-
- // Generate the interface for the comfort wrappers
- {
- File *file = openWriteFile(NewStringf("%s%s.i3", SWIG_output_directory(), m3wrap_name));
-
- emitBanner(file);
-
- Printf(file, "INTERFACE %s;\n", m3wrap_name);
-
- emitImportStatements(m3wrap_intf.import, file);
- Printf(file, "\n");
-
- {
- Iterator it = First(enumeration_coll);
- if (it.key != NIL) {
- Printf(file, "TYPE\n");
- }
- for (; it.key != NIL; it = Next(it)) {
- Printf(file, "\n");
- emitEnumeration(file, it.key, it.item);
- }
- }
-
- // Add the wrapper methods
- Printv(file, m3wrap_intf.f, NIL);
-
- // Finish off the class
- Printf(file, "\nEND %s.\n", m3wrap_name);
- Delete(file);
- }
-
- // Generate the wrapper routines implemented in Modula 3
- {
- File *file = openWriteFile(NewStringf("%s%s.m3", SWIG_output_directory(), m3wrap_name));
-
- emitBanner(file);
-
- if (unsafe_module) {
- Printf(file, "UNSAFE ");
- }
- Printf(file, "MODULE %s;\n\n", m3wrap_name);
-
- emitImportStatements(m3wrap_impl.import, file);
- Printf(file, "\n");
-
- // Add the wrapper methods
- Printv(file, m3wrap_impl.f, NIL);
-
- Printf(file, "\nBEGIN\nEND %s.\n", m3wrap_name);
- Delete(file);
- }
-
- if (upcasts_code)
- Printv(f_wrappers, upcasts_code, NIL);
-
- Printf(f_wrappers, "#ifdef __cplusplus\n");
- Printf(f_wrappers, "}\n");
- Printf(f_wrappers, "#endif\n");
-
- // Output a Modula 3 type wrapper class for each SWIG type
- for (Iterator swig_type = First(swig_types_hash); swig_type.item != NIL; swig_type = Next(swig_type)) {
- emitTypeWrapperClass(swig_type.key, swig_type.item);
- }
-
- Delete(swig_types_hash);
- swig_types_hash = NULL;
- Delete(constant_values);
- constant_values = NULL;
- Delete(enumeration_coll);
- enumeration_coll = NULL;
- Delete(m3raw_name);
- m3raw_name = NULL;
- Delete(m3raw_baseclass);
- m3raw_baseclass = NULL;
- Delete(m3raw_interfaces);
- m3raw_interfaces = NULL;
- Delete(m3raw_class_modifiers);
- m3raw_class_modifiers = NULL;
- Delete(m3raw_imports);
- m3raw_imports = NULL;
- Delete(m3raw_cppcasts_code);
- m3raw_cppcasts_code = NULL;
- Delete(proxy_class_def);
- proxy_class_def = NULL;
- Delete(proxy_class_code);
- proxy_class_code = NULL;
- Delete(m3wrap_name);
- m3wrap_name = NULL;
- Delete(m3wrap_modifiers);
- m3wrap_modifiers = NULL;
- Delete(targetlibrary);
- targetlibrary = NULL;
- Delete(module_baseclass);
- module_baseclass = NULL;
- Delete(module_interfaces);
- module_interfaces = NULL;
- Delete(module_imports);
- module_imports = NULL;
- Delete(upcasts_code);
- upcasts_code = NULL;
- Delete(constantfilename);
- constantfilename = NULL;
- Delete(renamefilename);
- renamefilename = NULL;
- Delete(typemapfilename);
- typemapfilename = NULL;
-
- /* Close all of the files */
- Dump(f_runtime, f_begin);
- Dump(f_header, f_begin);
- Dump(f_wrappers, f_begin);
- Wrapper_pretty_print(f_init, f_begin);
- Delete(f_header);
- Delete(f_wrappers);
- Delete(f_init);
- Delete(f_runtime);
- Delete(f_begin);
- return SWIG_OK;
- }
-
- /* -----------------------------------------------------------------------------
- * emitBanner()
- * ----------------------------------------------------------------------------- */
-
- void emitBanner(File *f) {
- Printf(f, "(*******************************************************************************\n");
- Swig_banner_target_lang(f, " *");
- Printf(f, "*******************************************************************************)\n\n");
- }
-
- /* ----------------------------------------------------------------------
- * nativeWrapper()
- * ---------------------------------------------------------------------- */
-
- virtual int nativeWrapper(Node *n) {
- String *wrapname = Getattr(n, "wrap:name");
-
- if (!addSymbol(wrapname, n))
- return SWIG_ERROR;
-
- if (Getattr(n, "type")) {
- Swig_save("nativeWrapper", n, "name", NIL);
- Setattr(n, "name", wrapname);
- native_function_flag = true;
- functionWrapper(n);
- Swig_restore(n);
- native_function_flag = false;
- } else {
- Swig_error(input_file, line_number, "No return type for %%native method %s.\n", Getattr(n, "wrap:name"));
- }
-
- return SWIG_OK;
- }
-
- /* ----------------------------------------------------------------------
- * functionWrapper()
- * ---------------------------------------------------------------------- */
-
- virtual int functionWrapper(Node *n) {
- String *type = nodeType(n);
- String *funcType = Getattr(n, "modula3:functype");
- String *rawname = Getattr(n, "name");
- String *symname = Getattr(n, "sym:name");
- String *capname = capitalizeFirst(symname);
- //String *wname = Swig_name_wrapper(symname);
-
- //printf("function: %s\n", Char(symname));
- //printf(" purpose: %s\n", Char(funcType));
-
- if (Strcmp(type, "cdecl") == 0) {
- if (funcType == NIL) {
- // no wrapper needed for plain functions
- emitM3RawPrototype(n, rawname, symname);
- emitM3Wrapper(n, symname);
- } else if (Strcmp(funcType, "method") == 0) {
- Setattr(n, "modula3:funcname", capname);
- emitCWrapper(n, capname);
- emitM3RawPrototype(n, capname, capname);
- emitM3Wrapper(n, capname);
- } else if (Strcmp(funcType, "accessor") == 0) {
- /*
- * Generate the proxy class properties for public member variables.
- * Not for enums and constants.
- */
- if (proxy_flag && wrapping_member_flag && !enum_constant_flag) {
- // Capitalize the first letter in the function name
- Setattr(n, "proxyfuncname", capname);
- Setattr(n, "imfuncname", symname);
- if (hasPrefix(capname, "Set")) {
- Setattr(n, "modula3:setname", capname);
- } else {
- Setattr(n, "modula3:getname", capname);
- }
-
- emitCWrapper(n, capname);
- emitM3RawPrototype(n, capname, capname);
- emitM3Wrapper(n, capname);
- //proxyClassFunctionHandler(n);
- }
-#ifdef DEBUG
- } else {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Function type <%s> unknown.\n", Char(funcType));
-#endif
- }
- } else if ((Strcmp(type, "constructor") == 0) || (Strcmp(type, "destructor") == 0)) {
- emitCWrapper(n, capname);
- emitM3RawPrototype(n, capname, capname);
- emitM3Wrapper(n, capname);
- }
-// a Java relict
-#if 0
- if (!(proxy_flag && is_wrapping_class()) && !enum_constant_flag) {
- emitM3Wrapper(n, capname);
- }
-#endif
-
- Delete(capname);
-
- return SWIG_OK;
- }
-
- /* ----------------------------------------------------------------------
- * emitCWrapper()
- *
- * Generate the wrapper in C which calls C++ methods.
- * ---------------------------------------------------------------------- */
-
- virtual int emitCWrapper(Node *n, const String *wname) {
- String *rawname = Getattr(n, "name");
- String *c_return_type = NewString("");
- String *cleanup = NewString("");
- String *outarg = NewString("");
- String *body = NewString("");
- Hash *throws_hash = NewHash();
- ParmList *l = Getattr(n, "parms");
- SwigType *t = Getattr(n, "type");
- String *symname = Getattr(n, "sym:name");
-
- if (!Getattr(n, "sym:overloaded")) {
- if (!addSymbol(wname, n)) {
- return SWIG_ERROR;
- }
- }
- // A new wrapper function object
- Wrapper *f = NewWrapper();
-
- /* Attach the non-standard typemaps to the parameter list. */
- Swig_typemap_attach_parms("ctype", l, f);
-
- /* Get return types */
- {
- String *tm = getMappedTypeNew(n, "ctype", "");
- if (tm != NIL) {
- Printf(c_return_type, "%s", tm);
- }
- }
-
- bool is_void_return = (Cmp(c_return_type, "void") == 0);
- if (!is_void_return) {
- Wrapper_add_localv(f, "cresult", c_return_type, "cresult = 0", NIL);
- }
-
- Printv(f->def, " SWIGEXPORT ", c_return_type, " ", wname, "(", NIL);
-
- // Emit all of the local variables for holding arguments.
- emit_parameter_variables(l, f);
-
- /* Attach the standard typemaps */
- emit_attach_parmmaps(l, f);
- Setattr(n, "wrap:parms", l);
-
- // Generate signature and argument conversion for C wrapper
- {
- Parm *p;
- attachParameterNames(n, "tmap:name", "c:wrapname", "m3arg%d");
- bool gencomma = false;
- for (p = skipIgnored(l, "in"); p; p = skipIgnored(p, "in")) {
-
- String *arg = Getattr(p, "c:wrapname");
- {
- /* Get the ctype types of the parameter */
- String *c_param_type = getMappedType(p, "ctype");
- // Add parameter to C function
- Printv(f->def, gencomma ? ", " : "", c_param_type, " ", arg, NIL);
- Delete(c_param_type);
- gencomma = true;
- }
-
- // Get typemap for this argument
- String *tm = getMappedType(p, "in");
- if (tm != NIL) {
- addThrows(throws_hash, "in", p);
- Replaceall(tm, "$input", arg);
- Setattr(p, "emit:input", arg); /*??? */
- Printf(f->code, "%s\n", tm);
- p = Getattr(p, "tmap:in:next");
- } else {
- p = nextSibling(p);
- }
- }
- }
-
- /* Insert constraint checking code */
- {
- Parm *p;
- for (p = l; p;) {
- String *tm = Getattr(p, "tmap:check");
- if (tm != NIL) {
- addThrows(throws_hash, "check", p);
- Replaceall(tm, "$arg", Getattr(p, "emit:input")); /* deprecated? */
- Replaceall(tm, "$input", Getattr(p, "emit:input"));
- Printv(f->code, tm, "\n", NIL);
- p = Getattr(p, "tmap:check:next");
- } else {
- p = nextSibling(p);
- }
- }
- }
-
- /* Insert cleanup code */
- {
- Parm *p;
- for (p = l; p;) {
- String *tm = Getattr(p, "tmap:freearg");
- if (tm != NIL) {
- addThrows(throws_hash, "freearg", p);
- Replaceall(tm, "$arg", Getattr(p, "emit:input")); /* deprecated? */
- Replaceall(tm, "$input", Getattr(p, "emit:input"));
- Printv(cleanup, tm, "\n", NIL);
- p = Getattr(p, "tmap:freearg:next");
- } else {
- p = nextSibling(p);
- }
- }
- }
-
- /* Insert argument output code */
- {
- Parm *p;
- for (p = l; p;) {
- String *tm = Getattr(p, "tmap:argout");
- if (tm != NIL) {
- addThrows(throws_hash, "argout", p);
- Replaceall(tm, "$arg", Getattr(p, "emit:input")); /* deprecated? */
- Replaceall(tm, "$result", "cresult");
- Replaceall(tm, "$input", Getattr(p, "emit:input"));
- Printv(outarg, tm, "\n", NIL);
- p = Getattr(p, "tmap:argout:next");
- } else {
- p = nextSibling(p);
- }
- }
- }
-
- // Get any Modula 3 exception classes in the throws typemap
- ParmList *throw_parm_list = NULL;
- if ((throw_parm_list = Getattr(n, "catchlist"))) {
- Swig_typemap_attach_parms("throws", throw_parm_list, f);
- Parm *p;
- for (p = throw_parm_list; p; p = nextSibling(p)) {
- addThrows(throws_hash, "throws", p);
- }
- }
-
- Setattr(n, "wrap:name", wname);
-
- // Now write code to make the function call
- if (!native_function_flag) {
- String *actioncode = emit_action(n);
-
- /* Return value if necessary */
- String *tm;
- if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) {
- addThrows(throws_hash, "out", n);
- Replaceall(tm, "$result", "cresult");
- Printf(f->code, "%s", tm);
- if (hasContent(tm))
- Printf(f->code, "\n");
- } else {
- Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number, "Unable to use return type %s in function %s.\n", SwigType_str(t, 0), rawname);
- }
- emit_return_variable(n, t, f);
- }
-
- /* Output argument output code */
- Printv(f->code, outarg, NIL);
-
- /* Output cleanup code */
- Printv(f->code, cleanup, NIL);
-
- /* Look to see if there is any newfree cleanup code */
- if (GetFlag(n, "feature:new")) {
- String *tm = Swig_typemap_lookup("newfree", n, Swig_cresult_name(), 0);
- if (tm != NIL) {
- addThrows(throws_hash, "newfree", n);
- Printf(f->code, "%s\n", tm);
- }
- }
-
- /* See if there is any return cleanup code */
- if (!native_function_flag) {
- String *tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0);
- if (tm != NIL) {
- Printf(f->code, "%s\n", tm);
- }
- }
-
- /* Finish C wrapper */
- Printf(f->def, ") {");
-
- if (!is_void_return)
- Printv(f->code, " return cresult;\n", NIL);
- Printf(f->code, "}\n");
-
- /* Substitute the cleanup code */
- Replaceall(f->code, "$cleanup", cleanup);
-
- /* Substitute the function name */
- Replaceall(f->code, "$symname", symname);
-
- if (!is_void_return) {
- Replaceall(f->code, "$null", "0");
- } else {
- Replaceall(f->code, "$null", "");
- }
-
- /* Dump the function out */
- if (!native_function_flag) {
- Wrapper_print(f, f_wrappers);
- }
-
- Delete(c_return_type);
- Delete(cleanup);
- Delete(outarg);
- Delete(body);
- Delete(throws_hash);
- DelWrapper(f);
- return SWIG_OK;
- }
-
- /* ----------------------------------------------------------------------
- * emitM3RawPrototype()
- *
- * Generate an EXTERNAL procedure declaration in Modula 3
- * which is the interface to an existing C routine or a C wrapper.
- * ---------------------------------------------------------------------- */
-
- virtual int emitM3RawPrototype(Node *n, const String *cname, const String *m3name) {
- String *im_return_type = NewString("");
- //String *symname = Getattr(n,"sym:name");
- ParmList *l = Getattr(n, "parms");
-
- /* Attach the non-standard typemaps to the parameter list. */
- Swig_typemap_attach_parms("m3rawinmode", l, NULL);
- Swig_typemap_attach_parms("m3rawintype", l, NULL);
-
- /* Get return types */
- bool has_return;
- {
- String *tm = getMappedTypeNew(n, "m3rawrettype", "");
- if (tm != NIL) {
- Printf(im_return_type, "%s", tm);
- }
- has_return = hasContent(tm);
- }
-
- /* cname is the original name if 'n' denotes a C function
- and it is the relabeled name (sym:name) if 'n' denotes a C++ method or similar */
- m3raw_intf.enterBlock(no_block);
- Printf(m3raw_intf.f, "\n<* EXTERNAL %s *>\nPROCEDURE %s (", cname, m3name);
-
- // Generate signature for raw interface
- {
- Parm *p;
- writeArgState state;
- attachParameterNames(n, "tmap:rawinname", "modula3:rawname", "arg%d");
- for (p = skipIgnored(l, "m3rawintype"); p; p = skipIgnored(p, "m3rawintype")) {
-
- /* Get argument passing mode, should be one of VALUE, VAR, READONLY */
- String *mode = Getattr(p, "tmap:m3rawinmode");
- String *argname = Getattr(p, "modula3:rawname");
- String *im_param_type = getMappedType(p, "m3rawintype");
- addImports(m3raw_intf.import, "m3rawintype", p);
-
- writeArg(m3raw_intf.f, state, mode, argname, im_param_type, NIL);
- if (im_param_type != NIL) {
- p = Getattr(p, "tmap:m3rawintype:next");
- } else {
- p = nextSibling(p);
- }
- }
- writeArg(m3raw_intf.f, state, NIL, NIL, NIL, NIL);
- }
-
- /* Finish M3 raw prototype */
- Printf(m3raw_intf.f, ")");
- // neither a C wrapper nor a plain C function may throw an exception
- //generateThrowsClause(throws_hash, m3raw_intf.f);
- if (has_return) {
- Printf(m3raw_intf.f, ": %s", im_return_type);
- }
- Printf(m3raw_intf.f, ";\n");
-
- Delete(im_return_type);
- return SWIG_OK;
- }
-
- /* -----------------------------------------------------------------------
- * variableWrapper()
- * ----------------------------------------------------------------------- */
-
- virtual int variableWrapper(Node *n) {
- Language::variableWrapper(n);
- return SWIG_OK;
- }
-
- /* -----------------------------------------------------------------------
- * globalvariableHandler()
- * ----------------------------------------------------------------------- */
-
- virtual int globalvariableHandler(Node *n) {
- SwigType *t = Getattr(n, "type");
- String *tm;
-
- // Get the variable type
- if ((tm = getMappedTypeNew(n, "m3wraptype", ""))) {
- substituteClassname(t, tm);
- }
-
- variable_name = Getattr(n, "sym:name");
- variable_type = Copy(tm);
-
- // Get the variable type expressed in terms of Modula 3 equivalents of C types
- if ((tm = getMappedTypeNew(n, "m3rawtype", ""))) {
- m3raw_intf.enterBlock(no_block);
- Printf(m3raw_intf.f, "\n<* EXTERNAL *> VAR %s: %s;\n", variable_name, tm);
- }
- // Output the property's accessor methods
- /*
- global_variable_flag = true;
- int ret = Language::globalvariableHandler(n);
- global_variable_flag = false;
- */
-
- Printf(m3wrap_impl.f, "\n\n");
-
- //return ret;
- return 1;
- }
-
- long getConstNumeric(Node *n) {
- String *constnumeric = Getfeature(n, "constnumeric");
- String *name = Getattr(n, "name");
- long numvalue;
- if (constnumeric == NIL) {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Feature 'constnumeric' is necessary to obtain value of %s.\n", name);
- return 0;
- } else if (!strToL(constnumeric, numvalue)) {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number,
- "The feature 'constnumeric' of %s specifies value <%s> which is not an integer constant.\n", name, constnumeric);
- return 0;
- } else {
- return numvalue;
- }
- }
-
- /* ------------------------------------------------------------------------
- * generateIntConstant()
- *
- * Considers node as an integer constant definition
- * and generate a Modula 3 constant definition.
- * ------------------------------------------------------------------------ */
- void generateIntConstant(Node *n, String *name) {
- String *value = Getattr(n, "value");
- String *type = Getfeature(n, "modula3:constint:type");
- String *conv = Getfeature(n, "modula3:constint:conv");
-
- if (name == NIL) {
- name = Getattr(n, "sym:name");
- }
-
- long numvalue;
- bool isSimpleNum = strToL(value, numvalue);
- if (!isSimpleNum) {
- numvalue = getConstNumeric(n);
- }
-
- String *m3value;
- if ((conv == NIL) || ((Strcmp(conv, "set:int") != 0) && (Strcmp(conv, "int:set") != 0))) {
- /* The original value of the constant has precedence over
- 'constnumeric' feature since we like to keep
- the style (that is the base) of simple numeric constants */
- if (isSimpleNum) {
- if (hasPrefix(value, "0x")) {
- m3value = NewStringf("16_%s", Char(value) + 2);
- } else if ((Len(value) > 1) && (*Char(value) == '0')) {
- m3value = NewStringf("8_%s", Char(value) + 1);
- } else {
- m3value = Copy(value);
- }
- /* If we cannot easily obtain the value of a numeric constant,
- we use the results given by a C compiler. */
- } else {
- m3value = Copy(Getfeature(n, "constnumeric"));
- }
- } else {
- // if the value can't be converted, it is ignored
- if (convertInt(numvalue, numvalue, conv)) {
- m3value = NewStringf("%d", numvalue);
- } else {
- m3value = NIL;
- }
- }
-
- if (m3value != NIL) {
- m3wrap_intf.enterBlock(constant);
- Printf(m3wrap_intf.f, "%s", name);
- if (hasContent(type)) {
- Printf(m3wrap_intf.f, ": %s", type);
- }
- Printf(m3wrap_intf.f, " = %s;\n", m3value);
- Delete(m3value);
- }
- }
-
- /* -----------------------------------------------------------------------
- * generateSetConstant()
- *
- * Considers node as a set constant definition
- * and generate a Modula 3 constant definition.
- * ------------------------------------------------------------------------ */
- void generateSetConstant(Node *n, String *name) {
- String *value = Getattr(n, "value");
- String *type = Getfeature(n, "modula3:constset:type");
- String *setname = Getfeature(n, "modula3:constset:set");
- String *basename = Getfeature(n, "modula3:constset:base");
- String *conv = Getfeature(n, "modula3:constset:conv");
-
- m3wrap_intf.enterBlock(constant);
-
- Printf(m3wrap_intf.f, "%s", name);
- if (type != NIL) {
- Printf(m3wrap_intf.f, ":%s ", type);
- }
- Printf(m3wrap_intf.f, " = %s{", setname);
-
- long numvalue = 0;
- if (!strToL(value, numvalue)) {
- numvalue = getConstNumeric(n);
- }
- convertInt(numvalue, numvalue, conv);
-
- bool isIntType = Strcmp(basename, "CARDINAL") == 0;
- Hash *items = NIL;
- if (!isIntType) {
- Hash *enumeration = Getattr(enumeration_coll, basename);
- if (enumeration == NIL) {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "There is no enumeration <%s> as needed for the set.\n", setname);
- isIntType = true;
- } else {
- items = Getattr(enumeration, "items");
- }
- }
-
- bool gencomma = false;
- int bitpos = 0;
- while (numvalue > 0) {
- if ((numvalue & 1) != 0) {
- if (isIntType) {
- if (gencomma) {
- Printv(m3wrap_intf.f, ",", NIL);
- }
- gencomma = true;
- Printf(m3wrap_intf.f, "%d", bitpos);
- } else {
- char bitval[15];
- sprintf(bitval, "%d", bitpos);
- String *bitname = Getattr(items, bitval);
- if (bitname == NIL) {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Enumeration <%s> has no value <%s>.\n", setname, bitval);
- } else {
- if (gencomma) {
- Printv(m3wrap_intf.f, ",", NIL);
- }
- gencomma = true;
- Printf(m3wrap_intf.f, "%s.%s", basename, bitname);
- }
- }
- }
- numvalue >>= 1;
- bitpos++;
- }
- Printf(m3wrap_intf.f, "};\n");
- }
-
- void generateConstant(Node *n) {
- // any of the special interpretation disables the default behaviour
- String *enumitem = Getfeature(n, "modula3:enumitem:name");
- String *constset = Getfeature(n, "modula3:constset:name");
- String *constint = Getfeature(n, "modula3:constint:name");
- if (hasContent(enumitem) || hasContent(constset) || hasContent(constint)) {
- if (hasContent(constset)) {
- generateSetConstant(n, constset);
- }
- if (hasContent(constint)) {
- generateIntConstant(n, constint);
- }
- } else {
- String *value = Getattr(n, "value");
- String *name = Getattr(n, "sym:name");
- if (name == NIL) {
- name = Getattr(n, "name");
- }
- m3wrap_intf.enterBlock(constant);
- Printf(m3wrap_intf.f, "%s = %s;\n", name, value);
- }
- }
-
- void emitEnumeration(File *file, String *name, Node *n) {
- Printf(file, "%s = {", name);
- int i;
- bool gencomma = false;
- int max = aToL(Getattr(n, "max"));
- Hash *items = Getattr(n, "items");
- for (i = 0; i <= max; i++) {
- if (gencomma) {
- Printf(file, ",");
- }
- Printf(file, "\n");
- gencomma = true;
- char numstr[15];
- sprintf(numstr, "%d", i);
- String *name = Getattr(items, numstr);
- if (name != NIL) {
- Printv(file, name, NIL);
- } else {
- Printf(file, "Dummy%d", i);
- }
- }
- Printf(file, "\n};\n");
- }
-
- /* -----------------------------------------------------------------------
- * constantWrapper()
- *
- * Handles constants and enumeration items.
- * ------------------------------------------------------------------------ */
-
- virtual int constantWrapper(Node *n) {
- generateConstant(n);
- return SWIG_OK;
- }
-
-#if 0
-// enumerations are handled like constant definitions
- /* -----------------------------------------------------------------------------
- * enumDeclaration()
- * ----------------------------------------------------------------------------- */
-
- virtual int enumDeclaration(Node *n) {
- String *symname = nameToModula3(Getattr(n, "sym:name"), true);
- enumerationStart(symname);
- int result = Language::enumDeclaration(n);
- enumerationStop();
- Delete(symname);
- return result;
- }
-#endif
-
- /* -----------------------------------------------------------------------------
- * enumvalueDeclaration()
- * ----------------------------------------------------------------------------- */
-
- virtual int enumvalueDeclaration(Node *n) {
- generateConstant(n);
- /*
- This call would continue processing in the constantWrapper
- which cannot handle values like "RED+1".
- return Language::enumvalueDeclaration(n);
- */
- return SWIG_OK;
- }
-
- /* -----------------------------------------------------------------------------
- * pragmaDirective()
- *
- * Valid Pragmas:
- * imclassbase - base (extends) for the intermediary class
- * imclassclassmodifiers - class modifiers for the intermediary class
- * imclasscode - text (Modula 3 code) is copied verbatim to the intermediary class
- * imclassimports - import statements for the intermediary class
- * imclassinterfaces - interface (implements) for the intermediary class
- *
- * modulebase - base (extends) for the module class
- * moduleclassmodifiers - class modifiers for the module class
- * modulecode - text (Modula 3 code) is copied verbatim to the module class
- * moduleimports - import statements for the module class
- * moduleinterfaces - interface (implements) for the module class
- *
- * ----------------------------------------------------------------------------- */
-
- virtual int pragmaDirective(Node *n) {
- if (!ImportMode) {
- String *lang = Getattr(n, "lang");
- String *code = Getattr(n, "name");
- String *value = Getattr(n, "value");
-
- if (Strcmp(lang, "modula3") == 0) {
-
- String *strvalue = NewString(value);
- Replaceall(strvalue, "\\\"", "\"");
-/*
- bool isEnumItem = Strcmp(code, "enumitem") == 0;
- bool isSetItem = Strcmp(code, "setitem") == 0;
-*/
- if (Strcmp(code, "imclassbase") == 0) {
- Delete(m3raw_baseclass);
- m3raw_baseclass = Copy(strvalue);
- } else if (Strcmp(code, "imclassclassmodifiers") == 0) {
- Delete(m3raw_class_modifiers);
- m3raw_class_modifiers = Copy(strvalue);
- } else if (Strcmp(code, "imclasscode") == 0) {
- Printf(m3raw_intf.f, "%s\n", strvalue);
- } else if (Strcmp(code, "imclassimports") == 0) {
- Delete(m3raw_imports);
- m3raw_imports = Copy(strvalue);
- } else if (Strcmp(code, "imclassinterfaces") == 0) {
- Delete(m3raw_interfaces);
- m3raw_interfaces = Copy(strvalue);
- } else if (Strcmp(code, "modulebase") == 0) {
- Delete(module_baseclass);
- module_baseclass = Copy(strvalue);
- } else if (Strcmp(code, "moduleclassmodifiers") == 0) {
- Delete(m3wrap_modifiers);
- m3wrap_modifiers = Copy(strvalue);
- } else if (Strcmp(code, "modulecode") == 0) {
- Printf(m3wrap_impl.f, "%s\n", strvalue);
- } else if (Strcmp(code, "moduleimports") == 0) {
- Delete(module_imports);
- module_imports = Copy(strvalue);
- } else if (Strcmp(code, "moduleinterfaces") == 0) {
- Delete(module_interfaces);
- module_interfaces = Copy(strvalue);
- } else if (Strcmp(code, "unsafe") == 0) {
- unsafe_module = true;
- } else if (Strcmp(code, "library") == 0) {
- if (targetlibrary) {
- Delete(targetlibrary);
- }
- targetlibrary = Copy(strvalue);
- } else if (Strcmp(code, "enumitem") == 0) {
- } else if (Strcmp(code, "constset") == 0) {
- } else if (Strcmp(code, "constint") == 0) {
- } else if (Strcmp(code, "makesetofenum") == 0) {
- m3wrap_intf.enterBlock(blocktype);
- Printf(m3wrap_intf.f, "%sSet = SET OF %s;\n", value, value);
- } else {
- Swig_warning(WARN_MODULA3_UNKNOWN_PRAGMA, input_file, line_number, "Unrecognized pragma <%s>.\n", code);
- }
- Delete(strvalue);
- }
- }
- return Language::pragmaDirective(n);
- }
-
- void Setfeature(Node *n, const char *feature, const String *value, bool warn = false) {
- //printf("tag feature <%s> with value <%s>\n", feature, Char(value));
- String *attr = NewStringf("feature:%s", feature);
- if ((Setattr(n, attr, value) != 0) && warn) {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Feature <%s> of %s did already exist.\n", feature, Getattr(n, "name"));
- }
- Delete(attr);
- }
-
- String *Getfeature(Node *n, const char *feature) {
- //printf("retrieve feature <%s> with value <%s>\n", feature, Char(value));
- String *attr = NewStringf("feature:%s", feature);
- String *result = Getattr(n, attr);
- Delete(attr);
- return result;
- }
-
- bool convertInt(long in, long &out, const String *mode) {
- if ((mode == NIL) || (Strcmp(mode, "int:int") == 0) || (Strcmp(mode, "set:set") == 0)) {
- out = in;
- return true;
- } else if (Strcmp(mode, "set:int") == 0) {
- return log2(in, out);
- } else if (Strcmp(mode, "int:set") == 0) {
- out = 1L << in;
- return unsigned (in) < (sizeof(out) * 8);
- } else {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Unknown integer conversion method <%s>.\n", mode);
- return false;
- }
- }
-
- void collectEnumerations(Hash *enums, Node *n) {
- Node *child = firstChild(n);
- while (child != NIL) {
- String *name = Getattr(child, "name");
- const bool isConstant = Strcmp(nodeType(child), "constant") == 0;
- const bool isEnumItem = Strcmp(nodeType(child), "enumitem") == 0;
- if (isConstant || isEnumItem) {
-//printf("%s%s name %s\n", isConstant?"constant":"", isEnumItem?"enumitem":"", Char(name));
- {
- String *m3name = Getfeature(child, "modula3:enumitem:name");
- String *m3enum = Getfeature(child, "modula3:enumitem:enum");
- String *conv = Getfeature(child, "modula3:enumitem:conv");
-
- if (m3enum != NIL) {
-//printf("m3enum %s\n", Char(m3enum));
- if (m3name == NIL) {
- m3name = name;
- }
-
- long max = -1;
- Hash *items;
- Hash *enumnode = Getattr(enums, m3enum);
- if (enumnode == NIL) {
- enumnode = NewHash();
- items = NewHash();
- Setattr(enumnode, "items", items);
- Setattr(enums, m3enum, enumnode);
- } else {
- String *maxstr = Getattr(enumnode, "max");
- if (maxstr != NIL) {
- max = aToL(maxstr);
- }
- items = Getattr(enumnode, "items");
- }
- long numvalue;
- String *value = Getattr(child, "value");
-//printf("value: %s\n", Char(value));
- if ((value == NIL) || (!strToL(value, numvalue))) {
- value = Getattr(child, "enumvalue");
- if ((value == NIL) || (!evalExpr(value, numvalue))) {
- numvalue = getConstNumeric(child);
- }
-//printf("constnumeric: %s\n", Char(value));
- }
- Setattr(constant_values, name, NewStringf("%d", numvalue));
- if (convertInt(numvalue, numvalue, conv)) {
- String *newvalue = NewStringf("%d", numvalue);
- String *oldname = Getattr(items, newvalue);
- if (oldname != NIL) {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "The value <%s> is already assigned to <%s>.\n", value, oldname);
- }
-//printf("items %p, set %s = %s\n", items, Char(newvalue), Char(m3name));
- Setattr(items, newvalue, m3name);
- if (max < numvalue) {
- max = numvalue;
- }
- Setattr(enumnode, "max", NewStringf("%d", max));
- }
- }
- }
- }
-
- collectEnumerations(enums, child);
- child = nextSibling(child);
- }
- }
-
- enum const_pragma_type { cpt_none, cpt_constint, cpt_constset, cpt_enumitem };
-
- struct const_id_pattern {
- String *prefix, *parentEnum;
- };
-
- void tagConstants(Node *first, String *parentEnum, const const_id_pattern & pat, const String *pragma, List *convdesc) {
- Node *n = first;
- while (n != NIL) {
- String *name = getQualifiedName(n);
- bool isConstant = Strcmp(nodeType(n), "constant") == 0;
- bool isEnumItem = Strcmp(nodeType(n), "enumitem") == 0;
- if ((isConstant || isEnumItem) && ((pat.prefix == NIL) || (hasPrefix(name, pat.prefix))) && ((pat.parentEnum == NIL) || ((parentEnum != NIL)
- &&
- (Strcmp
- (pat.parentEnum, parentEnum)
- == 0)))) {
- //printf("tag %s\n", Char(name));
- String *srctype = Getitem(convdesc, 1);
- String *relationstr = Getitem(convdesc, 3);
- List *relationdesc = Split(relationstr, ',', 2);
-
- // transform name from C to Modula3 style
- String *srcstyle = NIL;
- String *newprefix = NIL;
- {
- //printf("name conversion <%s>\n", Char(Getitem(convdesc,2)));
- List *namedesc = Split(Getitem(convdesc, 2), ',', INT_MAX);
- Iterator nameit = First(namedesc);
- for (; nameit.item != NIL; nameit = Next(nameit)) {
- List *nameassign = Split(nameit.item, '=', 2);
- String *tag = Getitem(nameassign, 0);
- String *data = Getitem(nameassign, 1);
- //printf("name conv <%s> = <%s>\n", Char(tag), Char(data));
- if (Strcmp(tag, "srcstyle") == 0) {
- srcstyle = Copy(data);
- } else if (Strcmp(tag, "prefix") == 0) {
- newprefix = Copy(data);
- } else {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Unknown name conversion tag <%s> with value <%s>.\n", tag, data);
- }
- Delete(nameassign);
- }
- Delete(namedesc);
- }
- const char *stem = Char(name);
- if (pat.prefix != NIL) {
- //printf("pat.prefix %s for %s\n", Char(pat.prefix), Char(name));
- stem += Len(pat.prefix);
- }
- String *newname;
- if (srcstyle && Strcmp(srcstyle, "underscore") == 0) {
- if (newprefix != NIL) {
- String *newstem = nameToModula3(stem, true);
- newname = NewStringf("%s%s", newprefix, newstem);
- Delete(newstem);
- } else {
- newname = nameToModula3(stem, true);
- }
- } else {
- if (srcstyle != NIL) {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Unknown C identifier style <%s>.\n", srcstyle);
- }
- newname = Copy(name);
- }
-
- if (Strcmp(pragma, "enumitem") == 0) {
- if (Len(relationdesc) != 1) {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Expected <enumeration>, got <%s>.\n", relationstr);
- }
- Setfeature(n, "modula3:enumitem:name", newname, true);
- Setfeature(n, "modula3:enumitem:enum", relationstr, true);
- Setfeature(n, "modula3:enumitem:conv", NewStringf("%s:int", srctype), true);
- } else if (Strcmp(pragma, "constint") == 0) {
- if (Len(relationdesc) != 1) {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Expected <ordinal type>, got <%s>.\n", relationstr);
- }
- Setfeature(n, "modula3:constint:name", newname, true);
- Setfeature(n, "modula3:constint:type", Getitem(relationdesc, 0), true);
- Setfeature(n, "modula3:constint:conv", NewStringf("%s:int", srctype), true);
- } else if (Strcmp(pragma, "constset") == 0) {
- if (Len(relationdesc) != 2) {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Expected <set type,base type>, got <%s>.\n", relationstr);
- }
- String *settype = Getitem(relationdesc, 0);
- Setfeature(n, "modula3:constset:name", newname, true);
- //Setfeature(n,"modula3:constset:type",settype,true);
- Setfeature(n, "modula3:constset:set", settype, true);
- Setfeature(n, "modula3:constset:base", Getitem(relationdesc, 1), true);
- Setfeature(n, "modula3:constset:conv", NewStringf("%s:set", srctype), true);
- }
-
- Delete(newname);
- Delete(relationdesc);
- }
-
- if (Strcmp(nodeType(n), "enum") == 0) {
- //printf("explore enum %s, qualification %s\n", Char(name), Char(Swig_symbol_qualified(n)));
- tagConstants(firstChild(n), name, pat, pragma, convdesc);
- } else {
- tagConstants(firstChild(n), NIL, pat, pragma, convdesc);
- }
- n = nextSibling(n);
- }
- }
-
- void scanForConstPragmas(Node *n) {
- Node *child = firstChild(n);
- while (child != NIL) {
- const String *type = nodeType(child);
- if (Strcmp(type, "pragma") == 0) {
- const String *lang = Getattr(child, "lang");
- const String *code = Getattr(child, "name");
- String *value = Getattr(child, "value");
-
- if (Strcmp(lang, "modula3") == 0) {
- const_pragma_type cpt = cpt_none;
- if (Strcmp(code, "constint") == 0) {
- cpt = cpt_constint;
- } else if (Strcmp(code, "constset") == 0) {
- cpt = cpt_constset;
- } else if (Strcmp(code, "enumitem") == 0) {
- cpt = cpt_enumitem;
- }
- if (cpt != cpt_none) {
- const_id_pattern pat = { NIL, NIL };
-
- List *convdesc = Split(value, ';', 4);
- List *patterndesc = Split(Getitem(convdesc, 0), ',', INT_MAX);
- Iterator patternit;
- for (patternit = First(patterndesc); patternit.item != NIL; patternit = Next(patternit)) {
- List *patternassign = Split(patternit.item, '=', 2);
- String *tag = Getitem(patternassign, 0);
- String *data = Getitem(patternassign, 1);
- if (Strcmp(tag, "prefix") == 0) {
- pat.prefix = Copy(data);
- } else if (Strcmp(tag, "enum") == 0) {
- pat.parentEnum = Copy(data);
- } else {
- Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Unknown identification tag <%s> with value <%s>.\n", tag, data);
- }
- Delete(patternassign);
- }
- tagConstants(child, NIL, pat, code, convdesc);
-
- Delete(patterndesc);
- }
- }
- }
- scanForConstPragmas(child);
- child = nextSibling(child);
- }
- }
-
- /* -----------------------------------------------------------------------------
- * emitProxyClassDefAndCPPCasts()
- * ----------------------------------------------------------------------------- */
-
- void emitProxyClassDefAndCPPCasts(Node *n) {
- String *c_classname = SwigType_namestr(Getattr(n, "name"));
- String *c_baseclass = NULL;
- String *baseclass = NULL;
- String *c_baseclassname = NULL;
- String *name = Getattr(n, "name");
-
- /* Deal with inheritance */
- List *baselist = Getattr(n, "bases");
- if (baselist) {
- Iterator base = First(baselist);
- while (base.item) {
- if (!GetFlag(base.item, "feature:ignore")) {
- String *baseclassname = Getattr(base.item, "name");
- if (!c_baseclassname) {
- c_baseclassname = baseclassname;
- baseclass = Copy(getProxyName(baseclassname));
- if (baseclass)
- c_baseclass = SwigType_namestr(baseclassname);
- } else {
- /* Warn about multiple inheritance for additional base class(es) */
- String *proxyclassname = Getattr(n, "classtypeobj");
- Swig_warning(WARN_MODULA3_MULTIPLE_INHERITANCE, Getfile(n), Getline(n),
- "Warning for %s, base %s ignored. Multiple inheritance is not supported in Modula 3.\n", SwigType_namestr(proxyclassname), SwigType_namestr(baseclassname));
- }
- }
- base = Next(base);
- }
- }
-
- bool derived = baseclass && getProxyName(c_baseclassname);
- if (!baseclass)
- baseclass = NewString("");
-
- // Inheritance from pure Modula 3 classes
- const String *pure_baseclass = typemapLookup(n, "m3base", name, WARN_NONE);
- if (hasContent(pure_baseclass) && hasContent(baseclass)) {
- Swig_warning(WARN_MODULA3_MULTIPLE_INHERITANCE, Getfile(n), Getline(n),
- "Warning for %s, base %s ignored. Multiple inheritance is not supported in Modula 3.\n", name, pure_baseclass);
- }
- // Pure Modula 3 interfaces
- const String *pure_interfaces = typemapLookup(n, derived ? "m3interfaces_derived" : "m3interfaces",
- name, WARN_NONE);
-
- // Start writing the proxy class
- Printv(proxy_class_def, typemapLookup(n, "m3imports", name, WARN_NONE), // Import statements
- "\n", typemapLookup(n, "m3classmodifiers", name, WARN_MODULA3_TYPEMAP_CLASSMOD_UNDEF), // Class modifiers
- " class $m3classname", // Class name and bases
- (derived || *Char(pure_baseclass) || *Char(pure_interfaces)) ? " : " : "", baseclass, pure_baseclass, ((derived || *Char(pure_baseclass)) && *Char(pure_interfaces)) ? // Interfaces
- ", " : "", pure_interfaces, " {\n", " private IntPtr swigCPtr;\n", // Member variables for memory handling
- derived ? "" : " protected bool swigCMemOwn;\n", "\n", " ", typemapLookup(n, "m3ptrconstructormodifiers", name, WARN_MODULA3_TYPEMAP_PTRCONSTMOD_UNDEF), // pointer constructor modifiers
- " $m3classname(IntPtr cPtr, bool cMemoryOwn) ", // Constructor used for wrapping pointers
- derived ?
- ": base($imclassname.$m3classnameTo$baseclass(cPtr), cMemoryOwn) {\n"
- : "{\n swigCMemOwn = cMemoryOwn;\n", " swigCPtr = cPtr;\n", " }\n", NIL);
-
- if (!have_default_constructor_flag) { // All proxy classes need a constructor
- Printv(proxy_class_def, "\n", " protected $m3classname() : this(IntPtr.Zero, false) {\n", " }\n", NIL);
- }
- // C++ destructor is wrapped by the Dispose method
- // Note that the method name is specified in a typemap attribute called methodname
- String *destruct = NewString("");
- const String *tm = NULL;
- Node *attributes = NewHash();
- String *destruct_methodname = NULL;
- if (derived) {
- tm = typemapLookup(n, "m3destruct_derived", name, WARN_NONE, attributes);
- destruct_methodname = Getattr(attributes, "tmap:m3destruct_derived:methodname");
- } else {
- tm = typemapLookup(n, "m3destruct", name, WARN_NONE, attributes);
- destruct_methodname = Getattr(attributes, "tmap:m3destruct:methodname");
- }
- if (!destruct_methodname) {
- Swig_error(Getfile(n), Getline(n), "No methodname attribute defined in m3destruct%s typemap for %s\n", (derived ? "_derived" : ""), proxy_class_name);
- }
- // Emit the Finalize and Dispose methods
- if (tm) {
- // Finalize method
- if (*Char(destructor_call)) {
- Printv(proxy_class_def, typemapLookup(n, "m3finalize", name, WARN_NONE), NIL);
- }
- // Dispose method
- Printv(destruct, tm, NIL);
- if (*Char(destructor_call))
- Replaceall(destruct, "$imcall", destructor_call);
- else
- Replaceall(destruct, "$imcall", "throw new MethodAccessException(\"C++ destructor does not have public access\")");
- if (*Char(destruct))
- Printv(proxy_class_def, "\n public ", derived ? "override" : "virtual", " void ", destruct_methodname, "() ", destruct, "\n", NIL);
- }
- Delete(attributes);
- Delete(destruct);
-
- // Emit various other methods
- Printv(proxy_class_def, typemapLookup(n, "m3getcptr", name, WARN_MODULA3_TYPEMAP_GETCPTR_UNDEF), // getCPtr method
- typemapLookup(n, "m3code", name, WARN_NONE), // extra Modula 3 code
- "\n", NIL);
-
- // Substitute various strings into the above template
- Replaceall(proxy_class_def, "$m3classname", proxy_class_name);
- Replaceall(proxy_class_code, "$m3classname", proxy_class_name);
-
- Replaceall(proxy_class_def, "$baseclass", baseclass);
- Replaceall(proxy_class_code, "$baseclass", baseclass);
-
- Replaceall(proxy_class_def, "$imclassname", m3raw_name);
- Replaceall(proxy_class_code, "$imclassname", m3raw_name);
-
- // Add code to do C++ casting to base class (only for classes in an inheritance hierarchy)
- if (derived) {
- Printv(m3raw_cppcasts_code, "\n [DllImport(\"", m3wrap_name, "\", EntryPoint=\"Modula3_", proxy_class_name, "To", baseclass, "\")]\n", NIL);
- Printv(m3raw_cppcasts_code, " public static extern IntPtr ", "$m3classnameTo$baseclass(IntPtr objectRef);\n", NIL);
-
- Replaceall(m3raw_cppcasts_code, "$m3classname", proxy_class_name);
- Replaceall(m3raw_cppcasts_code, "$baseclass", baseclass);
-
- Printv(upcasts_code,
- "SWIGEXPORT long Modula3_$imclazznameTo$imbaseclass",
- "(long objectRef) {\n",
- " long baseptr = 0;\n" " *($cbaseclass **)&baseptr = *($cclass **)&objectRef;\n" " return baseptr;\n" "}\n", "\n", NIL);
-
- Replaceall(upcasts_code, "$imbaseclass", baseclass);
- Replaceall(upcasts_code, "$cbaseclass", c_baseclass);
- Replaceall(upcasts_code, "$imclazzname", proxy_class_name);
- Replaceall(upcasts_code, "$cclass", c_classname);
- }
- Delete(baseclass);
- }
-
- /* ----------------------------------------------------------------------
- * getAttrString()
- *
- * If necessary create and return the string
- * associated with a certain attribute of 'n'.
- * ---------------------------------------------------------------------- */
-
- String *getAttrString(Node *n, const char *attr) {
- String *str = Getattr(n, attr);
- if (str == NIL) {
- str = NewString("");
- Setattr(n, attr, str);
- }
- return str;
- }
-
- /* ----------------------------------------------------------------------
- * getMethodDeclarations()
- *
- * If necessary create and return the handle
- * where the methods of the current access can be written to.
- * 'n' must be a member of a struct or a class.
- * ---------------------------------------------------------------------- */
-
- String *getMethodDeclarations(Node *n) {
- String *acc_str = Getattr(n, "access");
- String *methodattr;
- if (acc_str == NIL) {
- methodattr = NewString("modula3:method:public");
- } else {
- methodattr = NewStringf("modula3:method:%s", acc_str);
- }
- String *methods = getAttrString(parentNode(n), Char(methodattr));
- Delete(methodattr);
- return methods;
- }
-
- /* ----------------------------------------------------------------------
- * classHandler()
- * ---------------------------------------------------------------------- */
-
- virtual int classHandler(Node *n) {
-
- File *f_proxy = NULL;
- proxy_class_name = Copy(Getattr(n, "sym:name"));
- //String *rawname = Getattr(n,"name");
-
- if (proxy_flag) {
- if (!addSymbol(proxy_class_name, n))
- return SWIG_ERROR;
-
- if (Cmp(proxy_class_name, m3raw_name) == 0) {
- Printf(stderr, "Class name cannot be equal to intermediary class name: %s\n", proxy_class_name);
- SWIG_exit(EXIT_FAILURE);
- }
-
- if (Cmp(proxy_class_name, m3wrap_name) == 0) {
- Printf(stderr, "Class name cannot be equal to module class name: %s\n", proxy_class_name);
- SWIG_exit(EXIT_FAILURE);
- }
-
- String *filen = NewStringf("%s%s.m3", SWIG_output_directory(), proxy_class_name);
- f_proxy = NewFile(filen, "w", SWIG_output_files());
- if (!f_proxy) {
- FileErrorDisplay(filen);
- SWIG_exit(EXIT_FAILURE);
- }
- Delete(filen);
- filen = NULL;
-
- emitBanner(f_proxy);
-
- Clear(proxy_class_def);
- Clear(proxy_class_code);
-
- have_default_constructor_flag = false;
- destructor_call = NewString("");
- }
-
- /* This will invoke memberfunctionHandler, membervariableHandler ...
- and finally it may invoke functionWrapper
- for wrappers and member variable accessors.
- It will invoke Language:constructorDeclaration
- which decides whether to call MODULA3::constructorHandler */
- Language::classHandler(n);
-
- {
- String *kind = Getattr(n, "kind");
- if (Cmp(kind, "struct") == 0) {
- String *entries = NewString("");
- Node *child;
- writeArgState state;
- for (child = firstChild(n); child != NIL; child = nextSibling(child)) {
- String *childType = nodeType(child);
- if (Strcmp(childType, "cdecl") == 0) {
- String *member = Getattr(child, "sym:name");
- ParmList *pl = Getattr(child, "parms");
- if (pl == NIL) {
- // Get the variable type in Modula 3 type equivalents
- String *m3ct = getMappedTypeNew(child, "m3rawtype", "");
-
- writeArg(entries, state, NIL, member, m3ct, NIL);
- }
- }
- }
- writeArg(entries, state, NIL, NIL, NIL, NIL);
-
- m3raw_intf.enterBlock(blocktype);
- Printf(m3raw_intf.f, "%s =\nRECORD\n%sEND;\n", proxy_class_name, entries);
-
- Delete(entries);
-
- } else if (Cmp(kind, "class") == 0) {
- enum access_privilege { acc_public, acc_protected, acc_private };
- int max_acc = acc_public;
-
- const char *acc_name[3] = { "public", "protected", "private" };
- String *methods[3];
- int acc;
- for (acc = acc_public; acc <= acc_private; acc++) {
- String *methodattr = NewStringf("modula3:method:%s", acc_name[acc]);
- methods[acc] = Getattr(n, methodattr);
- Delete(methodattr);
- max_acc = max_acc > acc ? max_acc : acc;
- }
-
- /* Determine the name of the base class */
- String *baseclassname = NewString("");
- {
- List *baselist = Getattr(n, "bases");
- if (baselist) {
- /* Look for the first (principal?) base class -
- Modula 3 does not support multiple inheritance */
- Iterator base = First(baselist);
- if (base.item) {
- Append(baseclassname, Getattr(base.item, "sym:name"));
- base = Next(base);
- if (base.item) {
- Swig_warning(WARN_MODULA3_MULTIPLE_INHERITANCE, Getfile(n), Getline(n),
- "Warning for %s, base %s ignored. Multiple inheritance is not supported in Modula 3.\n",
- proxy_class_name, Getattr(base.item, "name"));
- }
- }
- }
- }
-
- /* the private class of the base class and only this
- need a pointer to the C++ object */
- bool need_private = !hasContent(baseclassname);
- max_acc = need_private ? acc_private : max_acc;
-
- /* Declare C++ object as abstract pointer in Modula 3 */
- /* The revelation system does not allow us
- to imitate the whole class hierarchy of the C++ library,
- but at least we can distinguish between classes of different roots. */
- if (hasContent(baseclassname)) {
- m3raw_intf.enterBlock(blocktype);
- Printf(m3raw_intf.f, "%s = %s;\n", proxy_class_name, baseclassname);
- } else {
- m3raw_intf.enterBlock(blocktype);
- Printf(m3raw_intf.f, "%s <: ADDRESS;\n", proxy_class_name);
- m3raw_impl.enterBlock(revelation);
- Printf(m3raw_impl.f, "%s = UNTRACED BRANDED REF RECORD (*Dummy*) END;\n", proxy_class_name);
- }
-
- String *superclass;
- m3wrap_intf.enterBlock(blocktype);
- if (hasContent(methods[acc_public])) {
- superclass = NewStringf("%sPublic", proxy_class_name);
- } else if (hasContent(baseclassname)) {
- superclass = Copy(baseclassname);
- } else {
- superclass = NewString("ROOT");
- }
- Printf(m3wrap_intf.f, "%s <: %s;\n", proxy_class_name, superclass);
- Delete(superclass);
-
- {
- static const char *acc_m3suffix[] = { "Public", "Protected", "Private" };
- int acc;
- for (acc = acc_public; acc <= acc_private; acc++) {
- bool process_private = (acc == acc_private) && need_private;
- if (hasContent(methods[acc]) || process_private) {
- String *subclass = NewStringf("%s%s", proxy_class_name, acc_m3suffix[acc]);
- /*
- m3wrap_intf.enterBlock(revelation);
- Printf(m3wrap_intf.f, "%s <: %s;\n", proxy_class_name, subclass);
- */
- if (acc == max_acc) {
- m3wrap_intf.enterBlock(revelation);
- Printf(m3wrap_intf.f, "%s =\n", proxy_class_name);
- } else {
- m3wrap_intf.enterBlock(blocktype);
- Printf(m3wrap_intf.f, "%s =\n", subclass);
- }
- Printf(m3wrap_intf.f, "%s BRANDED OBJECT\n", baseclassname);
- if (process_private) {
- Setattr(m3wrap_intf.import, m3raw_name, "");
- Printf(m3wrap_intf.f, "cxxObj:%s.%s;\n", m3raw_name, proxy_class_name);
- }
- if (hasContent(methods[acc])) {
- Printf(m3wrap_intf.f, "METHODS\n%s", methods[acc]);
- }
- if (acc == max_acc) {
- String *overrides = Getattr(n, "modula3:override");
- Printf(m3wrap_intf.f, "OVERRIDES\n%s", overrides);
- }
- Printf(m3wrap_intf.f, "END;\n");
- Delete(baseclassname);
- baseclassname = subclass;
- }
- }
- }
-
- Delete(methods[acc_public]);
- Delete(methods[acc_protected]);
- Delete(methods[acc_private]);
-
- } else {
- Swig_warning(WARN_MODULA3_TYPECONSTRUCTOR_UNKNOWN, input_file, line_number, "Unknown type constructor %s\n", kind);
- }
- }
-
- if (proxy_flag) {
-
- emitProxyClassDefAndCPPCasts(n);
-
- Printv(f_proxy, proxy_class_def, proxy_class_code, NIL);
-
- Printf(f_proxy, "}\n");
- Delete(f_proxy);
- f_proxy = NULL;
-
- Delete(proxy_class_name);
- proxy_class_name = NULL;
- Delete(destructor_call);
- destructor_call = NULL;
- }
- return SWIG_OK;
- }
-
- /* ----------------------------------------------------------------------
- * memberfunctionHandler()
- * ---------------------------------------------------------------------- */
-
- virtual int memberfunctionHandler(Node *n) {
- //printf("begin memberfunctionHandler(%s)\n", Char(Getattr(n,"name")));
- Setattr(n, "modula3:functype", "method");
- Language::memberfunctionHandler(n);
-
- {
- /* Language::memberfunctionHandler will remove the mapped types
- that emitM3Wrapper may attach */
- ParmList *pl = Getattr(n, "parms");
- Swig_typemap_attach_parms("m3wrapinmode", pl, NULL);
- Swig_typemap_attach_parms("m3wrapinname", pl, NULL);
- Swig_typemap_attach_parms("m3wrapintype", pl, NULL);
- Swig_typemap_attach_parms("m3wrapindefault", pl, NULL);
- attachParameterNames(n, "tmap:m3wrapinname", "autoname", "arg%d");
- String *rettype = getMappedTypeNew(n, "m3wrapouttype", "");
-
- String *methodname = Getattr(n, "sym:name");
-/*
- if (methodname==NIL) {
- methodname = Getattr(n,"name");
- }
-*/
- String *arguments = createM3Signature(n);
- String *storage = Getattr(n, "storage");
- String *overridden = Getattr(n, "override");
- bool isVirtual = (storage != NIL) && (Strcmp(storage, "virtual") == 0);
- bool isOverridden = (overridden != NIL)
- && (Strcmp(overridden, "1") == 0);
- if ((!isVirtual) || (!isOverridden)) {
- {
- String *methods = getMethodDeclarations(n);
- Printf(methods, "%s(%s)%s%s;%s\n",
- methodname, arguments,
- hasContent(rettype) ? ": " : "", hasContent(rettype) ? (const String *) rettype : "", isVirtual ? " (* base method *)" : "");
- }
- {
- /* this was attached by functionWrapper
- invoked by Language::memberfunctionHandler */
- String *fname = Getattr(n, "modula3:funcname");
- String *overrides = getAttrString(parentNode(n), "modula3:override");
- Printf(overrides, "%s := %s;\n", methodname, fname);
- }
- }
- }
-
- if (proxy_flag) {
- String *overloaded_name = getOverloadedName(n);
- String *intermediary_function_name = Swig_name_member(NSPACE_TODO, proxy_class_name, overloaded_name);
- Setattr(n, "proxyfuncname", Getattr(n, "sym:name"));
- Setattr(n, "imfuncname", intermediary_function_name);
- proxyClassFunctionHandler(n);
- Delete(overloaded_name);
- }
- //printf("end memberfunctionHandler(%s)\n", Char(Getattr(n,"name")));
- return SWIG_OK;
- }
-
- /* ----------------------------------------------------------------------
- * staticmemberfunctionHandler()
- * ---------------------------------------------------------------------- */
-
- virtual int staticmemberfunctionHandler(Node *n) {
-
- static_flag = true;
- Language::staticmemberfunctionHandler(n);
-
- if (proxy_flag) {
- String *overloaded_name = getOverloadedName(n);
- String *intermediary_function_name = Swig_name_member(NSPACE_TODO, proxy_class_name, overloaded_name);
- Setattr(n, "proxyfuncname", Getattr(n, "sym:name"));
- Setattr(n, "imfuncname", intermediary_function_name);
- proxyClassFunctionHandler(n);
- Delete(overloaded_name);
- }
- static_flag = false;
-
- return SWIG_OK;
- }
-
- /* -----------------------------------------------------------------------------
- * proxyClassFunctionHandler()
- *
- * Function called for creating a Modula 3 wrapper function around a c++ function in the
- * proxy class. Used for both static and non-static C++ class functions.
- * C++ class static functions map to Modula 3 static functions.
- * Two extra attributes in the Node must be available. These are "proxyfuncname" -
- * the name of the Modula 3 class proxy function, which in turn will call "imfuncname" -
- * the intermediary (PInvoke) function name in the intermediary class.
- * ----------------------------------------------------------------------------- */
-
- void proxyClassFunctionHandler(Node *n) {
- SwigType *t = Getattr(n, "type");
- ParmList *l = Getattr(n, "parms");
- Hash *throws_hash = NewHash();
- String *intermediary_function_name = Getattr(n, "imfuncname");
- String *proxy_function_name = Getattr(n, "proxyfuncname");
- String *tm;
- Parm *p;
- int i;
- String *imcall = NewString("");
- String *return_type = NewString("");
- String *function_code = NewString("");
- bool setter_flag = false;
-
- if (!proxy_flag)
- return;
-
- if (l) {
- if (SwigType_type(Getattr(l, "type")) == T_VOID) {
- l = nextSibling(l);
- }
- }
-
- /* Attach the non-standard typemaps to the parameter list */
- Swig_typemap_attach_parms("in", l, NULL);
- Swig_typemap_attach_parms("m3wraptype", l, NULL);
- Swig_typemap_attach_parms("m3in", l, NULL);
-
- /* Get return types */
- if ((tm = getMappedTypeNew(n, "m3wraptype", ""))) {
- substituteClassname(t, tm);
- Printf(return_type, "%s", tm);
- }
-
- if (proxy_flag && wrapping_member_flag && !enum_constant_flag) {
- // Properties
- setter_flag = (Cmp(Getattr(n, "sym:name"), Swig_name_set(NSPACE_TODO, Swig_name_member(NSPACE_TODO, proxy_class_name, variable_name)))
- == 0);
- }
-
- /* Start generating the proxy function */
- Printf(function_code, " %s ", Getattr(n, "feature:modula3:methodmodifiers"));
- if (static_flag)
- Printf(function_code, "static ");
- if (Getattr(n, "override"))
- Printf(function_code, "override ");
- else if (checkAttribute(n, "storage", "virtual"))
- Printf(function_code, "virtual ");
-
- Printf(function_code, "%s %s(", return_type, proxy_function_name);
-
- Printv(imcall, m3raw_name, ".", intermediary_function_name, "(", NIL);
- if (!static_flag)
- Printv(imcall, "swigCPtr", NIL);
-
- emit_mark_varargs(l);
-
- int gencomma = !static_flag;
-
- /* Output each parameter */
- for (i = 0, p = l; p; i++) {
-
- /* Ignored varargs */
- if (checkAttribute(p, "varargs:ignore", "1")) {
- p = nextSibling(p);
- continue;
- }
-
- /* Ignored parameters */
- if (checkAttribute(p, "tmap:in:numinputs", "0")) {
- p = Getattr(p, "tmap:in:next");
- continue;
- }
-
- /* Ignore the 'this' argument for variable wrappers */
- if (!(variable_wrapper_flag && i == 0)) {
- SwigType *pt = Getattr(p, "type");
- String *param_type = NewString("");
-
- /* Get the Modula 3 parameter type */
- if ((tm = getMappedType(p, "m3wraptype"))) {
- substituteClassname(pt, tm);
- Printf(param_type, "%s", tm);
- }
-
- if (gencomma)
- Printf(imcall, ", ");
-
- String *arg = variable_wrapper_flag ? NewString("value") : makeParameterName(n,
- p,
- i);
-
- // Use typemaps to transform type used in Modula 3 wrapper function (in proxy class) to type used in PInvoke function (in intermediary class)
- if ((tm = getMappedType(p, "in"))) {
- addThrows(throws_hash, "in", p);
- substituteClassname(pt, tm);
- Replaceall(tm, "$input", arg);
- Printv(imcall, tm, NIL);
- }
-
- /* Add parameter to proxy function */
- if (gencomma >= 2)
- Printf(function_code, ", ");
- gencomma = 2;
- Printf(function_code, "%s %s", param_type, arg);
-
- Delete(arg);
- Delete(param_type);
- }
- p = Getattr(p, "tmap:in:next");
- }
-
- Printf(imcall, ")");
- Printf(function_code, ")");
-
- // Transform return type used in PInvoke function (in intermediary class) to type used in Modula 3 wrapper function (in proxy class)
- if ((tm = getMappedTypeNew(n, "m3out", ""))) {
- addThrows(throws_hash, "m3out", n);
- if (GetFlag(n, "feature:new"))
- Replaceall(tm, "$owner", "true");
- else
- Replaceall(tm, "$owner", "false");
- substituteClassname(t, tm);
- Replaceall(tm, "$imcall", imcall);
- }
-
- generateThrowsClause(throws_hash, function_code);
- Printf(function_code, " %s\n\n", tm ? (const String *) tm : empty_string);
-
- if (proxy_flag && wrapping_member_flag && !enum_constant_flag) {
- // Properties
- if (setter_flag) {
- // Setter method
- if ((tm = getMappedTypeNew(n, "m3varin", ""))) {
- if (GetFlag(n, "feature:new"))
- Replaceall(tm, "$owner", "true");
- else
- Replaceall(tm, "$owner", "false");
- substituteClassname(t, tm);
- Replaceall(tm, "$imcall", imcall);
- Printf(proxy_class_code, "%s", tm);
- }
- } else {
- // Getter method
- if ((tm = getMappedTypeNew(n, "m3varout", ""))) {
- if (GetFlag(n, "feature:new"))
- Replaceall(tm, "$owner", "true");
- else
- Replaceall(tm, "$owner", "false");
- substituteClassname(t, tm);
- Replaceall(tm, "$imcall", imcall);
- Printf(proxy_class_code, "%s", tm);
- }
- }
- } else {
- // Normal function call
- Printv(proxy_class_code, function_code, NIL);
- }
-
- Delete(function_code);
- Delete(return_type);
- Delete(imcall);
- Delete(throws_hash);
- }
-
- /* ----------------------------------------------------------------------
- * constructorHandler()
- * ---------------------------------------------------------------------- */
-
- virtual int constructorHandler(Node *n) {
- // this invokes functionWrapper
- Language::constructorHandler(n);
-
- if (proxy_flag) {
- ParmList *l = Getattr(n, "parms");
-
- Hash *throws_hash = NewHash();
- String *overloaded_name = getOverloadedName(n);
- String *imcall = NewString("");
-
- Printf(proxy_class_code, " %s %s(", Getattr(n, "feature:modula3:methodmodifiers"), proxy_class_name);
- Printv(imcall, " : this(", m3raw_name, ".", Swig_name_construct(NSPACE_TODO, overloaded_name), "(", NIL);
-
- /* Attach the non-standard typemaps to the parameter list */
- Swig_typemap_attach_parms("in", l, NULL);
- Swig_typemap_attach_parms("m3wraptype", l, NULL);
- Swig_typemap_attach_parms("m3in", l, NULL);
-
- emit_mark_varargs(l);
-
- int gencomma = 0;
-
- String *tm;
- Parm *p = l;
- int i;
-
- /* Output each parameter */
- for (i = 0; p; i++) {
-
- /* Ignored varargs */
- if (checkAttribute(p, "varargs:ignore", "1")) {
- p = nextSibling(p);
- continue;
- }
-
- /* Ignored parameters */
- if (checkAttribute(p, "tmap:in:numinputs", "0")) {
- p = Getattr(p, "tmap:in:next");
- continue;
- }
-
- SwigType *pt = Getattr(p, "type");
- String *param_type = NewString("");
-
- /* Get the Modula 3 parameter type */
- if ((tm = getMappedType(p, "m3wraptype"))) {
- substituteClassname(pt, tm);
- Printf(param_type, "%s", tm);
- }
-
- if (gencomma)
- Printf(imcall, ", ");
-
- String *arg = makeParameterName(n, p, i);
-
- // Use typemaps to transform type used in Modula 3 wrapper function (in proxy class) to type used in PInvoke function (in intermediary class)
- if ((tm = getMappedType(p, "in"))) {
- addThrows(throws_hash, "in", p);
- substituteClassname(pt, tm);
- Replaceall(tm, "$input", arg);
- Printv(imcall, tm, NIL);
- }
-
- /* Add parameter to proxy function */
- if (gencomma)
- Printf(proxy_class_code, ", ");
- Printf(proxy_class_code, "%s %s", param_type, arg);
- gencomma = 1;
-
- Delete(arg);
- Delete(param_type);
- p = Getattr(p, "tmap:in:next");
- }
-
- Printf(imcall, "), true)");
-
- Printf(proxy_class_code, ")");
- Printf(proxy_class_code, "%s", imcall);
- generateThrowsClause(throws_hash, proxy_class_code);
- Printf(proxy_class_code, " {\n");
- Printf(proxy_class_code, " }\n\n");
-
- if (!gencomma) // We must have a default constructor
- have_default_constructor_flag = true;
-
- Delete(overloaded_name);
- Delete(imcall);
- Delete(throws_hash);
- }
-
- return SWIG_OK;
- }
-
- /* ----------------------------------------------------------------------
- * destructorHandler()
- * ---------------------------------------------------------------------- */
-
- virtual int destructorHandler(Node *n) {
- Language::destructorHandler(n);
- String *symname = Getattr(n, "sym:name");
-
- if (proxy_flag) {
- Printv(destructor_call, m3raw_name, ".", Swig_name_destroy(NSPACE_TODO, symname), "(swigCPtr)", NIL);
- }
- return SWIG_OK;
- }
-
- /* ----------------------------------------------------------------------
- * membervariableHandler()
- * ---------------------------------------------------------------------- */
-
- virtual int membervariableHandler(Node *n) {
- //printf("begin membervariableHandler(%s)\n", Char(Getattr(n,"name")));
- SwigType *t = Getattr(n, "type");
- String *tm;
-
- // Get the variable type
- if ((tm = getMappedTypeNew(n, "m3wraptype", ""))) {
- substituteClassname(t, tm);
- }
-
- variable_name = Getattr(n, "sym:name");
- //printf("member variable: %s\n", Char(variable_name));
-
- // Output the property's field declaration and accessor methods
- Printf(proxy_class_code, " public %s %s {", tm, variable_name);
-
- Setattr(n, "modula3:functype", "accessor");
- wrapping_member_flag = true;
- variable_wrapper_flag = true;
- Language::membervariableHandler(n);
- wrapping_member_flag = false;
- variable_wrapper_flag = false;
-
- Printf(proxy_class_code, "\n }\n\n");
-
- {
- String *methods = getMethodDeclarations(n);
- String *overrides = getAttrString(parentNode(n), "modula3:override");
- SwigType *type = Getattr(n, "type");
- String *m3name = capitalizeFirst(variable_name);
- //String *m3name = nameToModula3(variable_name,true);
- if (!SwigType_isconst(type)) {
- {
- String *inmode = getMappedTypeNew(n, "m3wrapinmode", "", false);
- String *intype = getMappedTypeNew(n, "m3wrapintype", "");
- Printf(methods, "set%s(%s val:%s);\n", m3name, (inmode != NIL) ? (const String *) inmode : "", intype);
- }
- {
- /* this was attached by functionWrapper
- invoked by Language::memberfunctionHandler */
- String *fname = Getattr(n, "modula3:setname");
- Printf(overrides, "set%s := %s;\n", m3name, fname);
- }
- }
- {
- {
- String *outtype = getMappedTypeNew(n, "m3wrapouttype", "");
- Printf(methods, "get%s():%s;\n", m3name, outtype);
- }
- {
- /* this was attached by functionWrapper
- invoked by Language::memberfunctionHandler */
- String *fname = Getattr(n, "modula3:getname");
- Printf(overrides, "get%s := %s;\n", m3name, fname);
- }
- }
- Delete(m3name);
- }
- //printf("end membervariableHandler(%s)\n", Char(Getattr(n,"name")));
-
- return SWIG_OK;
- }
-
- /* ----------------------------------------------------------------------
- * staticmembervariableHandler()
- * ---------------------------------------------------------------------- */
-
- virtual int staticmembervariableHandler(Node *n) {
-
- bool static_const_member_flag = (Getattr(n, "value") == 0);
- if (static_const_member_flag) {
- SwigType *t = Getattr(n, "type");
- String *tm;
-
- // Get the variable type
- if ((tm = getMappedTypeNew(n, "m3wraptype", ""))) {
- substituteClassname(t, tm);
- }
- // Output the property's field declaration and accessor methods
- Printf(proxy_class_code, " public static %s %s {", tm, Getattr(n, "sym:name"));
- }
-
- variable_name = Getattr(n, "sym:name");
- wrapping_member_flag = true;
- static_flag = true;
- Language::staticmembervariableHandler(n);
- wrapping_member_flag = false;
- static_flag = false;
-
- if (static_const_member_flag)
- Printf(proxy_class_code, "\n }\n\n");
-
- return SWIG_OK;
- }
-
- /* ----------------------------------------------------------------------
- * memberconstantHandler()
- * ---------------------------------------------------------------------- */
-
- virtual int memberconstantHandler(Node *n) {
- variable_name = Getattr(n, "sym:name");
- wrapping_member_flag = true;
- Language::memberconstantHandler(n);
- wrapping_member_flag = false;
- return SWIG_OK;
- }
-
- /* -----------------------------------------------------------------------------
- * getOverloadedName()
- * ----------------------------------------------------------------------------- */
-
- String *getOverloadedName(Node *n) {
- String *overloaded_name = Copy(Getattr(n, "sym:name"));
-
- if (Getattr(n, "sym:overloaded")) {
- Printv(overloaded_name, Getattr(n, "sym:overname"), NIL);
- }
-
- return overloaded_name;
- }
-
- /* -----------------------------------------------------------------------------
- * emitM3Wrapper()
- * It is also used for set and get methods of global variables.
- * ----------------------------------------------------------------------------- */
-
- void emitM3Wrapper(Node *n, const String *func_name) {
- SwigType *t = Getattr(n, "type");
- ParmList *l = Getattr(n, "parms");
- Hash *throws_hash = NewHash();
- int num_exceptions = 0;
- int num_returns = 0;
- String *rawcall = NewString("");
- String *reccall = NewString("");
- String *local_variables = NewString("");
- String *local_constants = NewString("");
- String *incheck = NewString("");
- String *outcheck = NewString("");
- String *setup = NewString("");
- String *cleanup = NewString("");
- String *outarg = NewString(""); /* don't mix up with 'autark' :-] */
- String *storeout = NewString("");
- String *result_name = NewString("");
- String *return_variables = NewString("");
- const char *result_return = "ret";
- String *function_code = NewString("");
- /*several names for the same function */
- String *raw_name = Getattr(n, "name"); /*original C function name */
- //String *func_name = Getattr(n,"sym:name"); /*final Modula3 name chosen by the user*/
- bool setter_flag = false;
- int multiretval = GetFlag(n, "feature:modula3:multiretval");
-
- if (l) {
- if (SwigType_type(Getattr(l, "type")) == T_VOID) {
- l = nextSibling(l);
- }
- }
-
- /* Attach the non-standard typemaps to the parameter list */
- Swig_typemap_attach_parms("m3wrapargvar", l, NULL);
- Swig_typemap_attach_parms("m3wrapargconst", l, NULL);
- Swig_typemap_attach_parms("m3wrapargraw", l, NULL);
- Swig_typemap_attach_parms("m3wrapargdir", l, NULL);
- Swig_typemap_attach_parms("m3wrapinmode", l, NULL);
- Swig_typemap_attach_parms("m3wrapinname", l, NULL);
- Swig_typemap_attach_parms("m3wrapintype", l, NULL);
- Swig_typemap_attach_parms("m3wrapindefault", l, NULL);
- Swig_typemap_attach_parms("m3wrapinconv", l, NULL);
- Swig_typemap_attach_parms("m3wrapincheck", l, NULL);
- Swig_typemap_attach_parms("m3wrapoutname", l, NULL);
- Swig_typemap_attach_parms("m3wrapouttype", l, NULL);
- Swig_typemap_attach_parms("m3wrapoutconv", l, NULL);
- Swig_typemap_attach_parms("m3wrapoutcheck", l, NULL);
-
- attachMappedType(n, "m3wrapretraw");
- attachMappedType(n, "m3wrapretname");
- attachMappedType(n, "m3wraprettype");
- attachMappedType(n, "m3wrapretvar");
- attachMappedType(n, "m3wrapretconv");
- attachMappedType(n, "m3wrapretcheck");
-
- Swig_typemap_attach_parms("m3wrapfreearg", l, NULL);
-
-/*
- Swig_typemap_attach_parms("m3wrapargvar:throws", l, NULL);
- Swig_typemap_attach_parms("m3wrapargraw:throws", l, NULL);
- Swig_typemap_attach_parms("m3wrapinconv:throws", l, NULL);
- Swig_typemap_attach_parms("m3wrapincheck:throws", l, NULL);
- Swig_typemap_attach_parms("m3wrapoutconv:throws", l, NULL);
- Swig_typemap_attach_parms("m3wrapoutcheck:throws", l, NULL);
-
- attachMappedType(n, "m3wrapretvar:throws");
- attachMappedType(n, "m3wrapretconv:throws");
- attachMappedType(n, "m3wrapretcheck:throws");
-
- Swig_typemap_attach_parms("m3wrapfreearg:throws", l, NULL);
-*/
-
- /* Attach argument names to the parameter list */
- /* should be a separate procedure making use of hashes */
- attachParameterNames(n, "tmap:m3wrapinname", "autoname", "arg%d");
-
- /* Get return types */
- String *result_m3rawtype = Copy(getMappedTypeNew(n, "m3rawrettype", ""));
- String *result_m3wraptype = Copy(getMappedTypeNew(n, "m3wraprettype", ""));
- bool has_return_raw = hasContent(result_m3rawtype);
- bool has_return_m3 = hasContent(result_m3wraptype);
- if (has_return_m3) {
- num_returns++;
- //printf("%s: %s\n", Char(func_name),Char(result_m3wraptype));
- }
-
- String *arguments = createM3Signature(n);
-
- /* Create local variables or RECORD fields for return values
- and determine return type that might result from a converted VAR argument. */
- {
- writeArgState state;
- if (multiretval && has_return_m3) {
- writeArg(return_variables, state, NIL, NewString(result_return), result_m3wraptype, NIL);
- }
-
- Parm *p = skipIgnored(l, "m3wrapouttype");
- while (p != NIL) {
-
- String *arg = Getattr(p, "tmap:m3wrapoutname");
- if (arg == NIL) {
- arg = Getattr(p, "name");
- }
-
- String *tm = Getattr(p, "tmap:m3wrapouttype");
- if (tm != NIL) {
- if (isOutParam(p)) {
- if (!multiretval) {
- if (num_returns == 0) {
- Printv(result_name, arg, NIL);
- Clear(result_m3wraptype);
- Printv(result_m3wraptype, tm, NIL);
- } else {
- Swig_warning(WARN_MODULA3_TYPEMAP_MULTIPLE_RETURN, input_file, line_number,
- "Typemap m3wrapargdir set to 'out' for %s implies a RETURN value, but the routine %s has already one.\nUse %%multiretval feature.\n",
- SwigType_str(Getattr(p, "type"), 0), raw_name);
- }
- }
- num_returns++;
- addImports(m3wrap_intf.import, "m3wrapouttype", p);
- writeArg(return_variables, state, NIL, arg, tm, NIL);
- }
- p = skipIgnored(Getattr(p, "tmap:m3wrapouttype:next"), "m3wrapouttype");
- } else {
- p = nextSibling(p);
- }
- }
- writeArg(return_variables, state, NIL, NIL, NIL, NIL);
-
- if (multiretval) {
- Printv(result_name, Swig_cresult_name(), NIL);
- Printf(result_m3wraptype, "%sResult", func_name);
- m3wrap_intf.enterBlock(blocktype);
- Printf(m3wrap_intf.f, "%s =\nRECORD\n%sEND;\n", result_m3wraptype, return_variables);
- Printf(local_variables, "%s: %s;\n", result_name, result_m3wraptype);
- } else {
- Append(local_variables, return_variables);
- }
- }
-
- /* Declare local constants e.g. for storing argument names. */
- {
- Parm *p = l;
- while (p != NIL) {
-
- String *arg = Getattr(p, "autoname");
-
- String *tm = Getattr(p, "tmap:m3wrapargconst");
- if (tm != NIL) {
- addImports(m3wrap_impl.import, "m3wrapargconst", p);
- Replaceall(tm, "$input", arg);
- Printv(local_constants, tm, "\n", NIL);
- p = Getattr(p, "tmap:m3wrapargconst:next");
- } else {
- p = nextSibling(p);
- }
-
- }
- }
-
- /* Declare local variables e.g. for converted input values. */
- {
- String *tm = getMappedTypeNew(n, "m3wrapretvar", "", false);
- if (tm != NIL) {
- addImports(m3wrap_impl.import, "m3wrapretvar", n);
- addThrows(throws_hash, "m3wrapretvar", n);
- Printv(local_variables, tm, "\n", NIL);
- }
-
- Parm *p = l;
- while (p != NIL) {
-
- String *arg = Getattr(p, "autoname");
-
- tm = Getattr(p, "tmap:m3wrapargvar");
- if (tm != NIL) {
- /* exceptions that may be raised but can't be caught,
- thus we won't count them in num_exceptions */
- addImports(m3wrap_impl.import, "m3wrapargvar", p);
- addThrows(throws_hash, "m3wrapargvar", p);
- Replaceall(tm, "$input", arg);
- Printv(local_variables, tm, "\n", NIL);
- p = Getattr(p, "tmap:m3wrapargvar:next");
- } else {
- p = nextSibling(p);
- }
-
- }
- }
-
- /* Convert input values from Modula 3 to C. */
- {
- Parm *p = l;
- while (p != NIL) {
-
- String *arg = Getattr(p, "autoname");
-
- String *tm = Getattr(p, "tmap:m3wrapinconv");
- if (tm != NIL) {
- addImports(m3wrap_impl.import, "m3wrapinconv", p);
- num_exceptions += addThrows(throws_hash, "m3wrapinconv", p);
- Replaceall(tm, "$input", arg);
- Printv(setup, tm, "\n", NIL);
- p = Getattr(p, "tmap:m3wrapinconv:next");
- } else {
- p = nextSibling(p);
- }
-
- }
- }
-
- /* Generate checks for input value integrity. */
- {
- Parm *p = l;
- while (p != NIL) {
-
- String *arg = Getattr(p, "autoname");
-
- String *tm = Getattr(p, "tmap:m3wrapincheck");
- if (tm != NIL) {
- addImports(m3wrap_impl.import, "m3wrapincheck", p);
- num_exceptions += addThrows(throws_hash, "m3wrapincheck", p);
- Replaceall(tm, "$input", arg);
- Printv(incheck, tm, "\n", NIL);
- p = Getattr(p, "tmap:m3wrapincheck:next");
- } else {
- p = nextSibling(p);
- }
-
- }
- }
-
- Printv(rawcall, m3raw_name, ".", func_name, "(", NIL);
- /* Arguments to the raw C function */
- {
- bool gencomma = false;
- Parm *p = l;
- while (p != NIL) {
- if (gencomma) {
- Printf(rawcall, ", ");
- }
- gencomma = true;
- addImports(m3wrap_impl.import, "m3wrapargraw", p);
- num_exceptions += addThrows(throws_hash, "m3wrapargraw", p);
-
- String *arg = Getattr(p, "autoname");
- String *qualarg = NewString("");
- if (!isInParam(p)) {
- String *tmparg = Getattr(p, "tmap:m3wrapoutname");
- if (tmparg != NIL) {
- arg = tmparg;
- }
- if (multiretval /*&& isOutParam(p) - automatically fulfilled */ ) {
- Printf(qualarg, "%s.", result_name);
- }
- }
- Append(qualarg, arg);
- Setattr(p, "m3outarg", qualarg);
-
- String *tm = Getattr(p, "tmap:m3wrapargraw");
- if (tm != NIL) {
- Replaceall(tm, "$input", arg);
- Replaceall(tm, "$output", qualarg);
- Printv(rawcall, tm, NIL);
- p = Getattr(p, "tmap:m3wrapargraw:next");
- } else {
- //Printv(rawcall, Getattr(p,"lname"), NIL);
- Printv(rawcall, qualarg, NIL);
- p = nextSibling(p);
- }
- Delete(qualarg);
- }
- }
- Printf(rawcall, ")");
-
- /* Check for error codes and integrity of results */
- {
- String *tm = getMappedTypeNew(n, "m3wrapretcheck", "", false);
- if (tm != NIL) {
- addImports(m3wrap_impl.import, "m3wrapretcheck", n);
- num_exceptions += addThrows(throws_hash, "m3wrapretcheck", n);
- Printv(outcheck, tm, "\n", NIL);
- }
-
- Parm *p = l;
- while (p != NIL) {
- tm = Getattr(p, "tmap:m3wrapoutcheck");
- if (tm != NIL) {
- String *arg = Getattr(p, "autoname");
- String *outarg = Getattr(p, "m3outarg");
- addImports(m3wrap_impl.import, "m3wrapoutcheck", p);
- num_exceptions += addThrows(throws_hash, "m3wrapoutcheck", p);
- //substituteClassname(Getattr(p,"type"), tm);
- Replaceall(tm, "$input", arg);
- Replaceall(tm, "$output", outarg);
- Printv(outcheck, tm, "\n", NIL);
- p = Getattr(p, "tmap:m3wrapoutcheck:next");
- } else {
- p = nextSibling(p);
- }
- }
- }
-
- /* Convert the results to Modula 3 data structures and
- put them in the record prepared for returning */
- {
- /* m3wrapretconv is processed
- when it is clear if there is some output conversion and checking code */
- Parm *p = l;
- while (p != NIL) {
- String *tm = Getattr(p, "tmap:m3wrapoutconv");
- if (tm != NIL) {
- String *arg = Getattr(p, "autoname");
- String *outarg = Getattr(p, "m3outarg");
- addImports(m3wrap_impl.import, "m3wrapoutconv", n);
- num_exceptions += addThrows(throws_hash, "m3wrapoutconv", p);
- //substituteClassname(Getattr(p,"type"), tm);
- Replaceall(tm, "$input", arg);
- Replaceall(tm, "$output", outarg);
- Printf(storeout, "%s := %s;\n", outarg, tm);
- p = Getattr(p, "tmap:m3wrapoutconv:next");
- } else {
- p = nextSibling(p);
- }
- }
- }
-
- /* Generate cleanup code */
- {
- Parm *p = l;
- while (p != NIL) {
- String *tm = Getattr(p, "tmap:m3wrapfreearg");
- if (tm != NIL) {
- String *arg = Getattr(p, "autoname");
- String *outarg = Getattr(p, "m3outarg");
- addImports(m3wrap_impl.import, "m3wrapfreearg", p);
- num_exceptions += addThrows(throws_hash, "m3wrapfreearg", p);
- //substituteClassname(Getattr(p,"type"), tm);
- Replaceall(tm, "$input", arg);
- Replaceall(tm, "$output", outarg);
- Printv(cleanup, tm, "\n", NIL);
- p = Getattr(p, "tmap:m3wrapfreearg:next");
- } else {
- p = nextSibling(p);
- }
- }
- }
-
- {
- /* Currently I don't know how a typemap similar to the original 'out' typemap
- could help returning the return value. */
- /* Receive result from call to raw library function */
- if (!has_return_raw) {
- /*
- rawcall(arg1);
- result.val := arg1;
- RETURN result;
- */
- /*
- rawcall(arg1);
- RETURN arg1;
- */
- Printf(reccall, "%s;\n", rawcall);
-
- if (hasContent(result_name)) {
- Printf(outarg, "RETURN %s;\n", result_name);
- }
- } else {
- /*
- arg0 := rawcall(arg1);
- result.ret := Convert(arg0);
- result.val := arg1;
- RETURN result;
- */
- /*
- arg0 := rawcall();
- RETURN Convert(arg0);
- */
- /*
- RETURN rawcall();
- */
- String *return_raw = getMappedTypeNew(n, "m3wrapretraw", "", false);
- String *return_conv = getMappedTypeNew(n, "m3wrapretconv", "", false);
-
- /* immediate RETURN would skip result checking */
- if ((hasContent(outcheck) || hasContent(storeout)
- || hasContent(cleanup)) && (!hasContent(result_name))
- && (return_raw == NIL)) {
- Printv(result_name, Swig_cresult_name(), NIL);
- Printf(local_variables, "%s: %s;\n", result_name, result_m3wraptype);
- }
-
- String *result_lvalue = Copy(result_name);
- if (multiretval) {
- Printf(result_lvalue, ".%s", result_return);
- }
- if (return_raw != NIL) {
- Printf(reccall, "%s := %s;\n", return_raw, rawcall);
- } else if (hasContent(result_name)) {
- Printf(reccall, "%s := %s;\n", result_lvalue, rawcall);
- } else {
- Printf(outarg, "RETURN %s;\n", rawcall);
- }
- if (return_conv != NIL) {
- addImports(m3wrap_impl.import, "m3wrapretconv", n);
- num_exceptions += addThrows(throws_hash, "m3wrapretconv", n);
- if (hasContent(result_name)) {
- Printf(reccall, "%s := %s;\n", result_lvalue, return_conv);
- Printf(outarg, "RETURN %s;\n", result_name);
- } else {
- Printf(outarg, "RETURN %s;\n", return_conv);
- }
- } else {
- if (hasContent(result_name)) {
- Printf(outarg, "RETURN %s;\n", result_name);
- }
- }
- }
- }
-
- /* Create procedure header */
- {
- String *header = NewStringf("PROCEDURE %s (%s)",
- func_name, arguments);
-
- if ((num_returns > 0) || multiretval) {
- Printf(header, ": %s", result_m3wraptype);
- }
- generateThrowsClause(throws_hash, header);
-
- Append(function_code, header);
-
- m3wrap_intf.enterBlock(no_block);
- Printf(m3wrap_intf.f, "%s;\n\n", header);
- }
-
- {
- String *body = NewStringf("%s%s%s%s%s",
- incheck,
- setup,
- reccall,
- outcheck,
- storeout);
-
- String *exc_handler;
- if (hasContent(cleanup) && (num_exceptions > 0)) {
- exc_handler = NewStringf("TRY\n%sFINALLY\n%sEND;\n", body, cleanup);
- } else {
- exc_handler = NewStringf("%s%s", body, cleanup);
- }
-
- Printf(function_code, " =\n%s%s%s%sBEGIN\n%s%sEND %s;\n\n",
- hasContent(local_constants) ? "CONST\n" : "", local_constants,
- hasContent(local_variables) ? "VAR\n" : "", local_variables, exc_handler, outarg, func_name);
-
- Delete(exc_handler);
- Delete(body);
- }
-
- m3wrap_impl.enterBlock(no_block);
- if (proxy_flag && global_variable_flag) {
- setter_flag = (Cmp(Getattr(n, "sym:name"), Swig_name_set(NSPACE_TODO, variable_name)) == 0);
- // Properties
- if (setter_flag) {
- // Setter method
- String *tm = getMappedTypeNew(n, "m3varin", "");
- if (tm != NIL) {
- if (GetFlag(n, "feature:new")) {
- Replaceall(tm, "$owner", "true");
- } else {
- Replaceall(tm, "$owner", "false");
- }
- substituteClassname(t, tm);
- Replaceall(tm, "$rawcall", rawcall);
- Replaceall(tm, "$vartype", variable_type); /* $type is already replaced by some super class */
- Replaceall(tm, "$var", variable_name);
- Printf(m3wrap_impl.f, "%s", tm);
- }
- } else {
- // Getter method
- String *tm = getMappedTypeNew(n, "m3varout", "");
- if (tm != NIL) {
- if (GetFlag(n, "feature:new"))
- Replaceall(tm, "$owner", "true");
- else
- Replaceall(tm, "$owner", "false");
- substituteClassname(t, tm);
- Replaceall(tm, "$rawcall", rawcall);
- Replaceall(tm, "$vartype", variable_type);
- Replaceall(tm, "$var", variable_name);
- Printf(m3wrap_impl.f, "%s", tm);
- }
- }
- } else {
- // Normal function call
- Printv(m3wrap_impl.f, function_code, NIL);
- }
-
- Delete(arguments);
- Delete(return_variables);
- Delete(local_variables);
- Delete(local_constants);
- Delete(outarg);
- Delete(incheck);
- Delete(outcheck);
- Delete(setup);
- Delete(cleanup);
- Delete(storeout);
- Delete(function_code);
- Delete(result_name);
- Delete(result_m3wraptype);
- Delete(reccall);
- Delete(rawcall);
- Delete(throws_hash);
- }
-
- /*----------------------------------------------------------------------
- * replaceSpecialVariables()
- *--------------------------------------------------------------------*/
-
- virtual void replaceSpecialVariables(String *method, String *tm, Parm *parm) {
- (void)method;
- SwigType *type = Getattr(parm, "type");
- substituteClassname(type, tm);
- }
-
- /* -----------------------------------------------------------------------------
- * substituteClassname()
- *
- * Substitute the special variable $m3classname with the proxy class name for classes/structs/unions
- * that SWIG knows about.
- * Otherwise use the $descriptor name for the Modula 3 class name. Note that the $&m3classname substitution
- * is the same as a $&descriptor substitution, ie one pointer added to descriptor name.
- * Inputs:
- * pt - parameter type
- * tm - typemap contents that might contain the special variable to be replaced
- * Outputs:
- * tm - typemap contents complete with the special variable substitution
- * Return:
- * substitution_performed - flag indicating if a substitution was performed
- * ----------------------------------------------------------------------------- */
-
- bool substituteClassname(SwigType *pt, String *tm) {
- bool substitution_performed = false;
- if (Strstr(tm, "$m3classname") || Strstr(tm, "$&m3classname")) {
- String *classname = getProxyName(pt);
- if (classname) {
- Replaceall(tm, "$&m3classname", classname); // getProxyName() works for pointers to classes too
- Replaceall(tm, "$m3classname", classname);
- } else { // use $descriptor if SWIG does not know anything about this type. Note that any typedefs are resolved.
- String *descriptor = NULL;
- SwigType *type = Copy(SwigType_typedef_resolve_all(pt));
-
- if (Strstr(tm, "$&m3classname")) {
- SwigType_add_pointer(type);
- descriptor = NewStringf("SWIGTYPE%s", SwigType_manglestr(type));
- Replaceall(tm, "$&m3classname", descriptor);
- } else { // $m3classname
- descriptor = NewStringf("SWIGTYPE%s", SwigType_manglestr(type));
- Replaceall(tm, "$m3classname", descriptor);
- }
-
- // Add to hash table so that the type wrapper classes can be created later
- Setattr(swig_types_hash, descriptor, type);
- Delete(descriptor);
- Delete(type);
- }
- substitution_performed = true;
- }
- return substitution_performed;
- }
-
- /* -----------------------------------------------------------------------------
- * attachParameterNames()
- *
- * Inputs:
- * n - Node of a function declaration
- * tmid - attribute name for overriding C argument names,
- * e.g. "tmap:m3wrapinname",
- * don't forget to attach the mapped types before
- * nameid - attribute for attaching the names,
- * e.g. "modula3:inname"
- * fmt - format for the argument name containing %d
- * e.g. "arg%d"
- * ----------------------------------------------------------------------------- */
-
- void attachParameterNames(Node *n, const char *tmid, const char *nameid, const char *fmt) {
- /* Use C parameter name if present and unique,
- otherwise create an 'arg%d' name */
- Hash *hash = NewHash();
- Parm *p = Getattr(n, "parms");
- int count = 0;
- while (p != NIL) {
- String *name = Getattr(p, tmid);
- if (name == NIL) {
- name = Getattr(p, "name");
- }
- String *newname;
- if ((!hasContent(name)) || (Getattr(hash, name) != NIL)) {
- newname = NewStringf(fmt, count);
- } else {
- newname = Copy(name);
- }
- if (1 == Setattr(hash, newname, "1")) {
- Swig_warning(WARN_MODULA3_DOUBLE_ID, input_file, line_number, "Argument '%s' twice.\n", newname);
- }
- Setattr(p, nameid, newname);
-// Delete(newname);
- p = nextSibling(p);
- count++;
- }
- Delete(hash);
- }
-
- /* -----------------------------------------------------------------------------
- * createM3Signature()
- *
- * Create signature of M3 wrapper procedure
- * Call attachParameterNames and attach mapped types before!
- * m3wrapintype, m3wrapinmode, m3wrapindefault
- * ----------------------------------------------------------------------------- */
-
- String *createM3Signature(Node *n) {
- String *arguments = NewString("");
- Parm *p = skipIgnored(Getattr(n, "parms"), "m3wrapintype");
- writeArgState state;
- while (p != NIL) {
-
- /* Get the M3 parameter type */
- String *tm = getMappedType(p, "m3wrapintype");
- if (tm != NIL) {
- if (isInParam(p)) {
- addImports(m3wrap_intf.import, "m3wrapintype", p);
- addImports(m3wrap_impl.import, "m3wrapintype", p);
- String *mode = Getattr(p, "tmap:m3wrapinmode");
- String *deflt = Getattr(p, "tmap:m3wrapindefault");
- String *arg = Getattr(p, "autoname");
- SwigType *pt = Getattr(p, "type");
- substituteClassname(pt, tm); /* do we need this ? */
-
- writeArg(arguments, state, mode, arg, tm, deflt);
- }
- p = skipIgnored(Getattr(p, "tmap:m3wrapintype:next"), "m3wrapintype");
- } else {
- p = nextSibling(p);
- }
- }
- writeArg(arguments, state, NIL, NIL, NIL, NIL);
- return (arguments);
- }
-
-/* not used any longer
- - try SwigType_str if required again */
-#if 0
- /* -----------------------------------------------------------------------------
- * createCSignature()
- *
- * Create signature of C function
- * ----------------------------------------------------------------------------- */
-
- String *createCSignature(Node *n) {
- String *arguments = NewString("");
- bool gencomma = false;
- Node *p;
- for (p = Getattr(n, "parms"); p != NIL; p = nextSibling(p)) {
- if (gencomma) {
- Append(arguments, ",");
- }
- gencomma = true;
- String *type = Getattr(p, "type");
- String *ctype = getMappedTypeNew(type, "ctype");
- Append(arguments, ctype);
- }
- return arguments;
- }
-#endif
-
- /* -----------------------------------------------------------------------------
- * emitTypeWrapperClass()
- * ----------------------------------------------------------------------------- */
-
- void emitTypeWrapperClass(String *classname, SwigType *type) {
- Node *n = NewHash();
- Setfile(n, input_file);
- Setline(n, line_number);
-
- String *filen = NewStringf("%s%s.m3", SWIG_output_directory(), classname);
- File *f_swigtype = NewFile(filen, "w", SWIG_output_files());
- if (!f_swigtype) {
- FileErrorDisplay(filen);
- SWIG_exit(EXIT_FAILURE);
- }
- String *swigtype = NewString("");
-
- // Emit banner name
- emitBanner(f_swigtype);
-
- // Pure Modula 3 baseclass and interfaces
- const String *pure_baseclass = typemapLookup(n, "m3base", type, WARN_NONE);
- const String *pure_interfaces = typemapLookup(n, "m3interfaces", type, WARN_NONE);
-
- // Emit the class
- Printv(swigtype, typemapLookup(n, "m3imports", type, WARN_NONE), // Import statements
- "\n", typemapLookup(n, "m3classmodifiers", type, WARN_MODULA3_TYPEMAP_CLASSMOD_UNDEF), // Class modifiers
- " class $m3classname", // Class name and bases
- *Char(pure_baseclass) ? " : " : "", pure_baseclass, *Char(pure_interfaces) ? // Interfaces
- " : " : "", pure_interfaces, " {\n", " private IntPtr swigCPtr;\n", "\n", " ", typemapLookup(n, "m3ptrconstructormodifiers", type, WARN_MODULA3_TYPEMAP_PTRCONSTMOD_UNDEF), // pointer constructor modifiers
- " $m3classname(IntPtr cPtr, bool bFutureUse) {\n", // Constructor used for wrapping pointers
- " swigCPtr = cPtr;\n", " }\n", "\n", " protected $m3classname() {\n", // Default constructor
- " swigCPtr = IntPtr.Zero;\n", " }\n", typemapLookup(n, "m3getcptr", type, WARN_MODULA3_TYPEMAP_GETCPTR_UNDEF), // getCPtr method
- typemapLookup(n, "m3code", type, WARN_NONE), // extra Modula 3 code
- "}\n", "\n", NIL);
-
- Replaceall(swigtype, "$m3classname", classname);
- Printv(f_swigtype, swigtype, NIL);
-
- Delete(f_swigtype);
- Delete(filen);
- Delete(swigtype);
- }
-
- /* -----------------------------------------------------------------------------
- * typemapLookup()
- * n - for input only and must contain info for Getfile(n) and Getline(n) to work
- * tmap_method - typemap method name
- * type - typemap type to lookup
- * warning - warning number to issue if no typemaps found
- * typemap_attributes - the typemap attributes are attached to this node and will
- * also be used for temporary storage if non null
- * return is never NULL, unlike Swig_typemap_lookup()
- * ----------------------------------------------------------------------------- */
-
- const String *typemapLookup(Node *n, const_String_or_char_ptr tmap_method, SwigType *type, int warning, Node *typemap_attributes = 0) {
- Node *node = !typemap_attributes ? NewHash() : typemap_attributes;
- Setattr(node, "type", type);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *tm = Swig_typemap_lookup(tmap_method, node, "", 0);
- if (!tm) {
- tm = empty_string;
- if (warning != WARN_NONE)
- Swig_warning(warning, Getfile(n), Getline(n), "No %s typemap defined for %s\n", tmap_method, SwigType_str(type, 0));
- }
- if (!typemap_attributes)
- Delete(node);
- return tm;
- }
-
- /* -----------------------------------------------------------------------------
- * addThrows()
- *
- * Add all exceptions to a hash that are associated with the 'typemap'.
- * Return number the number of these exceptions.
- * ----------------------------------------------------------------------------- */
-
- int addThrows(Hash *throws_hash, const String *typemap, Node *parameter) {
- // Get the comma separated throws clause - held in "throws" attribute in the typemap passed in
- int len = 0;
- String *throws_attribute = NewStringf("%s:throws", typemap);
-
- addImports(m3wrap_intf.import, throws_attribute, parameter);
- addImports(m3wrap_impl.import, throws_attribute, parameter);
-
- String *throws = getMappedTypeNew(parameter, Char(throws_attribute), "", false);
- //printf("got exceptions %s for %s\n", Char(throws), Char(throws_attribute));
-
- if (throws) {
- // Put the exception classes in the throws clause into a temporary List
- List *temp_classes_list = Split(throws, ',', INT_MAX);
- len = Len(temp_classes_list);
-
- // Add the exception classes to the node throws list, but don't duplicate if already in list
- if (temp_classes_list /*&& hasContent(temp_classes_list) */ ) {
- for (Iterator cls = First(temp_classes_list); cls.item != NIL; cls = Next(cls)) {
- String *exception_class = NewString(cls.item);
- Replaceall(exception_class, " ", ""); // remove spaces
- Replaceall(exception_class, "\t", ""); // remove tabs
- if (hasContent(exception_class)) {
- // $m3classname substitution
- SwigType *pt = Getattr(parameter, "type");
- substituteClassname(pt, exception_class);
- // Don't duplicate the exception class in the throws clause
- //printf("add exception %s\n", Char(exception_class));
- Setattr(throws_hash, exception_class, "1");
- }
- Delete(exception_class);
- }
- }
- Delete(temp_classes_list);
- }
- Delete(throws_attribute);
- return len;
- }
-
- /* -----------------------------------------------------------------------------
- * generateThrowsClause()
- * ----------------------------------------------------------------------------- */
-
- void generateThrowsClause(Hash *throws_hash, String *code) {
- // Add the throws clause into code
- if (Len(throws_hash) > 0) {
- Iterator cls = First(throws_hash);
- Printf(code, " RAISES {%s", cls.key);
- for (cls = Next(cls); cls.key != NIL; cls = Next(cls)) {
- Printf(code, ", %s", cls.key);
- }
- Printf(code, "}");
- }
- }
-
- /* -----------------------------------------------------------------------------
- * addImports()
- *
- * Add all imports that are needed for contents of 'typemap'.
- * ----------------------------------------------------------------------------- */
-
- void addImports(Hash *imports_hash, const String *typemap, Node *node) {
- // Get the comma separated throws clause - held in "throws" attribute in the typemap passed in
- String *imports_attribute = NewStringf("%s:import", typemap);
- String *imports = getMappedTypeNew(node, Char(imports_attribute), "", false);
- //printf("got imports %s for %s\n", Char(imports), Char(imports_attribute));
-
- if (imports != NIL) {
- List *import_list = Split(imports, ',', INT_MAX);
-
- // Add the exception classes to the node imports list, but don't duplicate if already in list
- if (import_list != NIL) {
- for (Iterator imp = First(import_list); imp.item != NIL; imp = Next(imp)) {
- List *import_pair = Split(imp.item, ' ', 3);
- if (Len(import_pair) == 1) {
- Setattr(imports_hash, Getitem(import_pair, 0), "");
- } else if ((Len(import_pair) == 3)
- && Strcmp(Getitem(import_pair, 1), "AS") == 0) {
- Setattr(imports_hash, Getitem(import_pair, 0), Getitem(import_pair, 2));
- } else {
- Swig_warning(WARN_MODULA3_BAD_IMPORT, input_file, line_number,
- "Malformed import '%s' for typemap '%s' defined for type '%s'\n", imp, typemap, SwigType_str(Getattr(node, "type"), 0));
- }
- Delete(import_pair);
- }
- }
- Delete(import_list);
- }
- Delete(imports_attribute);
- }
-
- /* -----------------------------------------------------------------------------
- * emitImportStatements()
- * ----------------------------------------------------------------------------- */
-
- void emitImportStatements(Hash *imports_hash, String *code) {
- // Add the imports statements into code
- Iterator imp = First(imports_hash);
- while (imp.key != NIL) {
- Printf(code, "IMPORT %s", imp.key);
- String *imp_as = imp.item;
- if (hasContent(imp_as)) {
- Printf(code, " AS %s", imp_as);
- }
- Printf(code, ";\n");
- imp = Next(imp);
- }
- }
-
-}; /* class MODULA3 */
-
-/* -----------------------------------------------------------------------------
- * swig_modula3() - Instantiate module
- * ----------------------------------------------------------------------------- */
-
-extern "C" Language *swig_modula3(void) {
- return new MODULA3();
-}
-
-/* -----------------------------------------------------------------------------
- * Static member variables
- * ----------------------------------------------------------------------------- */
-
-const char *MODULA3::usage = "\
-Modula 3 Options (available with -modula3)\n\
- -generateconst <file> - Generate code for computing numeric values of constants\n\
- -generaterename <file> - Generate suggestions for %rename\n\
- -generatetypemap <file> - Generate templates for some basic typemaps\n\
- -oldvarnames - Old intermediary method names for variable wrappers\n\
-\n";
-
-/*
- -generateconst <file> - stem of the .c source file for computing the numeric values of constants\n\
- -generaterename <file> - stem of the .i source file containing %rename suggestions\n\
- -generatetypemap <file> - stem of the .i source file containing typemap patterns\n\
-*/
diff --git a/Source/Modules/pike.cxx b/Source/Modules/pike.cxx
deleted file mode 100644
index c8cd087..0000000
--- a/Source/Modules/pike.cxx
+++ /dev/null
@@ -1,892 +0,0 @@
-/* -----------------------------------------------------------------------------
- * This file is part of SWIG, which is licensed as a whole under version 3
- * (or any later version) of the GNU General Public License. Some additional
- * terms also apply to certain portions of SWIG. The full details of the SWIG
- * license and copyrights can be found in the LICENSE and COPYRIGHT files
- * included with the SWIG source code as distributed by the SWIG developers
- * and at http://www.swig.org/legal.html.
- *
- * pike.cxx
- *
- * Pike language module for SWIG.
- * ----------------------------------------------------------------------------- */
-
-/*
- * Notes:
- *
- * - The current approach used for "out" typemaps is inconsistent with
- * how "out" typemaps are handled by other language modules. Instead
- * of converting the C/C++ type ($1) to a Pike object type (e.g. a
- * struct svalue), we're just calling the appropriate push_XXX
- * (e.g. push_int) to push the return value onto the stack.
- *
- * - Pike classes can't have static member functions or data, so we need
- * to find some other appropriate mapping for C++ static member functions
- * and data.
- *
- * - Pike doesn't seem to provide any default way to print the memory
- * address, etc. for extension objects. Should we do something here?
- *
- */
-
-#include "swigmod.h"
-
-#include <ctype.h> // for isalnum()
-
-static const char *usage = "\
-Pike Options (available with -pike)\n\
- [no additional options]\n\
-\n";
-
-class PIKE:public Language {
-private:
-
- File *f_begin;
- File *f_runtime;
- File *f_header;
- File *f_wrappers;
- File *f_init;
- File *f_classInit;
-
- String *PrefixPlusUnderscore;
- int current;
-
- // Wrap modes
- enum {
- NO_CPP,
- MEMBER_FUNC,
- CONSTRUCTOR,
- DESTRUCTOR,
- MEMBER_VAR,
- CLASS_CONST,
- STATIC_FUNC,
- STATIC_VAR
- };
-
-public:
-
- /* ---------------------------------------------------------------------
- * PIKE()
- *
- * Initialize member data
- * --------------------------------------------------------------------- */
-
- PIKE() {
- f_begin = 0;
- f_runtime = 0;
- f_header = 0;
- f_wrappers = 0;
- f_init = 0;
- f_classInit = 0;
- PrefixPlusUnderscore = 0;
- current = NO_CPP;
- }
-
- /* ---------------------------------------------------------------------
- * main()
- *
- * Parse command line options and initializes variables.
- * --------------------------------------------------------------------- */
-
- virtual void main(int argc, char *argv[]) {
-
- /* Set location of SWIG library */
- SWIG_library_directory("pike");
-
- /* Look for certain command line options */
- for (int i = 1; i < argc; i++) {
- if (argv[i]) {
- if (strcmp(argv[i], "-help") == 0) {
- fputs(usage, stdout);
- }
- }
- }
-
- /* Add a symbol to the parser for conditional compilation */
- Preprocessor_define("SWIGPIKE 1", 0);
-
- /* Set language-specific configuration file */
- SWIG_config_file("pike.swg");
-
- /* Set typemap language */
- SWIG_typemap_lang("pike");
-
- /* Enable overloaded methods support */
- allow_overloading();
- }
-
- /* ---------------------------------------------------------------------
- * top()
- * --------------------------------------------------------------------- */
-
- virtual int top(Node *n) {
- /* Get the module name */
- String *module = Getattr(n, "name");
-
- /* Get the output file name */
- String *outfile = Getattr(n, "outfile");
-
- /* Open the output file */
- f_begin = NewFile(outfile, "w", SWIG_output_files());
- if (!f_begin) {
- FileErrorDisplay(outfile);
- SWIG_exit(EXIT_FAILURE);
- }
- f_runtime = NewString("");
- f_init = NewString("");
- f_classInit = NewString("");
- f_header = NewString("");
- f_wrappers = NewString("");
-
- /* Register file targets with the SWIG file handler */
- Swig_register_filebyname("header", f_header);
- Swig_register_filebyname("wrapper", f_wrappers);
- Swig_register_filebyname("begin", f_begin);
- Swig_register_filebyname("runtime", f_runtime);
- Swig_register_filebyname("init", f_init);
- Swig_register_filebyname("classInit", f_classInit);
-
- /* Standard stuff for the SWIG runtime section */
- Swig_banner(f_begin);
-
- Printf(f_runtime, "\n\n#ifndef SWIGPIKE\n#define SWIGPIKE\n#endif\n\n");
-
- Printf(f_header, "#define SWIG_init pike_module_init\n");
- Printf(f_header, "#define SWIG_name \"%s\"\n\n", module);
-
- /* Change naming scheme for constructors and destructors */
- Swig_name_register("construct", "%n%c_create");
- Swig_name_register("destroy", "%n%c_destroy");
-
- /* Current wrap type */
- current = NO_CPP;
-
- /* Emit code for children */
- Language::top(n);
-
- /* Close the initialization function */
- Printf(f_init, "}\n");
- SwigType_emit_type_table(f_runtime, f_wrappers);
-
- /* Close all of the files */
- Dump(f_runtime, f_begin);
- Dump(f_header, f_begin);
- Dump(f_wrappers, f_begin);
- Wrapper_pretty_print(f_init, f_begin);
-
- Delete(f_header);
- Delete(f_wrappers);
- Delete(f_init);
- Delete(f_classInit);
- Delete(f_runtime);
- Delete(f_begin);
-
- /* Done */
- return SWIG_OK;
- }
-
- /* ------------------------------------------------------------
- * validIdentifier()
- * ------------------------------------------------------------ */
-
- virtual int validIdentifier(String *s) {
- char *c = Char(s);
- const char *c0 = c;
- const char *c1 = c0 + 1;
- while (*c) {
- if (*c == '`' && c == c0) {
- c++;
- continue;
- }
- if ((*c == '+' || *c == '-' || *c == '*' || *c == '/') && c == c1) {
- c++;
- continue;
- }
- if (!(isalnum(*c) || (*c == '_')))
- return 0;
- c++;
- }
- return 1;
- }
-
- /* ------------------------------------------------------------
- * importDirective()
- * ------------------------------------------------------------ */
-
- virtual int importDirective(Node *n) {
- String *modname = Getattr(n, "module");
- if (modname) {
- Printf(f_init, "pike_require(\"%s\");\n", modname);
- }
- return Language::importDirective(n);
- }
-
- /* ------------------------------------------------------------
- * strip()
- *
- * For names that begin with the current class prefix plus an
- * underscore (e.g. "Foo_enum_test"), return the base function
- * name (i.e. "enum_test").
- * ------------------------------------------------------------ */
-
- String *strip(const DOHconst_String_or_char_ptr name) {
- String *s = Copy(name);
- if (Strncmp(name, PrefixPlusUnderscore, Len(PrefixPlusUnderscore)) != 0) {
- return s;
- }
- Replaceall(s, PrefixPlusUnderscore, "");
- return s;
- }
-
- /* ------------------------------------------------------------
- * add_method()
- * ------------------------------------------------------------ */
-
- void add_method(const DOHconst_String_or_char_ptr name, const DOHconst_String_or_char_ptr function, const DOHconst_String_or_char_ptr description) {
- String *rename = NULL;
- switch (current) {
- case NO_CPP:
- rename = NewString(name);
- Printf(f_init, "ADD_FUNCTION(\"%s\", %s, tFunc(%s), 0);\n", rename, function, description);
- break;
- case STATIC_FUNC:
- case STATIC_VAR:
- rename = NewString(name);
- Printf(f_init, "ADD_FUNCTION(\"%s\", %s, tFunc(%s), 0);\n", rename, function, description);
- break;
- case CONSTRUCTOR:
- case DESTRUCTOR:
- case MEMBER_FUNC:
- case MEMBER_VAR:
- rename = strip(name);
- Printf(f_classInit, "ADD_FUNCTION(\"%s\", %s, tFunc(%s), 0);\n", rename, function, description);
- break;
- case CLASS_CONST: // shouldn't have gotten here for CLASS_CONST nodes
- default: // what is this?
- assert(false);
- }
- Delete(rename);
- }
-
- /* ---------------------------------------------------------------------
- * functionWrapper()
- *
- * Create a function declaration and register it with the interpreter.
- * --------------------------------------------------------------------- */
-
- virtual int functionWrapper(Node *n) {
-
- String *name = Getattr(n, "name");
- String *iname = Getattr(n, "sym:name");
- SwigType *d = Getattr(n, "type");
- ParmList *l = Getattr(n, "parms");
-
- Parm *p;
- String *tm;
- int i;
-
- String *overname = 0;
- if (Getattr(n, "sym:overloaded")) {
- overname = Getattr(n, "sym:overname");
- } else {
- if (!addSymbol(iname, n))
- return SWIG_ERROR;
- }
-
- Wrapper *f = NewWrapper();
-
- // Emit all of the local variables for holding arguments.
- emit_parameter_variables(l, f);
-
- /* Attach the standard typemaps */
- emit_attach_parmmaps(l, f);
- Setattr(n, "wrap:parms", l);
-
- /* Get number of required and total arguments */
- int num_arguments = emit_num_arguments(l);
- int varargs = emit_isvarargs(l);
-
- /* Which input argument to start with? */
- int start = (current == MEMBER_FUNC || current == MEMBER_VAR || current == DESTRUCTOR) ? 1 : 0;
-
- /* Offset to skip over the attribute name */
- // int offset = (current == MEMBER_VAR) ? 1 : 0;
- int offset = 0;
-
- String *wname = Swig_name_wrapper(iname);
- if (overname) {
- Append(wname, overname);
- }
- Setattr(n, "wrap:name", wname);
-
- Printv(f->def, "static void ", wname, "(INT32 args) {", NIL);
-
- /* Generate code for argument marshalling */
- String *description = NewString("");
- char source[64];
- for (i = 0, p = l; i < num_arguments; i++) {
-
- while (checkAttribute(p, "tmap:in:numinputs", "0")) {
- p = Getattr(p, "tmap:in:next");
- }
-
- SwigType *pt = Getattr(p, "type");
- String *ln = Getattr(p, "lname");
-
- if (i < start) {
- String *lstr = SwigType_lstr(pt, 0);
- Printf(f->code, "%s = (%s) THIS;\n", ln, lstr);
- Delete(lstr);
- } else {
- /* Look for an input typemap */
- sprintf(source, "Pike_sp[%d-args]", i - start + offset);
- if ((tm = Getattr(p, "tmap:in"))) {
- Replaceall(tm, "$input", source);
- Setattr(p, "emit:input", source);
- Printf(f->code, "%s\n", tm);
- String *pikedesc = Getattr(p, "tmap:in:pikedesc");
- if (pikedesc) {
- Printv(description, pikedesc, " ", NIL);
- }
- p = Getattr(p, "tmap:in:next");
- continue;
- } else {
- Swig_warning(WARN_TYPEMAP_IN_UNDEF, input_file, line_number, "Unable to use type %s as a function argument.\n", SwigType_str(pt, 0));
- break;
- }
- }
- p = nextSibling(p);
- }
-
- /* Check for trailing varargs */
- if (varargs) {
- if (p && (tm = Getattr(p, "tmap:in"))) {
- Replaceall(tm, "$input", "varargs");
- Printv(f->code, tm, "\n", NIL);
- }
- }
-
- /* Insert constraint checking code */
- for (p = l; p;) {
- if ((tm = Getattr(p, "tmap:check"))) {
- Printv(f->code, tm, "\n", NIL);
- p = Getattr(p, "tmap:check:next");
- } else {
- p = nextSibling(p);
- }
- }
-
- /* Insert cleanup code */
- String *cleanup = NewString("");
- for (p = l; p;) {
- if ((tm = Getattr(p, "tmap:freearg"))) {
- Printv(cleanup, tm, "\n", NIL);
- p = Getattr(p, "tmap:freearg:next");
- } else {
- p = nextSibling(p);
- }
- }
-
- /* Insert argument output code */
- String *outarg = NewString("");
- for (p = l; p;) {
- if ((tm = Getattr(p, "tmap:argout"))) {
- Replaceall(tm, "$arg", Getattr(p, "emit:input"));
- Replaceall(tm, "$input", Getattr(p, "emit:input"));
- Printv(outarg, tm, "\n", NIL);
- p = Getattr(p, "tmap:argout:next");
- } else {
- p = nextSibling(p);
- }
- }
-
- /* Emit the function call */
- String *actioncode = emit_action(n);
-
- /* Clear the return stack */
- Printf(actioncode, "pop_n_elems(args);\n");
-
- /* Return the function value */
- if (current == CONSTRUCTOR) {
- Printv(actioncode, "THIS = (void *) ", Swig_cresult_name(), ";\n", NIL);
- Printv(description, ", tVoid", NIL);
- } else if (current == DESTRUCTOR) {
- Printv(description, ", tVoid", NIL);
- } else {
- Printv(description, ", ", NIL);
- if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) {
- actioncode = 0;
- Replaceall(tm, "$result", "resultobj");
- if (GetFlag(n, "feature:new")) {
- Replaceall(tm, "$owner", "1");
- } else {
- Replaceall(tm, "$owner", "0");
- }
- String *pikedesc = Getattr(n, "tmap:out:pikedesc");
- if (pikedesc) {
- Printv(description, pikedesc, NIL);
- }
- Printf(f->code, "%s\n", tm);
- } else {
- Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number, "Unable to use return type %s in function %s.\n", SwigType_str(d, 0), name);
- }
- }
- if (actioncode) {
- Append(f->code, actioncode);
- Delete(actioncode);
- }
- emit_return_variable(n, d, f);
-
- /* Output argument output code */
- Printv(f->code, outarg, NIL);
-
- /* Output cleanup code */
- Printv(f->code, cleanup, NIL);
-
- /* Look to see if there is any newfree cleanup code */
- if (GetFlag(n, "feature:new")) {
- if ((tm = Swig_typemap_lookup("newfree", n, Swig_cresult_name(), 0))) {
- Printf(f->code, "%s\n", tm);
- }
- }
-
- /* See if there is any return cleanup code */
- if ((tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0))) {
- Printf(f->code, "%s\n", tm);
- }
-
- /* Close the function */
- Printf(f->code, "}\n");
-
- /* Substitute the cleanup code */
- Replaceall(f->code, "$cleanup", cleanup);
-
- /* Substitute the function name */
- Replaceall(f->code, "$symname", iname);
- Replaceall(f->code, "$result", "resultobj");
-
- /* Dump the function out */
- Wrapper_print(f, f_wrappers);
-
- /* Now register the function with the interpreter. */
- if (!Getattr(n, "sym:overloaded")) {
- add_method(iname, wname, description);
- } else {
- if (!Getattr(n, "sym:nextSibling")) {
- dispatchFunction(n);
- }
- }
-
- Delete(cleanup);
- Delete(outarg);
- Delete(description);
- Delete(wname);
- DelWrapper(f);
-
- return SWIG_OK;
- }
-
- /* ------------------------------------------------------------
- * dispatchFunction()
- *
- * Emit overloading dispatch function
- * ------------------------------------------------------------ */
-
- void dispatchFunction(Node *n) {
- /* Last node in overloaded chain */
-
- int maxargs;
- String *tmp = NewString("");
- String *dispatch = Swig_overload_dispatch(n, "%s(args); return;", &maxargs);
-
- /* Generate a dispatch wrapper for all overloaded functions */
-
- Wrapper *f = NewWrapper();
- String *symname = Getattr(n, "sym:name");
- String *wname = Swig_name_wrapper(symname);
-
- Printf(f->def, "static void %s(INT32 args) {", wname);
-
- Wrapper_add_local(f, "argc", "INT32 argc");
- Printf(tmp, "struct svalue argv[%d]", maxargs);
- Wrapper_add_local(f, "argv", tmp);
- Wrapper_add_local(f, "ii", "INT32 ii");
-
- Printf(f->code, "argc = args;\n");
- Printf(f->code, "for (ii = 0; (ii < argc) && (ii < %d); ii++) {\n", maxargs);
- Printf(f->code, "argv[ii] = Pike_sp[ii-args];\n");
- Printf(f->code, "}\n");
-
- Replaceall(dispatch, "$args", "self, args");
- Printv(f->code, dispatch, "\n", NIL);
- Printf(f->code, "Pike_error(\"No matching function for overloaded '%s'.\");\n", symname);
- Printv(f->code, "}\n", NIL);
-
- Wrapper_print(f, f_wrappers);
-
- String *description = NewString("");
- Printf(description, "tAny,");
- if (current == CONSTRUCTOR || current == DESTRUCTOR) {
- Printf(description, " tVoid");
- } else {
- String *pd = Getattr(n, "tmap:out:pikedesc");
- if (pd)
- Printf(description, " %s", pd);
- }
- add_method(symname, wname, description);
- Delete(description);
-
- DelWrapper(f);
- Delete(dispatch);
- Delete(tmp);
- Delete(wname);
- }
-
- /* ------------------------------------------------------------
- * variableWrapper()
- * ------------------------------------------------------------ */
-
- virtual int variableWrapper(Node *n) {
- return Language::variableWrapper(n);
- }
-
- /* ------------------------------------------------------------
- * constantWrapper()
- * ------------------------------------------------------------ */
-
- virtual int constantWrapper(Node *n) {
-
- Swig_require("constantWrapper", n, "*sym:name", "type", "value", NIL);
-
- String *symname = Getattr(n, "sym:name");
- SwigType *type = Getattr(n, "type");
- String *value = Getattr(n, "value");
- bool is_enum_item = (Cmp(nodeType(n), "enumitem") == 0);
-
- if (SwigType_type(type) == T_MPOINTER) {
- /* Special hook for member pointer */
- String *wname = Swig_name_wrapper(symname);
- Printf(f_header, "static %s = %s;\n", SwigType_str(type, wname), value);
- value = wname;
- } else if (SwigType_type(type) == T_CHAR && is_enum_item) {
- type = NewSwigType(T_INT);
- Setattr(n, "type", type);
- }
-
- /* Perform constant typemap substitution */
- String *tm = Swig_typemap_lookup("constant", n, value, 0);
- if (tm) {
- Replaceall(tm, "$symname", symname);
- Replaceall(tm, "$value", value);
- Printf(f_init, "%s\n", tm);
- } else {
- Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number, "Unsupported constant value %s = %s\n", SwigType_str(type, 0), value);
- }
-
- Swig_restore(n);
-
- return SWIG_OK;
- }
-
- /* ------------------------------------------------------------
- * nativeWrapper()
- * ------------------------------------------------------------ */
-
- virtual int nativeWrapper(Node *n) {
- // return Language::nativeWrapper(n);
- String *name = Getattr(n, "sym:name");
- String *wrapname = Getattr(n, "wrap:name");
-
- if (!addSymbol(wrapname, n))
- return SWIG_ERROR;
-
- add_method(name, wrapname, 0);
- return SWIG_OK;
- }
-
- /* ------------------------------------------------------------
- * enumDeclaration()
- * ------------------------------------------------------------ */
-
- virtual int enumDeclaration(Node *n) {
- return Language::enumDeclaration(n);
- }
-
- /* ------------------------------------------------------------
- * enumvalueDeclaration()
- * ------------------------------------------------------------ */
-
- virtual int enumvalueDeclaration(Node *n) {
- return Language::enumvalueDeclaration(n);
- }
-
- /* ------------------------------------------------------------
- * classDeclaration()
- * ------------------------------------------------------------ */
-
- virtual int classDeclaration(Node *n) {
- return Language::classDeclaration(n);
- }
-
- /* ------------------------------------------------------------
- * classHandler()
- * ------------------------------------------------------------ */
-
- virtual int classHandler(Node *n) {
-
- String *symname = Getattr(n, "sym:name");
- if (!addSymbol(symname, n))
- return SWIG_ERROR;
-
- PrefixPlusUnderscore = NewStringf("%s_", getClassPrefix());
-
- Printf(f_classInit, "start_new_program();\n");
-
- /* Handle inheritance */
- List *baselist = Getattr(n, "bases");
- if (baselist && Len(baselist) > 0) {
- Iterator base = First(baselist);
- while (base.item) {
- String *basename = Getattr(base.item, "name");
- SwigType *basetype = NewString(basename);
- SwigType_add_pointer(basetype);
- SwigType_remember(basetype);
- String *basemangle = SwigType_manglestr(basetype);
- Printf(f_classInit, "low_inherit((struct program *) SWIGTYPE%s->clientdata, 0, 0, 0, 0, 0);\n", basemangle);
- Delete(basemangle);
- Delete(basetype);
- base = Next(base);
- }
- } else {
- Printf(f_classInit, "ADD_STORAGE(swig_object_wrapper);\n");
- }
-
- Language::classHandler(n);
-
- /* Accessors for member variables */
- /*
- List *membervariables = Getattr(n,"membervariables");
- if (membervariables && Len(membervariables) > 0) {
- membervariableAccessors(membervariables);
- }
- */
-
- /* Done, close the class and dump its definition to the init function */
- Printf(f_classInit, "add_program_constant(\"%s\", pr = end_program(), 0);\n", symname);
- Dump(f_classInit, f_init);
- Clear(f_classInit);
-
- SwigType *tt = NewString(symname);
- SwigType_add_pointer(tt);
- SwigType_remember(tt);
- String *tm = SwigType_manglestr(tt);
- Printf(f_init, "SWIG_TypeClientData(SWIGTYPE%s, (void *) pr);\n", tm);
- Delete(tm);
- Delete(tt);
-
- Delete(PrefixPlusUnderscore);
- PrefixPlusUnderscore = 0;
-
- return SWIG_OK;
- }
-
- /* ------------------------------------------------------------
- * memberfunctionHandler()
- *
- * Method for adding C++ member function
- * ------------------------------------------------------------ */
-
- virtual int memberfunctionHandler(Node *n) {
- current = MEMBER_FUNC;
- Language::memberfunctionHandler(n);
- current = NO_CPP;
- return SWIG_OK;
- }
-
- /* ------------------------------------------------------------
- * constructorHandler()
- *
- * Method for adding C++ member constructor
- * ------------------------------------------------------------ */
-
- virtual int constructorHandler(Node *n) {
- current = CONSTRUCTOR;
- Language::constructorHandler(n);
- current = NO_CPP;
- return SWIG_OK;
- }
-
- /* ------------------------------------------------------------
- * destructorHandler()
- * ------------------------------------------------------------ */
-
- virtual int destructorHandler(Node *n) {
- current = DESTRUCTOR;
- Language::destructorHandler(n);
- current = NO_CPP;
- return SWIG_OK;
- }
-
- /* ------------------------------------------------------------
- * membervariableAccessors()
- * ------------------------------------------------------------ */
-
- void membervariableAccessors(List *membervariables) {
- String *name;
- Iterator i;
- bool need_setter;
- String *funcname;
-
- /* If at least one of them is mutable, we need a setter */
- need_setter = false;
- i = First(membervariables);
- while (i.item) {
- if (!GetFlag(i.item, "feature:immutable")) {
- need_setter = true;
- break;
- }
- i = Next(i);
- }
-
- /* Create a function to set the values of the (mutable) variables */
- if (need_setter) {
- Wrapper *wrapper = NewWrapper();
- String *setter = Swig_name_member(NSPACE_TODO, getClassPrefix(), "`->=");
- String *wname = Swig_name_wrapper(setter);
- Printv(wrapper->def, "static void ", wname, "(INT32 args) {", NIL);
- Printf(wrapper->locals, "char *name = (char *) STR0(Pike_sp[0-args].u.string);\n");
-
- i = First(membervariables);
- while (i.item) {
- if (!GetFlag(i.item, "feature:immutable")) {
- name = Getattr(i.item, "name");
- funcname = Swig_name_wrapper(Swig_name_set(NSPACE_TODO, Swig_name_member(NSPACE_TODO, getClassPrefix(), name)));
- Printf(wrapper->code, "if (!strcmp(name, \"%s\")) {\n", name);
- Printf(wrapper->code, "%s(args);\n", funcname);
- Printf(wrapper->code, "return;\n");
- Printf(wrapper->code, "}\n");
- Delete(funcname);
- }
- i = Next(i);
- }
-
- /* Close the function */
- Printf(wrapper->code, "pop_n_elems(args);\n");
- Printf(wrapper->code, "}\n");
-
- /* Dump wrapper code to the output file */
- Wrapper_print(wrapper, f_wrappers);
-
- /* Register it with Pike */
- String *description = NewString("tStr tFloat, tVoid");
- add_method("`->=", wname, description);
- Delete(description);
-
- /* Clean up */
- Delete(wname);
- Delete(setter);
- DelWrapper(wrapper);
- }
-
- /* Create a function to get the values of the (mutable) variables */
- Wrapper *wrapper = NewWrapper();
- String *getter = Swig_name_member(NSPACE_TODO, getClassPrefix(), "`->");
- String *wname = Swig_name_wrapper(getter);
- Printv(wrapper->def, "static void ", wname, "(INT32 args) {", NIL);
- Printf(wrapper->locals, "char *name = (char *) STR0(Pike_sp[0-args].u.string);\n");
-
- i = First(membervariables);
- while (i.item) {
- name = Getattr(i.item, "name");
- funcname = Swig_name_wrapper(Swig_name_get(NSPACE_TODO, Swig_name_member(NSPACE_TODO, getClassPrefix(), name)));
- Printf(wrapper->code, "if (!strcmp(name, \"%s\")) {\n", name);
- Printf(wrapper->code, "%s(args);\n", funcname);
- Printf(wrapper->code, "return;\n");
- Printf(wrapper->code, "}\n");
- Delete(funcname);
- i = Next(i);
- }
-
- /* Close the function */
- Printf(wrapper->code, "pop_n_elems(args);\n");
- Printf(wrapper->code, "}\n");
-
- /* Dump wrapper code to the output file */
- Wrapper_print(wrapper, f_wrappers);
-
- /* Register it with Pike */
- String *description = NewString("tStr, tMix");
- add_method("`->", wname, description);
- Delete(description);
-
- /* Clean up */
- Delete(wname);
- Delete(getter);
- DelWrapper(wrapper);
- }
-
- /* ------------------------------------------------------------
- * membervariableHandler()
- * ------------------------------------------------------------ */
-
- virtual int membervariableHandler(Node *n) {
- List *membervariables = Getattr(getCurrentClass(), "membervariables");
- if (!membervariables) {
- membervariables = NewList();
- Setattr(getCurrentClass(), "membervariables", membervariables);
- }
- Append(membervariables, n);
- current = MEMBER_VAR;
- Language::membervariableHandler(n);
- current = NO_CPP;
- return SWIG_OK;
- }
-
- /* -----------------------------------------------------------------------
- * staticmemberfunctionHandler()
- *
- * Wrap a static C++ function
- * ---------------------------------------------------------------------- */
-
- virtual int staticmemberfunctionHandler(Node *n) {
- current = STATIC_FUNC;
- Language::staticmemberfunctionHandler(n);
- current = NO_CPP;
- return SWIG_OK;
- }
-
- /* ------------------------------------------------------------
- * memberconstantHandler()
- *
- * Create a C++ constant
- * ------------------------------------------------------------ */
-
- virtual int memberconstantHandler(Node *n) {
- current = CLASS_CONST;
- constantWrapper(n);
- current = NO_CPP;
- return SWIG_OK;
- }
-
- /* ---------------------------------------------------------------------
- * staticmembervariableHandler()
- * --------------------------------------------------------------------- */
-
- virtual int staticmembervariableHandler(Node *n) {
- current = STATIC_VAR;
- Language::staticmembervariableHandler(n);
- current = NO_CPP;
- return SWIG_OK;
- }
-};
-
-/* -----------------------------------------------------------------------------
- * swig_pike() - Instantiate module
- * ----------------------------------------------------------------------------- */
-
-static Language *new_swig_pike() {
- return new PIKE();
-}
-extern "C" Language *swig_pike(void) {
- return new_swig_pike();
-}
diff --git a/Source/Modules/s-exp.cxx b/Source/Modules/s-exp.cxx
deleted file mode 100644
index fe3b1fa..0000000
--- a/Source/Modules/s-exp.cxx
+++ /dev/null
@@ -1,402 +0,0 @@
-/* -----------------------------------------------------------------------------
- * This file is part of SWIG, which is licensed as a whole under version 3
- * (or any later version) of the GNU General Public License. Some additional
- * terms also apply to certain portions of SWIG. The full details of the SWIG
- * license and copyrights can be found in the LICENSE and COPYRIGHT files
- * included with the SWIG source code as distributed by the SWIG developers
- * and at http://www.swig.org/legal.html.
- *
- * s-exp.cxx
- *
- * A parse tree represented as Lisp s-expressions.
- * ----------------------------------------------------------------------------- */
-
-#include "swigmod.h"
-#include "dohint.h"
-
-static const char *usage = "\
-S-Exp Options (available with -sexp)\n\
- -typemaplang <lang> - Typemap language\n\n";
-
-//static Node *view_top = 0;
-static File *out = 0;
-
-class Sexp:public Language {
- int indent_level;
- DOHHash *print_circle_hash;
- int print_circle_count;
- int hanging_parens;
- bool need_whitespace;
- bool need_newline;
-
-public:
- Sexp():
- indent_level(0),
- print_circle_hash(0),
- print_circle_count(0),
- hanging_parens(0),
- need_whitespace(0),
- need_newline(0) {
- }
-
- virtual ~ Sexp() {
- }
-
- virtual void main(int argc, char *argv[]) {
- // Add a symbol to the parser for conditional compilation
- Preprocessor_define("SWIGSEXP 1", 0);
-
- SWIG_typemap_lang("sexp");
- for (int iX = 0; iX < argc; iX++) {
- if (strcmp(argv[iX], "-typemaplang") == 0) {
- Swig_mark_arg(iX);
- iX++;
- SWIG_typemap_lang(argv[iX]);
- Swig_mark_arg(iX);
- continue;
- }
- if (strcmp(argv[iX], "-help") == 0) {
- fputs(usage, stdout);
- }
- }
- }
-
- /* Top of the parse tree */
- virtual int top(Node *n) {
- if (out == 0) {
- String *outfile = Getattr(n, "outfile");
- Replaceall(outfile, "_wrap.cxx", ".lisp");
- Replaceall(outfile, "_wrap.c", ".lisp");
- out = NewFile(outfile, "w", SWIG_output_files());
- if (!out) {
- FileErrorDisplay(outfile);
- SWIG_exit(EXIT_FAILURE);
- }
- }
- String *f_sink = NewString("");
- Swig_register_filebyname("header", f_sink);
- Swig_register_filebyname("wrapper", f_sink);
- Swig_register_filebyname("begin", f_sink);
- Swig_register_filebyname("runtime", f_sink);
- Swig_register_filebyname("init", f_sink);
-
- Swig_banner_target_lang(out, ";;;");
-
- Language::top(n);
- Printf(out, "\n");
- Printf(out, ";;; Lisp parse tree produced by SWIG\n");
- print_circle_hash = NewHash();
- print_circle_count = 0;
- hanging_parens = 0;
- need_whitespace = 0;
- need_newline = 0;
- Sexp_print_node(n);
- flush_parens();
- return SWIG_OK;
- }
-
- void print_indent() {
- int i;
- for (i = 0; i < indent_level; i++) {
- Printf(out, " ");
- }
- }
-
- void open_paren(const String *oper) {
- flush_parens();
- Printf(out, "(");
- if (oper)
- Printf(out, "%s ", oper);
- indent_level += 2;
- }
-
- void close_paren(bool neednewline = false) {
- hanging_parens++;
- if (neednewline)
- print_lazy_whitespace();
- indent_level -= 2;
- }
-
- void flush_parens() {
- int i;
- if (hanging_parens) {
- for (i = 0; i < hanging_parens; i++)
- Printf(out, ")");
- hanging_parens = 0;
- need_newline = true;
- need_whitespace = true;
- }
- if (need_newline) {
- Printf(out, "\n");
- print_indent();
- need_newline = false;
- need_whitespace = false;
- } else if (need_whitespace) {
- Printf(out, " ");
- need_whitespace = false;
- }
- }
-
- void print_lazy_whitespace() {
- need_whitespace = 1;
- }
-
- void print_lazy_newline() {
- need_newline = 1;
- }
-
- bool internal_key_p(DOH *key) {
- return ((Cmp(key, "nodeType") == 0)
- || (Cmp(key, "firstChild") == 0)
- || (Cmp(key, "lastChild") == 0)
- || (Cmp(key, "parentNode") == 0)
- || (Cmp(key, "nextSibling") == 0)
- || (Cmp(key, "previousSibling") == 0)
- || (Cmp(key, "csym:nextSibling") == 0)
- || (Cmp(key, "csym:previousSibling") == 0)
- || (Cmp(key, "typepass:visit") == 0)
- || (Cmp(key, "allocate:visit") == 0)
- || (*(Char(key)) == '$'));
- }
-
- bool boolean_key_p(DOH *key) {
- return ((Cmp(key, "allocate:default_constructor") == 0)
- || (Cmp(key, "allocate:default_destructor") == 0)
- || (Cmp(key, "allows_typedef") == 0)
- || (Cmp(key, "feature:immutable") == 0));
- }
-
- bool list_key_p(DOH *key) {
- return ((Cmp(key, "parms") == 0)
- || (Cmp(key, "baselist") == 0));
- }
-
- bool plist_key_p(DOH *key)
- // true if KEY is the name of data that is a mapping from keys to
- // values, which should be printed as a plist.
- {
- return ((Cmp(key, "typescope") == 0));
- }
-
- bool maybe_plist_key_p(DOH *key) {
- return (Strncmp(key, "tmap:", 5) == 0);
- }
-
- bool print_circle(DOH *obj, bool list_p)
- // We have a complex object, which might be referenced several
- // times, or even recursively. Use Lisp's reader notation for
- // circular structures (#n#, #n=).
- //
- // An object can be printed in list-mode or object-mode; LIST_P toggles.
- // return TRUE if OBJ still needs to be printed
- {
- flush_parens();
- // Following is a silly hack. It works around the limitation of
- // DOH's hash tables that only work with string keys!
- char address[32];
- sprintf(address, "%p%c", obj, list_p ? 'L' : 'O');
- DOH *placeholder = Getattr(print_circle_hash, address);
- if (placeholder) {
- Printv(out, placeholder, NIL);
- return false;
- } else {
- String *placeholder = NewStringf("#%d#", ++print_circle_count);
- Setattr(print_circle_hash, address, placeholder);
- Printf(out, "#%d=", print_circle_count);
- return true;
- }
- }
-
- void Sexp_print_value_of_key(DOH *value, DOH *key) {
- if ((Cmp(key, "parms") == 0) || (Cmp(key, "wrap:parms") == 0)
- || (Cmp(key, "kwargs") == 0) || (Cmp(key, "pattern") == 0))
- Sexp_print_parms(value);
- else if (plist_key_p(key))
- Sexp_print_plist(value);
- else if (maybe_plist_key_p(key)) {
- if (DohIsMapping(value))
- Sexp_print_plist(value);
- else
- Sexp_print_doh(value);
- } else if (list_key_p(key))
- Sexp_print_list(value);
- else if (boolean_key_p(key))
- Sexp_print_boolean(value);
- else
- Sexp_print_doh(value);
- }
-
- void Sexp_print_boolean(DOH *obj) {
- flush_parens();
- /* See DOH/Doh/base.c, DohGetInt() */
- if (DohIsString(obj)) {
- if (atoi(Char(obj)) != 0)
- Printf(out, "t");
- else
- Printf(out, "nil");
- } else
- Printf(out, "nil");
- }
-
- void Sexp_print_list(DOH *obj) {
- if (print_circle(obj, true)) {
- open_paren(NIL);
- for (; obj; obj = nextSibling(obj)) {
- Sexp_print_doh(obj);
- print_lazy_whitespace();
- }
- close_paren(true);
- }
- }
-
- void Sexp_print_parms(DOH *obj) {
- // print it as a list of plists
- if (print_circle(obj, true)) {
- open_paren(NIL);
- for (; obj; obj = nextSibling(obj)) {
- if (DohIsMapping(obj)) {
- Iterator k;
- open_paren(NIL);
- for (k = First(obj); k.key; k = Next(k)) {
- if (!internal_key_p(k.key)) {
- DOH *value = Getattr(obj, k.key);
- Sexp_print_as_keyword(k.key);
- Sexp_print_value_of_key(value, k.key);
- print_lazy_whitespace();
- }
- }
- close_paren(true);
- } else
- Sexp_print_doh(obj);
- print_lazy_whitespace();
- }
- close_paren(true);
- }
- }
-
- void Sexp_print_doh(DOH *obj) {
- flush_parens();
- if (DohIsString(obj)) {
- String *o = Str(obj);
- Replaceall(o, "\\", "\\\\");
- Replaceall(o, "\"", "\\\"");
- Printf(out, "\"%s\"", o);
- Delete(o);
- } else {
- if (print_circle(obj, false)) {
- // Dispatch type
- if (nodeType(obj)) {
- Sexp_print_node(obj);
- }
-
- else if (DohIsMapping(obj)) {
- Iterator k;
- open_paren(NIL);
- for (k = First(obj); k.key; k = Next(k)) {
- if (!internal_key_p(k.key)) {
- DOH *value = Getattr(obj, k.key);
- flush_parens();
- open_paren(NIL);
- Sexp_print_doh(k.key);
- Printf(out, " . ");
- Sexp_print_value_of_key(value, k.key);
- close_paren();
- }
- }
- close_paren();
- } else if (strcmp(ObjType(obj)->objname, "List") == 0) {
- int i;
- open_paren(NIL);
- for (i = 0; i < Len(obj); i++) {
- DOH *item = Getitem(obj, i);
- Sexp_print_doh(item);
- }
- close_paren();
- } else {
- // What is it?
- Printf(out, "#<DOH %s %p>", ObjType(obj)->objname, obj);
- }
- }
- }
- }
-
- void Sexp_print_as_keyword(const DOH *k) {
- /* Print key, replacing ":" with "-" because : is CL's package prefix */
- flush_parens();
- String *key = NewString(k);
- Replaceall(key, ":", "-");
- Replaceall(key, "_", "-");
- Printf(out, ":%s ", key);
- Delete(key);
- }
-
- void Sexp_print_plist_noparens(DOH *obj) {
- /* attributes map names to objects */
- Iterator k;
- bool first;
- for (k = First(obj), first = true; k.key; k = Next(k), first = false) {
- if (!internal_key_p(k.key)) {
- DOH *value = Getattr(obj, k.key);
- flush_parens();
- if (!first) {
- Printf(out, " ");
- }
- Sexp_print_as_keyword(k.key);
- /* Print value */
- Sexp_print_value_of_key(value, k.key);
- }
- }
- }
-
- void Sexp_print_plist(DOH *obj) {
- flush_parens();
- if (print_circle(obj, true)) {
- open_paren(NIL);
- Sexp_print_plist_noparens(obj);
- close_paren();
- }
- }
-
- void Sexp_print_attributes(Node *obj) {
- Sexp_print_plist_noparens(obj);
- }
-
- void Sexp_print_node(Node *obj) {
- Node *cobj;
- open_paren(nodeType(obj));
- /* A node has an attribute list... */
- Sexp_print_attributes(obj);
- /* ... and child nodes. */
- cobj = firstChild(obj);
- if (cobj) {
- print_lazy_newline();
- flush_parens();
- Sexp_print_as_keyword("children");
- open_paren(NIL);
- for (; cobj; cobj = nextSibling(cobj)) {
- Sexp_print_node(cobj);
- }
- close_paren();
- }
- close_paren();
- }
-
-
- virtual int functionWrapper(Node *n) {
- ParmList *l = Getattr(n, "parms");
- Wrapper *f = NewWrapper();
- emit_attach_parmmaps(l, f);
- Setattr(n, "wrap:parms", l);
- DelWrapper(f);
- return SWIG_OK;
- }
-
-};
-
-
-static Language *new_swig_sexp() {
- return new Sexp();
-}
-extern "C" Language *swig_sexp(void) {
- return new_swig_sexp();
-}
diff --git a/Source/Modules/uffi.cxx b/Source/Modules/uffi.cxx
deleted file mode 100644
index 10a53a5..0000000
--- a/Source/Modules/uffi.cxx
+++ /dev/null
@@ -1,405 +0,0 @@
-/* -----------------------------------------------------------------------------
- * This file is part of SWIG, which is licensed as a whole under version 3
- * (or any later version) of the GNU General Public License. Some additional
- * terms also apply to certain portions of SWIG. The full details of the SWIG
- * license and copyrights can be found in the LICENSE and COPYRIGHT files
- * included with the SWIG source code as distributed by the SWIG developers
- * and at http://www.swig.org/legal.html.
- *
- * uffi.cxx
- *
- * Uffi language module for SWIG.
- * ----------------------------------------------------------------------------- */
-
-// TODO: remove remnants of lisptype
-
-#include "swigmod.h"
-
-static const char *usage = "\
-UFFI Options (available with -uffi)\n\
- -identifier-converter <type or funcname> - \n\
- Specifies the type of conversion to do on C identifiers\n\
- to convert them to symbols. There are two built-in\n\
- converters: 'null' and 'lispify'. The default is\n\
- 'null'. If you supply a name other than one of the\n\
- built-ins, then a function by that name will be\n\
- called to convert identifiers to symbols.\n\
-";
-
-class UFFI:public Language {
-public:
-
- virtual void main(int argc, char *argv[]);
- virtual int top(Node *n);
- virtual int functionWrapper(Node *n);
- virtual int constantWrapper(Node *n);
- virtual int classHandler(Node *n);
- virtual int membervariableHandler(Node *n);
-
-};
-
-static File *f_cl = 0;
-
-static struct {
- int count;
- String **entries;
-} defined_foreign_types;
-
-static String *identifier_converter = NewString("identifier-convert-null");
-
-static int any_varargs(ParmList *pl) {
- Parm *p;
-
- for (p = pl; p; p = nextSibling(p)) {
- if (SwigType_isvarargs(Getattr(p, "type")))
- return 1;
- }
-
- return 0;
-}
-
-
-/* utilities */
-/* returns new string w/ parens stripped */
-static String *strip_parens(String *string) {
- char *s = Char(string), *p;
- int len = Len(string);
- String *res;
-
- if (len == 0 || s[0] != '(' || s[len - 1] != ')') {
- return NewString(string);
- }
-
- p = (char *) malloc(len - 2 + 1);
- if (!p) {
- Printf(stderr, "Malloc failed\n");
- SWIG_exit(EXIT_FAILURE);
- }
-
- strncpy(p, s + 1, len - 1);
- p[len - 2] = 0; /* null terminate */
-
- res = NewString(p);
- free(p);
-
- return res;
-}
-
-
-static String *convert_literal(String *num_param, String *type) {
- String *num = strip_parens(num_param), *res;
- char *s = Char(num);
-
- /* Make sure doubles use 'd' instead of 'e' */
- if (!Strcmp(type, "double")) {
- String *updated = Copy(num);
- if (Replace(updated, "e", "d", DOH_REPLACE_ANY) > 1) {
- Printf(stderr, "Weird!! number %s looks invalid.\n", num);
- SWIG_exit(EXIT_FAILURE);
- }
- Delete(num);
- return updated;
- }
-
- if (SwigType_type(type) == T_CHAR) {
- /* Use CL syntax for character literals */
- return NewStringf("#\\%s", num_param);
- } else if (SwigType_type(type) == T_STRING) {
- /* Use CL syntax for string literals */
- return NewStringf("\"%s\"", num_param);
- }
-
- if (Len(num) < 2 || s[0] != '0') {
- return num;
- }
-
- /* octal or hex */
-
- res = NewStringf("#%c%s", s[1] == 'x' ? 'x' : 'o', s + 2);
- Delete(num);
-
- return res;
-}
-
-static void add_defined_foreign_type(String *type) {
- if (!defined_foreign_types.count) {
- /* Make fresh */
- defined_foreign_types.count = 1;
- defined_foreign_types.entries = (String **) malloc(sizeof(String *));
- } else {
- /* make room */
- defined_foreign_types.count++;
- defined_foreign_types.entries = (String **)
- realloc(defined_foreign_types.entries, defined_foreign_types.count * sizeof(String *));
- }
-
- if (!defined_foreign_types.entries) {
- Printf(stderr, "Out of memory\n");
- SWIG_exit(EXIT_FAILURE);
- }
-
- /* Fill in the new data */
- defined_foreign_types.entries[defined_foreign_types.count - 1] = Copy(type);
-
-}
-
-
-static String *get_ffi_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
- Node *node = NewHash();
- Setattr(node, "type", ty);
- Setattr(node, "name", name);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *tm = Swig_typemap_lookup("ffitype", node, "", 0);
- Delete(node);
-
- if (tm) {
- return NewString(tm);
- } else {
- SwigType *tr = SwigType_typedef_resolve_all(ty);
- char *type_reduced = Char(tr);
- int i;
-
- //Printf(stdout,"convert_type %s\n", ty);
- if (SwigType_isconst(tr)) {
- SwigType_pop(tr);
- type_reduced = Char(tr);
- }
-
- if (SwigType_ispointer(type_reduced) || SwigType_isarray(ty) || !strncmp(type_reduced, "p.f", 3)) {
- return NewString(":pointer-void");
- }
-
- for (i = 0; i < defined_foreign_types.count; i++) {
- if (!Strcmp(ty, defined_foreign_types.entries[i])) {
- return NewStringf("#.(%s \"%s\" :type :type)", identifier_converter, ty);
- }
- }
-
- if (!Strncmp(type_reduced, "enum ", 5)) {
- return NewString(":int");
- }
-
- Printf(stderr, "Unsupported data type: %s (was: %s)\n", type_reduced, ty);
- SWIG_exit(EXIT_FAILURE);
- }
- return 0;
-}
-
-static String *get_lisp_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
- Node *node = NewHash();
- Setattr(node, "type", ty);
- Setattr(node, "name", name);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *tm = Swig_typemap_lookup("lisptype", node, "", 0);
- Delete(node);
-
- return tm ? NewString(tm) : NewString("");
-}
-
-void UFFI::main(int argc, char *argv[]) {
- int i;
-
- Preprocessor_define("SWIGUFFI 1", 0);
- SWIG_library_directory("uffi");
- SWIG_config_file("uffi.swg");
-
-
- for (i = 1; i < argc; i++) {
- if (!strcmp(argv[i], "-identifier-converter")) {
- char *conv = argv[i + 1];
-
- if (!conv)
- Swig_arg_error();
-
- Swig_mark_arg(i);
- Swig_mark_arg(i + 1);
- i++;
-
- /* check for built-ins */
- if (!strcmp(conv, "lispify")) {
- Delete(identifier_converter);
- identifier_converter = NewString("identifier-convert-lispify");
- } else if (!strcmp(conv, "null")) {
- Delete(identifier_converter);
- identifier_converter = NewString("identifier-convert-null");
- } else {
- /* Must be user defined */
- Delete(identifier_converter);
- identifier_converter = NewString(conv);
- }
- }
-
- if (!strcmp(argv[i], "-help")) {
- Printf(stdout, "%s\n", usage);
- }
- }
-}
-
-int UFFI::top(Node *n) {
- String *module = Getattr(n, "name");
- String *output_filename = NewString("");
- File *f_null = NewString("");
-
- Printf(output_filename, "%s%s.cl", SWIG_output_directory(), module);
-
-
- f_cl = NewFile(output_filename, "w", SWIG_output_files());
- if (!f_cl) {
- FileErrorDisplay(output_filename);
- SWIG_exit(EXIT_FAILURE);
- }
-
- Swig_register_filebyname("header", f_null);
- Swig_register_filebyname("begin", f_null);
- Swig_register_filebyname("runtime", f_null);
- Swig_register_filebyname("wrapper", f_cl);
-
- Swig_banner_target_lang(f_cl, ";;");
-
- Printf(f_cl, "\n"
- ";; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; package: %s -*-\n\n(defpackage :%s\n (:use :common-lisp :uffi))\n\n(in-package :%s)\n",
- module, module, module);
- Printf(f_cl, "(eval-when (compile load eval)\n (defparameter *swig-identifier-converter* '%s))\n", identifier_converter);
-
- Language::top(n);
-
- Delete(f_cl); // Delete the handle, not the file
- Delete(f_null);
-
- return SWIG_OK;
-}
-
-int UFFI::functionWrapper(Node *n) {
- String *funcname = Getattr(n, "sym:name");
- ParmList *pl = Getattr(n, "parms");
- Parm *p;
- int argnum = 0, first = 1;
-// int varargs = 0;
-
- //Language::functionWrapper(n);
-
- Printf(f_cl, "(swig-defun \"%s\"\n", funcname);
- Printf(f_cl, " (");
-
- /* Special cases */
-
- if (ParmList_len(pl) == 0) {
- Printf(f_cl, ":void");
- } else if (any_varargs(pl)) {
- Printf(f_cl, "#| varargs |#");
-// varargs = 1;
- } else {
- for (p = pl; p; p = nextSibling(p), argnum++) {
- String *argname = Getattr(p, "name");
- SwigType *argtype = Getattr(p, "type");
- String *ffitype = get_ffi_type(n, argtype, argname);
- String *lisptype = get_lisp_type(n, argtype, argname);
- int tempargname = 0;
-
- if (!argname) {
- argname = NewStringf("arg%d", argnum);
- tempargname = 1;
- }
-
- if (!first) {
- Printf(f_cl, "\n ");
- }
- Printf(f_cl, "(%s %s %s)", argname, ffitype, lisptype);
- first = 0;
-
- Delete(ffitype);
- Delete(lisptype);
- if (tempargname)
- Delete(argname);
-
- }
- }
- Printf(f_cl, ")\n"); /* finish arg list */
- Printf(f_cl, " :returning %s\n"
- //" :strings-convert t\n"
- //" :call-direct %s\n"
- //" :optimize-for-space t"
- ")\n", get_ffi_type(n, Getattr(n, "type"), Swig_cresult_name())
- //,varargs ? "nil" : "t"
- );
-
-
- return SWIG_OK;
-}
-
-int UFFI::constantWrapper(Node *n) {
- String *type = Getattr(n, "type");
- String *converted_value = convert_literal(Getattr(n, "value"), type);
- String *name = Getattr(n, "sym:name");
-
-#if 0
- Printf(stdout, "constant %s is of type %s. value: %s\n", name, type, converted_value);
-#endif
-
- Printf(f_cl, "(swig-defconstant \"%s\" %s)\n", name, converted_value);
-
- Delete(converted_value);
-
- return SWIG_OK;
-}
-
-// Includes structs
-int UFFI::classHandler(Node *n) {
-
- String *name = Getattr(n, "sym:name");
- String *kind = Getattr(n, "kind");
- Node *c;
-
- if (Strcmp(kind, "struct")) {
- Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
- Printf(stderr, " (name: %s)\n", name);
- SWIG_exit(EXIT_FAILURE);
- }
-
- Printf(f_cl, "(swig-def-struct \"%s\"\n \n", name);
-
- for (c = firstChild(n); c; c = nextSibling(c)) {
- SwigType *type = Getattr(c, "type");
- SwigType *decl = Getattr(c, "decl");
- if (type) {
- type = Copy(type);
- SwigType_push(type, decl);
- String *lisp_type;
-
- if (Strcmp(nodeType(c), "cdecl")) {
- Printf(stderr, "Structure %s has a slot that we can't deal with.\n", name);
- Printf(stderr, "nodeType: %s, name: %s, type: %s\n", nodeType(c), Getattr(c, "name"), Getattr(c, "type"));
- SWIG_exit(EXIT_FAILURE);
- }
-
- /* Printf(stdout, "Converting %s in %s\n", type, name); */
- lisp_type = get_ffi_type(n, type, Getattr(c, "sym:name"));
-
- Printf(f_cl, " (#.(%s \"%s\" :type :slot) %s)\n", identifier_converter, Getattr(c, "sym:name"), lisp_type);
-
- Delete(lisp_type);
- }
- }
-
- // Language::classHandler(n);
-
- Printf(f_cl, " )\n");
-
- /* Add this structure to the known lisp types */
- //Printf(stdout, "Adding %s foreign type\n", name);
- add_defined_foreign_type(name);
-
- return SWIG_OK;
-}
-
-int UFFI::membervariableHandler(Node *n) {
- Language::membervariableHandler(n);
- return SWIG_OK;
-}
-
-
-extern "C" Language *swig_uffi(void) {
- return new UFFI();
-}
diff --git a/Source/README b/Source/README
index 814ec45..0889333 100644
--- a/Source/README
+++ b/Source/README
@@ -13,13 +13,3 @@
Source/Modules - Language modules.
Source/Include - Include files.
-
-Historic directories which may be in CVS, but have been removed:
-
- Source/Modules1.1 - Old SWIG-1.1 modules. Empty.
-
- Source/LParse - Experimental parser. Officially dead
- as CParse is more capable.
-
- Source/SWIG1.1 - Old SWIG1.1 core. Completely empty now.
-
diff --git a/Tools/check-include-path.pike b/Tools/check-include-path.pike
deleted file mode 100644
index 2bfb2b9..0000000
--- a/Tools/check-include-path.pike
+++ /dev/null
@@ -1,20 +0,0 @@
-/**
- * This is a helper script to identify the proper include path
- * for Pike header files. It should be run with the full path
- * to the Pike executable as its single argument, e.g.
- *
- * pike check-include-path.pike /usr/local/bin/pike
- *
- * and its output should be the correct path to the header
- * files, e.g.
- *
- * /usr/local/pike/7.2.239/include/pike
- *
- */
-
-int main(int argc, array(string) argv)
-{
- string prefix = replace(argv[1], "/bin/pike", "");
- write(prefix + "/pike/" + __MAJOR__ + "." + __MINOR__ + "." + __BUILD__ + "/include/pike");
- return 0;
-}
