04/24/2004: mkoeppe (Matthias Koeppe)

[Guile] New runtime functions SWIG_PointerAddress,
	    SWIG_PointerType, SWIG_IsPointerOfType, SWIG_IsPointer.

	    [Guile] In -scm mode, wrap several SWIG runtime functions
	    and export them into the module (Swig swigrun).  The
	    runtime module is now built with "module" linkage.

	    [Guile] GOOPS proxy objects now also print the pointer
	    address of the C object.


git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@5912 626c5289-ae23-0410-ae9c-e8d60b6d4f22

Lib/guile/common.scm

@@ -5,13 +5,17 @@
 ;;;*     GOOPS file support
 ;;;*
 ;;;* Copyright (C) 2003 John Lenz (jelenz@wisc.edu)
+;;;* Copyright (C) 2004 Matthias Koeppe (mkoeppe@mail.math.uni-magdeburg.de)
 ;;;*
 ;;;* This file may be freely redistributed without license or fee provided
 ;;;* this copyright message remains intact.
 ;;;************************************************************************
 
-(define-module (Swig common))
+(define-module (Swig swigrun))
-(use-modules (oop goops))
+
+(define-module (Swig common)
+  #:use-module (oop goops)
+  #:use-module (Swig swigrun))
 
 (define-class <swig-metaclass> (<class>)
   (new-function #:init-value #f))
@@ -39,4 +43,27 @@
             (slot-ref ret 'swig-smob)
             ret))))))
 
+(define (display-address o file)
+  (display (number->string (object-address o) 16) file))
+
+(define (display-pointer-address o file)
+  (display (number->string (SWIG-PointerAddress o) 16) file))
+(define-method (write (o <swig>) file)
+  ;; We display _two_ addresses to show the object's identity:
+  ;;  * first the address of the GOOPS proxy object,
+  ;;  * second the pointer address.
+  ;; The reason is that proxy objects are created and discarded on the
+  ;; fly, so different proxy objects for the same C object will appear.
+  (let ((class (class-of o)))
+    (if (slot-bound? class 'name)
+	(begin
+	  (display "#<" file)
+	  (display (class-name class) file)
+	  (display #\space file)
+	  (display-address o file)
+	  (display " @ " file)
+	  (display-pointer-address o file)
+	  (display ">" file))
+	(next-method))))
+                                              
 (export <swig-metaclass> <swig>)

Lib/guile/guile_gh.swg

@@ -3,6 +3,8 @@
    with gh_ flavor.
 */
 
+#define SWIGGUILE_GH
+
 %runtime "guile_gh_run.swg"
 %include "guile.i"
 

Lib/guile/guile_scm.swg

@@ -3,8 +3,23 @@
    with SCM_ flavor.
 */
 
+#define SWIGGUILE_SCM
+
 %runtime "precommon.swg"
 %runtime "common.swg"
+
+#ifdef SWIG_RUNTIME_MODE
+/* Hook the runtime module initialization
+   into the shared initialization function SWIG_Guile_Init. */
+%runtime %{
+/* Hook the runtime module initialization
+   into the shared initialization function SWIG_Guile_Init. */
+#include <libguile.h>
+SCM scm_init_Swig_swigrun_module (void);
+#define SWIG_INIT_RUNTIME_MODULE scm_init_Swig_swigrun_module();
+%}
+#endif
+
 %runtime "guile_scm_run.swg"
 %include "ghinterface.i"
 %include "guile.i"

Lib/guile/guile_scm_run.swg

@@ -34,6 +34,14 @@ typedef struct swig_guile_clientdata {
   SWIG_Guile_MustGetPtr(s, type, argnum, flags, FUNC_NAME)
 #define SWIG_NewPointerObj(ptr, type, owner) \
   SWIG_Guile_NewPointerObj((void*)ptr, type, owner)
+#define SWIG_PointerAddress(object) \
+  SWIG_Guile_PointerAddress(object)
+#define SWIG_PointerType(object) \
+  SWIG_Guile_PointerType(object)
+#define SWIG_IsPointerOfType(object, type) \
+  SWIG_Guile_IsPointerOfType(object, type)
+#define SWIG_IsPointer(object) \
+  SWIG_Guile_IsPointer(object)
 #define SWIG_PropagateClientData(type) \
   SWIG_Guile_PropagateClientData(type)
 #define SWIG_contract_assert(expr, msg)				\
@@ -68,6 +76,15 @@ SWIG_Guile_MarkPointerNoncollectable(SCM s);
 /* Mark a pointer object destroyed */
 SWIGIMPORT(void)
 SWIG_Guile_MarkPointerDestroyed(SCM s);
+/* Access type and address of a pointer object. */
+SWIGIMPORT(unsigned long)
+SWIG_Guile_PointerAddress(SCM object);
+SWIGIMPORT(swig_type_info *)
+SWIG_Guile_PointerType(SCM object);
+SWIGIMPORT(int)
+SWIG_Guile_IsPointer(SCM object);
+SWIGIMPORT(int)
+SWIG_Guile_IsPointerOfType(SCM object, swig_type_info *type);
 
 #else
 
@@ -130,6 +147,32 @@ SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner)
   }
 }
 
