diff options
192 files changed, 44 insertions, 23275 deletions
diff --git a/CHANGES.current b/CHANGES.current index 19b2e90c0..d82cde76d 100644 --- a/CHANGES.current +++ b/CHANGES.current @@ -7,8 +7,8 @@ the issue number to the end of the URL: https://github.com/swig/swig/issues/ 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 @@ Version 4.1.0 (in progress) 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 4069ecd8b..000000000 --- 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 3a80811bd..000000000 --- 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 fc4ffa03c..000000000 --- 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 2b8432399..000000000 --- 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 16973c918..eeb7a25a5 100644 --- a/Examples/Makefile.in +++ b/Examples/Makefile.in @@ -1251,46 +1251,6 @@ lua_clean: 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 d4f91baf6..000000000 --- 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 9ea022bfb..000000000 --- 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 ea2d8b62e..000000000 --- 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 046304519..000000000 --- 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 5bad31693..000000000 --- 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 fbdf7249f..000000000 --- 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 7c59c0aaa..000000000 --- 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 5ba1d6adb..000000000 --- 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 2fdde0a58..000000000 --- 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 0995c19b9..000000000 --- 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 1b10b2605..000000000 --- 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 0137dc0a7..000000000 --- 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 b5df0e631..000000000 --- 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 6a2940b89..000000000 --- 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 e9ae4a6a8..000000000 --- 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 95aeb001c..000000000 --- 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 600491d5b..000000000 --- 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 46266b4bf..000000000 --- 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 4b503ec21..000000000 --- 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 4ec94ed18..000000000 --- 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 551d1c74d..000000000 --- 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 b8360fa8a..000000000 --- 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 02567f48f..000000000 --- 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 ebe644004..000000000 --- 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 019390192..000000000 --- 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 9487c3f3e..000000000 --- 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 65e743941..000000000 --- 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 1c135d509..000000000 --- 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 23a29986e..000000000 --- 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 168490f76..000000000 --- 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 f5dd1a966..000000000 --- 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 07e8da069..000000000 --- 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 f2b074781..000000000 --- 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 5b3e95580..000000000 --- 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 05aa87081..000000000 --- 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 37ac8c105..000000000 --- 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 b25f636c3..000000000 --- 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 046304519..000000000 --- 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 0dff185b2..000000000 --- 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 2fafadbd6..000000000 --- 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 e3e9bf178..000000000 --- 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 2c5c9b0a5..000000000 --- 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 bd808ff7c..000000000 --- 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 2f44a6ccf..000000000 --- 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 f5947b3bc..000000000 --- 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 8d12ef19e..000000000 --- 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 0e9e0e81d..000000000 --- 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 92a716fae..000000000 --- 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 eaceceb1f..000000000 --- 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 9dbaed2ee..000000000 --- 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 7b4ba8fb8..000000000 --- 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 002090918..000000000 --- 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 3ba35d18b..000000000 --- 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 1c2af789c..000000000 --- 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 1694e6dbe..000000000 --- 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 3ba35d18b..000000000 --- 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 2f454eff3..000000000 --- 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 ac0fa4a56..a261b92e7 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 d6c8e2e7b..000000000 --- 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 e5319dbe2..000000000 --- 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 046304519..000000000 --- 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 0dff185b2..000000000 --- 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 fbdf7249f..000000000 --- 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 a6377600e..000000000 --- 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 45da7d269..000000000 --- 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 4f7b1a4d7..000000000 --- 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 a8d9f944f..000000000 --- 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 e5319dbe2..000000000 --- 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 055aa9fce..000000000 --- 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 6785e57ac..000000000 --- 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 525d62afc..000000000 --- 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 23ee8a822..000000000 --- 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 4846356b3..000000000 --- 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 5e5fe669b..000000000 --- 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 3760fdd49..000000000 --- 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 e47a122ee..000000000 --- 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 ddcd006be..000000000 --- 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 d30e947b3..000000000 --- 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 8b49b4ea5..000000000 --- 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 1c2af789c..000000000 --- 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 24093b9bf..000000000 --- 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 a6a78e9e7..000000000 --- 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 513dc3b4b..000000000 --- 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 7401df650..000000000 --- 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 8f94c4da1..000000000 --- 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 36825c3e3..000000000 --- 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 aea9a1405..000000000 --- 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 b13d546da..000000000 --- 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 695dd068f..14283bb11 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 b3dccc9c3..000000000 --- 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 aad730ec4..000000000 --- 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 2eca46149..000000000 --- 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 50dff3018..000000000 --- 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 1dd6a7d53..000000000 --- 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 65fa4e085..000000000 --- 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 ba84810a3..000000000 --- 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 62f2c2053..000000000 --- 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 eb39c7ff0..000000000 --- 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 006bcfdec..000000000 --- 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 7b0b6d722..000000000 --- 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 4d4ec7623..000000000 --- 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 800172ed8..000000000 --- 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 1e81d5555..000000000 --- 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 802205b7c..000000000 --- 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 3c4500d6b..000000000 --- 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 7e64053bc..000000000 --- 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 ac5fb9890..000000000 --- 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 50a084a95..000000000 --- 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 cc64287dd..000000000 --- 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 e1e240970..000000000 --- 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 1ad6e921e..000000000 --- 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 52997c6fe..000000000 --- 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 67d52f609..000000000 --- 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 f2226b20a..000000000 --- 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 313157c70..000000000 --- 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 f5aafcbf4..000000000 --- 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 938915dcb..000000000 --- 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 7bc5a241a..000000000 --- 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 cc445f477..000000000 --- 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 36b8cda7f..000000000 --- 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 f89f70bde..000000000 --- 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 4ec542205..000000000 --- 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 5f4808070..000000000 --- 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 75c0ea8a8..000000000 --- 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 a19cb29a9..000000000 --- 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 2a6867e22..000000000 --- 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 24fa67aec..000000000 --- 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 0ae3e6215..000000000 --- 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 b3663b719..000000000 --- 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 d83d59a11..000000000 --- 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 807c4ebad..000000000 --- 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 1e1914be3..000000000 --- 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 e1152a6fe..000000000 --- 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 62bc7befb..000000000 --- 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 111296d60..000000000 --- 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 60fc3203b..000000000 --- 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 465784a43..000000000 --- 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 4dd14148d..000000000 --- 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 b4f726cc7..000000000 --- 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 3d207178f..000000000 --- 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 a228af289..f2537e109 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 3ac465cf6..0ff6abc26 100644 --- a/Examples/test-suite/exception_partial_info.i +++ b/Examples/test-suite/exception_partial_info.i @@ -30,8 +30,6 @@ class ex2 : public myException #if !defined(SWIGUTL) -#if !defined(SWIGCHICKEN) - %inline %{ class Impl { @@ -42,10 +40,6 @@ class Impl %} #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 272c96a3d..e6bd09adf 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 ba1900b40..fa2e335bb 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 6e1bdfbff..000000000 --- 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 215fdd0ef..1bcdcf7ac 100644 --- a/Examples/test-suite/preproc.i +++ b/Examples/test-suite/preproc.i @@ -298,11 +298,6 @@ inline const char* mangle_macro ## #@__VA_ARGS__ () { /* 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 161e803bb..a24bbdaf0 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 f61d4fee5..07bb8556f 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 537914155..6b70f680d 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 d771ef09e..83ffd5427 100644 --- a/Examples/test-suite/template_default.i +++ b/Examples/test-suite/template_default.i @@ -196,7 +196,6 @@ namespace ns1 { %} -#ifndef SWIGCHICKEN %include std_vector.i %{ @@ -211,6 +210,3 @@ void q(double = 0) {} %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 5d6dc110c..000000000 --- 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 524aa7c11..000000000 --- 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 d8d61feed..000000000 --- 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 a15adcdda..000000000 --- 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 a3660c9f7..000000000 --- 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 cbcd250a9..000000000 --- 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 293d1cd34..000000000 --- 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 f42fd27b9..000000000 --- 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 d2c26c74c..000000000 --- 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 bb14b4bc9..000000000 --- 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 48721cee0..000000000 --- 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 9d2e31d34..000000000 --- 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 fa77c1533..000000000 --- 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 e4bd72b71..000000000 --- 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 2e585960e..000000000 --- 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 fd587fd68..000000000 --- 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 e1d330cb3..000000000 --- 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 13d06e9c6..000000000 --- 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 af96a78d1..000000000 --- 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 1d76ab5e0..000000000 --- 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 a36bf3ad2..000000000 --- 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 844b1f189..000000000 --- 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 6ec1143cf..000000000 --- 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 b32b3c112..000000000 --- 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 41b085998..000000000 --- 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 48b98d460..955a8773a 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 e39abed2f..000000000 --- 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 7f584db65..6333fa153 100644 --- a/Source/Modules/cffi.cxx +++ b/Source/Modules/cffi.cxx @@ -227,7 +227,7 @@ int CFFI::classHandler(Node *n) { 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 3f4bff3b6..000000000 --- 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 d7f197197..000000000 --- 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 555d0269a..000000000 --- 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 c8cd08718..000000000 --- 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 fe3b1facc..000000000 --- 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 10a53a561..000000000 --- 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 814ec45bd..088933308 100644 --- a/Source/README +++ b/Source/README @@ -13,13 +13,3 @@ SWIG Source directory 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 2bfb2b901..000000000 --- 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; -} |