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

Merged first chunk of Guile changes contributed by John Lenz.

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@4858 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Matthias Köppe 2003-06-03 22:12:50 +00:00
commit e5ac3696bc
22 changed files with 1061 additions and 460 deletions
Download patch file Download diff file Expand all files Collapse all files

30
CHANGES.current
View file

@ -1,5 +1,35 @@
Version 1.3.20 (In progress) Version 1.3.20 (In progress)
============================ ============================
06/03/2003: mkoeppe
[Guile] Applied Guile module updates contributed by
John Lenz <jelenz@students.wisc.edu>.
- SWIG currently uses Guile's gh_ API, which is marked as
deprecated in Guile 1.6 and will be removed in Guile
1.9. This change introduces a command-line flag "-scm"
which causes SWIG to generate wrappers that use Guile's
SCM API instead; this requires Guile >= 1.6.
- The Lib/guile directory has been reorganized to
standardize names across language modules: guiledec.swg
and guile.swg have been moved into guile_gh_run.swg,
guile.i has been moved to guile_gh.swg, guile_scm.swg
and guile_scm_run.swg which contain the SCM API stuff
have been added
- ghinterface.i, which contains the defines from the gh_
functions to the scm_functions has been added
- The API for dealing with pointer objects is now
SWIG_ConvertPtr, SWIG_MustGetPtr, SWIG_NewPointerObj.
- Added varin and varout typemaps for SWIGTYPE [] and SWIGTYPE &
- Garbage collection has been added.
*** NEW FEATURE [Guile] ***
05/29/2003: beazley 05/29/2003: beazley
Refinement to default typemap matching and arrays. When an Refinement to default typemap matching and arrays. When an
array is declared like this: array is declared like this:

262
Doc/Manual/Guile.html
View file

