diff --git a/CHANGES.current b/CHANGES.current index 746127734..bb65f10ac 100644 --- a/CHANGES.current +++ b/CHANGES.current @@ -1,5 +1,35 @@ Version 1.3.20 (In progress) ============================ + +06/03/2003: mkoeppe + [Guile] Applied Guile module updates contributed by + John Lenz . + + - 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 Refinement to default typemap matching and arrays. When an array is declared like this: diff --git a/Doc/Manual/Guile.html b/Doc/Manual/Guile.html index 3bd2e9f96..be227d995 100644 --- a/Doc/Manual/Guile.html +++ b/Doc/Manual/Guile.html @@ -11,21 +11,28 @@ @@ -44,7 +51,56 @@ There are three different concepts of "module" involved, defined separately for SWIG, Guile, and Libtool. To avoid horrible confusion, we explicitly prefix the context, e.g., "guile-module". -

14.2 Linkage

+

14.2 Using the SCM or GH Guile API

+ +

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. +make runtime will now produce two libraries, libguilegh and libguilescm containing the +runtime code using the two different guile API's.

+ +

The GH interface to guile is deprecated. Read more about why in the +Guile manual. +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

+ +
+
+#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 
+...
+
+ +

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.

+ +

14.3 Linkage

@@ -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 policies implementing a usage convention is called a linkage. -

14.2.1 Simple Linkage

+

14.3.1 Simple Linkage

The default linkage is the simplest; nothing special is done. In this @@ -127,7 +183,7 @@ placed between the define-module form and the SWIG_init via a preprocessor define to avoid symbol clashes. For this case, however, passive linkage is available. -

14.2.2 Passive Linkage

+

14.3.2 Passive Linkage

Passive linkage is just like simple linkage, but it generates an @@ -137,7 +193,7 @@ package name (see below).

You should use passive linkage rather than simple linkage when you are using multiple modules. -

14.2.3 Native Guile Module Linkage

+

14.3.3 Native Guile Module Linkage

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: -

14.2.4 Old Auto-Loading Guile Module Linkage

+

14.3.4 Old Auto-Loading Guile Module Linkage

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. -

14.2.5 Hobbit4D Linkage

+

14.3.5 Hobbit4D Linkage

@@ -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. -

14.2.6 General Remarks on Multiple SWIG Modules

+

14.3.6 General Remarks on Multiple SWIG Modules