+SWIGRUNTIME(unsigned long)
+SWIG_Guile_PointerAddress(SCM object)
+{
+  SCM smob = SWIG_Guile_GetSmob(object);
+  if (SCM_NULLP(smob)) return 0;
+  else if (SCM_SMOB_PREDICATE(swig_tag, smob)
+	   || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)
+	   || SCM_SMOB_PREDICATE(swig_destroyed_tag, smob)) {
+    return (unsigned long) (void *) SCM_CELL_WORD_1(smob);
+  }
+  else scm_wrong_type_arg("SWIG-Guile-PointerAddress", 1, object);
+}
+
+SWIGRUNTIME(swig_type_info *)
+SWIG_Guile_PointerType(SCM object)
+{
+  SCM smob = SWIG_Guile_GetSmob(object);
+  if (SCM_NULLP(smob)) return NULL;
+  else if (SCM_SMOB_PREDICATE(swig_tag, smob)
+	   || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)
+	   || SCM_SMOB_PREDICATE(swig_destroyed_tag, smob)) {
+    return (swig_type_info *) SCM_CELL_WORD_2(smob);
+  }
+  else scm_wrong_type_arg("SWIG-Guile-PointerType", 1, object);
+}
+  
 /* Return 0 if successful. */
 SWIGRUNTIME(int)
 SWIG_Guile_ConvertPtr(SCM s, void **result, swig_type_info *type, int flags)
@@ -173,6 +216,23 @@ SWIG_Guile_MustGetPtr (SCM s, swig_type_info *type,
   return result;
 }
 
+SWIGRUNTIME(int)
+SWIG_Guile_IsPointerOfType (SCM s, swig_type_info *type)
+{
+  void *result;
+  if (SWIG_Guile_ConvertPtr(s, &result, type, 0)) {
+    /* type mismatch */
+    return 0;
+  }
+  else return 1;
+}
+  
+SWIGRUNTIME(int)
+SWIG_Guile_IsPointer (SCM s)
+{
+  return SWIG_Guile_IsPointerOfType (s, NULL);
+}
+
 /* Mark a pointer object non-collectable */
 SWIGRUNTIME(void)
 SWIG_Guile_MarkPointerNoncollectable(SCM s)
@@ -264,29 +324,30 @@ free_swig(SCM A)
 SWIGRUNTIME(void)
 SWIG_Guile_Init ()
 {
-  if (!swig_tag) {
+  static int initialized = 0;
+  if (initialized) return;
+  initialized = 1;
+
   swig_tag = scm_make_smob_type((char*)"swig-pointer", 0);
   scm_set_smob_print(swig_tag, print_swig);
   scm_set_smob_equalp(swig_tag, equalp_swig);
-  }
 
-  if (!swig_collectable_tag) {
   swig_collectable_tag = scm_make_smob_type((char*)"collectable-swig-pointer", 0);
   scm_set_smob_print(swig_collectable_tag, print_collectable_swig);
   scm_set_smob_equalp(swig_collectable_tag, equalp_swig);
   scm_set_smob_free(swig_collectable_tag, free_swig);
-  }
 
-  if (!swig_destroyed_tag) {
   swig_destroyed_tag = scm_make_smob_type((char*)"destroyed-swig-pointer", 0);
   scm_set_smob_print(swig_destroyed_tag, print_destroyed_swig);
   scm_set_smob_equalp(swig_destroyed_tag, equalp_swig);
-  }
       
   swig_make_func = scm_permanent_object(
   scm_variable_ref(scm_c_module_lookup(scm_c_resolve_module("oop goops"), "make")));
   swig_keyword = scm_permanent_object(scm_c_make_keyword((char*) "init-smob"));
   swig_symbol = scm_permanent_object(scm_str2symbol("swig-smob"));
+#ifdef SWIG_INIT_RUNTIME_MODULE
+  SWIG_INIT_RUNTIME_MODULE
+#endif
 }
 
 SWIGRUNTIME(int)

Lib/guile/swigrun.i

@@ -0,0 +1,36 @@
+/* -*- mode: c -*- */
+
+%module swigrun
+
+#ifdef SWIGGUILE_SCM
+
+/* The runtime type system from common.swg */
+
+typedef struct swig_type_info swig_type_info;
+
+const char *
+SWIG_TypeName(const swig_type_info *type);
+
+const char *
+SWIG_TypePrettyName(const swig_type_info *type);
+
+swig_type_info *
+SWIG_TypeQuery(const char *);
+
+/* Language-specific stuff */
+
+%apply bool { int };
+
+int
+SWIG_IsPointer(SCM object);
+
+int
+SWIG_IsPointerOfType(SCM object, swig_type_info *type);
+
+unsigned long
+SWIG_PointerAddress(SCM object);
+
+swig_type_info *
+SWIG_PointerType(SCM object);
+
+#endif