@ -11,21 +11,28 @@
<!-- INDEX --> <!-- INDEX -->
<ul> <ul>
<li><a href="#n2">Meaning of "Module"</a> <li><a href="#n2">Meaning of "Module"</a>
<li><a href="#n3">Linkage</a> <li><a href="#n3">Using the SCM or GH Guile API</a>
<li><a href="#n4">Linkage</a>
<ul> <ul>
<li><a href="#n4">Simple Linkage</a> <li><a href="#n5">Simple Linkage</a>
<li><a href="#n5">Passive Linkage</a> <li><a href="#n6">Passive Linkage</a>
<li><a href="#n6">Native Guile Module Linkage</a> <li><a href="#n7">Native Guile Module Linkage</a>
<li><a href="#n7">Old Auto-Loading Guile Module Linkage</a> <li><a href="#n8">Old Auto-Loading Guile Module Linkage</a>
<li><a href="#n8">Hobbit4D Linkage</a> <li><a href="#n9">Hobbit4D Linkage</a>
<li><a href="#n9">General Remarks on Multiple SWIG Modules</a> <li><a href="#n10">General Remarks on Multiple SWIG Modules</a>
</ul> </ul>
<li><a href="#n10">Underscore Folding</a> <li><a href="#n11">Underscore Folding</a>
<li><a href="#n11">Typemaps</a> <li><a href="#n12">Typemaps</a>
<li><a href="#n12">Smobs</a> <li><a href="#n13">Smobs</a>
<li><a href="#n13">Exception Handling</a> <ul>
<li><a href="#n14">Procedure documentation</a> <li><a href="#n14">GH API</a>
<li><a href="#n15">Procedures with setters</a> <li><a href="#n15">SCM API</a>
<li><a href="#n16">Garbage Collection</a>
<!--<li><a href="#n17">GOOPS</a>-->
</ul>
<li><a href="#n18">Exception Handling</a>
<li><a href="#n19">Procedure documentation</a>
<li><a href="#n20">Procedures with setters</a>
</ul> </ul>
<!-- INDEX --> <!-- INDEX -->
@ -44,7 +51,56 @@ There are three different concepts of "module" involved, defined
separately for SWIG, Guile, and Libtool. To avoid horrible confusion, separately for SWIG, Guile, and Libtool. To avoid horrible confusion,
we explicitly prefix the context, e.g., "guile-module". we explicitly prefix the context, e.g., "guile-module".
<a name="n3"></a><H2>14.2 Linkage</H2> <a name="n3"></a><H2>14.2 Using the SCM or GH Guile API</H2>
<p>The guile module can currently export wrapper files that use the guile GH interface or the
SCM interface. This is controlled by an argument passed to swig. The "-gh" argument causes swig
to output GH code, and the "-scm" argument causes swig to output SCM code. Right now the "-gh" argument
is the default. The "-scm" wrapper generation assumes a guile version >= 1.6 and has several advantages over
the "-gh" wrapper generation including garbage collection and possibly GOOPS support in the future.
The "-gh" wrapper generation can be used for older versions of guile. Thus eventually
the guile GH wrapper code generation will be depreciated (as guile 1.6 and above become more common) and the
SCM interface will become the default. The SCM and GH interface differ greatly in how they store
pointers and have completly different run-time code. See below for more info.
<code>make runtime</code> will now produce two libraries, libguilegh and libguilescm containing the
runtime code using the two different guile API's.</p>
<p>The GH interface to guile is deprecated. Read more about why in the
<a href="http://www.gnu.org/software/guile/docs/guile-ref/GH-deprecation.html">Guile manual</a>.
The idea of the GH interface was to provide a high level API that other languages and projects
could adopt. This was a good idea, but didn't pan out well for general development. But for the
specific, minimal uses that the SWIG typemaps put the GH interface to use is ideal for
using a high level API. So even though the GH interface is depreciated, SWIG will continue to use
the GH interface and provide mappings from the GH interface to whatever API we need.
We can maintain this mapping where guile failed because SWIG uses a small subset of all the GH functions
which map easily. All the guile typemaps like typemaps.i and std_vector.i
will continue to use the GH functions to do things like create lists of values, convert strings to
integers, etc. Then every language module will define a mapping between the GH interface and
whatever custom API the language uses. This is currently implemented by the guile module to use
the SCM guile API rather than the GH guile API.
For example, here are some of the current mapping file for the SCM API</p>
<blockquote><pre>
#define gh_append2(a, b) scm_append(scm_listify(a, b, SCM_UNDEFINED))
#define gh_apply(a, b) scm_apply(a, b, SCM_EOL)
#define gh_bool2scm SCM_BOOL
#define gh_boolean_p SCM_BOOLP
#define gh_car SCM_CAR
#define gh_cdr SCM_CDR
#define gh_cons scm_cons
#define gh_double2scm scm_make_real
...
</pre></blockquote>
<p>This file is parsed by SWIG at wrapper generation time, so every reference to a gh_ function is replaced
by a scm_ function in the wrapper file. Thus the gh_ function calls will never be seen in the wrapper;
the wrapper will look exactly like it was generated
for the specific API. Currently only the guile language module has created a mapping policy from gh_ to scm_,
but there is no reason other languages (like mzscheme or chicken) couldn't also use this.
If that happens, there is A LOT less code duplication in the standard typemaps.</p>
<a name="n4"></a><H2>14.3 Linkage</H2>
</a> </a>
@ -54,7 +110,7 @@ Guile support is complicated by a lack of user community cohesiveness,
which manifests in multiple shared-library usage conventions. A set of which manifests in multiple shared-library usage conventions. A set of
policies implementing a usage convention is called a <b>linkage</b>. policies implementing a usage convention is called a <b>linkage</b>.
<a name="n4"></a><H3>14.2.1 Simple Linkage</H3> <a name="n5"></a><H3>14.3.1 Simple Linkage</H3>
The default linkage is the simplest; nothing special is done. In this The default linkage is the simplest; nothing special is done. In this
@ -127,7 +183,7 @@ placed between the <code>define-module</code> form and the
<code>SWIG_init</code> via a preprocessor define to avoid symbol <code>SWIG_init</code> via a preprocessor define to avoid symbol
clashes. For this case, however, passive linkage is available. clashes. For this case, however, passive linkage is available.
<a name="n5"></a><H3>14.2.2 Passive Linkage</H3> <a name="n6"></a><H3>14.3.2 Passive Linkage</H3>
<p>Passive linkage is just like simple linkage, but it generates an <p>Passive linkage is just like simple linkage, but it generates an
@ -137,7 +193,7 @@ package name (see below).
<p>You should use passive linkage rather than simple linkage when you <p>You should use passive linkage rather than simple linkage when you
are using multiple modules. are using multiple modules.
<a name="n6"></a><H3>14.2.3 Native Guile Module Linkage</H3> <a name="n7"></a><H3>14.3.3 Native Guile Module Linkage</H3>
<p>SWIG can also generate wrapper code that does all the Guile module <p>SWIG can also generate wrapper code that does all the Guile module
@ -178,7 +234,7 @@ Newer Guile versions have a shorthand procedure for this:
</blockquote> </blockquote>
</ul> </ul>
<a name="n7"></a><H3>14.2.4 Old Auto-Loading Guile Module Linkage</H3> <a name="n8"></a><H3>14.3.4 Old Auto-Loading Guile Module Linkage</H3>
<p>Guile used to support an autoloading facility for object-code <p>Guile used to support an autoloading facility for object-code
@ -204,7 +260,7 @@ option, SWIG generates an exported module initialization function with
an apropriate name. an apropriate name.
<a name="n8"></a><H3>14.2.5 Hobbit4D Linkage</H3> <a name="n9"></a><H3>14.3.5 Hobbit4D Linkage</H3>
<p> <p>
@ -227,7 +283,7 @@ my/lib/libfoo.so.X.Y.Z and friends. This scheme is still very
experimental; the (hobbit4d link) conventions are not well understood. experimental; the (hobbit4d link) conventions are not well understood.
<a name="n9"></a><H3>14.2.6 General Remarks on Multiple SWIG Modules</H3> <a name="n10"></a><H3>14.3.6 General Remarks on Multiple SWIG Modules</H3>
If you want to use multiple SWIG modules, they have to share some If you want to use multiple SWIG modules, they have to share some
@ -241,13 +297,13 @@ with the C compiler switch <code>-DSWIG_GLOBAL</code>.
<li>Or generate all wrapper modules with the <code>-c</code> <li>Or generate all wrapper modules with the <code>-c</code>
command-line argument and compile all wrapper files with the C command-line argument and compile all wrapper files with the C
compiler switch <code>-DSWIG_GLOBAL</code>. Then link against the compiler switch <code>-DSWIG_GLOBAL</code>. Then link against the
runtime library <code>libswigguile</code>, which is built by runtime library <code>libswigguile</code> or <code>libswigguilescm</code>, which is built by
<code>make runtime</code>. The needed linker flags are reported by <code>make runtime</code>. The needed linker flags are reported by
SWIG if you invoke it with the <code>-guile -ldflags</code> SWIG if you invoke it with the <code>-guile -ldflags</code>
command-line arguments. command-line arguments.
</ul> </ul>
<a name="n10"></a><H2>14.3 Underscore Folding</H2> <a name="n11"></a><H2>14.4 Underscore Folding</H2>
</a> </a>
@ -261,7 +317,7 @@ complained so far.
<code>%rename</code> to specify the Guile name of the wrapped <code>%rename</code> to specify the Guile name of the wrapped
functions and variables (see CHANGES). functions and variables (see CHANGES).
<a name="n11"></a><H2>14.4 Typemaps</H2> <a name="n12"></a><H2>14.5 Typemaps</H2>
</a> </a>
@ -273,8 +329,8 @@ information is read from <code>Lib/guile/typemaps.i</code>.
Some non-standard typemap substitutions are supported: Some non-standard typemap substitutions are supported:
<ul> <ul>
<li><code>$descriptor</code> expands to a type descriptor for use with <li><code>$descriptor</code> expands to a type descriptor for use with
the <code>SWIG_Guile_MakePtr()</code> and the <code>SWIG_NewPointerObj()</code> and
<code>SWIG_Guile_GetPtr</code> functions. <code>SWIG_ConvertPtr</code> functions.
<li>For pointer types, <code>$*descriptor</code> expands to a <li>For pointer types, <code>$*descriptor</code> expands to a
descriptor for the direct base type (i.e., one pointer is stripped), descriptor for the direct base type (i.e., one pointer is stripped),
whereas <code>$basedescriptor</code> expands to a whereas <code>$basedescriptor</code> expands to a
@ -282,7 +338,7 @@ descriptor for the base type (i.e., all pointers are stripped).
</ul> </ul>
<p>A function returning <code>void</code> (more precisely, a function <p>A function returning <code>void</code> (more precisely, a function
whose <code>out</code> typemap returns <code>GH_UNSPECIFIED</code>) is whose <code>out</code> typemap returns <code>SCM_UNSPECIFIED</code>) is
treated as returning no values. In <code>argout</code> typemaps, one treated as returning no values. In <code>argout</code> typemaps, one
can use the macro <code>GUILE_APPEND_RESULT</code> in order to append can use the macro <code>GUILE_APPEND_RESULT</code> in order to append
a value to the list of function return values. a value to the list of function return values.
@ -326,13 +382,27 @@ In <code><var>body</var></code>, the first result of
</ul> </ul>
See also the "multivalue" example. See also the "multivalue" example.
<a name="n12"></a><H2>14.5 Smobs</H2> <a name="n13"></a><H2>14.6 Smobs</H2>
</a>
<p> <p>
For pointer types, SWIG uses Guile smobs. For pointer types, SWIG uses Guile smobs. SWIG smobs print
like this: <code>#&lt;swig struct xyzzy * 0x1234affe&gt;</code> Two of
them are <code>equal?</code> if and only if they have the same type
and value.
<p>
To construct a Scheme object from a C pointer, the wrapper code calls
the function <code>SWIG_NewPointerObj()</code>, passing a pointer to a
struct representing the pointer type. The type index to store in the
upper half of the CAR is read from this struct.
To get the pointer represented by a smob, the wrapper code calls the
function <code>SWIG_ConvertPtr()</code>, passing a pointer to a struct
representing the expected pointer type. See also
<a href="Typemaps.html#n41">Section 8.8 The run-time type checker</a>.
If the Scheme object passed was not a SWIG smob representing a compatible
pointer, a <code>wrong-type-arg</code> exception is raised.
<a name="n14"></a><H3>14.6.1 GH Smobs</H3>
<p> <p>
In earlier versions of SWIG, C pointers were represented as Scheme In earlier versions of SWIG, C pointers were represented as Scheme
@ -348,25 +418,117 @@ available. <code>SWIG_Guile_Init()</code> registers a smob type named
"swig" with Guile; its type tag is stored in the variable "swig" with Guile; its type tag is stored in the variable
<code>swig_tag</code>. The upper half of the CAR store an index into <code>swig_tag</code>. The upper half of the CAR store an index into
a table of all C pointer types seen so far, to which new types seen a table of all C pointer types seen so far, to which new types seen
are appended. The CDR stores the pointer value. SWIG smobs print are appended. The CDR stores the pointer value.
like this: <code>#&lt;swig struct xyzzy * 0x1234affe&gt;</code> Two of
them are <code>equal?</code> if and only if they have the same type
and value.
<p> <a name="n15"></a><H3>14.6.2 SCM Smobs</H3>
To construct a Scheme object from a C pointer, the wrapper code calls
the function <code>SWIG_Guile_MakePtr()</code>, passing a pointer to a
struct representing the pointer type. The type index to store in the
upper half of the CAR is read from this struct.
<p> <p>The SCM interface (using the "-scm" argument to swig) uses common.swg.
To get the pointer represented by a smob, the wrapper code calls the The whole type system, when it is first initialized, creates two smobs named "swig" and "collected_swig".
function <code>SWIG_Guile_GetPtr</code>, passing a pointer to a struct The swig smob is used for non-garbage collected smobs, while the collected_swig smob is used as described
representing the expected pointer type. If the below. Each smob has the same format, which is a double cell created by SCM_NEWSMOB2()
Scheme object passed was not a SWIG smob representing a compatible The first word of data is the pointer to the object and the second word of data is the swig_type_info *
pointer, a <code>wrong-type-arg</code> exception is raised. structure describing this type. This is a lot easier than the GH interface above because we can store
a pointer to the type info structure right in the type. With the GH interface, there was not enough
room in the smob to store two whole words of data so we needed to store part of the "swig_type_info address"
in the smob tag.</p>
<a name="n13"></a><H2>14.6 Exception Handling</H2>
<a name="n16"></a><H3>14.6.3 Garbage Collection</H3>
<p>Garbage collection is a feature of the new SCM interface, and it is automaticlly included
if you pass the "-scm" flag to swig. Thus the swig garbage collection support requires guile &gt;1.6.
Garbage collection works like this. Every swig_type_info structure stores in its clientdata field a pointer
to the destructor for this type. The destructor is the generated wrapper around the delete function.
So swig still exports a wrapper for the destructor, it just does not call scm_c_define_gsubr() for
the wrapped delete function. So the only way to delete an object is from the garbage collector, since the
delete function is not available to scripts. How swig determins if a type should be garbage collected
is exactly like described in <a href="Customization.html#n9">
Section 9.2 Object ownership and %newobject</a> in the SWIG manual. All typemaps use an $owner var, and
the guile module replaces $owner with 0 or 1 depending on feature:new.</p>
<!--<a name="n17"></a><H3>14.6.4 GOOPS</H3>
<p>GOOPS support is also a feature of the new SCM interface, and the "-goops" argument to swig causes
the GOOPS class defintions to be added to the scmstub file (the "-scmstub" argument is required if the
"-goops" argument is given.</p>
This is what a sample class export would look like
<blockquote>
<pre>
(define-class &lt;Foo&gt; (&lt;swig&gt;)
(a #:allocation #:swig-virtual #:slot-ref Foo-a-get #:slot-set! Foo-a-set #:accessor a)
#:metaclass &lt;swig-metaclass&gt;
#:new-function new-Foo)
(define-method (+ (a &lt;Foo&gt;) (b &lt;Foo&gt;))
(make &lt;Foo&gt; #:init-smob (Foo-add (slot-ref a 'smob) (slot-ref b 'smob))))
(define &lt;Helloo&gt; &lt;Foo&gt;)
(define-class &lt;Bar&gt; (&lt;swig&gt;)
(Foo #:allocation #:swig-virtual-class #:slot-ref Bar-Foo-set #:slot-set! Bar-Foo-get
#:class &lt;Foo&gt; #:accessor Foo)
#:metaclass &lt;swig-metaclass&gt;
#:new-function new-Bar)
(define-method (getInt (b &lt;Bar&gt;))
(Bar-getInt (slot-ref b 'smob)))
(define-method (getSqr (b &lt;Bar&gt;) c)
(make &lt;Helloo&gt; #:init-smob (Bar-getSqr (slot-ref b 'smob) c)))
</pre>
</blockquote>
And the goops base class definitions will look like
<pre>
<blockquote>
(define-class &lt;swig-metaclass&gt; (&lt;class&gt;)
(new-function #:init-value #f))
(define-method (compute-get-n-set (class &lt;swig-metaclass&gt;) s)
(case (slot-definition-allocation s)
((#:swig-virtual)
(list
;getter
(let ((func (get-keyword #:slot-ref (slot-definition-options s) #f)))
(lambda (x) (func (slot-ref x 'smob))))
;setter
(let ((func (get-keyword #:slot-set! (slot-definition-options s) #f)))
(lambda (x val) (func (slot-ref x 'smob) val)))))
((#:swig-virtual-class)
(list
;getter
(let ((func (get-keyword #:slot-ref (slot-definition-options s) #f))
(class (get-keyword #:class (slot-definition-options s) #f)))
(lambda (x) (make class #:init-smob (func (slot-ref x 'smob)))))
;setter
(let ((func (get-keyword #:slot-set! (slot-definition-options s) #f)))
(lambda (x val) (func (slot-ref x 'smob) (func (slot-ref val 'smob)))))))
((#:swig-new-function)
(let ((shared-variable (slot-ref class 'new-function)))
(list (lambda (x) shared-variable)
(lambda (x var) (set! shared-variable var)))))
(else (next-method))))
(define-method (initialize (class &lt;swig-metaclass&gt;) initargs)
(slot-set! class 'new-function (get-keyword #:new-function initargs #f))
(next-method))
(define-class &lt;swig&gt; ()
(smob #:init-value #f)
(new-function #:allocation #:swig-new-function)
#:metaclass &lt;swig-metaclass&gt;)
(define-method (initialize (obj &lt;swig&gt;) initargs)
(case (car initargs)
((#:init-smob)
(slot-set! obj 'smob (cadr initargs)))
(else
(slot-set! obj 'smob (apply (slot-ref obj 'new-function) initargs)))))
</pre>
</blockquote>-->
<a name="n18"></a><H2>14.7 Exception Handling</H2>
</a> </a>
@ -392,7 +554,7 @@ mapping:
The default when not specified here is to use "swig-error". The default when not specified here is to use "swig-error".
See Lib/exception.i for details. See Lib/exception.i for details.
<a name="n14"></a><H2>14.7 Procedure documentation</H2> <a name="n19"></a><H2>14.8 Procedure documentation</H2>
</a> </a>
@ -429,7 +591,7 @@ typemaps <code>indoc</code>, <code>outdoc</code>,
<code>varoutdoc</code>. See <code>Lib/guile/typemaps.i</code> for <code>varoutdoc</code>. See <code>Lib/guile/typemaps.i</code> for
details. details.
<a name="n15"></a><H2>14.8 Procedures with setters</H2> <a name="n20"></a><H2>14.9 Procedures with setters</H2>
</a> </a>
@ -453,4 +615,4 @@ is created, so you can use <code>(<var>struct</var>-<var>member</var>
<var>value</var>)</code> to set it. <var>value</var>)</code> to set it.
</body> </body>
</html> </html>

30
Examples/Makefile.in
View file

@ -338,6 +338,36 @@ guile_cpp: $(SRCS)
$(CXX) -c $(CCSHARED) $(CFLAGS) $(INCLUDES) $(GUILE_INCLUDE) $(ICXXSRCS) $(SRCS) $(CXXSRCS) $(CXX) -c $(CCSHARED) $(CFLAGS) $(INCLUDES) $(GUILE_INCLUDE) $(ICXXSRCS) $(SRCS) $(CXXSRCS)
$(CXXSHARED) $(OBJS) $(IOBJS) $(LIBS) $(CPP_DLLIBS) -o lib$(TARGET)$(SO) $(CXXSHARED) $(OBJS) $(IOBJS) $(LIBS) $(CPP_DLLIBS) -o lib$(TARGET)$(SO)
#------------------------------------------------------------------
# Build a dynamically loaded module with passive linkage and the scm interface
#------------------------------------------------------------------
guile_scm: $(SRCS)
$(SWIG) -guile -scm -Linkage passive $(SWIGOPT) $(INTERFACE)
$(CC) -c $(CCSHARED) $(CFLAGS) $(INCLUDES) $(GUILE_INCLUDE) $(ISRCS) $(SRCS)
$(LDSHARED) $(OBJS) $(IOBJS) $(LIBS) -o lib$(TARGET)$(SO)
guile_scm_cpp: $(SRCS)
$(SWIG) -c++ -guile -scm -Linkage passive $(SWIGOPT) $(INTERFACE)
$(CXX) -c $(CCSHARED) $(CFLAGS) $(INCLUDES) $(GUILE_INCLUDE) $(ICXXSRCS) $(SRCS) $(CXXSRCS)
$(CXXSHARED) $(OBJS) $(IOBJS) $(LIBS) $(CPP_DLLIBS) -o lib$(TARGET)$(SO)
# -----------------------------------------------------------------
# Build a dynamically loadable module with passive linkage using the scm interface,
# linked against SWIG runtime lib
# -----------------------------------------------------------------
GUILE_SCM_RUNTIME=-L$(RUNTIMEDIR) -lswigguilescm@release_suffix@
guile_scm_multi: $(SRCS)
$(SWIG) -c -guile -scm -Linkage passive $(SWIGOPT) $(INTERFACE)
$(CC) -c $(CCSHARED) $(CFLAGS) $(INCLUDES) $(GUILE_INCLUDE) $(ISRCS) $(SRCS)
$(LDSHARED) $(OBJS) $(IOBJS) $(GUILE_SCM_RUNTIME) $(LIBS) -o lib$(TARGET)$(SO)
guile_scm_multi_cpp: $(SRCS)
$(SWIG) -c -c++ -guile -scm -Linkage passive $(SWIGOPT) $(INTERFACE)
$(CXX) -c $(CCSHARED) $(CFLAGS) $(INCLUDES) $(GUILE_INCLUDE) $(ICXXSRCS) $(SRCS) $(CXXSRCS)
$(CXXSHARED) $(OBJS) $(IOBJS) $(GUILE_SCM_RUNTIME) $(LIBS) $(CPP_DLLIBS) -o lib$(TARGET)$(SO)
# ----------------------------------------------------------------- # -----------------------------------------------------------------
# Build a dynamically loadable module with passive linkage # Build a dynamically loadable module with passive linkage
# ----------------------------------------------------------------- # -----------------------------------------------------------------

5
Examples/test-suite/pointer_reference.i
View file

@ -8,8 +8,9 @@
#ifdef SWIGGUILE #ifdef SWIGGUILE
/* A silly testing typemap for feeding a doubly indirect integer */ /* A silly testing typemap for feeding a doubly indirect integer */
%typemap(in) int *&XYZZY (int temp1, int *temp2) %typemap(in) int *&XYZZY (int temp1, int *temp2) {
"temp1 = gh_scm2int($input); temp2 = &temp1; $1 = &temp2;"; temp1 = gh_scm2int($input); temp2 = &temp1; $1 = &temp2;
};
#endif #endif
%inline %{ %inline %{

32
Lib/guile/ghinterface.i Normal file
View file

@ -0,0 +1,32 @@
#define gh_append2(a, b) scm_append(scm_listify(a, b, SCM_UNDEFINED))
#define gh_apply(a, b) scm_apply(a, b, SCM_EOL)
#define gh_bool2scm SCM_BOOL
#define gh_boolean_p SCM_BOOLP
#define gh_car SCM_CAR
#define gh_cdr SCM_CDR
#define gh_cons scm_cons
#define gh_double2scm scm_make_real
#define gh_int2scm scm_long2num
#define gh_length(lst) scm_num2ulong(scm_length(lst), SCM_ARG1, FUNC_NAME)
#define gh_list scm_listify
#define gh_list_to_vector scm_vector
#define gh_make_vector scm_make_vector
#define gh_null_p SCM_NULLP
#define gh_number_p SCM_NUMBERP
#define gh_pair_p SCM_CONSP
#define gh_scm2bool SCM_NFALSEP
#define gh_scm2char SCM_CHAR
#define gh_scm2double(a) scm_num2dbl(a, FUNC_NAME)
#define gh_scm2int(a) scm_num2int(a, SCM_ARG1, FUNC_NAME)
#define gh_scm2long(a) scm_num2long(a, SCM_ARG1, FUNC_NAME)
#define gh_scm2newstr SWIG_scm2newstr
#define gh_scm2ulong(a) scm_num2ulong(a, SCM_ARG1, FUNC_NAME)
#define gh_ulong2scm scm_ulong2num
#define gh_long2scm scm_long2num
#define gh_str02scm scm_makfrom0str
#define gh_string_p SCM_STRINGP
#define gh_vector_length SCM_VECTOR_LENGTH
#define gh_vector_p SCM_VECTORP
#define gh_vector_ref scm_vector_ref
#define gh_vector_set_x scm_vector_set_x
#define gh_char2scm SCM_MAKE_CHAR

27
Lib/guile/guile.i
View file

@ -1,13 +1,4 @@
/* SWIG Configuration File for Guile. -*-c-*- /* SWIG Configuration File for Guile. -*-c-*-*/
This file is parsed by SWIG before reading any other interface
file. */
/* Include headers */
%insert(runtime) "guiledec.swg"
#ifndef SWIG_NOINCLUDE
%insert(runtime) "guile.swg"
#endif
/* Macro for inserting Scheme code into the stub */ /* Macro for inserting Scheme code into the stub */
#define %scheme %insert("scheme") #define %scheme %insert("scheme")
@ -32,20 +23,6 @@
%pragma(guile) return_multi_doc = "Returns $num_values values: $values." %pragma(guile) return_multi_doc = "Returns $num_values values: $values."
%enddef %enddef
/* The following definitions are supposed to provide a common API for #define GUILE_APPEND_RESULT SWIG_APPEND_VALUE
the supported Scheme dialects, so that typemaps may be shared. I
also plan to adopt Guile's high-level interface (GH) for this
purpose. */
#define SWIG_malloc(size) \
SCM_MUST_MALLOC(size)
#define SWIG_free(mem) \
scm_must_free(mem)
#define SWIG_GetPtr(s, result, type) \
SWIG_Guile_GetPtr(s, result, type)
#define SWIG_MustGetPtr(s, type, argnum) \
SWIG_Guile_MustGetPtr(s, type, argnum, FUNC_NAME)
#define SWIG_MakePtr(ptr, type) \
SWIG_Guile_MakePtr(ptr, type)
/* Read in standard typemaps. */
%include "typemaps.i" %include "typemaps.i"

24
Lib/guile/guile_gh.swg Normal file
View file

@ -0,0 +1,24 @@
%runtime %{
#define SWIG_malloc(size) \
SCM_MUST_MALLOC(size)
#define SWIG_free(mem) \
scm_must_free(mem)
#define SWIG_ConvertPtr(s, result, type, flags) \
SWIG_Guile_GetPtr(s, result, type)
#define SWIG_MustGetPtr(s, type, argnum, flags) \
SWIG_Guile_MustGetPtr(s, type, argnum, FUNC_NAME)
#define SWIG_NewPointerObj(ptr, type, owner) \
SWIG_Guile_MakePtr((void*)ptr, type)
%}
%runtime "guile_gh_run.swg"
%include "guile.i"
%init %{
static int _swig_init = 0;
if (!_swig_init) {
SWIG_Guile_RegisterTypes(swig_types, swig_types_initial);
_swig_init = 1;
}
%}

157
Lib/guile/guile.swg → Lib/guile/guile_gh_run.swg
View file

@ -1,10 +1,161 @@
/* -*- c -*- /* -*- c -*-
* ----------------------------------------------------------------------- * -----------------------------------------------------------------------
* swig_lib/guile/guile.swg * Lib/guile/guile_gh_run.swg
* *
* Guile configuration file. * Guile GH runtime file
* Copyright (C) 2000 Matthias Koeppe
* ----------------------------------------------------------------------- */ * ----------------------------------------------------------------------- */
#include "guile/gh.h"
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#ifdef __cplusplus
extern "C" {
#endif
#if defined(SWIG_NOINCLUDE)
# define SWIGSTATIC
#elif defined(SWIG_GLOBAL)
# define SWIGSTATIC
#else
# define SWIGSTATIC static
#endif
#define GH_NOT_PASSED SCM_UNDEFINED
#define GH_UNSPECIFIED SCM_UNSPECIFIED
#define SWIG_APPEND_VALUE(object) \
if (gswig_result == GH_UNSPECIFIED) \
gswig_result = object; \
else { \
if (!gswig_list_p) { \
gswig_list_p = 1; \
gswig_result = gh_list(gswig_result, object, GH_NOT_PASSED); \
} \
else \
gswig_result = gh_append2(gswig_result, \
gh_list(object, GH_NOT_PASSED)); \
}
#define GUILE_APPEND_RESULT SWIG_APPEND_VALUE
/* scm_values was implemented on C level in 1.4.1, and the prototype
is not included in libguile.h, so play safe and lookup `values'... */
#define GUILE_MAYBE_VALUES \
if (gswig_list_p) \
gswig_result = gh_apply(gh_lookup("values"), gswig_result);
#define GUILE_MAYBE_VECTOR \
if (gswig_list_p) \
gswig_result = gh_list_to_vector(gswig_result);
static char *
SWIG_scm2str (SCM s)
{
return gh_scm2newstr (s, NULL);
}
#define GSWIG_scm2str SWIG_scm2str
/* SCM_CHAR and SCM_CHARP were introduced in Guile 1.4; the following is for
1.3.4 compatibility. */
#ifndef SCM_CHAR
# define SCM_CHAR SCM_ICHR
#endif
#ifndef SCM_CHARP
# define SCM_CHARP SCM_ICHRP
#endif
/* This function replaces gh_scm2char, which is broken in Guile 1.4 */
static char
GSWIG_scm2char (SCM s)
{
if (SCM_CHARP(s)) return SCM_CHAR(s);
scm_wrong_type_arg(NULL, 0, s);
}
#define gh_scm2char GSWIG_scm2char
/* More 1.3.4 compatibility */
#ifndef SCM_INPUT_PORT_P
# define SCM_INPUT_PORT_P SCM_INPORTP
# define SCM_OUTPUT_PORT_P SCM_OUTPORTP
#endif
/* Type system */
typedef void *(*swig_converter_func)(void *);
typedef struct swig_type_info *(*swig_dycast_func)(void **);
typedef struct SwigPtrType SwigPtrType;
typedef struct swig_type_info {
const char *name;
swig_converter_func converter;
const char *str;
void *clientdata;
size_t tag;
swig_dycast_func dcast;
} swig_type_info;
SWIGSTATIC void
SWIG_Guile_RegisterTypes (swig_type_info **table,
swig_type_info **init);
/* Register a new type-mapping with the type-checker. origtype is the
original datatype and newtype is an equivalent type. cast is optional
pointer to a function to cast pointer values between types (this is
typically used to cast pointers from derived classes to base classes in
C++). */
SWIGSTATIC void
SWIG_RegisterMapping (const char *origtype, const char *newtype,
swig_converter_func cast);
/* Dynamic pointer casting. Down an inheritance hierarchy */
SWIGSTATIC swig_type_info *
SWIG_TypeDynamicCast(swig_type_info *ty, void **ptr);
/* Register SWIG smobs with Guile. */
SWIGSTATIC void
SWIG_Guile_Init();
/* Initialization function for this SWIG module; actually renamed by a
#define */
/* extern void SWIG_init(); */
/* Get a pointer value from a smob. If there is a type-mismatch,
return nonzero; on success, return 0. */
SWIGSTATIC int
SWIG_Guile_GetPtr (SCM s, void **result, swig_type_info *type);
/* Get a pointer value from a smob. If there is a type-mismatch,
signal a wrong-type-arg error for the given argument number. */
SWIGSTATIC void *
SWIG_Guile_MustGetPtr (SCM s, swig_type_info *type,
int argnum, const char *func_name);
/* Make a smob from a pointer and typeinfo. */
SWIGSTATIC SCM
SWIG_Guile_MakePtr (void *ptr, swig_type_info *type);
/* Get arguments from an argument list */
SWIGSTATIC int
SWIG_Guile_GetArgs (SCM *dest, SCM rest,
int reqargs, int optargs,
const char *procname);
typedef SCM (*swig_guile_proc)();
#ifdef __cplusplus
}
#endif
/* guiledec.swg ends here */
#ifndef SWIG_NOINCLUDE
/* SWIG pointer structure */ /* SWIG pointer structure */
#ifdef __cplusplus #ifdef __cplusplus
@ -318,3 +469,5 @@ SWIG_Guile_GetArgs (SCM *dest, SCM rest,
#endif #endif
/* guile.swg ends here */ /* guile.swg ends here */
#endif

57
Lib/guile/guile_scm.swg Normal file
View file

@ -0,0 +1,57 @@
%runtime %{
#define SWIG_malloc(size) \
SCM_MUST_MALLOC(size)
#define SWIG_free(mem) \
scm_must_free(mem)
#define SWIG_ConvertPtr(s, result, type, flags) \
SWIG_Guile_ConvertPtr(s, result, type, flags)
#define SWIG_MustGetPtr(s, type, argnum, flags) \
SWIG_Guile_MustGetPtr(s, type, argnum, flags, FUNC_NAME)
#define SWIG_NewPointerObj(ptr, type, owner) \
SWIG_Guile_NewPointerObj((void*)ptr, type, owner)
%}
%runtime "common.swg"
%runtime "guile_scm_run.swg"
%include "ghinterface.i"
%include "guile.i"
%runtime %{
#define GUILE_MAYBE_VALUES \
if (gswig_list_p) gswig_result = scm_values(gswig_result);
#define GUILE_MAYBE_VECTOR \
if (gswig_list_p) gswig_result = scm_vector(gswig_result);
#define SWIG_APPEND_VALUE(object) \
if (gswig_result == SCM_UNSPECIFIED) \
gswig_result = object; \
else { \
if (!gswig_list_p) { \
gswig_list_p = 1; \
gswig_result = scm_listify(gswig_result, object, SCM_UNDEFINED); \
} \
else \
gswig_result = scm_append(scm_listify(gswig_result, scm_listify(object, SCM_UNDEFINED), SCM_UNDEFINED)); \
}
/* used by Lib/exception.i */
#define gh_symbol2scm scm_str2symbol
/* useb by Lib/cdata.i */
#define gh_str2scm scm_mem2string
%}
%init %{
static int _swig_init = 0;
if (!_swig_init) {
int i;
for (i = 0; swig_types_initial[i]; i++) {
swig_types[i] = SWIG_TypeRegister(swig_types_initial[i]);
}
_swig_init = 1;
}
SWIG_Guile_Init();
%}

220
Lib/guile/guile_scm_run.swg Normal file
View file

@ -0,0 +1,220 @@
/* -*- c -*-
* -----------------------------------------------------------------------
* swig_lib/guile/guile_scm_run.swg
*
* Author: John Lenz <jelenz@students.wisc.edu>
* ----------------------------------------------------------------------- */
#include <libguile.h>
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#ifdef __cplusplus
extern "C" {
#endif
typedef SCM (*swig_guile_proc)();
typedef SCM (*guile_destructor)(SCM);
#define SWIG_scm2str(s) SWIG_scm2newstr(s, NULL)
#ifdef SWIG_NOINCLUDE
/* Interface helper function */
SWIGIMPORT(char *) SWIG_scm2newstr(SCM str, size_t *len);
/* Register SWIG smobs with Guile. */
SWIGIMPORT(void) SWIG_Guile_Init();
/* Get a pointer value from a smob. If there is a type-mismatch,
return nonzero; on success, return 0. */
SWIGIMPORT(int) SWIG_Guile_ConvertPtr(SCM s, void **result, swig_type_info *type, int flags);
/* Get a pointer value from a smob. If there is a type-mismatch,
signal a wrong-type-arg error for the given argument number. */
SWIGIMPORT(void *) SWIG_Guile_MustGetPtr(SCM s, swig_type_info *type, int argnum, int flags, const char *func_name);
/* Make a smob from a pointer and typeinfo. */
SWIGIMPORT(SCM) SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner);
/* Get arguments from an argument list */
SWIGIMPORT(int) SWIG_Guile_GetArgs(SCM *dest, SCM rest, int reqargs, int optargs, const char *procname);
#else
SWIGRUNTIME(char *)
SWIG_scm2newstr(SCM str, size_t *len) {
#define FUNC_NAME "swig_scm2newstr"
char *ret;
size_t l;
l = SCM_STRING_LENGTH(str);
ret = (char *) SWIG_malloc( (l + 1) * sizeof(char));
if (!ret) return NULL;
memcpy(ret, SCM_STRING_CHARS(str), l);
ret[l] = '\0';
if (len) *len = l;
return ret;
#undef FUNC_NAME
}
static scm_t_bits swig_tag = 0;
static scm_t_bits swig_collected_tag = 0;
SWIGRUNTIME(SCM)
SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner)
{
if (owner)
SCM_RETURN_NEWSMOB2(swig_collected_tag, ptr, (void *) type);
else
SCM_RETURN_NEWSMOB2(swig_tag, ptr, (void *) type);
}
/* Return 0 if successful. */
SWIGRUNTIME(int)
SWIG_Guile_ConvertPtr(SCM s, void **result, swig_type_info *type, int flags)
{
swig_type_info *cast;
swig_type_info *from;
if (SCM_NULLP(s)) {
*result = NULL;
return 0;
} else if (SCM_SMOB_PREDICATE(swig_tag, s) || SCM_SMOB_PREDICATE(swig_collected_tag, s)) {
from = (swig_type_info *) SCM_CELL_WORD_2(s);
if (!from) return 1;
if (type) {
cast = SWIG_TypeCheck((char*)from->name, type);
if (cast) {
*result = SWIG_TypeCast(cast, (void *) SCM_CELL_WORD_1(s));
return 0;
} else {
return 1;
}
} else {
*result = (void *) SCM_CELL_WORD_1(s);
return 0;
}
}
return 1;
}
SWIGRUNTIME(void *)
SWIG_Guile_MustGetPtr (SCM s, swig_type_info *type,
int argnum, int flags, const char *func_name)
{
void *result;
if (SWIG_Guile_ConvertPtr(s, &result, type, flags)) {
/* type mismatch */
scm_wrong_type_arg((char *) func_name, argnum, s);
}
return result;
}
/* Init */
static int
print_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
{
swig_type_info *type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob);
if (type) {
scm_puts((char *) "#<swig ", port);
if (type->str != NULL)
scm_puts(type->str, port);
else
scm_puts(type->name, port);
scm_puts((char *) " ", port);
scm_intprint((long) SCM_CELL_WORD_1(swig_smob), 16, port);
scm_puts((char *) ">", port);
/* non-zero means success */
return 1;
} else {
return 0;
}
}
static int
print_collected_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
{
swig_type_info *type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob);
if (type) {
scm_puts((char *) "#<collected swig ", port);
if (type->str != NULL)
scm_puts(type->str, port);
else
scm_puts(type->name, port);
scm_puts((char *) " ", port);
scm_intprint((long) SCM_CELL_WORD_1(swig_smob), 16, port);
scm_puts((char *) ">", port);
/* non-zero means success */
return 1;
} else {
return 0;
}
}
static SCM
equalp_swig (SCM A, SCM B)
{
if (SCM_CAR(A) == SCM_CAR(B) && SCM_CELL_WORD_1(A) == SCM_CELL_WORD_1(B)
&& SCM_CELL_WORD_2(A) == SCM_CELL_WORD_2(B))
return SCM_BOOL_T;
else return SCM_BOOL_F;
}
static size_t
free_swig(SCM A)
{
swig_type_info *type = (swig_type_info *) SCM_CELL_WORD_2(A);
if (type) {
if (type->clientdata)
((guile_destructor)type->clientdata)(A);
}
return 0;
}
SWIGRUNTIME(void)
SWIG_Guile_Init ()
{
if (!swig_tag) {
swig_tag = scm_make_smob_type("swig", 0);
scm_set_smob_print(swig_tag, print_swig);
scm_set_smob_equalp(swig_tag, equalp_swig);
}
if (!swig_collected_tag) {
swig_collected_tag = scm_make_smob_type("collected swig", 0);
scm_set_smob_print(swig_collected_tag, print_collected_swig);
scm_set_smob_equalp(swig_collected_tag, equalp_swig);
scm_set_smob_free(swig_collected_tag, free_swig);
}
}
SWIGRUNTIME(int)
SWIG_Guile_GetArgs (SCM *dest, SCM rest,
int reqargs, int optargs,
const char *procname)
{
int i;
int num_args_passed = 0;
for (i = 0; i<reqargs; i++) {
if (!SCM_CONSP(rest))
scm_wrong_num_args(scm_makfrom0str((char *) procname));
*dest++ = SCM_CAR(rest);
rest = SCM_CDR(rest);
num_args_passed++;
}
for (i = 0; i<optargs && SCM_CONSP(rest); i++) {
*dest++ = SCM_CAR(rest);
rest = SCM_CDR(rest);
num_args_passed++;
}
for (; i<optargs; i++)
*dest++ = SCM_UNDEFINED;
if (!SCM_NULLP(rest))
scm_wrong_num_args(scm_makfrom0str((char *) procname));
return num_args_passed;
}
#endif
#ifdef __cplusplus
}
#endif

157
Lib/guile/guiledec.swg
View file

@ -1,157 +0,0 @@
/* -*- c -*-
* -----------------------------------------------------------------------
* swig_lib/guile/guiledec.swg
* Copyright (C) 2000 Matthias Koeppe
*
* Guile configuration file -- declarations
* ----------------------------------------------------------------------- */
#define SWIGGUILE
#include "guile/gh.h"
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#ifdef __cplusplus
extern "C" {
#endif
#if defined(SWIG_NOINCLUDE)
# define SWIGSTATIC
#elif defined(SWIG_GLOBAL)
# define SWIGSTATIC
#else
# define SWIGSTATIC static
#endif
#define GH_NOT_PASSED SCM_UNDEFINED
#define GH_UNSPECIFIED SCM_UNSPECIFIED
#define SWIG_APPEND_VALUE(object) \
if (gswig_result == GH_UNSPECIFIED) \
gswig_result = object; \
else { \
if (!gswig_list_p) { \
gswig_list_p = 1; \
gswig_result = gh_list(gswig_result, object, GH_NOT_PASSED); \
} \
else \
gswig_result = gh_append2(gswig_result, \
gh_list(object, GH_NOT_PASSED)); \
}
#define GUILE_APPEND_RESULT SWIG_APPEND_VALUE
/* scm_values was implemented on C level in 1.4.1, and the prototype
is not included in libguile.h, so play safe and lookup `values'... */
#define GUILE_MAYBE_VALUES \
if (gswig_list_p) \
gswig_result = gh_apply(gh_lookup("values"), gswig_result);
#define GUILE_MAYBE_VECTOR \
if (gswig_list_p) \
gswig_result = gh_list_to_vector(gswig_result);
static char *
SWIG_scm2str (SCM s)
{
return gh_scm2newstr (s, NULL);
}
#define GSWIG_scm2str SWIG_scm2str
/* SCM_CHAR and SCM_CHARP were introduced in Guile 1.4; the following is for
1.3.4 compatibility. */
#ifndef SCM_CHAR
# define SCM_CHAR SCM_ICHR
#endif
#ifndef SCM_CHARP
# define SCM_CHARP SCM_ICHRP
#endif
/* This function replaces gh_scm2char, which is broken in Guile 1.4 */
static char
GSWIG_scm2char (SCM s)
{
if (SCM_CHARP(s)) return SCM_CHAR(s);
scm_wrong_type_arg(NULL, 0, s);
}
#define gh_scm2char GSWIG_scm2char
/* More 1.3.4 compatibility */
#ifndef SCM_INPUT_PORT_P
# define SCM_INPUT_PORT_P SCM_INPORTP
# define SCM_OUTPUT_PORT_P SCM_OUTPORTP
#endif
/* Type system */
typedef void *(*swig_converter_func)(void *);
typedef struct swig_type_info *(*swig_dycast_func)(void **);
typedef struct SwigPtrType SwigPtrType;
typedef struct swig_type_info {
const char *name;
swig_converter_func converter;
const char *str;
void *clientdata;
size_t tag;
swig_dycast_func dcast;
} swig_type_info;
SWIGSTATIC void
SWIG_Guile_RegisterTypes (swig_type_info **table,
swig_type_info **init);
/* Register a new type-mapping with the type-checker. origtype is the
original datatype and newtype is an equivalent type. cast is optional
pointer to a function to cast pointer values between types (this is
typically used to cast pointers from derived classes to base classes in
C++). */
SWIGSTATIC void
SWIG_RegisterMapping (const char *origtype, const char *newtype,
swig_converter_func cast);
/* Dynamic pointer casting. Down an inheritance hierarchy */
SWIGSTATIC swig_type_info *
SWIG_TypeDynamicCast(swig_type_info *ty, void **ptr);
/* Register SWIG smobs with Guile. */
SWIGSTATIC void
SWIG_Guile_Init();
/* Initialization function for this SWIG module; actually renamed by a
#define */
/* extern void SWIG_init(); */
/* Get a pointer value from a smob. If there is a type-mismatch,
return nonzero; on success, return 0. */
SWIGSTATIC int
SWIG_Guile_GetPtr (SCM s, void **result, swig_type_info *type);
/* Get a pointer value from a smob. If there is a type-mismatch,
signal a wrong-type-arg error for the given argument number. */
SWIGSTATIC void *
SWIG_Guile_MustGetPtr (SCM s, swig_type_info *type,
int argnum, const char *func_name);
/* Make a smob from a pointer and typeinfo. */
SWIGSTATIC SCM
SWIG_Guile_MakePtr (void *ptr, swig_type_info *type);
/* Get arguments from an argument list */
SWIGSTATIC int
SWIG_Guile_GetArgs (SCM *dest, SCM rest,
int reqargs, int optargs,
const char *procname);
typedef SCM (*swig_guile_proc)();
#ifdef __cplusplus
}
#endif
/* guiledec.swg ends here */

8
Lib/guile/list-vector.i
View file

@ -66,7 +66,7 @@
$1 = gh_vector_length($input); $1 = gh_vector_length($input);
if ($1 > 0) { if ($1 > 0) {
$1_ltype i; $1_ltype i;
$2 = SWIG_malloc(sizeof(C_TYPE) * $1); $2 = (C_TYPE *) SWIG_malloc(sizeof(C_TYPE) * $1);
for (i = 0; i<$1; i++) { for (i = 0; i<$1; i++) {
SCM swig_scm_value = gh_vector_ref($input, gh_int2scm(i)); SCM swig_scm_value = gh_vector_ref($input, gh_int2scm(i));
$2[i] = SCM_TO_C_EXPR; $2[i] = SCM_TO_C_EXPR;
@ -84,7 +84,7 @@
if ($1 > 0) { if ($1 > 0) {
$1_ltype i; $1_ltype i;
SCM rest; SCM rest;
$2 = SWIG_malloc(sizeof(C_TYPE) * $1); $2 = (C_TYPE *) SWIG_malloc(sizeof(C_TYPE) * $1);
for (i = 0, rest = $input; for (i = 0, rest = $input;
i<$1; i<$1;
i++, rest = gh_cdr(rest)) { i++, rest = gh_cdr(rest)) {
@ -278,7 +278,7 @@ TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(const char *, SWIG_scm2str, gh_str02scm, string
*_global_vector_length = gh_vector_length($input); *_global_vector_length = gh_vector_length($input);
if (*_global_vector_length > 0) { if (*_global_vector_length > 0) {
int i; int i;
$1 = SWIG_malloc(sizeof(C_TYPE) $1 = (C_TYPE *) SWIG_malloc(sizeof(C_TYPE)
* (*_global_vector_length)); * (*_global_vector_length));
for (i = 0; i<*_global_vector_length; i++) { for (i = 0; i<*_global_vector_length; i++) {
SCM swig_scm_value = gh_vector_ref($input, gh_int2scm(i)); SCM swig_scm_value = gh_vector_ref($input, gh_int2scm(i));
@ -297,7 +297,7 @@ TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(const char *, SWIG_scm2str, gh_str02scm, string
if (*_global_list_length > 0) { if (*_global_list_length > 0) {
int i; int i;
SCM rest; SCM rest;
$1 = SWIG_malloc(sizeof(C_TYPE) $1 = (C_TYPE *) SWIG_malloc(sizeof(C_TYPE)
* (*_global_list_length)); * (*_global_list_length));
for (i = 0, rest = $input; for (i = 0, rest = $input;
i<*_global_list_length; i<*_global_list_length;

8
Lib/guile/pointer-in-out.i
View file

@ -36,7 +36,7 @@
%typemap(in, doc="$NAME is of type <" #SCM_TYPE ">") PTRTYPE *INPUT(PTRTYPE temp) %typemap(in, doc="$NAME is of type <" #SCM_TYPE ">") PTRTYPE *INPUT(PTRTYPE temp)
{ {
if (SWIG_Guile_GetPtr($input, (void **) &temp, $*descriptor)) { if (SWIG_ConvertPtr($input, (void **) &temp, $*descriptor, 0)) {
scm_wrong_type_arg(FUNC_NAME, $argnum, $input); scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
} }
$1 = &temp; $1 = &temp;
@ -46,7 +46,7 @@
"$1 = &temp;"; "$1 = &temp;";
%typemap(argout, doc="<" #SCM_TYPE ">") PTRTYPE *OUTPUT %typemap(argout, doc="<" #SCM_TYPE ">") PTRTYPE *OUTPUT
"SWIG_APPEND_VALUE(SWIG_Guile_MakePtr(*$1, $*descriptor));"; "SWIG_APPEND_VALUE(SWIG_NewPointerObj(*$1, $*descriptor, 1));";
%typemap(in) PTRTYPE *BOTH = PTRTYPE *INPUT; %typemap(in) PTRTYPE *BOTH = PTRTYPE *INPUT;
%typemap(argout) PTRTYPE *BOTH = PTRTYPE *OUTPUT; %typemap(argout) PTRTYPE *BOTH = PTRTYPE *OUTPUT;
@ -57,12 +57,12 @@
SCM_TYPE to the standard pointer typemaps */ SCM_TYPE to the standard pointer typemaps */
%typemap(in, doc="$NAME is of type <" #SCM_TYPE ">") PTRTYPE { %typemap(in, doc="$NAME is of type <" #SCM_TYPE ">") PTRTYPE {
if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor)) if (SWIG_ConvertPtr($input, (void **) &$1, $descriptor, 0))
scm_wrong_type_arg(FUNC_NAME, $argnum, $input); scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
} }
%typemap(out, doc="<" #SCM_TYPE ">") PTRTYPE { %typemap(out, doc="<" #SCM_TYPE ">") PTRTYPE {
$result = SWIG_Guile_MakePtr ($1, $descriptor); $result = SWIG_NewPointerObj ($1, $descriptor, $owner);
} }
%enddef %enddef

19
Lib/guile/std_common.i
View file

@ -5,22 +5,17 @@
// //
// Guile implementation // Guile implementation
#define SWIG_bool2scm(b) gh_bool2scm(b ? 1 : 0)
#define SWIG_string2scm(s) gh_str02scm(s.c_str())
%{ %{
#include <string> #include <string>
SCM SWIG_bool2scm(bool b) { inline std::string SWIG_scm2string(SCM x) {
int i = b ? 1 : 0;
return gh_bool2scm(i);
}
std::string SWIG_scm2string(SCM x) {
char* temp; char* temp;
std::string s; temp = SWIG_scm2str(x);
temp = gh_scm2newstr(x, NULL); std::string s(temp);
s = std::string(temp); if (temp) SWIG_free(temp);
if (temp) scm_must_free(temp);
return s; return s;
} }
SCM SWIG_string2scm(const std::string& s) {
return gh_str02scm(s.c_str());
}
%} %}

140
Lib/guile/std_map.i
View file

@ -74,20 +74,20 @@ namespace std {
SWIG_exception(SWIG_TypeError,"alist expected"); SWIG_exception(SWIG_TypeError,"alist expected");
key = gh_car(entry); key = gh_car(entry);
val = gh_cdr(entry); val = gh_cdr(entry);
k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum); k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum, 0);
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) != 0) { $descriptor(T *), 0) != 0) {
if (!gh_pair_p(val)) if (!gh_pair_p(val))
SWIG_exception(SWIG_TypeError,"alist expected"); SWIG_exception(SWIG_TypeError,"alist expected");
val = gh_car(val); val = gh_car(val);
x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum); x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum, 0);
} }
(($1_type &)$1)[*k] = *x; (($1_type &)$1)[*k] = *x;
alist = gh_cdr(alist); alist = gh_cdr(alist);
} }
} else { } else {
$1 = *(($&1_type) $1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
} }
} }
%typemap(in) const map<K,T>& (std::map<K,T> temp, %typemap(in) const map<K,T>& (std::map<K,T> temp,
@ -110,19 +110,19 @@ namespace std {
SWIG_exception(SWIG_TypeError,"alist expected"); SWIG_exception(SWIG_TypeError,"alist expected");
key = gh_car(entry); key = gh_car(entry);
val = gh_cdr(entry); val = gh_cdr(entry);
k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum); k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum, 0);
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) != 0) { $descriptor(T *), 0) != 0) {
if (!gh_pair_p(val)) if (!gh_pair_p(val))
SWIG_exception(SWIG_TypeError,"alist expected"); SWIG_exception(SWIG_TypeError,"alist expected");
val = gh_car(val); val = gh_car(val);
x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum); x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum, 0);
} }
temp[*k] = *x; temp[*k] = *x;
alist = gh_cdr(alist); alist = gh_cdr(alist);
} }
} else { } else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum); $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
} }
} }
%typemap(out) map<K,T> { %typemap(out) map<K,T> {
@ -131,8 +131,8 @@ namespace std {
i!=$1.rend(); ++i) { i!=$1.rend(); ++i) {
K* key = new K(i->first); K* key = new K(i->first);
T* val = new T(i->second); T* val = new T(i->second);
SCM k = SWIG_MakePtr(key,$descriptor(K *)); SCM k = SWIG_NewPointerObj(key,$descriptor(K *), 1);
SCM x = SWIG_MakePtr(val,$descriptor(T *)); SCM x = SWIG_NewPointerObj(val,$descriptor(T *), 1);
SCM entry = gh_cons(k,x); SCM entry = gh_cons(k,x);
alist = gh_cons(entry,alist); alist = gh_cons(entry,alist);
} }
@ -151,17 +151,17 @@ namespace std {
if (gh_pair_p(head)) { if (gh_pair_p(head)) {
SCM key = gh_car(head); SCM key = gh_car(head);
SCM val = gh_cdr(head); SCM val = gh_cdr(head);
if (SWIG_GetPtr(key,(void**) &k, if (SWIG_ConvertPtr(key,(void**) &k,
$descriptor(K *)) != 0) { $descriptor(K *), 0) != 0) {
$1 = 0; $1 = 0;
} else { } else {
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) == 0) { $descriptor(T *), 0) == 0) {
$1 = 1; $1 = 1;
} else if (gh_pair_p(val)) { } else if (gh_pair_p(val)) {
val = gh_car(val); val = gh_car(val);
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) == 0) $descriptor(T *), 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -175,8 +175,8 @@ namespace std {
} else { } else {
/* wrapped map? */ /* wrapped map? */
std::map<K,T >* m; std::map<K,T >* m;
if (SWIG_GetPtr($input,(void **) &m, if (SWIG_ConvertPtr($input,(void **) &m,
$&1_descriptor) == 0) $&1_descriptor, 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -196,17 +196,17 @@ namespace std {
if (gh_pair_p(head)) { if (gh_pair_p(head)) {
SCM key = gh_car(head); SCM key = gh_car(head);
SCM val = gh_cdr(head); SCM val = gh_cdr(head);
if (SWIG_GetPtr(key,(void**) &k, if (SWIG_ConvertPtr(key,(void**) &k,
$descriptor(K *)) != 0) { $descriptor(K *), 0) != 0) {
$1 = 0; $1 = 0;
} else { } else {
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) == 0) { $descriptor(T *), 0) == 0) {
$1 = 1; $1 = 1;
} else if (gh_pair_p(val)) { } else if (gh_pair_p(val)) {
val = gh_car(val); val = gh_car(val);
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) == 0) $descriptor(T *), 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -220,8 +220,8 @@ namespace std {
} else { } else {
/* wrapped map? */ /* wrapped map? */
std::map<K,T >* m; std::map<K,T >* m;
if (SWIG_GetPtr($input,(void **) &m, if (SWIG_ConvertPtr($input,(void **) &m,
$1_descriptor) == 0) $1_descriptor, 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -268,7 +268,7 @@ namespace std {
for (std::map<K,T >::reverse_iterator i=$1.rbegin(); for (std::map<K,T >::reverse_iterator i=$1.rbegin();
i!=$1.rend(); ++i) { i!=$1.rend(); ++i) {
K* key = new K(i->first); K* key = new K(i->first);
SCM k = SWIG_MakePtr(key,$descriptor(K *)); SCM k = SWIG_NewPointerObj(key,$descriptor(K *), 1);
result = gh_cons(k,result); result = gh_cons(k,result);
} }
return result; return result;
@ -299,19 +299,19 @@ namespace std {
if (!CHECK(key)) if (!CHECK(key))
SWIG_exception(SWIG_TypeError, SWIG_exception(SWIG_TypeError,
"map<" #K "," #T "> expected"); "map<" #K "," #T "> expected");
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) != 0) { $descriptor(T *), 0) != 0) {
if (!gh_pair_p(val)) if (!gh_pair_p(val))
SWIG_exception(SWIG_TypeError,"alist expected"); SWIG_exception(SWIG_TypeError,"alist expected");
val = gh_car(val); val = gh_car(val);
x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum); x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum, 0);
} }
(($1_type &)$1)[CONVERT_FROM(key)] = *x; (($1_type &)$1)[CONVERT_FROM(key)] = *x;
alist = gh_cdr(alist); alist = gh_cdr(alist);
} }
} else { } else {
$1 = *(($&1_type) $1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
} }
} }
%typemap(in) const map<K,T>& (std::map<K,T> temp, %typemap(in) const map<K,T>& (std::map<K,T> temp,
@ -336,18 +336,18 @@ namespace std {
if (!CHECK(key)) if (!CHECK(key))
SWIG_exception(SWIG_TypeError, SWIG_exception(SWIG_TypeError,
"map<" #K "," #T "> expected"); "map<" #K "," #T "> expected");
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) != 0) { $descriptor(T *), 0) != 0) {
if (!gh_pair_p(val)) if (!gh_pair_p(val))
SWIG_exception(SWIG_TypeError,"alist expected"); SWIG_exception(SWIG_TypeError,"alist expected");
val = gh_car(val); val = gh_car(val);
x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum); x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum, 0);
} }
temp[CONVERT_FROM(key)] = *x; temp[CONVERT_FROM(key)] = *x;
alist = gh_cdr(alist); alist = gh_cdr(alist);
} }
} else { } else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum); $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
} }
} }
%typemap(out) map<K,T> { %typemap(out) map<K,T> {
@ -356,7 +356,7 @@ namespace std {
i!=$1.rend(); ++i) { i!=$1.rend(); ++i) {
T* val = new T(i->second); T* val = new T(i->second);
SCM k = CONVERT_TO(i->first); SCM k = CONVERT_TO(i->first);
SCM x = SWIG_MakePtr(val,$descriptor(T *)); SCM x = SWIG_NewPointerObj(val,$descriptor(T *), 1);
SCM entry = gh_cons(k,x); SCM entry = gh_cons(k,x);
alist = gh_cons(entry,alist); alist = gh_cons(entry,alist);
} }
@ -377,13 +377,13 @@ namespace std {
if (!CHECK(key)) { if (!CHECK(key)) {
$1 = 0; $1 = 0;
} else { } else {
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) == 0) { $descriptor(T *), 0) == 0) {
$1 = 1; $1 = 1;
} else if (gh_pair_p(val)) { } else if (gh_pair_p(val)) {
val = gh_car(val); val = gh_car(val);
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) == 0) $descriptor(T *), 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -397,8 +397,8 @@ namespace std {
} else { } else {
// wrapped map? // wrapped map?
std::map<K,T >* m; std::map<K,T >* m;
if (SWIG_GetPtr($input,(void **) &m, if (SWIG_ConvertPtr($input,(void **) &m,
$&1_descriptor) == 0) $&1_descriptor, 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -420,13 +420,13 @@ namespace std {
if (!CHECK(key)) { if (!CHECK(key)) {
$1 = 0; $1 = 0;
} else { } else {
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) == 0) { $descriptor(T *), 0) == 0) {
$1 = 1; $1 = 1;
} else if (gh_pair_p(val)) { } else if (gh_pair_p(val)) {
val = gh_car(val); val = gh_car(val);
if (SWIG_GetPtr(val,(void**) &x, if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *)) == 0) $descriptor(T *), 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -440,8 +440,8 @@ namespace std {
} else { } else {
// wrapped map? // wrapped map?
std::map<K,T >* m; std::map<K,T >* m;
if (SWIG_GetPtr($input,(void **) &m, if (SWIG_ConvertPtr($input,(void **) &m,
$1_descriptor) == 0) $1_descriptor, 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -512,7 +512,7 @@ namespace std {
SWIG_exception(SWIG_TypeError,"alist expected"); SWIG_exception(SWIG_TypeError,"alist expected");
key = gh_car(entry); key = gh_car(entry);
val = gh_cdr(entry); val = gh_cdr(entry);
k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum); k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum, 0);
if (!CHECK(val)) { if (!CHECK(val)) {
if (!gh_pair_p(val)) if (!gh_pair_p(val))
SWIG_exception(SWIG_TypeError,"alist expected"); SWIG_exception(SWIG_TypeError,"alist expected");
@ -526,7 +526,7 @@ namespace std {
} }
} else { } else {
$1 = *(($&1_type) $1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
} }
} }
%typemap(in) const map<K,T>& (std::map<K,T> temp, %typemap(in) const map<K,T>& (std::map<K,T> temp,
@ -548,7 +548,7 @@ namespace std {
SWIG_exception(SWIG_TypeError,"alist expected"); SWIG_exception(SWIG_TypeError,"alist expected");
key = gh_car(entry); key = gh_car(entry);
val = gh_cdr(entry); val = gh_cdr(entry);
k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum); k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum, 0);
if (!CHECK(val)) { if (!CHECK(val)) {
if (!gh_pair_p(val)) if (!gh_pair_p(val))
SWIG_exception(SWIG_TypeError,"alist expected"); SWIG_exception(SWIG_TypeError,"alist expected");
@ -561,7 +561,7 @@ namespace std {
alist = gh_cdr(alist); alist = gh_cdr(alist);
} }
} else { } else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum); $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
} }
} }
%typemap(out) map<K,T> { %typemap(out) map<K,T> {
@ -569,7 +569,7 @@ namespace std {
for (std::map<K,T >::reverse_iterator i=$1.rbegin(); for (std::map<K,T >::reverse_iterator i=$1.rbegin();
i!=$1.rend(); ++i) { i!=$1.rend(); ++i) {
K* key = new K(i->first); K* key = new K(i->first);
SCM k = SWIG_MakePtr(key,$descriptor(K *)); SCM k = SWIG_NewPointerObj(key,$descriptor(K *), 1);
SCM x = CONVERT_TO(i->second); SCM x = CONVERT_TO(i->second);
SCM entry = gh_cons(k,x); SCM entry = gh_cons(k,x);
alist = gh_cons(entry,alist); alist = gh_cons(entry,alist);
@ -588,8 +588,8 @@ namespace std {
if (gh_pair_p(head)) { if (gh_pair_p(head)) {
SCM key = gh_car(head); SCM key = gh_car(head);
SCM val = gh_cdr(head); SCM val = gh_cdr(head);
if (SWIG_GetPtr(val,(void **) &k, if (SWIG_ConvertPtr(val,(void **) &k,
$descriptor(K *)) != 0) { $descriptor(K *), 0) != 0) {
$1 = 0; $1 = 0;
} else { } else {
if (CHECK(val)) { if (CHECK(val)) {
@ -610,8 +610,8 @@ namespace std {
} else { } else {
// wrapped map? // wrapped map?
std::map<K,T >* m; std::map<K,T >* m;
if (SWIG_GetPtr($input,(void **) &m, if (SWIG_ConvertPtr($input,(void **) &m,
$&1_descriptor) == 0) $&1_descriptor, 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -630,8 +630,8 @@ namespace std {
if (gh_pair_p(head)) { if (gh_pair_p(head)) {
SCM key = gh_car(head); SCM key = gh_car(head);
SCM val = gh_cdr(head); SCM val = gh_cdr(head);
if (SWIG_GetPtr(val,(void **) &k, if (SWIG_ConvertPtr(val,(void **) &k,
$descriptor(K *)) != 0) { $descriptor(K *), 0) != 0) {
$1 = 0; $1 = 0;
} else { } else {
if (CHECK(val)) { if (CHECK(val)) {
@ -652,8 +652,8 @@ namespace std {
} else { } else {
// wrapped map? // wrapped map?
std::map<K,T >* m; std::map<K,T >* m;
if (SWIG_GetPtr($input,(void **) &m, if (SWIG_ConvertPtr($input,(void **) &m,
$1_descriptor) == 0) $1_descriptor, 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -700,7 +700,7 @@ namespace std {
for (std::map<K,T >::reverse_iterator i=$1.rbegin(); for (std::map<K,T >::reverse_iterator i=$1.rbegin();
i!=$1.rend(); ++i) { i!=$1.rend(); ++i) {
K* key = new K(i->first); K* key = new K(i->first);
SCM k = SWIG_MakePtr(key,$descriptor(K *)); SCM k = SWIG_NewPointerObj(key,$descriptor(K *), 1);
result = gh_cons(k,result); result = gh_cons(k,result);
} }
return result; return result;
@ -742,7 +742,7 @@ namespace std {
} }
} else { } else {
$1 = *(($&1_type) $1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
} }
} }
%typemap(in) const map<K,T>& (std::map<K,T> temp, %typemap(in) const map<K,T>& (std::map<K,T> temp,
@ -778,7 +778,7 @@ namespace std {
alist = gh_cdr(alist); alist = gh_cdr(alist);
} }
} else { } else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum); $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
} }
} }
%typemap(out) map<K,T> { %typemap(out) map<K,T> {
@ -824,8 +824,8 @@ namespace std {
} else { } else {
// wrapped map? // wrapped map?
std::map<K,T >* m; std::map<K,T >* m;
if (SWIG_GetPtr($input,(void **) &m, if (SWIG_ConvertPtr($input,(void **) &m,
$&1_descriptor) == 0) $&1_descriptor, 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -864,8 +864,8 @@ namespace std {
} else { } else {
// wrapped map? // wrapped map?
std::map<K,T >* m; std::map<K,T >* m;
if (SWIG_GetPtr($input,(void **) &m, if (SWIG_ConvertPtr($input,(void **) &m,
$1_descriptor) == 0) $1_descriptor, 0) == 0)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;

8
Lib/guile/std_string.i
View file

@ -27,9 +27,9 @@ namespace std {
%typemap(in) string (char* tempptr) { %typemap(in) string (char* tempptr) {
if (gh_string_p($input)) { if (gh_string_p($input)) {
tempptr = gh_scm2newstr($input, NULL); tempptr = SWIG_scm2str($input);
$1 = std::string(tempptr); $1 = std::string(tempptr);
if (tempptr) scm_must_free(tempptr); if (tempptr) SWIG_free(tempptr);
} else { } else {
SWIG_exception(SWIG_TypeError, "string expected"); SWIG_exception(SWIG_TypeError, "string expected");
} }
@ -38,9 +38,9 @@ namespace std {
%typemap(in) const string & (std::string temp, %typemap(in) const string & (std::string temp,
char* tempptr) { char* tempptr) {
if (gh_string_p($input)) { if (gh_string_p($input)) {
tempptr = gh_scm2newstr($input, NULL); tempptr = SWIG_scm2str($input);
temp = std::string(tempptr); temp = std::string(tempptr);
if (tempptr) scm_must_free(tempptr); if (tempptr) SWIG_free(tempptr);
$1 = &temp; $1 = &temp;
} else { } else {
SWIG_exception(SWIG_TypeError, "string expected"); SWIG_exception(SWIG_TypeError, "string expected");

62
Lib/guile/std_vector.i
View file

@ -75,7 +75,7 @@ namespace std {
for (unsigned long i=0; i<size; i++) { for (unsigned long i=0; i<size; i++) {
SCM o = gh_vector_ref($input,gh_ulong2scm(i)); SCM o = gh_vector_ref($input,gh_ulong2scm(i));
(($1_type &)$1)[i] = (($1_type &)$1)[i] =
*((T*) SWIG_MustGetPtr(o,$descriptor(T *),$argnum)); *((T*) SWIG_MustGetPtr(o,$descriptor(T *),$argnum, 0));
} }
} else if (gh_null_p($input)) { } else if (gh_null_p($input)) {
$1 = std::vector<T >(); $1 = std::vector<T >();
@ -86,13 +86,13 @@ namespace std {
while (!gh_null_p(tail)) { while (!gh_null_p(tail)) {
head = gh_car(tail); head = gh_car(tail);
tail = gh_cdr(tail); tail = gh_cdr(tail);
$1.push_back(*((T*) SWIG_MustGetPtr(head, $1.push_back(*((T*)SWIG_MustGetPtr(head,
$descriptor(T *), $descriptor(T *),
$argnum))); $argnum, 0)));
} }
} else { } else {
$1 = *(($&1_type) $1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
} }
} }
%typemap(in) const vector<T>& (std::vector<T> temp), %typemap(in) const vector<T>& (std::vector<T> temp),
@ -105,7 +105,7 @@ namespace std {
SCM o = gh_vector_ref($input,gh_ulong2scm(i)); SCM o = gh_vector_ref($input,gh_ulong2scm(i));
temp[i] = *((T*) SWIG_MustGetPtr(o, temp[i] = *((T*) SWIG_MustGetPtr(o,
$descriptor(T *), $descriptor(T *),
$argnum)); $argnum, 0));
} }
} else if (gh_null_p($input)) { } else if (gh_null_p($input)) {
temp = std::vector<T >(); temp = std::vector<T >();
@ -120,10 +120,10 @@ namespace std {
tail = gh_cdr(tail); tail = gh_cdr(tail);
temp.push_back(*((T*) SWIG_MustGetPtr(head, temp.push_back(*((T*) SWIG_MustGetPtr(head,
$descriptor(T *), $descriptor(T *),
$argnum))); $argnum, 0)));
} }
} else { } else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum); $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
} }
} }
%typemap(out) vector<T> { %typemap(out) vector<T> {
@ -131,7 +131,7 @@ namespace std {
for (unsigned int i=0; i<$1.size(); i++) { for (unsigned int i=0; i<$1.size(); i++) {
T* x = new T((($1_type &)$1)[i]); T* x = new T((($1_type &)$1)[i]);
gh_vector_set_x($result,gh_long2scm(i), gh_vector_set_x($result,gh_long2scm(i),
SWIG_MakePtr(x,$descriptor(T *))); SWIG_NewPointerObj(x, $descriptor(T *), 1));
} }
} }
%typecheck(SWIG_TYPECHECK_VECTOR) vector<T> { %typecheck(SWIG_TYPECHECK_VECTOR) vector<T> {
@ -145,8 +145,8 @@ namespace std {
/* check the first element only */ /* check the first element only */
SCM o = gh_vector_ref($input,gh_ulong2scm(0)); SCM o = gh_vector_ref($input,gh_ulong2scm(0));
T* x; T* x;
if (SWIG_GetPtr(o,(void**) &x, if (SWIG_ConvertPtr(o,(void**) &x,
$descriptor(T *)) == 0) $descriptor(T *), 0) != -1)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -158,16 +158,16 @@ namespace std {
/* check the first element only */ /* check the first element only */
T* x; T* x;
SCM head = gh_car($input); SCM head = gh_car($input);
if (SWIG_GetPtr(head,(void**) &x, if (SWIG_ConvertPtr(head,(void**) &x,
$descriptor(T *)) == 0) $descriptor(T *), 0) != -1)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
} else { } else {
/* wrapped vector? */ /* wrapped vector? */
std::vector<T >* v; std::vector<T >* v;
if (SWIG_GetPtr($input,(void **) &v, if (SWIG_ConvertPtr($input,(void **) &v,
$&1_descriptor) == 0) $&1_descriptor, 0) != -1)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -185,8 +185,8 @@ namespace std {
/* check the first element only */ /* check the first element only */
T* x; T* x;
SCM o = gh_vector_ref($input,gh_ulong2scm(0)); SCM o = gh_vector_ref($input,gh_ulong2scm(0));
if (SWIG_GetPtr(o,(void**) &x, if (SWIG_ConvertPtr(o,(void**) &x,
$descriptor(T *)) == 0) $descriptor(T *), 0) != -1)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -198,16 +198,16 @@ namespace std {
/* check the first element only */ /* check the first element only */
T* x; T* x;
SCM head = gh_car($input); SCM head = gh_car($input);
if (SWIG_GetPtr(head,(void**) &x, if (SWIG_ConvertPtr(head,(void**) &x,
$descriptor(T *)) == 0) $descriptor(T *), 0) != -1)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
} else { } else {
/* wrapped vector? */ /* wrapped vector? */
std::vector<T >* v; std::vector<T >* v;
if (SWIG_GetPtr($input,(void **) &v, if (SWIG_ConvertPtr($input,(void **) &v,
$1_descriptor) == 0) $1_descriptor, 0) != -1)
$1 = 1; $1 = 1;
else else
$1 = 0; $1 = 0;
@ -282,7 +282,7 @@ namespace std {
} }
} else { } else {
$1 = *(($&1_type) $1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
} }
} }
%typemap(in) const vector<T>& (std::vector<T> temp), %typemap(in) const vector<T>& (std::vector<T> temp),
@ -314,8 +314,7 @@ namespace std {
scm_wrong_type_arg(FUNC_NAME, $argnum, $input); scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
} }
} else { } else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor, $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
$argnum);
} }
} }
%typemap(out) vector<T> { %typemap(out) vector<T> {
@ -349,8 +348,8 @@ namespace std {
} else { } else {
/* wrapped vector? */ /* wrapped vector? */
std::vector<T >* v; std::vector<T >* v;
$1 = (SWIG_GetPtr($input,(void **) &v, $1 = (SWIG_ConvertPtr($input,(void **) &v,
$&1_descriptor) == 0) ? 1 : 0; $&1_descriptor, 0) != -1) ? 1 : 0;
} }
} }
%typecheck(SWIG_TYPECHECK_VECTOR) const vector<T>&, %typecheck(SWIG_TYPECHECK_VECTOR) const vector<T>&,
@ -378,8 +377,8 @@ namespace std {
} else { } else {
/* wrapped vector? */ /* wrapped vector? */
std::vector<T >* v; std::vector<T >* v;
$1 = (SWIG_GetPtr($input,(void **) &v, $1 = (SWIG_ConvertPtr($input,(void **) &v,
$1_descriptor) == 0) ? 1 : 0; $1_descriptor, 0) != -1) ? 1 : 0;
} }
} }
public: public:
@ -428,12 +427,9 @@ namespace std {
specialize_stl_vector(short,gh_number_p,gh_scm2long,gh_long2scm); specialize_stl_vector(short,gh_number_p,gh_scm2long,gh_long2scm);
specialize_stl_vector(unsigned int,gh_number_p,gh_scm2ulong,gh_ulong2scm); specialize_stl_vector(unsigned int,gh_number_p,gh_scm2ulong,gh_ulong2scm);
specialize_stl_vector(unsigned long,gh_number_p,gh_scm2ulong,gh_ulong2scm); specialize_stl_vector(unsigned long,gh_number_p,gh_scm2ulong,gh_ulong2scm);
specialize_stl_vector(unsigned short,gh_number_p, specialize_stl_vector(unsigned short,gh_number_p,gh_scm2ulong,gh_ulong2scm);
gh_scm2ulong,gh_ulong2scm);
specialize_stl_vector(float,gh_number_p,gh_scm2double,gh_double2scm); specialize_stl_vector(float,gh_number_p,gh_scm2double,gh_double2scm);
specialize_stl_vector(double,gh_number_p,gh_scm2double,gh_double2scm); specialize_stl_vector(double,gh_number_p,gh_scm2double,gh_double2scm);
specialize_stl_vector(std::string,gh_string_p, specialize_stl_vector(std::string,gh_string_p,SWIG_scm2string,SWIG_string2scm);
SWIG_scm2string,SWIG_string2scm);
} }

130
Lib/guile/typemaps.i
View file

@ -30,51 +30,66 @@
/* Pointers */ /* Pointers */
%typemap(in) SWIGTYPE * { %typemap(in) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {
if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor)) $1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, 0);
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
} }
%typemap(in) void * { %typemap(in) void * {
if (SWIG_Guile_GetPtr($input, (void **) &$1, NULL)) $1 = SWIG_MustGetPtr($input, NULL, $argnum, 0);
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
} }
%typemap(varin) SWIGTYPE * { %typemap(varin) SWIGTYPE * {
if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor)) $1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, 0);
scm_wrong_type_arg(FUNC_NAME, 1, $input); }
%typemap(varin) SWIGTYPE & {
$1 = *(($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, 0));
}
%typemap(varin) SWIGTYPE [] {
scm_wrong_type_arg((char *) FUNC_NAME, 1, $input);
}
%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 * { %typemap(varin) void * {
if (SWIG_Guile_GetPtr($input, (void **) &$1, NULL)) $1 = SWIG_MustGetPtr($input, NULL, 1, 0);
scm_wrong_type_arg(FUNC_NAME, 1, $input);
} }
%typemap(out) SWIGTYPE * { %typemap(out) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {
$result = SWIG_Guile_MakePtr ($1, $descriptor); $result = SWIG_NewPointerObj ($1, $descriptor, $owner);
} }
%typemap(out) SWIGTYPE *DYNAMIC { %typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1); swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1);
$result = SWIG_Guile_MakePtr ($1, ty); $result = SWIG_NewPointerObj ($1, ty, $owner);
} }
%typemap(varout) SWIGTYPE * { %typemap(varout) SWIGTYPE *, SWIGTYPE [] {
$result = SWIG_Guile_MakePtr ($1, $descriptor); $result = SWIG_NewPointerObj ($1, $descriptor, 0);
}
%typemap(varout) SWIGTYPE & {
$result = SWIG_NewPointerObj((void *) &$1, $1_descriptor, 0);
} }
/* Pass-by-value */ /* Pass-by-value */
%typemap(in) SWIGTYPE($&1_ltype argp) { %typemap(in) SWIGTYPE($&1_ltype argp) {
if (SWIG_Guile_GetPtr($input, (void **) &argp, $&1_descriptor)) argp = ($&1_ltype)SWIG_MustGetPtr($input, $&1_descriptor, $argnum, 0);
scm_wrong_type_arg(FUNC_NAME,$argnum,$input);
$1 = *argp; $1 = *argp;
} }
%typemap(varin) SWIGTYPE { %typemap(varin) SWIGTYPE {
$&1_ltype argp; $&1_ltype argp;
if (SWIG_Guile_GetPtr($input, (void **) &argp, $&1_descriptor)) argp = ($&1_ltype)SWIG_MustGetPtr($input, $&1_descriptor, 1, 0);
scm_wrong_type_arg(FUNC_NAME,1,$input);
$1 = *argp; $1 = *argp;
} }
@ -83,14 +98,14 @@
{ {
$&1_ltype resultptr; $&1_ltype resultptr;
resultptr = new $1_ltype(($1_ltype &) $1); resultptr = new $1_ltype(($1_ltype &) $1);
$result = SWIG_Guile_MakePtr (resultptr, $&1_descriptor); $result = SWIG_NewPointerObj (resultptr, $&1_descriptor, 1);
} }
#else #else
{ {
$&1_ltype resultptr; $&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type)); resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type)); memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_Guile_MakePtr(resultptr, $&1_descriptor); $result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 1);
} }
#endif #endif
@ -99,54 +114,23 @@
{ {
$&1_ltype resultptr; $&1_ltype resultptr;
resultptr = new $1_ltype(($1_ltype&) $1); resultptr = new $1_ltype(($1_ltype&) $1);
$result = SWIG_Guile_MakePtr (resultptr, $&1_descriptor); $result = SWIG_NewPointerObj (resultptr, $&1_descriptor, 0);
} }
#else #else
{ {
$&1_ltype resultptr; $&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type)); resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type)); memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_Guile_MakePtr(resultptr, $&1_descriptor); $result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 0);
} }
#endif #endif
/* C++ References */
#ifdef __cplusplus
%typemap(in) SWIGTYPE &, const SWIGTYPE & {
if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor)!=0 || $1 == NULL)
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
%typemap(out) SWIGTYPE &, const SWIGTYPE & {
$result = SWIG_Guile_MakePtr ($1, $descriptor);
}
%typemap(out) SWIGTYPE &DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1);
$result = SWIG_Guile_MakePtr ($1, ty);
}
#endif
/* Arrays */
%typemap(in) SWIGTYPE[] {
if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor)!=0)
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
%typemap(out) SWIGTYPE[] {
$result = SWIG_Guile_MakePtr ($1, $descriptor);
}
/* Enums */ /* Enums */
%typemap(in) enum SWIGTYPE "$1 = gh_scm2int($input);"; %typemap(in) enum SWIGTYPE { $1 = gh_scm2int($input); }
%typemap(varin) enum SWIGTYPE "$1 = ($1_type) gh_scm2int($input);"; %typemap(varin) enum SWIGTYPE { $1 = ($1_type) gh_scm2int($input); }
%typemap(out) enum SWIGTYPE "$result = gh_int2scm($1);"; %typemap(out) enum SWIGTYPE { $result = gh_int2scm($1); }
%typemap(varout) enum SWIGTYPE "$result = gh_int2scm($1);"; %typemap(varout) enum SWIGTYPE { $result = gh_int2scm($1); }
/* The SIMPLE_MAP_WITH_EXPR macro below defines the whole set of /* The SIMPLE_MAP_WITH_EXPR macro below defines the whole set of
typemaps needed for simple types. typemaps needed for simple types.
@ -208,17 +192,19 @@
C_NAME {$result = C_TO_SCM($1);} C_NAME {$result = C_TO_SCM($1);}
/* INPUT and OUTPUT */ /* INPUT and OUTPUT */
%typemap (in, doc="$NAME is of type <" #SCM_NAME ">)") %typemap (in, doc="$NAME is of type <" #SCM_NAME ">)")
C_NAME *INPUT(C_NAME temp) { C_NAME *INPUT(C_NAME temp), C_NAME &INPUT(C_NAME temp) {
temp = (C_NAME) SCM_TO_C($input); $1 = &temp; temp = (C_NAME) SCM_TO_C($input); $1 = &temp;
} }
%typemap (in,numinputs=0) C_NAME *OUTPUT (C_NAME temp) %typemap (in,numinputs=0) C_NAME *OUTPUT (C_NAME temp), C_NAME &OUTPUT(C_NAME temp)
{$1 = &temp;} {$1 = &temp;}
%typemap (argout,doc="$name (of type <" #SCM_NAME ">)") C_NAME *OUTPUT %typemap (argout,doc="$name (of type <" #SCM_NAME ">)") C_NAME *OUTPUT, C_NAME &OUTPUT
{SWIG_APPEND_VALUE(C_TO_SCM(*$1));} {SWIG_APPEND_VALUE(C_TO_SCM(*$1));}
%typemap (in) C_NAME *BOTH = C_NAME *INPUT; %typemap (in) C_NAME *BOTH = C_NAME *INPUT;
%typemap (argout) C_NAME *BOTH = C_NAME *OUTPUT; %typemap (argout) C_NAME *BOTH = C_NAME *OUTPUT;
%typemap (in) C_NAME *INOUT = C_NAME *INPUT; %typemap (in) C_NAME *INOUT = C_NAME *INPUT;
%typemap (argout) C_NAME *INOUT = C_NAME *OUTPUT; %typemap (argout) C_NAME *INOUT = C_NAME *OUTPUT;
%typemap (in) C_NAME &INOUT = C_NAME &INPUT;
%typemap (argout) C_NAME &INOUT = C_NAME &OUTPUT;
/* Const primitive references. Passed by value */ /* Const primitive references. Passed by value */
%typemap(in, doc="$NAME is of type <" #SCM_NAME ">") const C_NAME & (C_NAME temp) { %typemap(in, doc="$NAME is of type <" #SCM_NAME ">") const C_NAME & (C_NAME temp) {
temp = SCM_TO_C($input); temp = SCM_TO_C($input);
@ -232,6 +218,7 @@
SIMPLE_MAP(bool, gh_scm2bool, gh_bool2scm, boolean); SIMPLE_MAP(bool, gh_scm2bool, gh_bool2scm, boolean);
SIMPLE_MAP(char, gh_scm2char, gh_char2scm, char); SIMPLE_MAP(char, gh_scm2char, gh_char2scm, char);
SIMPLE_MAP(unsigned char, gh_scm2char, gh_char2scm, char); SIMPLE_MAP(unsigned char, gh_scm2char, gh_char2scm, char);
SIMPLE_MAP(signed char, gh_scm2char, gh_char2scm, char);
SIMPLE_MAP(int, gh_scm2int, gh_int2scm, integer); SIMPLE_MAP(int, gh_scm2int, gh_int2scm, integer);
SIMPLE_MAP(short, gh_scm2int, gh_int2scm, integer); SIMPLE_MAP(short, gh_scm2int, gh_int2scm, integer);
SIMPLE_MAP(long, gh_scm2long, gh_long2scm, integer); SIMPLE_MAP(long, gh_scm2long, gh_long2scm, integer);
@ -267,12 +254,12 @@
%typemap (in) char * *INOUT = char * *INPUT; %typemap (in) char * *INOUT = char * *INPUT;
%typemap (argout) char * *INOUT = char * *OUTPUT; %typemap (argout) char * *INOUT = char * *OUTPUT;
/* GSWIG_scm2str makes a malloc'ed copy of the string, so get rid of it after /* SWIG_scm2str makes a malloc'ed copy of the string, so get rid of it after
the function call. */ the function call. */
%typemap (freearg) char * "if (must_free$argnum && $1) scm_must_free($1);"; %typemap (freearg) char * "if (must_free$argnum && $1) SWIG_free($1);";
%typemap (freearg) char **INPUT, char **BOTH "if (must_free$argnum && (*$1)) scm_must_free(*$1);" %typemap (freearg) char **INPUT, char **BOTH "if (must_free$argnum && (*$1)) SWIG_free(*$1);"
%typemap (freearg) char **OUTPUT "scm_must_free(*$1);" %typemap (freearg) char **OUTPUT "SWIG_free(*$1);"
/* But this shall not apply if we try to pass a single char by /* But this shall not apply if we try to pass a single char by
reference. */ reference. */
@ -288,7 +275,7 @@
/* Void */ /* Void */
%typemap (out,doc="") void "gswig_result = GH_UNSPECIFIED;"; %typemap (out,doc="") void "gswig_result = SCM_UNSPECIFIED;";
/* SCM is passed through */ /* SCM is passed through */
@ -353,17 +340,12 @@ typedef unsigned long SCM;
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] { %typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {
void *ptr; void *ptr;
$1 = !SWIG_Guile_GetPtr($input, &ptr, $1_descriptor); $1 = !SWIG_ConvertPtr($input, &ptr, $1_descriptor, 0);
} }
%typecheck(SWIG_TYPECHECK_VOIDPTR) void * { %typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
void *ptr; void *ptr;
$1 = !SWIG_Guile_GetPtr($input, &ptr, 0); $1 = !SWIG_ConvertPtr($input, &ptr, 0, 0);
} }
/* typemaps.i ends here */ /* typemaps.i ends here */

2
Makefile.in
View file

@ -39,6 +39,7 @@ skip-perl = test -n "@SKIP_PERL5@"
skip-python = test -n "@SKIP_PYTHON@" skip-python = test -n "@SKIP_PYTHON@"
skip-java = test -n "@SKIP_JAVA@" skip-java = test -n "@SKIP_JAVA@"
skip-guile = test -n "@SKIP_GUILE@" skip-guile = test -n "@SKIP_GUILE@"
skip-guilescm = test -n "@SKIP_GUILE@"
skip-mzscheme = test -n "@SKIP_MZSCHEME@" skip-mzscheme = test -n "@SKIP_MZSCHEME@"
skip-ruby = test -n "@SKIP_RUBY@" skip-ruby = test -n "@SKIP_RUBY@"
skip-php4 = test -n "@SKIP_PHP4@" skip-php4 = test -n "@SKIP_PHP4@"
@ -116,6 +117,7 @@ check-test-suite: \
check-python-test-suite \ check-python-test-suite \
check-java-test-suite \ check-java-test-suite \
check-guile-test-suite \ check-guile-test-suite \
check-guilescm-test-suite \
check-mzscheme-test-suite \ check-mzscheme-test-suite \
check-ruby-test-suite \ check-ruby-test-suite \
check-ocaml-test-suite \ check-ocaml-test-suite \

1
README
View file

@ -36,6 +36,7 @@ Major contributors include:
Loic Dachary (Perl5) Loic Dachary (Perl5)
Masaki Fukushima (Ruby) Masaki Fukushima (Ruby)
James Michael DuPont(mdupont777@yahoo.com) (C#/PNet Support with the original code from Neil Cawse) James Michael DuPont(mdupont777@yahoo.com) (C#/PNet Support with the original code from Neil Cawse)
John Lenz (Guile updates)
Past contributors include: Past contributors include:
Clark McGrew, Dustin Mitchell, Ian Cooke, Catalin Dumitrescu, Baran Clark McGrew, Dustin Mitchell, Ian Cooke, Catalin Dumitrescu, Baran

18
Runtime/Makefile.am
View file

@ -21,7 +21,7 @@ if !SKIP_PYTHON
lib_LTLIBRARIES += libswigpy.la lib_LTLIBRARIES += libswigpy.la
endif endif
if !SKIP_GUILE if !SKIP_GUILE
lib_LTLIBRARIES += libswigguile.la lib_LTLIBRARIES += libswigguile.la libswigguilescm.la
endif endif
if !SKIP_RUBY if !SKIP_RUBY
lib_LTLIBRARIES += libswigrb.la lib_LTLIBRARIES += libswigrb.la
@ -87,15 +87,23 @@ libpy.c: $(SWIG_TYPECHECK) $(PYTHON_RUNTIME)
# ---------------------------------------------------------------------- # ----------------------------------------------------------------------
GUILE_INCLUDE = @GUILEINCLUDE@ GUILE_INCLUDE = @GUILEINCLUDE@
GUILE_RUNTIME = $(SWIGLIB)/guile/guiledec.swg $(SWIGLIB)/guile/guile.swg GUILE_GH_RUNTIME = $(SWIGLIB)/guile/guile_gh_run.swg
GUILE_SCM_RUNTIME = $(SWIGLIB)/guile/guile_scm_run.swg
GUILE_DLNK = GUILE_DLNK =
libswigguile_la_SOURCES = libguile.c libswigguile_la_SOURCES = libguile_gh.c
libswigguile_la_LDFLAGS = -no-undefined $(RELEASE_SUFFIX_LIBTOOL) $(GUILE_DLNK) libswigguile_la_LDFLAGS = -no-undefined $(RELEASE_SUFFIX_LIBTOOL) $(GUILE_DLNK)
libswigguile_la_CFLAGS = -DSWIG_GLOBAL $(GUILE_INCLUDE) libswigguile_la_CFLAGS = -DSWIG_GLOBAL $(GUILE_INCLUDE)
libguile.c: $(GUILE_RUNTIME) libguile_gh.c: $(GUILE_GH_RUNTIME)
cat $(GUILE_RUNTIME) > libguile.c cat $(GUILE_GH_RUNTIME) > libguile_gh.c
libswigguilescm_la_SOURCES = libguile_scm.c
libswigguilescm_la_LDFLAGS = -no-undefined $(RELEASE_SUFFIX_LIBTOOL) $(GUILE_DLNK)
libswigguilescm_la_CFLAGS = -DSWIG_GLOBAL $(GUILE_INCLUDE)
libguile_scm.c: $(SWIG_TYPECHECK) $(GUILE_SCM_RUNTIME)
cat $(SWIG_TYPECHECK) $(GUILE_SCM_RUNTIME) > libguile_scm.c
# ---------------------------------------------------------------------- # ----------------------------------------------------------------------
# Ruby run-time library # Ruby run-time library

124
Source/Modules/guile.cxx
View file

@ -43,6 +43,8 @@ Guile Options (available with -guile)\n\
one of `guile-1.4', `plain', `texinfo'\n\ one of `guile-1.4', `plain', `texinfo'\n\
-scmstub file - Output Scheme FILE with module declaration and\n\ -scmstub file - Output Scheme FILE with module declaration and\n\
exports; only with `passive' and `simple' linkage\n\ exports; only with `passive' and `simple' linkage\n\
-gh - Use the gh_ guile interface. (default) \n\
-scm - Use the scm guile interface. (guile >=1.6) \n\
\n\ \n\
When unspecified, the default LSTYLE is `simple'. For native Guile\n\ When unspecified, the default LSTYLE is `simple'. For native Guile\n\
module linking (for Guile versions >=1.5.0), use `module'. Other\n\ module linking (for Guile versions >=1.5.0), use `module'. Other\n\
@ -88,6 +90,10 @@ static String *return_multi_doc = 0;
static String *exported_symbols = 0; static String *exported_symbols = 0;
static int use_scm_interface = 0;
static int exporting_destructor = 0;
static String *swigtype_ptr = 0;
class GUILE : public Language { class GUILE : public Language {
public: public:
@ -97,7 +103,7 @@ public:
virtual void main (int argc, char *argv[]) { virtual void main (int argc, char *argv[]) {
int i, orig_len; int i, orig_len;
SWIG_library_directory("guile"); SWIG_library_directory("guile");
SWIG_typemap_lang("guile"); SWIG_typemap_lang("guile");
@ -192,6 +198,14 @@ public:
Swig_arg_error(); Swig_arg_error();
} }
} }
else if (strcmp(argv[i], "-gh") == 0) {
use_scm_interface = 0;
Swig_mark_arg(i);
}
else if (strcmp(argv[i], "-scm") == 0) {
use_scm_interface = 1;
Swig_mark_arg(i);
}
} }
} }
@ -206,7 +220,10 @@ public:
/* Add a symbol for this module */ /* Add a symbol for this module */
Preprocessor_define ("SWIGGUILE 1",0); Preprocessor_define ("SWIGGUILE 1",0);
/* Read in default typemaps */ /* Read in default typemaps */
SWIG_config_file("guile.i"); if (use_scm_interface)
SWIG_config_file("guile_scm.swg");
else
SWIG_config_file("guile_gh.swg");
allow_overloading(); allow_overloading();
} }
@ -268,7 +285,6 @@ public:
Printf (f_init, "static void\nSWIG_init (void)\n{\n"); Printf (f_init, "static void\nSWIG_init (void)\n{\n");
break; break;
} }
Printf (f_init, "\tSWIG_Guile_Init();\n");
if (CPlusPlus) { if (CPlusPlus) {
Printf(f_runtime, "\n}\n"); Printf(f_runtime, "\n}\n");
} }
@ -281,10 +297,8 @@ public:
SwigType_emit_type_table (f_runtime, f_wrappers); SwigType_emit_type_table (f_runtime, f_wrappers);
Printf(f_wrappers,"#ifdef __cplusplus\n}\n#endif\n");
Printf (f_init, "SWIG_Guile_RegisterTypes(swig_types, swig_types_initial);\n");
Printf (f_init, "}\n\n"); Printf (f_init, "}\n\n");
Printf (f_init, "#ifdef __cplusplus\n}\n#endif\n");
char module_name[256]; char module_name[256];
if (!module) if (!module)
@ -618,7 +632,7 @@ public:
Printf(f->def,"SCM s_%d", i); Printf(f->def,"SCM s_%d", i);
} }
if (opt_p) { if (opt_p) {
Printf(f->code," if (%s != GH_NOT_PASSED) {\n", source); Printf(f->code," if (%s != SCM_UNDEFINED) {\n", source);
} }
if ((tm = Getattr(p,"tmap:in"))) { if ((tm = Getattr(p,"tmap:in"))) {
Replaceall(tm,"$source",source); Replaceall(tm,"$source",source);
@ -701,9 +715,11 @@ public:
Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL); Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
// Now write code to make the function call // Now write code to make the function call
Printv(f->code, tab4, "gh_defer_ints();\n", NIL); if (!use_scm_interface)
Printv(f->code, tab4, "gh_defer_ints();\n", NIL);
emit_action(n,f); emit_action(n,f);
Printv(f->code, tab4, "gh_allow_ints();\n", NIL); if (!use_scm_interface)
Printv(f->code, tab4, "gh_allow_ints();\n", NIL);
// Now have return value, figure out what to do with it. // Now have return value, figure out what to do with it.
@ -711,6 +727,10 @@ public:
Replaceall(tm,"$result","gswig_result"); Replaceall(tm,"$result","gswig_result");
Replaceall(tm,"$target","gswig_result"); Replaceall(tm,"$target","gswig_result");
Replaceall(tm,"$source","result"); Replaceall(tm,"$source","result");
if (Getattr(n, "feature:new"))
Replaceall(tm, "$owner", "1");
else
Replaceall(tm, "$owner", "0");
Printv(f->code,tm,"\n",NIL); Printv(f->code,tm,"\n",NIL);
} }
else { else {
@ -768,8 +788,13 @@ public:
Printv(f_wrappers, ");\n", NIL); Printv(f_wrappers, ");\n", NIL);
Printv(f_wrappers, "}\n", NIL); Printv(f_wrappers, "}\n", NIL);
/* Register it */ /* Register it */
Printf (f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s_rest, 0, 0, 1);\n", if (use_scm_interface) {
proc_name, wname, numreq, numargs-numreq); Printf(f_init, "scm_c_define_gsubr(\"%s\", 0, 0, 1, (swig_guile_proc) %s_rest);\n",
proc_name, wname);
} else {
Printf (f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s_rest, 0, 0, 1);\n",
proc_name, wname, numreq, numargs-numreq);
}
} }
else if (emit_setters && struct_member && strlen(Char(proc_name))>3) { else if (emit_setters && struct_member && strlen(Char(proc_name))>3) {
int len = Len(proc_name); int len = Len(proc_name);
@ -781,8 +806,13 @@ public:
struct_member = 2; /* have a setter */ struct_member = 2; /* have a setter */
} }
else Printf(f_init, "SCM getter = "); else Printf(f_init, "SCM getter = ");
if (use_scm_interface) {
Printf(f_init, "scm_c_define_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
proc_name, numreq, numargs-numreq, wname);
} else {
Printf (f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s, %d, %d, 0);\n", Printf (f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s, %d, %d, 0);\n",
proc_name, wname, numreq, numargs-numreq); proc_name, wname, numreq, numargs-numreq);
}
if (!is_setter) { if (!is_setter) {
/* Strip off "-get" */ /* Strip off "-get" */
char *pws_name = (char*) malloc(sizeof(char) * (len - 3)); char *pws_name = (char*) malloc(sizeof(char) * (len - 3));
@ -790,13 +820,23 @@ public:
pws_name[len - 4] = 0; pws_name[len - 4] = 0;
if (struct_member==2) { if (struct_member==2) {
/* There was a setter, so create a procedure with setter */ /* There was a setter, so create a procedure with setter */
Printf (f_init, "gh_define(\"%s\", " if (use_scm_interface) {
Printf(f_init, "scm_c_define");
} else {
Printf(f_init, "gh_define");
}
Printf (f_init, "(\"%s\", "
"scm_make_procedure_with_setter(getter, setter));\n", "scm_make_procedure_with_setter(getter, setter));\n",
pws_name); pws_name);
} }
else { else {
/* There was no setter, so make an alias to the getter */ /* There was no setter, so make an alias to the getter */
Printf (f_init, "gh_define(\"%s\", getter);\n", if (use_scm_interface) {
Printf(f_init, "scm_c_define");
} else {
Printf(f_init, "gh_define");
}
Printf (f_init, "(\"%s\", getter);\n",
pws_name); pws_name);
} }
Printf (exported_symbols, "\"%s\", ", pws_name); Printf (exported_symbols, "\"%s\", ", pws_name);
@ -805,8 +845,17 @@ public:
} }
else { else {
/* Register the function */ /* Register the function */
if (use_scm_interface) {
if (exporting_destructor) {
Printf(f_init, "SWIG_TypeClientData(SWIGTYPE%s, (void *) %s);\n", swigtype_ptr, wname);
} else {
Printf(f_init, "scm_c_define_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
proc_name, numreq, numargs-numreq, wname);
}
} else {
Printf (f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s, %d, %d, 0);\n", Printf (f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s, %d, %d, 0);\n",
proc_name, wname, numreq, numargs-numreq); proc_name, wname, numreq, numargs-numreq);
}
} }
} }
else { /* overloaded function; don't export the single methods */ else { /* overloaded function; don't export the single methods */
@ -832,8 +881,13 @@ public:
Printf(df->code,"scm_misc_error(\"%s\", \"No matching method for generic function `%s'\", SCM_EOL);\n", proc_name, iname); Printf(df->code,"scm_misc_error(\"%s\", \"No matching method for generic function `%s'\", SCM_EOL);\n", proc_name, iname);
Printv(df->code,"}\n",NIL); Printv(df->code,"}\n",NIL);
Wrapper_print(df,f_wrappers); Wrapper_print(df,f_wrappers);
Printf(f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s, 0, 0, 1);\n", if (use_scm_interface) {
Printf(f_init, "scm_c_define_gsubr(\"%s\", 0, 0, 1, (swig_guile_proc) %s);\n",
proc_name, dname);
} else {
Printf(f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s, 0, 0, 1);\n",
proc_name, dname); proc_name, dname);
}
DelWrapper(df); DelWrapper(df);
Delete(dispatch); Delete(dispatch);
Delete(dname); Delete(dname);
@ -919,7 +973,7 @@ public:
if (!Getattr(n,"feature:immutable")) { if (!Getattr(n,"feature:immutable")) {
/* Check for a setting of the variable value */ /* Check for a setting of the variable value */
Printf (f->code, "if (s_0 != GH_NOT_PASSED) {\n"); Printf (f->code, "if (s_0 != SCM_UNDEFINED) {\n");
if ((tm = Swig_typemap_lookup_new("varin",n,name,0))) { if ((tm = Swig_typemap_lookup_new("varin",n,name,0))) {
Replaceall(tm,"$source","s_0"); Replaceall(tm,"$source","s_0");
Replaceall(tm,"$input","s_0"); Replaceall(tm,"$input","s_0");
@ -957,14 +1011,26 @@ public:
/* Read-only variables become a simple procedure returning the /* Read-only variables become a simple procedure returning the
value; read-write variables become a simple procedure with value; read-write variables become a simple procedure with
an optional argument. */ an optional argument. */
Printf (f_init, "\t gh_new_procedure(\"%s\", (swig_guile_proc) %s, 0, %d, 0);\n", if (use_scm_interface) {
Printf(f_init, "scm_c_define_gsubr(\"%s\", 0, %d, 0, (swig_guile_proc) %s);\n",
proc_name, Getattr(n, "feature:immutable") ? 0 : 1, var_name);
} else {
Printf (f_init, "\t gh_new_procedure(\"%s\", (swig_guile_proc) %s, 0, %d, 0);\n",
proc_name, var_name, Getattr(n,"feature:immutable") ? 0 : 1); proc_name, var_name, Getattr(n,"feature:immutable") ? 0 : 1);
}
} }
else { else {
/* Read/write variables become a procedure with setter. */ /* Read/write variables become a procedure with setter. */
Printf (f_init, "\t{ SCM p = gh_new_procedure(\"%s\", (swig_guile_proc) %s, 0, 1, 0);\n", if (use_scm_interface) {
Printf(f_init, "{ SCM p = scm_c_define_gsubr(\"%s\", 0, 1, 0, (swig_guile_proc %s);\n",
proc_name, var_name);
Printf(f_init, "scm_c_define");
} else {
Printf (f_init, "\t{ SCM p = gh_new_procedure(\"%s\", (swig_guile_proc) %s, 0, 1, 0);\n",
proc_name, var_name); proc_name, var_name);
Printf (f_init, "\t gh_define(\"%s\", " Printf(f_init, "gh_define");
}
Printf (f_init, "(\"%s\", "
"scm_make_procedure_with_setter(p, p)); }\n", "scm_make_procedure_with_setter(p, p)); }\n",
proc_name); proc_name);
} }
@ -1164,6 +1230,28 @@ public:
return Language::pragmaDirective(n); return Language::pragmaDirective(n);
} }
/* ------------------------------------------------------------
* destructorHandler()
* ------------------------------------------------------------ */
virtual int destructorHandler(Node *n) {
exporting_destructor = true;
Language::destructorHandler(n);
exporting_destructor = false;
return SWIG_OK;
}
virtual int classHandler(Node *n) {
SwigType *t = NewStringf("p.%s", Getattr(n, "name"));
swigtype_ptr = SwigType_manglestr(t);
Delete(t);
Language::classHandler(n);
Delete(swigtype_ptr);
swigtype_ptr = 0;
return SWIG_OK;
}
/* ------------------------------------------------------------ /* ------------------------------------------------------------
* validIdentifier() * validIdentifier()
* ------------------------------------------------------------ */ * ------------------------------------------------------------ */