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
This commit is contained in:
Matthias Köppe
parent
c25bb79fdb
commit
2593d326f6
5 changed files with 160 additions and 19 deletions
|
|
@ -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 <swig-metaclass> (<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 <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>)
|
||||
|
|
|
|||
|
|
@ -3,6 +3,8 @@
|
|||
with gh_ flavor.
|
||||
*/
|
||||
|
||||
#define SWIGGUILE_GH
|
||||
|
||||
%runtime "guile_gh_run.swg"
|
||||
%include "guile.i"
|
||||
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
36
Lib/guile/swigrun.i
Normal file
36
Lib/guile/swigrun.i
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Add a link
Reference in a new issue