If you want to use multiple SWIG modules, they have to share some @@ -241,13 +297,13 @@ with the C compiler switch -DSWIG_GLOBAL.
  • Or generate all wrapper modules with the -c command-line argument and compile all wrapper files with the C compiler switch -DSWIG_GLOBAL. Then link against the -runtime library libswigguile, which is built by +runtime library libswigguile or libswigguilescm, which is built by make runtime. The needed linker flags are reported by SWIG if you invoke it with the -guile -ldflags command-line arguments. -

    14.3 Underscore Folding

    +

    14.4 Underscore Folding

    @@ -261,7 +317,7 @@ complained so far. %rename to specify the Guile name of the wrapped functions and variables (see CHANGES). -

    14.4 Typemaps

    +

    14.5 Typemaps

    @@ -273,8 +329,8 @@ information is read from Lib/guile/typemaps.i. Some non-standard typemap substitutions are supported:

    A function returning void (more precisely, a function -whose out typemap returns GH_UNSPECIFIED) is +whose out typemap returns SCM_UNSPECIFIED) is treated as returning no values. In argout typemaps, one can use the macro GUILE_APPEND_RESULT in order to append a value to the list of function return values. @@ -326,13 +382,27 @@ In body, the first result of See also the "multivalue" example. -

    14.5 Smobs

    - - - +

    14.6 Smobs

    -For pointer types, SWIG uses Guile smobs. +For pointer types, SWIG uses Guile smobs. SWIG smobs print +like this: #<swig struct xyzzy * 0x1234affe> Two of +them are equal? if and only if they have the same type +and value. + +

    +To construct a Scheme object from a C pointer, the wrapper code calls +the function SWIG_NewPointerObj(), 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 SWIG_ConvertPtr(), passing a pointer to a struct +representing the expected pointer type. See also +Section 8.8 The run-time type checker. +If the Scheme object passed was not a SWIG smob representing a compatible +pointer, a wrong-type-arg exception is raised. + +

    14.6.1 GH Smobs

    In earlier versions of SWIG, C pointers were represented as Scheme @@ -348,25 +418,117 @@ available. SWIG_Guile_Init() registers a smob type named "swig" with Guile; its type tag is stored in the variable swig_tag. 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 -are appended. The CDR stores the pointer value. SWIG smobs print -like this: #<swig struct xyzzy * 0x1234affe> Two of -them are equal? if and only if they have the same type -and value. +are appended. The CDR stores the pointer value. -

    -To construct a Scheme object from a C pointer, the wrapper code calls -the function SWIG_Guile_MakePtr(), 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. +

    14.6.2 SCM Smobs

    -

    -To get the pointer represented by a smob, the wrapper code calls the -function SWIG_Guile_GetPtr, passing a pointer to a struct -representing the expected pointer type. If the -Scheme object passed was not a SWIG smob representing a compatible -pointer, a wrong-type-arg exception is raised. +

    The SCM interface (using the "-scm" argument to swig) uses common.swg. +The whole type system, when it is first initialized, creates two smobs named "swig" and "collected_swig". +The swig smob is used for non-garbage collected smobs, while the collected_swig smob is used as described +below. Each smob has the same format, which is a double cell created by SCM_NEWSMOB2() +The first word of data is the pointer to the object and the second word of data is the swig_type_info * +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.

    -

    14.6 Exception Handling

    + +

    14.6.3 Garbage Collection

    + +

    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 >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 +Section 9.2 Object ownership and %newobject in the SWIG manual. All typemaps use an $owner var, and +the guile module replaces $owner with 0 or 1 depending on feature:new.

    + + + +

    14.7 Exception Handling

    @@ -392,7 +554,7 @@ mapping: The default when not specified here is to use "swig-error". See Lib/exception.i for details. -

    14.7 Procedure documentation

    +

    14.8 Procedure documentation

    @@ -429,7 +591,7 @@ typemaps indoc, outdoc, varoutdoc. See Lib/guile/typemaps.i for details. -

    14.8 Procedures with setters

    +

    14.9 Procedures with setters

    @@ -453,4 +615,4 @@ is created, so you can use (struct-member value) to set it. - \ No newline at end of file + diff --git a/Examples/Makefile.in b/Examples/Makefile.in index ee261dbc9..d92ff076d 100644 --- a/Examples/Makefile.in +++ b/Examples/Makefile.in @@ -338,6 +338,36 @@ guile_cpp: $(SRCS) $(CXX) -c $(CCSHARED) $(CFLAGS) $(INCLUDES) $(GUILE_INCLUDE) $(ICXXSRCS) $(SRCS) $(CXXSRCS) $(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 # ----------------------------------------------------------------- diff --git a/Examples/test-suite/pointer_reference.i b/Examples/test-suite/pointer_reference.i index 5d233e5a7..e070dcabf 100644 --- a/Examples/test-suite/pointer_reference.i +++ b/Examples/test-suite/pointer_reference.i @@ -8,8 +8,9 @@ #ifdef SWIGGUILE /* A silly testing typemap for feeding a doubly indirect integer */ -%typemap(in) int *&XYZZY (int temp1, int *temp2) - "temp1 = gh_scm2int($input); temp2 = &temp1; $1 = &temp2;"; +%typemap(in) int *&XYZZY (int temp1, int *temp2) { + temp1 = gh_scm2int($input); temp2 = &temp1; $1 = &temp2; +}; #endif %inline %{ diff --git a/Lib/guile/ghinterface.i b/Lib/guile/ghinterface.i new file mode 100644 index 000000000..cbe2f39da --- /dev/null +++ b/Lib/guile/ghinterface.i @@ -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 diff --git a/Lib/guile/guile.i b/Lib/guile/guile.i index 601013474..ebd100208 100644 --- a/Lib/guile/guile.i +++ b/Lib/guile/guile.i @@ -1,13 +1,4 @@ -/* 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 +/* SWIG Configuration File for Guile. -*-c-*-*/ /* Macro for inserting Scheme code into the stub */ #define %scheme %insert("scheme") @@ -32,20 +23,6 @@ %pragma(guile) return_multi_doc = "Returns $num_values values: $values." %enddef -/* The following definitions are supposed to provide a common API for - 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) +#define GUILE_APPEND_RESULT SWIG_APPEND_VALUE -/* Read in standard typemaps. */ %include "typemaps.i" diff --git a/Lib/guile/guile_gh.swg b/Lib/guile/guile_gh.swg new file mode 100644 index 000000000..ddc394c19 --- /dev/null +++ b/Lib/guile/guile_gh.swg @@ -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; + } +%} diff --git a/Lib/guile/guile.swg b/Lib/guile/guile_gh_run.swg similarity index 67% rename from Lib/guile/guile.swg rename to Lib/guile/guile_gh_run.swg index b48799309..29a217468 100644 --- a/Lib/guile/guile.swg +++ b/Lib/guile/guile_gh_run.swg @@ -1,10 +1,161 @@ /* -*- 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 +#include +#include + +#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 */ #ifdef __cplusplus @@ -318,3 +469,5 @@ SWIG_Guile_GetArgs (SCM *dest, SCM rest, #endif /* guile.swg ends here */ + +#endif diff --git a/Lib/guile/guile_scm.swg b/Lib/guile/guile_scm.swg new file mode 100644 index 000000000..8b37ccc12 --- /dev/null +++ b/Lib/guile/guile_scm.swg @@ -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(); +%} diff --git a/Lib/guile/guile_scm_run.swg b/Lib/guile/guile_scm_run.swg new file mode 100644 index 000000000..93fc0cd26 --- /dev/null +++ b/Lib/guile/guile_scm_run.swg @@ -0,0 +1,220 @@ +/* -*- c -*- + * ----------------------------------------------------------------------- + * swig_lib/guile/guile_scm_run.swg + * + * Author: John Lenz + * ----------------------------------------------------------------------- */ + +#include +#include +#include +#include + +#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 *) "#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 *) "#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 -#include -#include - -#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 */ diff --git a/Lib/guile/list-vector.i b/Lib/guile/list-vector.i index 286f9da34..82ab47a66 100644 --- a/Lib/guile/list-vector.i +++ b/Lib/guile/list-vector.i @@ -66,7 +66,7 @@ $1 = gh_vector_length($input); if ($1 > 0) { $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++) { SCM swig_scm_value = gh_vector_ref($input, gh_int2scm(i)); $2[i] = SCM_TO_C_EXPR; @@ -84,7 +84,7 @@ if ($1 > 0) { $1_ltype i; SCM rest; - $2 = SWIG_malloc(sizeof(C_TYPE) * $1); + $2 = (C_TYPE *) SWIG_malloc(sizeof(C_TYPE) * $1); for (i = 0, rest = $input; i<$1; 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); if (*_global_vector_length > 0) { int i; - $1 = SWIG_malloc(sizeof(C_TYPE) + $1 = (C_TYPE *) SWIG_malloc(sizeof(C_TYPE) * (*_global_vector_length)); for (i = 0; i<*_global_vector_length; 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) { int i; SCM rest; - $1 = SWIG_malloc(sizeof(C_TYPE) + $1 = (C_TYPE *) SWIG_malloc(sizeof(C_TYPE) * (*_global_list_length)); for (i = 0, rest = $input; i<*_global_list_length; diff --git a/Lib/guile/pointer-in-out.i b/Lib/guile/pointer-in-out.i index 160cfa5e9..ed8726467 100644 --- a/Lib/guile/pointer-in-out.i +++ b/Lib/guile/pointer-in-out.i @@ -36,7 +36,7 @@ %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); } $1 = &temp; @@ -46,7 +46,7 @@ "$1 = &temp;"; %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(argout) PTRTYPE *BOTH = PTRTYPE *OUTPUT; @@ -57,12 +57,12 @@ SCM_TYPE to the standard pointer typemaps */ %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); } %typemap(out, doc="<" #SCM_TYPE ">") PTRTYPE { - $result = SWIG_Guile_MakePtr ($1, $descriptor); + $result = SWIG_NewPointerObj ($1, $descriptor, $owner); } %enddef diff --git a/Lib/guile/std_common.i b/Lib/guile/std_common.i index dc7f8fef5..088a6da53 100644 --- a/Lib/guile/std_common.i +++ b/Lib/guile/std_common.i @@ -5,22 +5,17 @@ // // Guile implementation +#define SWIG_bool2scm(b) gh_bool2scm(b ? 1 : 0) +#define SWIG_string2scm(s) gh_str02scm(s.c_str()) + %{ #include -SCM SWIG_bool2scm(bool b) { - int i = b ? 1 : 0; - return gh_bool2scm(i); -} -std::string SWIG_scm2string(SCM x) { +inline std::string SWIG_scm2string(SCM x) { char* temp; - std::string s; - temp = gh_scm2newstr(x, NULL); - s = std::string(temp); - if (temp) scm_must_free(temp); + temp = SWIG_scm2str(x); + std::string s(temp); + if (temp) SWIG_free(temp); return s; } -SCM SWIG_string2scm(const std::string& s) { - return gh_str02scm(s.c_str()); -} %} diff --git a/Lib/guile/std_map.i b/Lib/guile/std_map.i index 55fe10824..ab6cdf274 100644 --- a/Lib/guile/std_map.i +++ b/Lib/guile/std_map.i @@ -74,20 +74,20 @@ namespace std { SWIG_exception(SWIG_TypeError,"alist expected"); key = gh_car(entry); val = gh_cdr(entry); - k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum); - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) != 0) { + k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum, 0); + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) != 0) { if (!gh_pair_p(val)) SWIG_exception(SWIG_TypeError,"alist expected"); 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; alist = gh_cdr(alist); } } else { $1 = *(($&1_type) - SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); + SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0)); } } %typemap(in) const map& (std::map temp, @@ -110,19 +110,19 @@ namespace std { SWIG_exception(SWIG_TypeError,"alist expected"); key = gh_car(entry); val = gh_cdr(entry); - k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum); - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) != 0) { + k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum, 0); + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) != 0) { if (!gh_pair_p(val)) SWIG_exception(SWIG_TypeError,"alist expected"); val = gh_car(val); - x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum); + x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum, 0); } temp[*k] = *x; alist = gh_cdr(alist); } } else { - $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum); + $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0); } } %typemap(out) map { @@ -131,8 +131,8 @@ namespace std { i!=$1.rend(); ++i) { K* key = new K(i->first); T* val = new T(i->second); - SCM k = SWIG_MakePtr(key,$descriptor(K *)); - SCM x = SWIG_MakePtr(val,$descriptor(T *)); + SCM k = SWIG_NewPointerObj(key,$descriptor(K *), 1); + SCM x = SWIG_NewPointerObj(val,$descriptor(T *), 1); SCM entry = gh_cons(k,x); alist = gh_cons(entry,alist); } @@ -151,17 +151,17 @@ namespace std { if (gh_pair_p(head)) { SCM key = gh_car(head); SCM val = gh_cdr(head); - if (SWIG_GetPtr(key,(void**) &k, - $descriptor(K *)) != 0) { + if (SWIG_ConvertPtr(key,(void**) &k, + $descriptor(K *), 0) != 0) { $1 = 0; } else { - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) == 0) { + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) == 0) { $1 = 1; } else if (gh_pair_p(val)) { val = gh_car(val); - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) == 0) + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) == 0) $1 = 1; else $1 = 0; @@ -175,8 +175,8 @@ namespace std { } else { /* wrapped map? */ std::map* m; - if (SWIG_GetPtr($input,(void **) &m, - $&1_descriptor) == 0) + if (SWIG_ConvertPtr($input,(void **) &m, + $&1_descriptor, 0) == 0) $1 = 1; else $1 = 0; @@ -196,17 +196,17 @@ namespace std { if (gh_pair_p(head)) { SCM key = gh_car(head); SCM val = gh_cdr(head); - if (SWIG_GetPtr(key,(void**) &k, - $descriptor(K *)) != 0) { + if (SWIG_ConvertPtr(key,(void**) &k, + $descriptor(K *), 0) != 0) { $1 = 0; } else { - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) == 0) { + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) == 0) { $1 = 1; } else if (gh_pair_p(val)) { val = gh_car(val); - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) == 0) + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) == 0) $1 = 1; else $1 = 0; @@ -220,8 +220,8 @@ namespace std { } else { /* wrapped map? */ std::map* m; - if (SWIG_GetPtr($input,(void **) &m, - $1_descriptor) == 0) + if (SWIG_ConvertPtr($input,(void **) &m, + $1_descriptor, 0) == 0) $1 = 1; else $1 = 0; @@ -268,7 +268,7 @@ namespace std { for (std::map::reverse_iterator i=$1.rbegin(); i!=$1.rend(); ++i) { 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); } return result; @@ -299,19 +299,19 @@ namespace std { if (!CHECK(key)) SWIG_exception(SWIG_TypeError, "map<" #K "," #T "> expected"); - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) != 0) { + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) != 0) { if (!gh_pair_p(val)) SWIG_exception(SWIG_TypeError,"alist expected"); 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; alist = gh_cdr(alist); } } else { $1 = *(($&1_type) - SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); + SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0)); } } %typemap(in) const map& (std::map temp, @@ -336,18 +336,18 @@ namespace std { if (!CHECK(key)) SWIG_exception(SWIG_TypeError, "map<" #K "," #T "> expected"); - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) != 0) { + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) != 0) { if (!gh_pair_p(val)) SWIG_exception(SWIG_TypeError,"alist expected"); 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; alist = gh_cdr(alist); } } else { - $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum); + $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0); } } %typemap(out) map { @@ -356,7 +356,7 @@ namespace std { i!=$1.rend(); ++i) { T* val = new T(i->second); 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); alist = gh_cons(entry,alist); } @@ -377,13 +377,13 @@ namespace std { if (!CHECK(key)) { $1 = 0; } else { - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) == 0) { + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) == 0) { $1 = 1; } else if (gh_pair_p(val)) { val = gh_car(val); - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) == 0) + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) == 0) $1 = 1; else $1 = 0; @@ -397,8 +397,8 @@ namespace std { } else { // wrapped map? std::map* m; - if (SWIG_GetPtr($input,(void **) &m, - $&1_descriptor) == 0) + if (SWIG_ConvertPtr($input,(void **) &m, + $&1_descriptor, 0) == 0) $1 = 1; else $1 = 0; @@ -420,13 +420,13 @@ namespace std { if (!CHECK(key)) { $1 = 0; } else { - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) == 0) { + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) == 0) { $1 = 1; } else if (gh_pair_p(val)) { val = gh_car(val); - if (SWIG_GetPtr(val,(void**) &x, - $descriptor(T *)) == 0) + if (SWIG_ConvertPtr(val,(void**) &x, + $descriptor(T *), 0) == 0) $1 = 1; else $1 = 0; @@ -440,8 +440,8 @@ namespace std { } else { // wrapped map? std::map* m; - if (SWIG_GetPtr($input,(void **) &m, - $1_descriptor) == 0) + if (SWIG_ConvertPtr($input,(void **) &m, + $1_descriptor, 0) == 0) $1 = 1; else $1 = 0; @@ -512,7 +512,7 @@ namespace std { SWIG_exception(SWIG_TypeError,"alist expected"); key = gh_car(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 (!gh_pair_p(val)) SWIG_exception(SWIG_TypeError,"alist expected"); @@ -526,7 +526,7 @@ namespace std { } } else { $1 = *(($&1_type) - SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); + SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0)); } } %typemap(in) const map& (std::map temp, @@ -548,7 +548,7 @@ namespace std { SWIG_exception(SWIG_TypeError,"alist expected"); key = gh_car(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 (!gh_pair_p(val)) SWIG_exception(SWIG_TypeError,"alist expected"); @@ -561,7 +561,7 @@ namespace std { alist = gh_cdr(alist); } } else { - $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum); + $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0); } } %typemap(out) map { @@ -569,7 +569,7 @@ namespace std { for (std::map::reverse_iterator i=$1.rbegin(); i!=$1.rend(); ++i) { 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 entry = gh_cons(k,x); alist = gh_cons(entry,alist); @@ -588,8 +588,8 @@ namespace std { if (gh_pair_p(head)) { SCM key = gh_car(head); SCM val = gh_cdr(head); - if (SWIG_GetPtr(val,(void **) &k, - $descriptor(K *)) != 0) { + if (SWIG_ConvertPtr(val,(void **) &k, + $descriptor(K *), 0) != 0) { $1 = 0; } else { if (CHECK(val)) { @@ -610,8 +610,8 @@ namespace std { } else { // wrapped map? std::map* m; - if (SWIG_GetPtr($input,(void **) &m, - $&1_descriptor) == 0) + if (SWIG_ConvertPtr($input,(void **) &m, + $&1_descriptor, 0) == 0) $1 = 1; else $1 = 0; @@ -630,8 +630,8 @@ namespace std { if (gh_pair_p(head)) { SCM key = gh_car(head); SCM val = gh_cdr(head); - if (SWIG_GetPtr(val,(void **) &k, - $descriptor(K *)) != 0) { + if (SWIG_ConvertPtr(val,(void **) &k, + $descriptor(K *), 0) != 0) { $1 = 0; } else { if (CHECK(val)) { @@ -652,8 +652,8 @@ namespace std { } else { // wrapped map? std::map* m; - if (SWIG_GetPtr($input,(void **) &m, - $1_descriptor) == 0) + if (SWIG_ConvertPtr($input,(void **) &m, + $1_descriptor, 0) == 0) $1 = 1; else $1 = 0; @@ -700,7 +700,7 @@ namespace std { for (std::map::reverse_iterator i=$1.rbegin(); i!=$1.rend(); ++i) { 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); } return result; @@ -742,7 +742,7 @@ namespace std { } } else { $1 = *(($&1_type) - SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); + SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0)); } } %typemap(in) const map& (std::map temp, @@ -778,7 +778,7 @@ namespace std { alist = gh_cdr(alist); } } else { - $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum); + $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0); } } %typemap(out) map { @@ -824,8 +824,8 @@ namespace std { } else { // wrapped map? std::map* m; - if (SWIG_GetPtr($input,(void **) &m, - $&1_descriptor) == 0) + if (SWIG_ConvertPtr($input,(void **) &m, + $&1_descriptor, 0) == 0) $1 = 1; else $1 = 0; @@ -864,8 +864,8 @@ namespace std { } else { // wrapped map? std::map* m; - if (SWIG_GetPtr($input,(void **) &m, - $1_descriptor) == 0) + if (SWIG_ConvertPtr($input,(void **) &m, + $1_descriptor, 0) == 0) $1 = 1; else $1 = 0; diff --git a/Lib/guile/std_string.i b/Lib/guile/std_string.i index acb817852..e30b0fdda 100644 --- a/Lib/guile/std_string.i +++ b/Lib/guile/std_string.i @@ -27,9 +27,9 @@ namespace std { %typemap(in) string (char* tempptr) { if (gh_string_p($input)) { - tempptr = gh_scm2newstr($input, NULL); + tempptr = SWIG_scm2str($input); $1 = std::string(tempptr); - if (tempptr) scm_must_free(tempptr); + if (tempptr) SWIG_free(tempptr); } else { SWIG_exception(SWIG_TypeError, "string expected"); } @@ -38,9 +38,9 @@ namespace std { %typemap(in) const string & (std::string temp, char* tempptr) { if (gh_string_p($input)) { - tempptr = gh_scm2newstr($input, NULL); + tempptr = SWIG_scm2str($input); temp = std::string(tempptr); - if (tempptr) scm_must_free(tempptr); + if (tempptr) SWIG_free(tempptr); $1 = &temp; } else { SWIG_exception(SWIG_TypeError, "string expected"); diff --git a/Lib/guile/std_vector.i b/Lib/guile/std_vector.i index fc8c82bd1..96e770be8 100644 --- a/Lib/guile/std_vector.i +++ b/Lib/guile/std_vector.i @@ -75,7 +75,7 @@ namespace std { for (unsigned long i=0; i(); @@ -86,13 +86,13 @@ namespace std { while (!gh_null_p(tail)) { head = gh_car(tail); tail = gh_cdr(tail); - $1.push_back(*((T*) SWIG_MustGetPtr(head, - $descriptor(T *), - $argnum))); + $1.push_back(*((T*)SWIG_MustGetPtr(head, + $descriptor(T *), + $argnum, 0))); } } else { $1 = *(($&1_type) - SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); + SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0)); } } %typemap(in) const vector& (std::vector temp), @@ -105,7 +105,7 @@ namespace std { SCM o = gh_vector_ref($input,gh_ulong2scm(i)); temp[i] = *((T*) SWIG_MustGetPtr(o, $descriptor(T *), - $argnum)); + $argnum, 0)); } } else if (gh_null_p($input)) { temp = std::vector(); @@ -120,10 +120,10 @@ namespace std { tail = gh_cdr(tail); temp.push_back(*((T*) SWIG_MustGetPtr(head, $descriptor(T *), - $argnum))); + $argnum, 0))); } } else { - $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum); + $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0); } } %typemap(out) vector { @@ -131,7 +131,7 @@ namespace std { for (unsigned int i=0; i<$1.size(); i++) { T* x = new T((($1_type &)$1)[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 { @@ -145,8 +145,8 @@ namespace std { /* check the first element only */ SCM o = gh_vector_ref($input,gh_ulong2scm(0)); T* x; - if (SWIG_GetPtr(o,(void**) &x, - $descriptor(T *)) == 0) + if (SWIG_ConvertPtr(o,(void**) &x, + $descriptor(T *), 0) != -1) $1 = 1; else $1 = 0; @@ -158,16 +158,16 @@ namespace std { /* check the first element only */ T* x; SCM head = gh_car($input); - if (SWIG_GetPtr(head,(void**) &x, - $descriptor(T *)) == 0) + if (SWIG_ConvertPtr(head,(void**) &x, + $descriptor(T *), 0) != -1) $1 = 1; else $1 = 0; } else { /* wrapped vector? */ std::vector* v; - if (SWIG_GetPtr($input,(void **) &v, - $&1_descriptor) == 0) + if (SWIG_ConvertPtr($input,(void **) &v, + $&1_descriptor, 0) != -1) $1 = 1; else $1 = 0; @@ -185,8 +185,8 @@ namespace std { /* check the first element only */ T* x; SCM o = gh_vector_ref($input,gh_ulong2scm(0)); - if (SWIG_GetPtr(o,(void**) &x, - $descriptor(T *)) == 0) + if (SWIG_ConvertPtr(o,(void**) &x, + $descriptor(T *), 0) != -1) $1 = 1; else $1 = 0; @@ -198,16 +198,16 @@ namespace std { /* check the first element only */ T* x; SCM head = gh_car($input); - if (SWIG_GetPtr(head,(void**) &x, - $descriptor(T *)) == 0) + if (SWIG_ConvertPtr(head,(void**) &x, + $descriptor(T *), 0) != -1) $1 = 1; else $1 = 0; } else { /* wrapped vector? */ std::vector* v; - if (SWIG_GetPtr($input,(void **) &v, - $1_descriptor) == 0) + if (SWIG_ConvertPtr($input,(void **) &v, + $1_descriptor, 0) != -1) $1 = 1; else $1 = 0; @@ -282,7 +282,7 @@ namespace std { } } else { $1 = *(($&1_type) - SWIG_MustGetPtr($input,$&1_descriptor,$argnum)); + SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0)); } } %typemap(in) const vector& (std::vector temp), @@ -314,8 +314,7 @@ namespace std { scm_wrong_type_arg(FUNC_NAME, $argnum, $input); } } else { - $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor, - $argnum); + $1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0); } } %typemap(out) vector { @@ -349,8 +348,8 @@ namespace std { } else { /* wrapped vector? */ std::vector* v; - $1 = (SWIG_GetPtr($input,(void **) &v, - $&1_descriptor) == 0) ? 1 : 0; + $1 = (SWIG_ConvertPtr($input,(void **) &v, + $&1_descriptor, 0) != -1) ? 1 : 0; } } %typecheck(SWIG_TYPECHECK_VECTOR) const vector&, @@ -378,8 +377,8 @@ namespace std { } else { /* wrapped vector? */ std::vector* v; - $1 = (SWIG_GetPtr($input,(void **) &v, - $1_descriptor) == 0) ? 1 : 0; + $1 = (SWIG_ConvertPtr($input,(void **) &v, + $1_descriptor, 0) != -1) ? 1 : 0; } } public: @@ -428,12 +427,9 @@ namespace std { 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 long,gh_number_p,gh_scm2ulong,gh_ulong2scm); - specialize_stl_vector(unsigned short,gh_number_p, - gh_scm2ulong,gh_ulong2scm); + specialize_stl_vector(unsigned short,gh_number_p,gh_scm2ulong,gh_ulong2scm); 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(std::string,gh_string_p, - SWIG_scm2string,SWIG_string2scm); - + specialize_stl_vector(std::string,gh_string_p,SWIG_scm2string,SWIG_string2scm); } diff --git a/Lib/guile/typemaps.i b/Lib/guile/typemaps.i index ff68dd0c9..32c2181fb 100644 --- a/Lib/guile/typemaps.i +++ b/Lib/guile/typemaps.i @@ -30,51 +30,66 @@ /* Pointers */ -%typemap(in) SWIGTYPE * { - if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor)) - scm_wrong_type_arg(FUNC_NAME, $argnum, $input); +%typemap(in) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] { + $1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, 0); } %typemap(in) void * { - if (SWIG_Guile_GetPtr($input, (void **) &$1, NULL)) - scm_wrong_type_arg(FUNC_NAME, $argnum, $input); + $1 = SWIG_MustGetPtr($input, NULL, $argnum, 0); } %typemap(varin) SWIGTYPE * { - if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor)) - scm_wrong_type_arg(FUNC_NAME, 1, $input); + $1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, 0); +} + +%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 * { - if (SWIG_Guile_GetPtr($input, (void **) &$1, NULL)) - scm_wrong_type_arg(FUNC_NAME, 1, $input); + $1 = SWIG_MustGetPtr($input, NULL, 1, 0); } -%typemap(out) SWIGTYPE * { - $result = SWIG_Guile_MakePtr ($1, $descriptor); +%typemap(out) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] { + $result = SWIG_NewPointerObj ($1, $descriptor, $owner); } -%typemap(out) SWIGTYPE *DYNAMIC { - swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1); - $result = SWIG_Guile_MakePtr ($1, ty); +%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC { + swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1); + $result = SWIG_NewPointerObj ($1, ty, $owner); } -%typemap(varout) SWIGTYPE * { - $result = SWIG_Guile_MakePtr ($1, $descriptor); +%typemap(varout) SWIGTYPE *, SWIGTYPE [] { + $result = SWIG_NewPointerObj ($1, $descriptor, 0); +} + +%typemap(varout) SWIGTYPE & { + $result = SWIG_NewPointerObj((void *) &$1, $1_descriptor, 0); } /* Pass-by-value */ %typemap(in) SWIGTYPE($&1_ltype argp) { - if (SWIG_Guile_GetPtr($input, (void **) &argp, $&1_descriptor)) - scm_wrong_type_arg(FUNC_NAME,$argnum,$input); + argp = ($&1_ltype)SWIG_MustGetPtr($input, $&1_descriptor, $argnum, 0); $1 = *argp; } %typemap(varin) SWIGTYPE { $&1_ltype argp; - if (SWIG_Guile_GetPtr($input, (void **) &argp, $&1_descriptor)) - scm_wrong_type_arg(FUNC_NAME,1,$input); + argp = ($&1_ltype)SWIG_MustGetPtr($input, $&1_descriptor, 1, 0); $1 = *argp; } @@ -83,14 +98,14 @@ { $&1_ltype resultptr; resultptr = new $1_ltype(($1_ltype &) $1); - $result = SWIG_Guile_MakePtr (resultptr, $&1_descriptor); + $result = SWIG_NewPointerObj (resultptr, $&1_descriptor, 1); } #else { $&1_ltype resultptr; resultptr = ($&1_ltype) malloc(sizeof($1_type)); memmove(resultptr, &$1, sizeof($1_type)); - $result = SWIG_Guile_MakePtr(resultptr, $&1_descriptor); + $result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 1); } #endif @@ -99,54 +114,23 @@ { $&1_ltype resultptr; resultptr = new $1_ltype(($1_ltype&) $1); - $result = SWIG_Guile_MakePtr (resultptr, $&1_descriptor); + $result = SWIG_NewPointerObj (resultptr, $&1_descriptor, 0); } #else { $&1_ltype resultptr; resultptr = ($&1_ltype) malloc(sizeof($1_type)); memmove(resultptr, &$1, sizeof($1_type)); - $result = SWIG_Guile_MakePtr(resultptr, $&1_descriptor); + $result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 0); } #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 */ -%typemap(in) enum SWIGTYPE "$1 = gh_scm2int($input);"; -%typemap(varin) enum SWIGTYPE "$1 = ($1_type) gh_scm2int($input);"; -%typemap(out) enum SWIGTYPE "$result = gh_int2scm($1);"; -%typemap(varout) enum SWIGTYPE "$result = gh_int2scm($1);"; +%typemap(in) enum SWIGTYPE { $1 = gh_scm2int($input); } +%typemap(varin) enum SWIGTYPE { $1 = ($1_type) gh_scm2int($input); } +%typemap(out) 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 typemaps needed for simple types. @@ -208,17 +192,19 @@ C_NAME {$result = C_TO_SCM($1);} /* INPUT and OUTPUT */ %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; } - %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;} - %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));} %typemap (in) C_NAME *BOTH = C_NAME *INPUT; %typemap (argout) C_NAME *BOTH = C_NAME *OUTPUT; %typemap (in) C_NAME *INOUT = C_NAME *INPUT; %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 */ %typemap(in, doc="$NAME is of type <" #SCM_NAME ">") const C_NAME & (C_NAME temp) { temp = SCM_TO_C($input); @@ -232,6 +218,7 @@ SIMPLE_MAP(bool, gh_scm2bool, gh_bool2scm, boolean); SIMPLE_MAP(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(short, gh_scm2int, gh_int2scm, integer); SIMPLE_MAP(long, gh_scm2long, gh_long2scm, integer); @@ -267,12 +254,12 @@ %typemap (in) char * *INOUT = char * *INPUT; %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. */ -%typemap (freearg) char * "if (must_free$argnum && $1) scm_must_free($1);"; -%typemap (freearg) char **INPUT, char **BOTH "if (must_free$argnum && (*$1)) scm_must_free(*$1);" -%typemap (freearg) char **OUTPUT "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)) SWIG_free(*$1);" +%typemap (freearg) char **OUTPUT "SWIG_free(*$1);" /* But this shall not apply if we try to pass a single char by reference. */ @@ -288,7 +275,7 @@ /* Void */ -%typemap (out,doc="") void "gswig_result = GH_UNSPECIFIED;"; +%typemap (out,doc="") void "gswig_result = SCM_UNSPECIFIED;"; /* SCM is passed through */ @@ -353,17 +340,12 @@ typedef unsigned long SCM; %typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] { void *ptr; - $1 = !SWIG_Guile_GetPtr($input, &ptr, $1_descriptor); + $1 = !SWIG_ConvertPtr($input, &ptr, $1_descriptor, 0); } %typecheck(SWIG_TYPECHECK_VOIDPTR) void * { void *ptr; - $1 = !SWIG_Guile_GetPtr($input, &ptr, 0); + $1 = !SWIG_ConvertPtr($input, &ptr, 0, 0); } /* typemaps.i ends here */ - - - - - diff --git a/Makefile.in b/Makefile.in index 89fa903c0..fe0c42ed6 100644 --- a/Makefile.in +++ b/Makefile.in @@ -39,6 +39,7 @@ skip-perl = test -n "@SKIP_PERL5@" skip-python = test -n "@SKIP_PYTHON@" skip-java = test -n "@SKIP_JAVA@" skip-guile = test -n "@SKIP_GUILE@" +skip-guilescm = test -n "@SKIP_GUILE@" skip-mzscheme = test -n "@SKIP_MZSCHEME@" skip-ruby = test -n "@SKIP_RUBY@" skip-php4 = test -n "@SKIP_PHP4@" @@ -116,6 +117,7 @@ check-test-suite: \ check-python-test-suite \ check-java-test-suite \ check-guile-test-suite \ + check-guilescm-test-suite \ check-mzscheme-test-suite \ check-ruby-test-suite \ check-ocaml-test-suite \ diff --git a/README b/README index b2d27f20f..4956ed63d 100644 --- a/README +++ b/README @@ -36,6 +36,7 @@ Major contributors include: Loic Dachary (Perl5) Masaki Fukushima (Ruby) James Michael DuPont(mdupont777@yahoo.com) (C#/PNet Support with the original code from Neil Cawse) + John Lenz (Guile updates) Past contributors include: Clark McGrew, Dustin Mitchell, Ian Cooke, Catalin Dumitrescu, Baran diff --git a/Runtime/Makefile.am b/Runtime/Makefile.am index 7570d63b1..fdb2b6c3e 100644 --- a/Runtime/Makefile.am +++ b/Runtime/Makefile.am @@ -21,7 +21,7 @@ if !SKIP_PYTHON lib_LTLIBRARIES += libswigpy.la endif if !SKIP_GUILE -lib_LTLIBRARIES += libswigguile.la +lib_LTLIBRARIES += libswigguile.la libswigguilescm.la endif if !SKIP_RUBY lib_LTLIBRARIES += libswigrb.la @@ -87,15 +87,23 @@ libpy.c: $(SWIG_TYPECHECK) $(PYTHON_RUNTIME) # ---------------------------------------------------------------------- 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 = -libswigguile_la_SOURCES = libguile.c +libswigguile_la_SOURCES = libguile_gh.c libswigguile_la_LDFLAGS = -no-undefined $(RELEASE_SUFFIX_LIBTOOL) $(GUILE_DLNK) libswigguile_la_CFLAGS = -DSWIG_GLOBAL $(GUILE_INCLUDE) -libguile.c: $(GUILE_RUNTIME) - cat $(GUILE_RUNTIME) > libguile.c +libguile_gh.c: $(GUILE_GH_RUNTIME) + 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 diff --git a/Source/Modules/guile.cxx b/Source/Modules/guile.cxx index a6b53b536..7d2c24d8a 100644 --- a/Source/Modules/guile.cxx +++ b/Source/Modules/guile.cxx @@ -43,6 +43,8 @@ Guile Options (available with -guile)\n\ one of `guile-1.4', `plain', `texinfo'\n\ -scmstub file - Output Scheme FILE with module declaration and\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\ When unspecified, the default LSTYLE is `simple'. For native Guile\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 int use_scm_interface = 0; +static int exporting_destructor = 0; +static String *swigtype_ptr = 0; + class GUILE : public Language { public: @@ -97,7 +103,7 @@ public: virtual void main (int argc, char *argv[]) { int i, orig_len; - + SWIG_library_directory("guile"); SWIG_typemap_lang("guile"); @@ -192,6 +198,14 @@ public: 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 */ Preprocessor_define ("SWIGGUILE 1",0); /* 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(); } @@ -268,7 +285,6 @@ public: Printf (f_init, "static void\nSWIG_init (void)\n{\n"); break; } - Printf (f_init, "\tSWIG_Guile_Init();\n"); if (CPlusPlus) { Printf(f_runtime, "\n}\n"); } @@ -281,10 +297,8 @@ public: 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, "#ifdef __cplusplus\n}\n#endif\n"); char module_name[256]; if (!module) @@ -618,7 +632,7 @@ public: Printf(f->def,"SCM s_%d", i); } 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"))) { Replaceall(tm,"$source",source); @@ -701,9 +715,11 @@ public: Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL); // 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); - 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. @@ -711,6 +727,10 @@ public: Replaceall(tm,"$result","gswig_result"); Replaceall(tm,"$target","gswig_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); } else { @@ -768,8 +788,13 @@ public: Printv(f_wrappers, ");\n", NIL); Printv(f_wrappers, "}\n", NIL); /* Register it */ - Printf (f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s_rest, 0, 0, 1);\n", - proc_name, wname, numreq, numargs-numreq); + if (use_scm_interface) { + 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) { int len = Len(proc_name); @@ -781,8 +806,13 @@ public: struct_member = 2; /* have a setter */ } 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", proc_name, wname, numreq, numargs-numreq); + } if (!is_setter) { /* Strip off "-get" */ char *pws_name = (char*) malloc(sizeof(char) * (len - 3)); @@ -790,13 +820,23 @@ public: pws_name[len - 4] = 0; if (struct_member==2) { /* 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", pws_name); } else { /* 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); } Printf (exported_symbols, "\"%s\", ", pws_name); @@ -805,8 +845,17 @@ public: } else { /* 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", proc_name, wname, numreq, numargs-numreq); + } } } 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); Printv(df->code,"}\n",NIL); 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); + } DelWrapper(df); Delete(dispatch); Delete(dname); @@ -919,7 +973,7 @@ public: if (!Getattr(n,"feature:immutable")) { /* 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))) { Replaceall(tm,"$source","s_0"); Replaceall(tm,"$input","s_0"); @@ -957,14 +1011,26 @@ public: /* Read-only variables become a simple procedure returning the value; read-write variables become a simple procedure with 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); + } } else { /* 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); - Printf (f_init, "\t gh_define(\"%s\", " + Printf(f_init, "gh_define"); + } + Printf (f_init, "(\"%s\", " "scm_make_procedure_with_setter(p, p)); }\n", proc_name); } @@ -1164,6 +1230,28 @@ public: 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() * ------------------------------------------------------------ */