From 2593d326f6dfadc326d5f14a42e86ae4d928c8dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matthias=20K=C3=B6ppe?= Date: Mon, 17 May 2004 15:47:45 +0000 Subject: [PATCH] 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 | 31 +++++++++++- Lib/guile/guile_gh.swg | 2 + Lib/guile/guile_scm.swg | 15 ++++++ Lib/guile/guile_scm_run.swg | 95 ++++++++++++++++++++++++++++++------- Lib/guile/swigrun.i | 36 ++++++++++++++ 5 files changed, 160 insertions(+), 19 deletions(-) create mode 100644 Lib/guile/swigrun.i diff --git a/Lib/guile/common.scm b/Lib/guile/common.scm index ca313bd30..4c9128289 100644 --- a/Lib/guile/common.scm +++ b/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)) -(use-modules (oop goops)) +(define-module (Swig swigrun)) + +(define-module (Swig common) + #:use-module (oop goops) + #:use-module (Swig swigrun)) (define-class () (new-function #:init-value #f)) @@ -38,5 +42,28 @@ (if (slot-exists? ret 'swig-smob) (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 ) 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 ) diff --git a/Lib/guile/guile_gh.swg b/Lib/guile/guile_gh.swg index 314395876..bf64bf9f4 100644 --- a/Lib/guile/guile_gh.swg +++ b/Lib/guile/guile_gh.swg @@ -3,6 +3,8 @@ with gh_ flavor. */ +#define SWIGGUILE_GH + %runtime "guile_gh_run.swg" %include "guile.i" diff --git a/Lib/guile/guile_scm.swg b/Lib/guile/guile_scm.swg index 45f31cf11..a7e82362c 100644 --- a/Lib/guile/guile_scm.swg +++ b/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 +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" diff --git a/Lib/guile/guile_scm_run.swg b/Lib/guile/guile_scm_run.swg index 536a56202..c02190cc1 100644 --- a/Lib/guile/guile_scm_run.swg +++ b/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,7 +76,16 @@ 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 SWIGRUNTIME(char *) @@ -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) { - 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); - } + static int initialized = 0; + if (initialized) return; + initialized = 1; - 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); - } + 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_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_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); + + 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) diff --git a/Lib/guile/swigrun.i b/Lib/guile/swigrun.i new file mode 100644 index 000000000..eec8a2bb4 --- /dev/null +++ b/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