mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts: .gitignore doc/example-smob/Makefile doc/ref/api-smobs.texi doc/ref/libguile-concepts.texi doc/ref/libguile-smobs.texi libguile.h libguile/finalizers.c libguile/finalizers.h libguile/goops.c module/language/tree-il/compile-glil.scm module/oop/goops.scm
This commit is contained in:
commit
d7a67c3e91
35 changed files with 1488 additions and 1322 deletions
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -161,3 +161,5 @@ INSTALL
|
|||
/test-suite/standalone/test-scm-to-latin1-string
|
||||
/test-suite/standalone/test-scm-c-bind-keyword-arguments
|
||||
/libguile/vm-operations.h
|
||||
/test-suite/standalone/test-foreign-object-c
|
||||
/test-suite/standalone/test-srfi-4
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
## Process this file with Automake to create Makefile.in
|
||||
##
|
||||
## Copyright (C) 1998, 2002, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
## Copyright (C) 1998, 2002, 2006, 2008, 2009, 2010, 2014 Free Software Foundation, Inc.
|
||||
##
|
||||
## This file is part of GUILE.
|
||||
##
|
||||
|
@ -25,18 +25,6 @@ SUBDIRS = ref r5rs
|
|||
|
||||
dist_man1_MANS = guile.1
|
||||
|
||||
EXAMPLE_SMOB_FILES = \
|
||||
ChangeLog-2008 Makefile README image-type.c image-type.h myguile.c
|
||||
|
||||
OLDFMT = oldfmt.c
|
||||
|
||||
dist-hook:
|
||||
cp $(srcdir)/$(OLDFMT) $(distdir)/
|
||||
mkdir $(distdir)/example-smob
|
||||
for f in $(EXAMPLE_SMOB_FILES); do \
|
||||
cp $(srcdir)/example-smob/$$f $(distdir)/example-smob/; \
|
||||
done
|
||||
|
||||
EXTRA_DIST = groupings.alist ChangeLog-2008 # guile-api.alist
|
||||
|
||||
include $(top_srcdir)/am/maintainer-dirs
|
||||
|
|
|
@ -14,10 +14,6 @@ Please be aware that this is all very much work in progress (apart
|
|||
from the Revised^5 Report). Bug reports and contributions are
|
||||
welcome!
|
||||
|
||||
The file `oldfmt.c' contains a function which can be used by
|
||||
application writers to support both old-style and new-style error
|
||||
format strings.
|
||||
|
||||
The `sources' directory includes some stuff relevant to the Guile
|
||||
reference manual, and which may eventually be folded in to it. It's
|
||||
not immediately relevant, however, which is why it's not in this
|
||||
|
|
|
@ -1,56 +0,0 @@
|
|||
2008-01-22 Neil Jerram <neil@ossau.uklinux.net>
|
||||
|
||||
* COPYING: Removed.
|
||||
|
||||
2004-09-24 Marius Vollmer <mvo@zagadka.de>
|
||||
|
||||
* image-type.c: Updated from manual.
|
||||
|
||||
2002-02-28 Marius Vollmer <mvo@zagadka.ping.de>
|
||||
|
||||
* image-type.c (image_tag): Changed type to scm_t_bits.
|
||||
(make_image): Use scm_gc_malloc instead of scm_must_malloc.
|
||||
(free_image): Use scm_gc_free instead of free. Return zero.
|
||||
|
||||
2001-05-30 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
|
||||
|
||||
* image-type.c: Adapted to new typing and naming convention.
|
||||
|
||||
2001-04-26 Neil Jerram <neil@ossau.uklinux.net>
|
||||
|
||||
* image-type.c (make_image): Don't need to use SCM_NIMP before
|
||||
SCM_STRINGP.
|
||||
(clear_image): Use SCM_SMOB_PREDICATE.
|
||||
(clear_image, mark_image, free_image, print_image): Use
|
||||
SCM_SMOB_DATA rather than SCM_CDR.
|
||||
|
||||
2000-06-20 Mikael Djurfeldt <mdj@thalamus.nada.kth.se>
|
||||
|
||||
* image-type.c: Removed unused scm_smobfuns structure.
|
||||
(init_image_type): Use standard smob type interface.
|
||||
|
||||
Fri Jun 25 22:21:04 1999 Greg Badros <gjb@cs.washington.edu>
|
||||
|
||||
* image-type.c: Updated example to use scm_make_smob_type_mfpe,
|
||||
SCM_RETURN_NEWSMOB, SCM_NEWSMOB function and macros.
|
||||
|
||||
1998-10-19 Jim Blandy <jimb@zwingli.cygnus.com>
|
||||
|
||||
* image-type.c, myguile.c: Terminate copyright comments.
|
||||
|
||||
* COPYING: New file.
|
||||
* image-type.c myguile.c: Add copyright notice.
|
||||
|
||||
1998-10-16 Jim Blandy <jimb@zwingli.cygnus.com>
|
||||
|
||||
* Makefile (myguile): Fix link command, to put the Guile libraries
|
||||
after the object files. The old command worked on my machine, but
|
||||
I don't see how.
|
||||
|
||||
1998-10-15 Jim Blandy <jimb@zwingli.cygnus.com>
|
||||
|
||||
Created this directory for the Guile 1.3 release. Thanks to Jay
|
||||
Glascoe for suggesting that we provide a complete, buildable
|
||||
example!
|
||||
* ChangeLog, Makefile, README, image-type.c, image-type.h,
|
||||
myguile: New files.
|
|
@ -1,12 +0,0 @@
|
|||
CFLAGS = `pkg-config guile-2.2 --cflags`
|
||||
LIBS = `pkg-config guile-2.2 --libs`
|
||||
|
||||
O_FILES = image-type.o myguile.o
|
||||
|
||||
all: myguile
|
||||
|
||||
myguile: $(O_FILES)
|
||||
$(CC) $(O_FILES) $(LIBS) -o myguile
|
||||
|
||||
clean:
|
||||
-rm -rf myguile $(O_FILES)
|
|
@ -1,6 +0,0 @@
|
|||
This is the example code for the ``Defining New Types (Smobs)''
|
||||
chapter of the Guile manual.
|
||||
|
||||
When you try to execute the code, if the system complains that it
|
||||
can't find libguile.so, you need to add the directory containing the
|
||||
installed Guile libraries to your LD_LIBRARY_PATH environment variable.
|
|
@ -1,115 +0,0 @@
|
|||
/* image-type.c
|
||||
*
|
||||
* Copyright (C) 1998, 2000, 2004, 2006, 2011 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation; either version 3, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this software; see the file COPYING.LESSER. If
|
||||
* not, write to the Free Software Foundation, Inc., 51 Franklin
|
||||
* Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <libguile.h>
|
||||
|
||||
static scm_t_bits image_tag;
|
||||
|
||||
struct image
|
||||
{
|
||||
int width, height;
|
||||
char *pixels;
|
||||
|
||||
/* The name of this image */
|
||||
SCM name;
|
||||
|
||||
/* A function to call when this image is
|
||||
modified, e.g., to update the screen,
|
||||
or SCM_BOOL_F if no action necessary */
|
||||
SCM update_func;
|
||||
};
|
||||
|
||||
static SCM
|
||||
make_image (SCM name, SCM s_width, SCM s_height)
|
||||
{
|
||||
SCM smob;
|
||||
struct image *image;
|
||||
int width = scm_to_int (s_width);
|
||||
int height = scm_to_int (s_height);
|
||||
|
||||
/* Step 1: Allocate the memory block.
|
||||
*/
|
||||
image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");
|
||||
|
||||
/* Step 2: Initialize it with straight code.
|
||||
*/
|
||||
image->width = width;
|
||||
image->height = height;
|
||||
image->pixels = NULL;
|
||||
image->name = SCM_BOOL_F;
|
||||
image->update_func = SCM_BOOL_F;
|
||||
|
||||
/* Step 3: Create the smob.
|
||||
*/
|
||||
SCM_NEWSMOB (smob, image_tag, image);
|
||||
|
||||
/* Step 4: Finish the initialization.
|
||||
*/
|
||||
image->name = name;
|
||||
image->pixels = scm_gc_malloc_pointerless (width * height, "image pixels");
|
||||
|
||||
return smob;
|
||||
}
|
||||
|
||||
SCM
|
||||
clear_image (SCM image_smob)
|
||||
{
|
||||
int area;
|
||||
struct image *image;
|
||||
|
||||
scm_assert_smob_type (image_tag, image_smob);
|
||||
|
||||
image = (struct image *) SCM_SMOB_DATA (image_smob);
|
||||
area = image->width * image->height;
|
||||
memset (image->pixels, 0, area);
|
||||
|
||||
/* Invoke the image's update function.
|
||||
*/
|
||||
if (scm_is_true (image->update_func))
|
||||
scm_call_0 (image->update_func);
|
||||
|
||||
scm_remember_upto_here_1 (image_smob);
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
static int
|
||||
print_image (SCM image_smob, SCM port, scm_print_state *pstate)
|
||||
{
|
||||
struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
|
||||
|
||||
scm_puts ("#<image ", port);
|
||||
scm_display (image->name, port);
|
||||
scm_puts (">", port);
|
||||
|
||||
/* non-zero means success */
|
||||
return 1;
|
||||
}
|
||||
|
||||
void
|
||||
init_image_type (void)
|
||||
{
|
||||
image_tag = scm_make_smob_type ("image", sizeof (struct image));
|
||||
scm_set_smob_print (image_tag, print_image);
|
||||
|
||||
scm_c_define_gsubr ("clear-image", 1, 0, 0, clear_image);
|
||||
scm_c_define_gsubr ("make-image", 3, 0, 0, make_image);
|
||||
}
|
|
@ -1,3 +0,0 @@
|
|||
/* file "image-type.h" */
|
||||
|
||||
void init_image_type (void);
|
|
@ -1,37 +0,0 @@
|
|||
/* myguile.c
|
||||
*
|
||||
* Copyright (C) 1998, 2006 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation; either version 3, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this software; see the file COPYING.LESSER. If
|
||||
* not, write to the Free Software Foundation, Inc., 51 Franklin
|
||||
* Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
#include <libguile.h>
|
||||
#include "image-type.h"
|
||||
|
||||
static void
|
||||
inner_main (void *closure, int argc, char **argv)
|
||||
{
|
||||
/* module initializations would go here */
|
||||
init_image_type();
|
||||
scm_shell (argc, argv);
|
||||
}
|
||||
|
||||
int
|
||||
main (int argc, char **argv)
|
||||
{
|
||||
scm_boot_guile (argc, argv, inner_main, 0);
|
||||
return 0; /* never reached */
|
||||
}
|
194
doc/oldfmt.c
194
doc/oldfmt.c
|
@ -1,194 +0,0 @@
|
|||
/* Copyright (C) 2000,2001, 2006, 2008 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation; either version 3, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this software; see the file COPYING.LESSER. If
|
||||
* not, write to the Free Software Foundation, Inc., 51 Franklin
|
||||
* Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
|
||||
|
||||
/* From NEWS:
|
||||
*
|
||||
* * New primitive: `simple-format', affects `scm-error', scm_display_error, & scm_error message strings
|
||||
*
|
||||
* (ice-9 boot) makes `format' an alias for `simple-format' until possibly
|
||||
* extended by the more sophisticated version in (ice-9 format)
|
||||
*
|
||||
* (simple-format port message . args)
|
||||
* Write MESSAGE to DESTINATION, defaulting to `current-output-port'.
|
||||
* MESSAGE can contain ~A (was %s) and ~S (was %S) escapes. When printed,
|
||||
* the escapes are replaced with corresponding members of ARGS:
|
||||
* ~A formats using `display' and ~S formats using `write'.
|
||||
* If DESTINATION is #t, then use the `current-output-port',
|
||||
* if DESTINATION is #f, then return a string containing the formatted text.
|
||||
* Does not add a trailing newline."
|
||||
*
|
||||
* The two C procedures: scm_display_error and scm_error, as well as the
|
||||
* primitive `scm-error', now use scm_format to do their work. This means
|
||||
* that the message strings of all code must be updated to use ~A where %s
|
||||
* was used before, and ~S where %S was used before.
|
||||
*
|
||||
* During the period when there still are a lot of old Guiles out there,
|
||||
* you might want to support both old and new versions of Guile.
|
||||
*
|
||||
* There are basically two methods to achieve this. Both methods use
|
||||
* autoconf. Put
|
||||
*
|
||||
* AC_CHECK_FUNCS(scm_simple_format)
|
||||
*
|
||||
* in your configure.in.
|
||||
*
|
||||
* Method 1: Use the string concatenation features of ANSI C's
|
||||
* preprocessor.
|
||||
*
|
||||
* In C:
|
||||
*
|
||||
* #ifdef HAVE_SCM_SIMPLE_FORMAT
|
||||
* #define FMT_S "~S"
|
||||
* #else
|
||||
* #define FMT_S "%S"
|
||||
* #endif
|
||||
*
|
||||
* Then represent each of your error messages using a preprocessor macro:
|
||||
*
|
||||
* #define E_SPIDER_ERROR "There's a spider in your " ## FMT_S ## "!!!"
|
||||
*
|
||||
* In Scheme:
|
||||
*
|
||||
* (define fmt-s (if (defined? 'simple-format) "~S" "%S"))
|
||||
* (define make-message string-append)
|
||||
*
|
||||
* (define e-spider-error
|
||||
* (make-message "There's a spider in your " fmt-s "!!!"))
|
||||
*
|
||||
* Method 2: Use the oldfmt function found in doc/oldfmt.c.
|
||||
*
|
||||
* In C:
|
||||
*
|
||||
* scm_misc_error ("picnic", scm_c_oldfmt0 ("There's a spider in your ~S!!!"),
|
||||
* ...);
|
||||
*
|
||||
* In Scheme:
|
||||
*
|
||||
* (scm-error 'misc-error "picnic" (oldfmt "There's a spider in your ~S!!!")
|
||||
* ...)
|
||||
*
|
||||
*/
|
||||
|
||||
/*
|
||||
* Take a format string FROM adhering to the new standard format (~A and ~S
|
||||
* as placeholders) of length N and return a string which is adapted
|
||||
* to the format used by the Guile interpreter which you are running.
|
||||
*
|
||||
* On successive calls with similar strings but different storage, the
|
||||
* same string with same storage is returned. This is necessary since
|
||||
* the existence of a garbage collector in the system may cause the same
|
||||
* format string to be represented with different storage at different
|
||||
* calls.
|
||||
*/
|
||||
|
||||
char *
|
||||
scm_c_oldfmt (char *from, int n)
|
||||
{
|
||||
#ifdef HAVE_SCM_SIMPLE_FORMAT
|
||||
return from;
|
||||
#else
|
||||
static struct { int n; char *from; char *to; } *strings;
|
||||
static int size = 0;
|
||||
static int n_strings = 0;
|
||||
char *to;
|
||||
int i;
|
||||
|
||||
for (i = 0; i < n_strings; ++i)
|
||||
if (n == strings[i].n && strncmp (from, strings[i].from, n) == 0)
|
||||
return strings[i].to;
|
||||
|
||||
if (n_strings == size)
|
||||
{
|
||||
if (size == 0)
|
||||
{
|
||||
size = 10;
|
||||
strings = scm_must_malloc (size * sizeof (*strings), s_oldfmt);
|
||||
}
|
||||
else
|
||||
{
|
||||
int oldsize = size;
|
||||
size = 3 * oldsize / 2;
|
||||
strings = scm_must_realloc (strings,
|
||||
oldsize * sizeof (*strings),
|
||||
size * sizeof (*strings),
|
||||
s_oldfmt);
|
||||
}
|
||||
}
|
||||
|
||||
strings[n_strings].n = n;
|
||||
strings[n_strings].from = strncpy (scm_must_malloc (n, s_oldfmt), from, n);
|
||||
to = strings[n_strings].to = scm_must_malloc (n + 1, s_oldfmt);
|
||||
n_strings++;
|
||||
|
||||
for (i = 0; i < n; ++i)
|
||||
{
|
||||
if (from[i] == '~' && ++i < n)
|
||||
{
|
||||
if (from[i] == 'A')
|
||||
{
|
||||
to[i - 1] = '%';
|
||||
to[i] = 's';
|
||||
}
|
||||
else if (from[i] == 'S')
|
||||
{
|
||||
to[i - 1] = '%';
|
||||
to[i] = 'S';
|
||||
}
|
||||
else
|
||||
{
|
||||
to[i - 1] = '~';
|
||||
to[i] = from[i];
|
||||
}
|
||||
continue;
|
||||
}
|
||||
to[i] = from[i];
|
||||
}
|
||||
to[i] = '\0';
|
||||
|
||||
return to;
|
||||
#endif
|
||||
}
|
||||
|
||||
char *
|
||||
scm_c_oldfmt0 (char *s)
|
||||
{
|
||||
#ifdef HAVE_SCM_SIMPLE_FORMAT
|
||||
return s;
|
||||
#else
|
||||
return scm_c_oldfmt (s, strlen (s));
|
||||
#endif
|
||||
}
|
||||
|
||||
SCM_PROC (s_oldfmt, "oldfmt", 1, 0, 0, scm_oldfmt);
|
||||
|
||||
SCM
|
||||
scm_oldfmt (SCM s)
|
||||
{
|
||||
#ifdef HAVE_SCM_SIMPLE_FORMAT
|
||||
return s;
|
||||
#else
|
||||
int n;
|
||||
SCM_ASSERT (SCM_NIMP (s) && SCM_STRINGP (s), s, 1, s_oldfmt);
|
||||
n = SCM_LENGTH (s);
|
||||
return scm_return_first (scm_mem2string (scm_c_oldfmt (SCM_ROCHARS (s), n),
|
||||
n),
|
||||
s);
|
||||
#endif
|
||||
}
|
|
@ -1,7 +1,7 @@
|
|||
## Process this file with Automake to create Makefile.in
|
||||
##
|
||||
## Copyright (C) 1998, 2004, 2006, 2008, 2009, 2010,
|
||||
## 2011, 2013 Free Software Foundation, Inc.
|
||||
## 2011, 2013, 2014 Free Software Foundation, Inc.
|
||||
##
|
||||
## This file is part of GUILE.
|
||||
##
|
||||
|
@ -33,6 +33,7 @@ guile_TEXINFOS = preface.texi \
|
|||
api-scm.texi \
|
||||
api-snarf.texi \
|
||||
api-smobs.texi \
|
||||
api-foreign-objects.texi \
|
||||
scheme-ideas.texi \
|
||||
api-data.texi \
|
||||
api-procedures.texi \
|
||||
|
@ -83,7 +84,7 @@ guile_TEXINFOS = preface.texi \
|
|||
compiler.texi \
|
||||
fdl.texi \
|
||||
libguile-concepts.texi \
|
||||
libguile-smobs.texi \
|
||||
libguile-foreign-objects.texi \
|
||||
libguile-snarf.texi \
|
||||
libguile-linking.texi \
|
||||
libguile-extensions.texi \
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
@c -*-texinfo-*-
|
||||
@c This is part of the GNU Guile Reference Manual.
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010,
|
||||
@c 2011, 2012, 2013 Free Software Foundation, Inc.
|
||||
@c 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
|
||||
@c See the file guile.texi for copying conditions.
|
||||
|
||||
@node Control Mechanisms
|
||||
|
@ -1187,13 +1187,13 @@ The @var{body_data} and @var{handler_data} parameters are passed to
|
|||
the respective calls so an application can communicate extra
|
||||
information to those functions.
|
||||
|
||||
If the data consists of an @code{SCM} object, care should be taken
|
||||
that it isn't garbage collected while still required. If the
|
||||
@code{SCM} is a local C variable, one way to protect it is to pass a
|
||||
pointer to that variable as the data parameter, since the C compiler
|
||||
will then know the value must be held on the stack. Another way is to
|
||||
use @code{scm_remember_upto_here_1} (@pxref{Remembering During
|
||||
Operations}).
|
||||
If the data consists of an @code{SCM} object, care should be taken that
|
||||
it isn't garbage collected while still required. If the @code{SCM} is a
|
||||
local C variable, one way to protect it is to pass a pointer to that
|
||||
variable as the data parameter, since the C compiler will then know the
|
||||
value must be held on the stack. Another way is to use
|
||||
@code{scm_remember_upto_here_1} (@pxref{Foreign Object Memory
|
||||
Management}).
|
||||
@end deftypefn
|
||||
|
||||
|
||||
|
|
125
doc/ref/api-foreign-objects.texi
Normal file
125
doc/ref/api-foreign-objects.texi
Normal file
|
@ -0,0 +1,125 @@
|
|||
@c -*-texinfo-*-
|
||||
@c This is part of the GNU Guile Reference Manual.
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2013, 2014
|
||||
@c Free Software Foundation, Inc.
|
||||
@c See the file guile.texi for copying conditions.
|
||||
|
||||
@node Foreign Objects
|
||||
@section Foreign Objects
|
||||
|
||||
@cindex foreign object
|
||||
|
||||
This chapter contains reference information related to defining and
|
||||
working with foreign objects. @xref{Defining New Foreign Object Types},
|
||||
for a tutorial-like introduction to foreign objects.
|
||||
|
||||
@deftp {C Type} scm_t_struct_finalize
|
||||
This function type returns @code{void} and takes one @code{SCM}
|
||||
argument.
|
||||
@end deftp
|
||||
|
||||
@deftypefn {C Function} SCM scm_make_foreign_object_type (SCM name, SCM slots, scm_t_struct_finalize finalizer)
|
||||
Create a fresh foreign object type. @var{name} is a symbol naming the
|
||||
type. @var{slots} is a list of symbols, each one naming a field in the
|
||||
foreign object type. @var{finalizer} indicates the finalizer, and may
|
||||
be @code{NULL}.
|
||||
@end deftypefn
|
||||
|
||||
@cindex finalizer
|
||||
@cindex finalization
|
||||
|
||||
We recommend that finalizers be avoided if possible. @xref{Foreign
|
||||
Object Memory Management}. Finalizers must be async-safe and
|
||||
thread-safe. Again, @pxref{Foreign Object Memory Management}. If you
|
||||
are embedding Guile in an application that is not thread-safe, and you
|
||||
define foreign object types that need finalization, you might want to
|
||||
disable automatic finalization, and arrange to call
|
||||
@code{scm_manually_run_finalizers ()} yourself.
|
||||
|
||||
@deftypefn {C Function} int scm_set_automatic_finalization_enabled (int enabled_p)
|
||||
Enable or disable automatic finalization. By default, Guile arranges to
|
||||
invoke object finalizers automatically, in a separate thread if
|
||||
possible. Passing a zero value for @var{enabled_p} will disable
|
||||
automatic finalization for Guile as a whole. If you disable automatic
|
||||
finalization, you will have to call @code{scm_run_finalizers ()}
|
||||
periodically.
|
||||
|
||||
Unlike most other Guile functions, you can call
|
||||
@code{scm_set_automatic_finalization_enabled} before Guile has been
|
||||
initialized.
|
||||
|
||||
Return the previous status of automatic finalization.
|
||||
@end deftypefn
|
||||
|
||||
@deftypefn {C Function} int scm_run_finalizers (void)
|
||||
Invoke any pending finalizers. Returns the number of finalizers that
|
||||
were invoked. This function should be called when automatic
|
||||
finalization is disabled, though it may be called if it is enabled as
|
||||
well.
|
||||
@end deftypefn
|
||||
|
||||
@deftypefn {C Function} void scm_assert_foreign_object_type (SCM type, SCM val)
|
||||
When @var{val} is a foreign object of the given @var{type}, do nothing.
|
||||
Otherwise, signal an error.
|
||||
@end deftypefn
|
||||
|
||||
@deftypefn {C Function} SCM scm_make_foreign_object_0 (SCM type)
|
||||
@deftypefnx {C Function} SCM scm_make_foreign_object_1 (SCM type, void *val0)
|
||||
@deftypefnx {C Function} SCM scm_make_foreign_object_2 (SCM type, void *val0, void *val1)
|
||||
@deftypefnx {C Function} SCM scm_make_foreign_object_3 (SCM type, void *val0, void *val1, void *val2)
|
||||
@deftypefnx {C Function} SCM scm_make_foreign_object_n (SCM type, size_t n, void *vals[])
|
||||
Make a new foreign object of the type with type @var{type} and
|
||||
initialize the first @var{n} fields to the given values, as appropriate.
|
||||
|
||||
The number of fields for objects of a given type is fixed when the type
|
||||
is created. It is an error to give more initializers than there are
|
||||
fields in the value. It is perfectly fine to give fewer initializers
|
||||
than needed; this is convenient when some fields are of non-pointer
|
||||
types, and would be easier to initialize with the setters described
|
||||
below.
|
||||
@end deftypefn
|
||||
|
||||
@deftypefn {C Function} void* scm_foreign_object_ref (SCM obj, size_t n);
|
||||
@deftypefnx {C Function} scm_t_bits scm_foreign_object_unsigned_ref (SCM obj, size_t n);
|
||||
@deftypefnx {C Function} scm_t_signed_bits scm_foreign_object_signed_ref (SCM obj, size_t n);
|
||||
Return the value of the @var{n}th field of the foreign object @var{obj}.
|
||||
The backing store for the fields is as wide as a @code{scm_t_bits}
|
||||
value, which is at least as wide as a pointer. The different variants
|
||||
handle casting in a portable way.
|
||||
@end deftypefn
|
||||
|
||||
@deftypefn {C Function} void scm_foreign_object_set_x (SCM obj, size_t n, void *val);
|
||||
@deftypefnx {C Function} void scm_foreign_object_unsigned_set_x (SCM obj, size_t n, scm_t_bits val);
|
||||
@deftypefnx {C Function} void scm_foreign_object_signed_set_x (SCM obj, size_t n, scm_t_signed_bits val);
|
||||
Set the value of the @var{n}th field of the foreign object @var{obj} to
|
||||
@var{val}, after portably converting to a @code{scm_t_bits} value, if
|
||||
needed.
|
||||
@end deftypefn
|
||||
|
||||
One can also access foreign objects from Scheme. @xref{Foreign Objects
|
||||
and Scheme}, for some examples.
|
||||
|
||||
@example
|
||||
(use-modules (system foreign-object))
|
||||
@end example
|
||||
|
||||
@deffn {Scheme Procedure} make-foreign-object-type name slots [#:finalizer=#f]
|
||||
Make a new foreign object type. See the above documentation for
|
||||
@code{scm_make_foreign_object_type}; these functions are exactly
|
||||
equivalent, except for the way in which the finalizer gets attached to
|
||||
instances (an internal detail).
|
||||
|
||||
The resulting value is a GOOPS class. @xref{GOOPS}, for more on classes
|
||||
in Guile.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Syntax} define-foreign-object-type name constructor (slot ...) [#:finalizer=#f]
|
||||
A convenience macro to define a type, using
|
||||
@code{make-foreign-object-type}, and bind it to @var{name}. A
|
||||
constructor will be bound to @var{constructor}, and getters will be
|
||||
bound to each of @var{slot...}.
|
||||
@end deffn
|
||||
|
||||
@c Local Variables:
|
||||
@c TeX-master: "guile.texi"
|
||||
@c End:
|
|
@ -112,15 +112,16 @@ functions for dynamic memory allocation that are integrated into the
|
|||
garbage collector and the error reporting system.
|
||||
|
||||
Memory blocks that are associated with Scheme objects (for example a
|
||||
smob) should be allocated with @code{scm_gc_malloc} or
|
||||
foreign object) should be allocated with @code{scm_gc_malloc} or
|
||||
@code{scm_gc_malloc_pointerless}. These two functions will either
|
||||
return a valid pointer or signal an error. Memory blocks allocated this
|
||||
way can be freed with @code{scm_gc_free}; however, this is not strictly
|
||||
needed: memory allocated with @code{scm_gc_malloc} or
|
||||
@code{scm_gc_malloc_pointerless} is automatically reclaimed when the
|
||||
garbage collector no longer sees any live reference to it@footnote{In
|
||||
Guile up to version 1.8, memory allocated with @code{scm_gc_malloc}
|
||||
@emph{had} to be freed with @code{scm_gc_free}.}.
|
||||
way may be released explicitly; however, this is not strictly needed,
|
||||
and we recommend @emph{not} calling @code{scm_gc_free}. All memory
|
||||
allocated with @code{scm_gc_malloc} or @code{scm_gc_malloc_pointerless}
|
||||
is automatically reclaimed when the garbage collector no longer sees any
|
||||
live reference to it@footnote{In Guile up to version 1.8, memory
|
||||
allocated with @code{scm_gc_malloc} @emph{had} to be freed with
|
||||
@code{scm_gc_free}.}.
|
||||
|
||||
Memory allocated with @code{scm_gc_malloc} is scanned for live pointers.
|
||||
This means that if @code{scm_gc_malloc}-allocated memory contains a
|
||||
|
@ -204,7 +205,9 @@ size of a reallocated memory block as well. See below for a motivation.
|
|||
|
||||
@deftypefn {C Function} void scm_gc_free (void *@var{mem}, size_t @var{size}, const char *@var{what})
|
||||
Explicitly free the memory block pointed to by @var{mem}, which was
|
||||
previously allocated by one of the above @code{scm_gc} functions.
|
||||
previously allocated by one of the above @code{scm_gc} functions. This
|
||||
function is almost always unnecessary, except for codebases that still
|
||||
need to compile on Guile 1.8.
|
||||
|
||||
Note that you need to explicitly pass the @var{size} parameter. This
|
||||
is done since it should normally be easy to provide this parameter
|
||||
|
@ -225,7 +228,7 @@ often (as appropriate).
|
|||
|
||||
It is especially important to call this function when large unmanaged
|
||||
allocations, like images, may be freed by small Scheme allocations, like
|
||||
SMOBs.
|
||||
foreign objects.
|
||||
@end deftypefn
|
||||
|
||||
|
||||
|
|
|
@ -9,9 +9,17 @@
|
|||
|
||||
@cindex smob
|
||||
|
||||
This chapter contains reference information related to defining and
|
||||
working with smobs. See @ref{Defining New Types (Smobs)} for a
|
||||
tutorial-like introduction to smobs.
|
||||
A @dfn{smob} is a ``small object''. Before foreign objects were
|
||||
introduced in Guile 2.0.12 (@pxref{Foreign Objects}), smobs were the
|
||||
preferred way to for C code to define new kinds of Scheme objects. With
|
||||
the exception of the so-called ``applicable SMOBs'' discussed below,
|
||||
smobs are now a legacy interface and are headed for eventual
|
||||
deprecation. @xref{Deprecation}. New code should use the foreign
|
||||
object interface.
|
||||
|
||||
This section contains reference information related to defining and
|
||||
working with smobs. For a tutorial-like introduction to smobs, see
|
||||
``Defining New Types (Smobs)'' in previous versions of this manual.
|
||||
|
||||
@deftypefun scm_t_bits scm_make_smob_type (const char *name, size_t size)
|
||||
This function adds a new smob type, named @var{name}, with instance size
|
||||
|
@ -26,9 +34,8 @@ deallocate the memory block pointed to by @code{SCM_SMOB_DATA} with
|
|||
@code{scm_gc_free} will be @var{name}.
|
||||
|
||||
Default values are provided for the @emph{mark}, @emph{free},
|
||||
@emph{print}, and @emph{equalp} functions, as described in
|
||||
@ref{Defining New Types (Smobs)}. If you want to customize any of
|
||||
these functions, the call to @code{scm_make_smob_type} should be
|
||||
@emph{print}, and @emph{equalp} functions. If you want to customize any
|
||||
of these functions, the call to @code{scm_make_smob_type} should be
|
||||
immediately followed by calls to one or several of
|
||||
@code{scm_set_smob_mark}, @code{scm_set_smob_free},
|
||||
@code{scm_set_smob_print}, and/or @code{scm_set_smob_equalp}.
|
||||
|
@ -60,51 +67,30 @@ memory is automatically reclaimed by the garbage collector when it is no
|
|||
longer needed (@pxref{Memory Blocks, @code{scm_gc_malloc}}).
|
||||
@end deftypefn
|
||||
|
||||
Smob free functions must be thread-safe. @xref{Garbage Collecting
|
||||
Smobs}, for a discussion on finalizers and concurrency. If you are
|
||||
Smob free functions must be thread-safe. @xref{Foreign Object Memory
|
||||
Management}, for a discussion on finalizers and concurrency. If you are
|
||||
embedding Guile in an application that is not thread-safe, and you
|
||||
define smob types that need finalization, you might want to disable
|
||||
automatic finalization, and arrange to call
|
||||
@code{scm_manually_run_finalizers ()} yourself.
|
||||
|
||||
@deftypefn {C Function} int scm_set_automatic_finalization_enabled (int enabled_p)
|
||||
Enable or disable automatic finalization. By default, Guile arranges to
|
||||
invoke object finalizers automatically, in a separate thread if
|
||||
possible. Passing a zero value for @var{enabled_p} will disable
|
||||
automatic finalization for Guile as a whole. If you disable automatic
|
||||
finalization, you will have to call @code{scm_run_finalizers ()}
|
||||
periodically.
|
||||
|
||||
Unlike most other Guile functions, you can call
|
||||
@code{scm_set_automatic_finalization_enabled} before Guile has been
|
||||
initialized.
|
||||
|
||||
Return the previous status of automatic finalization.
|
||||
@end deftypefn
|
||||
|
||||
@deftypefn {C Function} int scm_run_finalizers (void)
|
||||
Invoke any pending finalizers. Returns the number of finalizers that
|
||||
were invoked. This function should be called when automatic
|
||||
finalization is disabled, though it may be called if it is enabled as
|
||||
well.
|
||||
@end deftypefn
|
||||
|
||||
|
||||
@cindex precise marking
|
||||
@code{scm_manually_run_finalizers ()} yourself. @xref{Foreign Objects}.
|
||||
|
||||
@deftypefn {C Function} void scm_set_smob_mark (scm_t_bits tc, SCM (*mark) (SCM obj))
|
||||
This function sets the smob marking procedure for the smob type specified by
|
||||
the tag @var{tc}. @var{tc} is the tag returned by @code{scm_make_smob_type}.
|
||||
|
||||
Defining a marking procedure may sometimes be unnecessary because large
|
||||
parts of the process' memory (with the exception of
|
||||
@code{scm_gc_malloc_pointerless} regions, and @code{malloc}- or
|
||||
@code{scm_malloc}-allocated memory) are scanned for live
|
||||
pointers@footnote{Conversely, in Guile up to the 1.8 series, the marking
|
||||
procedure was always required. The reason is that Guile's GC would only
|
||||
look for pointers in the memory area used for built-in types (the
|
||||
@dfn{cell heap}), not in user-allocated or statically allocated memory.
|
||||
This approach is often referred to as @dfn{precise marking}.}.
|
||||
Defining a marking procedure is almost always the wrong thing to do. It
|
||||
is much, much preferable to allocate smob data with the
|
||||
@code{scm_gc_malloc} and @code{scm_gc_malloc_pointerless} functions, and
|
||||
allow the GC to trace pointers automatically.
|
||||
|
||||
Any mark procedures you see currently almost surely date from the time
|
||||
of Guile 1.8, before the switch to the Boehm-Demers-Weiser collector.
|
||||
Such smob implementations should be changed to just use
|
||||
@code{scm_gc_malloc} and friends, and to lose their mark function.
|
||||
|
||||
If you decide to keep the mark function, note that it may be called on
|
||||
objects that are on the free list. Please read and digest the comments
|
||||
from the BDW GC's @code{gc/gc_mark.h} header.
|
||||
|
||||
The @var{mark} procedure must cause @code{scm_gc_mark} to be called
|
||||
for every @code{SCM} value that is directly referenced by the smob
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
@c -*-texinfo-*-
|
||||
@c This is part of the GNU Guile Reference Manual.
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2011, 2012, 2013
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2011, 2012, 2013, 2014
|
||||
@c Free Software Foundation, Inc.
|
||||
@c See the file guile.texi for copying conditions.
|
||||
|
||||
|
@ -163,12 +163,14 @@ same.
|
|||
into an infinite loop if asked to compare two circular lists or
|
||||
similar.
|
||||
|
||||
New application-defined object types (@pxref{Defining New Types
|
||||
(Smobs)}) have an @code{equalp} handler which is called by
|
||||
@code{equal?}. This lets an application traverse the contents or
|
||||
control what is considered @code{equal?} for two objects of such a
|
||||
type. If there's no such handler, the default is to just compare as
|
||||
per @code{eq?}.
|
||||
GOOPS object types (@pxref{GOOPS}), including foreign object types
|
||||
(@pxref{Defining New Foreign Object Types}), can have an @code{equal?}
|
||||
implementation specialized on two values of the same type. If
|
||||
@code{equal?} is called on two GOOPS objects of the same type,
|
||||
@code{equal?} will dispatch out to a generic function. This lets an
|
||||
application traverse the contents or control what is considered
|
||||
@code{equal?} for two objects of such a type. If there's no such
|
||||
handler, the default is to just compare as per @code{eq?}.
|
||||
@end deffn
|
||||
|
||||
|
||||
|
|
|
@ -246,7 +246,7 @@ continuations influence the control flow in a C program.
|
|||
|
||||
This knowledge should make it straightforward to add new functions to
|
||||
Guile that can be called from Scheme. Adding new data types is also
|
||||
possible and is done by defining @dfn{smobs}.
|
||||
possible and is done by defining @dfn{foreign objects}.
|
||||
|
||||
The @ref{Programming Overview} section of this part contains general
|
||||
musings and guidelines about programming with Guile. It explores
|
||||
|
@ -267,7 +267,7 @@ etc. that make up Guile's application programming interface (API),
|
|||
* Linking Programs With Guile:: More precisely, with the libguile library.
|
||||
* Linking Guile with Libraries:: To extend Guile itself.
|
||||
* General Libguile Concepts:: General concepts for using libguile.
|
||||
* Defining New Types (Smobs):: Adding new types to Guile.
|
||||
* Defining New Foreign Object Types:: Adding new types to Guile.
|
||||
* Function Snarfing:: A way to define new functions.
|
||||
* Programming Overview:: An overview of Guile programming.
|
||||
* Autoconf Support:: Putting m4 to good use.
|
||||
|
@ -277,7 +277,7 @@ etc. that make up Guile's application programming interface (API),
|
|||
@include libguile-linking.texi
|
||||
@include libguile-extensions.texi
|
||||
@include libguile-concepts.texi
|
||||
@include libguile-smobs.texi
|
||||
@include libguile-foreign-objects.texi
|
||||
@include libguile-snarf.texi
|
||||
@include libguile-program.texi
|
||||
@include libguile-autoconf.texi
|
||||
|
@ -299,7 +299,8 @@ available through both Scheme and C interfaces.
|
|||
* Snarfing Macros:: Macros for snarfing initialization actions.
|
||||
* Simple Data Types:: Numbers, strings, booleans and so on.
|
||||
* Compound Data Types:: Data types for holding other data.
|
||||
* Smobs:: Defining new data types in C.
|
||||
* Foreign Objects:: Defining new data types in C.
|
||||
* Smobs:: Use foreign objects instead.
|
||||
* Procedures:: Procedures.
|
||||
* Macros:: Extending the syntax of Scheme.
|
||||
* Utility Functions:: General utility functions.
|
||||
|
@ -328,6 +329,7 @@ available through both Scheme and C interfaces.
|
|||
@include api-snarf.texi
|
||||
@include api-data.texi
|
||||
@include api-compound.texi
|
||||
@include api-foreign-objects.texi
|
||||
@include api-smobs.texi
|
||||
@include api-procedures.texi
|
||||
@include api-macros.texi
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
@c -*-texinfo-*-
|
||||
@c This is part of the GNU Guile Reference Manual.
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010,
|
||||
@c 2011, 2013 Free Software Foundation, Inc.
|
||||
@c 2011, 2013, 2014 Free Software Foundation, Inc.
|
||||
@c See the file guile.texi for copying conditions.
|
||||
|
||||
@node General Libguile Concepts
|
||||
|
@ -191,38 +191,34 @@ periodically free all blocks that have been allocated but are not used
|
|||
by any active Scheme values. This activity is called @dfn{garbage
|
||||
collection}.
|
||||
|
||||
It is easy for Guile to remember all blocks of memory that it has
|
||||
allocated for use by Scheme values, but you need to help it with finding
|
||||
all Scheme values that are in use by C code.
|
||||
Guile's garbage collector will automatically discover references to
|
||||
@code{SCM} objects that originate in global variables, static data
|
||||
sections, function arguments or local variables on the C and Scheme
|
||||
stacks, and values in machine registers. Other references to @code{SCM}
|
||||
objects, such as those in other random data structures in the C heap
|
||||
that contain fields of type @code{SCM}, can be made visible to the
|
||||
garbage collector by calling the functions @code{scm_gc_protect} or
|
||||
@code{scm_permanent_object}. Collectively, these values form the ``root
|
||||
set'' of garbage collection; any value on the heap that is referenced
|
||||
directly or indirectly by a member of the root set is preserved, and all
|
||||
other objects are eligible for reclamation.
|
||||
|
||||
You do this when writing a SMOB mark function, for example
|
||||
(@pxref{Garbage Collecting Smobs}). By calling this function, the
|
||||
garbage collector learns about all references that your SMOB has to
|
||||
other @code{SCM} values.
|
||||
|
||||
Other references to @code{SCM} objects, such as global variables of type
|
||||
@code{SCM} or other random data structures in the heap that contain
|
||||
fields of type @code{SCM}, can be made visible to the garbage collector
|
||||
by calling the functions @code{scm_gc_protect} or
|
||||
@code{scm_permanent_object}. You normally use these functions for long
|
||||
lived objects such as a hash table that is stored in a global variable.
|
||||
For temporary references in local variables or function arguments, using
|
||||
these functions would be too expensive.
|
||||
|
||||
These references are handled differently: Local variables (and function
|
||||
arguments) of type @code{SCM} are automatically visible to the garbage
|
||||
collector. This works because the collector scans the stack for
|
||||
potential references to @code{SCM} objects and considers all referenced
|
||||
objects to be alive. The scanning considers each and every word of the
|
||||
stack, regardless of what it is actually used for, and then decides
|
||||
whether it could possibly be a reference to a @code{SCM} object. Thus,
|
||||
the scanning is guaranteed to find all actual references, but it might
|
||||
also find words that only accidentally look like references. These
|
||||
`false positives' might keep @code{SCM} objects alive that would
|
||||
otherwise be considered dead. While this might waste memory, keeping an
|
||||
object around longer than it strictly needs to is harmless. This is why
|
||||
this technique is called ``conservative garbage collection''. In
|
||||
practice, the wasted memory seems to be no problem.
|
||||
The Scheme stack and heap are scanned precisely; that is to say, Guile
|
||||
knows about all inter-object pointers on the Scheme stack and heap.
|
||||
This is not the case, unfortunately, for pointers on the C stack and
|
||||
static data segment. For this reason we have to scan the C stack and
|
||||
static data segment @dfn{conservatively}; any value that looks like a
|
||||
pointer to a GC-managed object is treated as such, whether it actually
|
||||
is a reference or not. Thus, scanning the C stack and static data
|
||||
segment is guaranteed to find all actual references, but it might also
|
||||
find words that only accidentally look like references. These ``false
|
||||
positives'' might keep @code{SCM} objects alive that would otherwise be
|
||||
considered dead. While this might waste memory, keeping an object
|
||||
around longer than it strictly needs to is harmless. This is why this
|
||||
technique is called ``conservative garbage collection''. In practice,
|
||||
the wasted memory seems to be no problem, as the static C root set is
|
||||
almost always finite and small, given that the Scheme stack is separate
|
||||
from the C stack.
|
||||
|
||||
The stack of every thread is scanned in this way and the registers of
|
||||
the CPU and all other memory locations where local variables or function
|
||||
|
@ -245,17 +241,17 @@ wanted.
|
|||
There are situations, however, where a @code{SCM} object needs to be
|
||||
around longer than its reference from a local variable or function
|
||||
parameter. This happens, for example, when you retrieve some pointer
|
||||
from a smob and work with that pointer directly. The reference to the
|
||||
@code{SCM} smob object might be dead after the pointer has been
|
||||
retrieved, but the pointer itself (and the memory pointed to) is still
|
||||
in use and thus the smob object must be protected. The compiler does
|
||||
not know about this connection and might overwrite the @code{SCM}
|
||||
reference too early.
|
||||
from a foreign object and work with that pointer directly. The
|
||||
reference to the @code{SCM} foreign object might be dead after the
|
||||
pointer has been retrieved, but the pointer itself (and the memory
|
||||
pointed to) is still in use and thus the foreign object must be
|
||||
protected. The compiler does not know about this connection and might
|
||||
overwrite the @code{SCM} reference too early.
|
||||
|
||||
To get around this problem, you can use @code{scm_remember_upto_here_1}
|
||||
and its cousins. It will keep the compiler from overwriting the
|
||||
reference. For a typical example of its use, see @ref{Remembering
|
||||
During Operations}.
|
||||
reference. @xref{Foreign Object Memory Management}.
|
||||
|
||||
|
||||
@node Control Flow
|
||||
@subsection Control Flow
|
||||
|
|
493
doc/ref/libguile-foreign-objects.texi
Normal file
493
doc/ref/libguile-foreign-objects.texi
Normal file
|
@ -0,0 +1,493 @@
|
|||
@c -*-texinfo-*-
|
||||
@c This is part of the GNU Guile Reference Manual.
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010, 2011, 2013, 2014
|
||||
@c Free Software Foundation, Inc.
|
||||
@c See the file guile.texi for copying conditions.
|
||||
|
||||
@node Defining New Foreign Object Types
|
||||
@section Defining New Foreign Object Types
|
||||
|
||||
The @dfn{foreign object type} facility is Guile's mechanism for
|
||||
importing object and types from C or other languages into Guile's
|
||||
system. If you have a C @code{struct foo} type, for example, you can
|
||||
define a corresponding Guile foreign object type that allows Scheme code
|
||||
to handle @code{struct foo *} objects.
|
||||
|
||||
To define a new foreign object type, the programmer provides Guile with
|
||||
some essential information about the type --- what its name is, how many
|
||||
fields it has, and its finalizer (if any) --- and Guile allocates a
|
||||
fresh type for it. Foreign objects can be accessed from Scheme or from
|
||||
C.
|
||||
|
||||
@menu
|
||||
* Defining Foreign Object Types::
|
||||
* Creating Foreign Objects::
|
||||
* Type Checking of Foreign Objects::
|
||||
* Foreign Object Memory Management::
|
||||
* Foreign Objects and Scheme::
|
||||
@end menu
|
||||
|
||||
@node Defining Foreign Object Types
|
||||
@subsection Defining Foreign Object Types
|
||||
|
||||
To create a new foreign object type from C, call
|
||||
@code{scm_make_foreign_object_type}. It returns a value of type
|
||||
@code{SCM} which identifies the new type.
|
||||
|
||||
Here is how one might declare a new type representing eight-bit
|
||||
gray-scale images:
|
||||
|
||||
@example
|
||||
#include <libguile.h>
|
||||
|
||||
struct image @{
|
||||
int width, height;
|
||||
char *pixels;
|
||||
|
||||
/* The name of this image */
|
||||
SCM name;
|
||||
|
||||
/* A function to call when this image is
|
||||
modified, e.g., to update the screen,
|
||||
or SCM_BOOL_F if no action necessary */
|
||||
SCM update_func;
|
||||
@};
|
||||
|
||||
static SCM image_type image_type;
|
||||
|
||||
void
|
||||
init_image_type (void)
|
||||
@{
|
||||
SCM name, slots;
|
||||
scm_t_struct_finalize finalizer;
|
||||
|
||||
name = scm_from_utf8_symbol ("image");
|
||||
slots = scm_list_1 (scm_from_utf8_symbol ("data"));
|
||||
finalizer = NULL;
|
||||
|
||||
image_type =
|
||||
scm_make_foreign_object_type (name, slots, finalizer);
|
||||
@}
|
||||
@end example
|
||||
|
||||
The result is an initialized @code{image_type} value that identifies the
|
||||
new foreign object type. The next section describes how to create
|
||||
foreign objects and how to access their slots.
|
||||
|
||||
|
||||
@node Creating Foreign Objects
|
||||
@subsection Creating Foreign Objects
|
||||
|
||||
Foreign objects contain zero or more ``slots'' of data. A slot can hold
|
||||
a pointer, an integer that fits into a @code{size_t} or @code{ssize_t},
|
||||
or a @code{SCM} value.
|
||||
|
||||
All objects of a given foreign type have the same number of slots. In
|
||||
the example from the previous section, the @code{image} type has one
|
||||
slot, because the slots list passed to
|
||||
@code{scm_make_foreign_object_type} is of length one. (The actual names
|
||||
given to slots are unimportant for most users of the C interface, but
|
||||
can be used on the Scheme side to introspect on the foreign object.)
|
||||
|
||||
To construct a foreign object and initialize its first slot, call
|
||||
@code{scm_make_foreign_object_1 (@var{type}, @var{first_slot_value})}.
|
||||
There are similarly named constructors for initializing 0, 1, 2, or 3
|
||||
slots, or initializing @var{n} slots via an array. @xref{Foreign
|
||||
Objects}, for full details. Any fields that are not explicitly
|
||||
initialized are set to 0.
|
||||
|
||||
To get or set the value of a slot by index, you can use the
|
||||
@code{scm_foreign_object_ref} and @code{scm_foreign_object_set_x}
|
||||
functions. These functions take and return values as @code{void *}
|
||||
pointers; there are corresponding convenience procedures like
|
||||
@code{_signed_ref}, @code{_unsigned_set_x} and so on for dealing with
|
||||
slots as signed or unsigned integers.
|
||||
|
||||
Foreign objects fields that are pointers can be tricky to manage. If
|
||||
possible, it is best that all memory that is referenced by a foreign
|
||||
object be managed by the garbage collector. That way, the GC can
|
||||
automatically ensure that memory is accessible when it is needed, and
|
||||
freed when it becomes inaccessible. If this is not the case for your
|
||||
program -- for example, if you are exposing an object to Scheme that was
|
||||
allocated by some other, Guile-unaware part of your program -- then you
|
||||
will probably need to implement a finalizer. @xref{Foreign Object
|
||||
Memory Management}, for more.
|
||||
|
||||
Continuing the example from the previous section, if the global variable
|
||||
@code{image_type} contains the type returned by
|
||||
@code{scm_make_foreign_object_type}, here is how we could construct a
|
||||
foreign object whose ``data'' field contains a pointer to a freshly
|
||||
allocated @code{struct image}:
|
||||
|
||||
@example
|
||||
SCM
|
||||
make_image (SCM name, SCM s_width, SCM s_height)
|
||||
@{
|
||||
struct image *image;
|
||||
int width = scm_to_int (s_width);
|
||||
int height = scm_to_int (s_height);
|
||||
|
||||
/* Allocate the `struct image'. Because we
|
||||
use scm_gc_malloc, this memory block will
|
||||
be automatically reclaimed when it becomes
|
||||
inaccessible, and its members will be traced
|
||||
by the garbage collector. */
|
||||
image = (struct image *)
|
||||
scm_gc_malloc (sizeof (struct image), "image");
|
||||
|
||||
image->width = width;
|
||||
image->height = height;
|
||||
|
||||
/* Allocating the pixels with
|
||||
scm_gc_malloc_pointerless means that the
|
||||
pixels data is collectable by GC, but
|
||||
that GC shouldn't spend time tracing its
|
||||
contents for nested pointers because there
|
||||
aren't any. */
|
||||
image->pixels =
|
||||
scm_gc_malloc_pointerless (width * height, "image pixels");
|
||||
|
||||
image->name = name;
|
||||
image->update_func = SCM_BOOL_F;
|
||||
|
||||
/* Now wrap the struct image* in a new foreign
|
||||
object, and return that object. */
|
||||
return scm_make_foreign_object_1 (image_type, image);
|
||||
@}
|
||||
@end example
|
||||
|
||||
We use @code{scm_gc_malloc_pointerless} for the pixel buffer to tell the
|
||||
garbage collector not to scan it for pointers. Calls to
|
||||
@code{scm_gc_malloc}, @code{scm_make_foreign_object_1}, and
|
||||
@code{scm_gc_malloc_pointerless} raise an exception in out-of-memory
|
||||
conditions; the garbage collector is able to reclaim previously
|
||||
allocated memory if that happens.
|
||||
|
||||
|
||||
@node Type Checking of Foreign Objects
|
||||
@subsection Type Checking of Foreign Objects
|
||||
|
||||
Functions that operate on foreign objects should check that the passed
|
||||
@code{SCM} value indeed is of the correct type before accessing its
|
||||
data. They can do this with @code{scm_assert_foreign_object_type}.
|
||||
|
||||
For example, here is a simple function that operates on an image object,
|
||||
and checks the type of its argument.
|
||||
|
||||
@example
|
||||
SCM
|
||||
clear_image (SCM image_obj)
|
||||
@{
|
||||
int area;
|
||||
struct image *image;
|
||||
|
||||
scm_assert_foreign_object_type (image_type, image_obj);
|
||||
|
||||
image = scm_foreign_object_ref (image_obj, 0);
|
||||
area = image->width * image->height;
|
||||
memset (image->pixels, 0, area);
|
||||
|
||||
/* Invoke the image's update function. */
|
||||
if (scm_is_true (image->update_func))
|
||||
scm_call_0 (image->update_func);
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
@}
|
||||
@end example
|
||||
|
||||
|
||||
@node Foreign Object Memory Management
|
||||
@subsection Foreign Object Memory Management
|
||||
|
||||
Once a foreign object has been released to the tender mercies of the
|
||||
Scheme system, it must be prepared to survive garbage collection. In
|
||||
the example above, all the memory associated with the foreign object is
|
||||
managed by the garbage collector because we used the @code{scm_gc_}
|
||||
allocation functions. Thus, no special care must be taken: the garbage
|
||||
collector automatically scans them and reclaims any unused memory.
|
||||
|
||||
However, when data associated with a foreign object is managed in some
|
||||
other way---e.g., @code{malloc}'d memory or file descriptors---it is
|
||||
possible to specify a @dfn{finalizer} function to release those
|
||||
resources when the foreign object is reclaimed.
|
||||
|
||||
As discussed in @pxref{Garbage Collection}, Guile's garbage collector
|
||||
will reclaim inaccessible memory as needed. This reclamation process
|
||||
runs concurrently with the main program. When Guile analyzes the heap
|
||||
and determines that an object's memory can be reclaimed, that memory is
|
||||
put on a ``free list'' of objects that can be reclaimed. Usually that's
|
||||
the end of it---the object is available for immediate re-use. However
|
||||
some objects can have ``finalizers'' associated with them---functions
|
||||
that are called on reclaimable objects to effect any external cleanup
|
||||
actions.
|
||||
|
||||
Finalizers are tricky business and it is best to avoid them. They can
|
||||
be invoked at unexpected times, or not at all---for example, they are
|
||||
not invoked on process exit. They don't help the garbage collector do
|
||||
its job; in fact, they are a hindrance. Furthermore, they perturb the
|
||||
garbage collector's internal accounting. The GC decides to scan the
|
||||
heap when it thinks that it is necessary, after some amount of
|
||||
allocation. Finalizable objects almost always represent an amount of
|
||||
allocation that is invisible to the garbage collector. The effect can
|
||||
be that the actual resource usage of a system with finalizable objects
|
||||
is higher than what the GC thinks it should be.
|
||||
|
||||
All those caveats aside, some foreign object types will need finalizers.
|
||||
For example, if we had a foreign object type that wrapped file
|
||||
descriptors---and we aren't suggesting this, as Guile already has ports
|
||||
---then you might define the type like this:
|
||||
|
||||
@example
|
||||
static SCM file_type;
|
||||
|
||||
static void
|
||||
finalize_file (SCM file)
|
||||
@{
|
||||
int fd = scm_foreign_object_signed_ref (file, 0);
|
||||
if (fd >= 0)
|
||||
@{
|
||||
scm_foreign_object_signed_set_x (file, 0, -1);
|
||||
close (fd);
|
||||
@}
|
||||
@}
|
||||
|
||||
static void
|
||||
init_file_type (void)
|
||||
@{
|
||||
SCM name, slots;
|
||||
scm_t_struct_finalize finalizer;
|
||||
|
||||
name = scm_from_utf8_symbol ("file");
|
||||
slots = scm_list_1 (scm_from_utf8_symbol ("fd"));
|
||||
finalizer = finalize_file;
|
||||
|
||||
image_type =
|
||||
scm_make_foreign_object_type (name, slots, finalizer);
|
||||
@}
|
||||
|
||||
static SCM
|
||||
make_file (int fd)
|
||||
@{
|
||||
return scm_make_foreign_object_1 (file_type, (void *) fd);
|
||||
@}
|
||||
@end example
|
||||
|
||||
@cindex finalizer
|
||||
@cindex finalization
|
||||
|
||||
Note that the finalizer may be invoked in ways and at times you might
|
||||
not expect. In particular, if the user's Guile is built with support
|
||||
for threads, the finalizer may be called from any thread that is running
|
||||
Guile. In Guile 2.0, finalizers are invoked via ``asyncs'', which
|
||||
interleaves them with running Scheme code; @pxref{System asyncs}. In
|
||||
Guile 2.2 there will be a dedicated finalization thread, to ensure that
|
||||
the finalization doesn't run within the critical section of any other
|
||||
thread known to Guile.
|
||||
|
||||
In either case, finalizers run concurrently with the main program, and
|
||||
so they need to be async-safe and thread-safe. If for some reason this
|
||||
is impossible, perhaps because you are embedding Guile in some
|
||||
application that is not itself thread-safe, you have a few options. One
|
||||
is to use guardians instead of finalizers, and arrange to pump the
|
||||
guardians for finalizable objects. @xref{Guardians}, for more
|
||||
information. The other option is to disable automatic finalization
|
||||
entirely, and arrange to call @code{scm_run_finalizers ()} at
|
||||
appropriate points. @xref{Foreign Objects}, for more on these
|
||||
interfaces.
|
||||
|
||||
Finalizers are allowed to allocate memory, access GC-managed memory, and
|
||||
in general can do anything any Guile user code can do. This was not the
|
||||
case in Guile 1.8, where finalizers were much more restricted. In
|
||||
particular, in Guile 2.0, finalizers can resuscitate objects. We do not
|
||||
recommend that users avail themselves of this possibility, however, as a
|
||||
resuscitated object can re-expose other finalizable objects that have
|
||||
been already finalized back to Scheme. These objects will not be
|
||||
finalized again, but they could cause use-after-free problems to code
|
||||
that handles objects of that particular foreign object type. To guard
|
||||
against this possibility, robust finalization routines should clear
|
||||
state from the foreign object, as in the above @code{free_file} example.
|
||||
|
||||
One final caveat. Foreign object finalizers are associated with the
|
||||
lifetime of a foreign object, not of its fields. If you access a field
|
||||
of a finalizable foreign object, and do not arrange to keep a reference
|
||||
on the foreign object itself, it could be that the outer foreign object
|
||||
gets finalized while you are working with its field.
|
||||
|
||||
For example, consider a procedure to read some data from a file, from
|
||||
our example above.
|
||||
|
||||
@example
|
||||
SCM
|
||||
read_bytes (SCM file, SCM n)
|
||||
@{
|
||||
int fd;
|
||||
SCM buf;
|
||||
size_t len, pos;
|
||||
|
||||
scm_assert_foreign_object_type (file_type, file);
|
||||
|
||||
fd = scm_foreign_object_signed_ref (file, 0);
|
||||
if (fd < 0)
|
||||
scm_wrong_type_arg_msg ("read-bytes", SCM_ARG1,
|
||||
file, "open file");
|
||||
|
||||
len = scm_to_size_t (n);
|
||||
SCM buf = scm_c_make_bytevector (scm_to_size_t (n));
|
||||
|
||||
pos = 0;
|
||||
while (pos < len)
|
||||
@{
|
||||
char *bytes = SCM_BYTEVECTOR_CONTENTS (buf);
|
||||
ssize_t count = read (fd, bytes + pos, len - pos);
|
||||
if (count < 0)
|
||||
scm_syserror ("read-bytes");
|
||||
if (count == 0)
|
||||
break;
|
||||
pos += count;
|
||||
@}
|
||||
|
||||
scm_remember_upto_here_1 (file);
|
||||
|
||||
return scm_values (scm_list_2 (buf, scm_from_size_t (pos)));
|
||||
@}
|
||||
@end example
|
||||
|
||||
After the prelude, only the @code{fd} value is used and the C compiler
|
||||
has no reason to keep the @code{file} object around. If
|
||||
@code{scm_c_make_bytevector} results in a garbage collection,
|
||||
@code{file} might not be on the stack or anywhere else and could be
|
||||
finalized, leaving @code{read} to read a closed (or, in a multi-threaded
|
||||
program, possibly re-used) file descriptor. The use of
|
||||
@code{scm_remember_upto_here_1} prevents this, by creating a reference
|
||||
to @code{file} after all data accesses. @xref{Garbage Collection
|
||||
Functions}.
|
||||
|
||||
@code{scm_remember_upto_here_1} is only needed on finalizable objects,
|
||||
because garbage collection of other values is invisible to the program
|
||||
-- it happens when needed, and is not observable. But if you can, save
|
||||
yourself the headache and build your program in such a way that it
|
||||
doesn't need finalization.
|
||||
|
||||
|
||||
@node Foreign Objects and Scheme
|
||||
@subsection Foreign Objects and Scheme
|
||||
|
||||
It is also possible to create foreign objects and object types from
|
||||
Scheme, and to access fields of foreign objects from Scheme. For
|
||||
example, the file example from the last section could be equivalently
|
||||
expressed as:
|
||||
|
||||
@example
|
||||
(define-module (my-file)
|
||||
#:use-module (system foreign-object)
|
||||
#:use-module ((oop goops) #:select (make))
|
||||
#:export (make-file))
|
||||
|
||||
(define (finalize-file file)
|
||||
(let ((fd (struct-ref file 0)))
|
||||
(unless (< fd 0)
|
||||
(struct-set! file 0 -1)
|
||||
(close-fdes fd))))
|
||||
|
||||
(define <file>
|
||||
(make-foreign-object-type '<file> '(fd)
|
||||
#:finalizer finalize-file))
|
||||
|
||||
(define (make-file fd)
|
||||
(make <file> #:fd fd))
|
||||
@end example
|
||||
|
||||
Here we see that the result of @code{make-foreign-object-type}, which is
|
||||
the equivalent of @code{scm_make_foreign_object_type}, is a struct
|
||||
vtable. @xref{Vtables}, for more information. To instantiate the
|
||||
foreign object, which is really a Guile struct, we use @code{make}. (We
|
||||
could have used @code{make-struct/no-tail}, but as an implementation
|
||||
detail, finalizers are attached in the @code{initialize} method called
|
||||
by @code{make}). To access the fields, we use @code{struct-ref} and
|
||||
@code{struct-set!}. @xref{Structure Basics}.
|
||||
|
||||
There is a convenience syntax, @code{define-foreign-object-type}, that
|
||||
defines a type along with a constructor, and getters for the fields. An
|
||||
appropriate invocation of @code{define-foreign-object-type} for the
|
||||
file object type could look like this:
|
||||
|
||||
@example
|
||||
(use-modules (system foreign-object))
|
||||
|
||||
(define-foreign-object-type <file>
|
||||
make-file
|
||||
(fd)
|
||||
#:finalizer finalize-file)
|
||||
@end example
|
||||
|
||||
This defines the @code{<file>} type with one field, a @code{make-file}
|
||||
constructor, and a getter for the @code{fd} field, bound to @code{fd}.
|
||||
|
||||
Foreign object types are not only vtables but are actually GOOPS
|
||||
classes, as hinted at above. @xref{GOOPS}, for more on Guile's
|
||||
object-oriented programming system. Thus one can define print and
|
||||
equality methods using GOOPS:
|
||||
|
||||
@example
|
||||
(use-modules (oop goops))
|
||||
|
||||
(define-method (write (file <file>) port)
|
||||
;; Assuming existence of the `fd' getter
|
||||
(format port "#<<file> ~a>" (fd file)))
|
||||
|
||||
(define-method (equal? (a <file>) (b <file>))
|
||||
(eqv? (fd a) (fd b)))
|
||||
@end example
|
||||
|
||||
One can even sub-class foreign types.
|
||||
|
||||
@example
|
||||
(define-class <named-file> (<file>)
|
||||
(name #:init-keyword #:name #:init-value #f #:accessor name))
|
||||
@end example
|
||||
|
||||
The question arises of how to construct these values, given that
|
||||
@code{make-file} returns a plain old @code{<file>} object. It turns out
|
||||
that you can use the GOOPS construction interface, where every field of
|
||||
the foreign object has an associated initialization keyword argument.
|
||||
|
||||
@example
|
||||
(define* (my-open-file name #:optional (flags O_RDONLY))
|
||||
(make <named-file> #:fd (open-fdes name flags) #:name name))
|
||||
|
||||
(define-method (write (file <named-file>) port)
|
||||
(format port "#<<file> ~s ~a>" (name file) (fd file)))
|
||||
@end example
|
||||
|
||||
@xref{Foreign Objects}, for full documentation on the Scheme interface
|
||||
to foreign objects. @xref{GOOPS}, for more on GOOPS.
|
||||
|
||||
As a final note, you might wonder how this system supports encapsulation
|
||||
of sensitive values. First, we have to recognize that some facilities
|
||||
are essentially unsafe and have global scope. For example, in C, the
|
||||
integrity and confidentiality of a part of a program is at the mercy of
|
||||
every other part of that program -- because any part of the program can
|
||||
read and write anything in its address space. At the same time,
|
||||
principled access to structured data is organized in C on lexical
|
||||
boundaries; if you don't expose accessors for your object, you trust
|
||||
other parts of the program not to work around that barrier.
|
||||
|
||||
The situation is not dissimilar in Scheme. Although Scheme's unsafe
|
||||
constructs are fewer in number than in C, they do exist. The
|
||||
@code{(system foreign)} module can be used to violate confidentiality
|
||||
and integrity, and shouldn't be exposed to untrusted code. Although
|
||||
@code{struct-ref} and @code{struct-set!} are less unsafe, they still
|
||||
have a cross-cutting capability of drilling through abstractions.
|
||||
Performing a @code{struct-set!} on a foreign object slot could cause
|
||||
unsafe foreign code to crash. Ultimately, structures in Scheme are
|
||||
capabilities for abstraction, and not abstractions themselves.
|
||||
|
||||
That leaves us with the lexical capabilities, like constructors and
|
||||
accessors. Here is where encapsulation lies: the practical degree to
|
||||
which the innards of your foreign objects are exposed is the degree to
|
||||
which their accessors are lexically available in user code. If you want
|
||||
to allow users to reference fields of your foreign object, provide them
|
||||
with a getter. Otherwise you should assume that the only access to your
|
||||
object may come from your code, which has the relevant authority, or via
|
||||
code with access to cross-cutting @code{struct-ref} and such, which also
|
||||
has the cross-cutting authority.
|
|
@ -1,6 +1,6 @@
|
|||
@c -*-texinfo-*-
|
||||
@c This is part of the GNU Guile Reference Manual.
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2014
|
||||
@c Free Software Foundation, Inc.
|
||||
@c See the file guile.texi for copying conditions.
|
||||
|
||||
|
@ -46,7 +46,7 @@ applications in general.
|
|||
@menu
|
||||
* Dia Objective:: Deciding why you want to add Guile.
|
||||
* Dia Steps:: Four steps required to add Guile.
|
||||
* Dia Smobs:: How to represent Dia data in Scheme.
|
||||
* Dia Objects:: How to represent Dia data in Scheme.
|
||||
* Dia Primitives:: Writing Guile primitives for Dia.
|
||||
* Dia Hook:: Providing a hook for Scheme evaluation.
|
||||
* Dia Structure:: Overall structure for adding Guile.
|
||||
|
@ -115,8 +115,8 @@ First, you need a way of representing your application-specific objects
|
|||
--- such as @code{shape} in the previous example --- when they are
|
||||
passed into the Scheme world. Unless your objects are so simple that
|
||||
they map naturally into builtin Scheme data types like numbers and
|
||||
strings, you will probably want to use Guile's @dfn{SMOB} interface to
|
||||
create a new Scheme data type for your objects.
|
||||
strings, you will probably want to use Guile's @dfn{foreign object}
|
||||
interface to create a new Scheme data type for your objects.
|
||||
|
||||
Second, you need to write code for the basic operations like
|
||||
@code{for-each-shape} and @code{square?} such that they access and
|
||||
|
@ -129,17 +129,18 @@ evaluated.
|
|||
|
||||
Finally, you need to restructure your top-level application C code a
|
||||
little so that it initializes the Guile interpreter correctly and
|
||||
declares your @dfn{SMOBs} and @dfn{primitives} to the Scheme world.
|
||||
declares your @dfn{foreign objects} and @dfn{primitives} to the Scheme
|
||||
world.
|
||||
|
||||
The following subsections expand on these four points in turn.
|
||||
|
||||
|
||||
@node Dia Smobs
|
||||
@node Dia Objects
|
||||
@subsubsection How to Represent Dia Data in Scheme
|
||||
|
||||
For all but the most trivial applications, you will probably want to
|
||||
allow some representation of your domain objects to exist on the Scheme
|
||||
level. This is where the idea of SMOBs comes in, and with it issues of
|
||||
level. This is where foreign objects come in, and with them issues of
|
||||
lifetime management and garbage collection.
|
||||
|
||||
To get more concrete about this, let's look again at the example we gave
|
||||
|
@ -189,21 +190,21 @@ finished evaluation. How do we avoid this happening?
|
|||
@end itemize
|
||||
|
||||
One resolution of these issues is for the Scheme-level representation of
|
||||
a shape to be a new, Scheme-specific C structure wrapped up as a SMOB.
|
||||
The SMOB is what is passed into and out of Scheme code, and the
|
||||
Scheme-specific C structure inside the SMOB points to Dia's underlying C
|
||||
structure so that the code for primitives like @code{square?} can get at
|
||||
it.
|
||||
a shape to be a new, Scheme-specific C structure wrapped up as a foreign
|
||||
object. The foreign object is what is passed into and out of Scheme
|
||||
code, and the Scheme-specific C structure inside the foreign object
|
||||
points to Dia's underlying C structure so that the code for primitives
|
||||
like @code{square?} can get at it.
|
||||
|
||||
To cope with an underlying shape being deleted while Scheme code is
|
||||
still holding onto a Scheme shape value, the underlying C structure
|
||||
should have a new field that points to the Scheme-specific SMOB. When a
|
||||
shape is deleted, the relevant code chains through to the
|
||||
Scheme-specific structure and sets its pointer back to the underlying
|
||||
structure to NULL. Thus the SMOB value for the shape continues to
|
||||
exist, but any primitive code that tries to use it will detect that the
|
||||
underlying shape has been deleted because the underlying structure
|
||||
pointer is NULL.
|
||||
should have a new field that points to the Scheme-specific foreign
|
||||
object. When a shape is deleted, the relevant code chains through to
|
||||
the Scheme-specific structure and sets its pointer back to the
|
||||
underlying structure to NULL. Thus the foreign object value for the
|
||||
shape continues to exist, but any primitive code that tries to use it
|
||||
will detect that the underlying shape has been deleted because the
|
||||
underlying structure pointer is NULL.
|
||||
|
||||
So, to summarize the steps involved in this resolution of the problem
|
||||
(and assuming that the underlying C structure for a shape is
|
||||
|
@ -238,33 +239,33 @@ struct dia_shape
|
|||
underlying shape is deleted.
|
||||
|
||||
@item
|
||||
Wrap @code{struct dia_guile_shape} as a SMOB type.
|
||||
Wrap @code{struct dia_guile_shape} as a foreign object type.
|
||||
|
||||
@item
|
||||
Whenever you need to represent a C shape onto the Scheme level, create a
|
||||
SMOB instance for it, and pass that.
|
||||
foreign object instance for it, and pass that.
|
||||
|
||||
@item
|
||||
In primitive code that receives a shape SMOB instance, check the
|
||||
In primitive code that receives a shape foreign object instance, check the
|
||||
@code{c_shape} field when decoding it, to find out whether the
|
||||
underlying C shape is still there.
|
||||
@end itemize
|
||||
|
||||
As far as memory management is concerned, the SMOB values and their
|
||||
Scheme-specific structures are under the control of the garbage
|
||||
As far as memory management is concerned, the foreign object values and
|
||||
their Scheme-specific structures are under the control of the garbage
|
||||
collector, whereas the underlying C structures are explicitly managed in
|
||||
exactly the same way that Dia managed them before we thought of adding
|
||||
Guile.
|
||||
|
||||
When the garbage collector decides to free a shape SMOB value, it calls
|
||||
the @dfn{SMOB free} function that was specified when defining the shape
|
||||
SMOB type. To maintain the correctness of the @code{guile_shape} field
|
||||
in the underlying C structure, this function should chain through to the
|
||||
underlying C structure (if it still exists) and set its
|
||||
@code{guile_shape} field to NULL.
|
||||
When the garbage collector decides to free a shape foreign object value,
|
||||
it calls the @dfn{finalizer} function that was specified when defining
|
||||
the shape foreign object type. To maintain the correctness of the
|
||||
@code{guile_shape} field in the underlying C structure, this function
|
||||
should chain through to the underlying C structure (if it still exists)
|
||||
and set its @code{guile_shape} field to NULL.
|
||||
|
||||
For full documentation on defining and using SMOB types, see
|
||||
@ref{Defining New Types (Smobs)}.
|
||||
For full documentation on defining and using foreign object types, see
|
||||
@ref{Defining New Foreign Object Types}.
|
||||
|
||||
|
||||
@node Dia Primitives
|
||||
|
@ -283,11 +284,11 @@ static SCM square_p (SCM shape)
|
|||
@{
|
||||
struct dia_guile_shape * guile_shape;
|
||||
|
||||
/* Check that arg is really a shape SMOB. */
|
||||
scm_assert_smob_type (shape_tag, shape);
|
||||
/* Check that arg is really a shape object. */
|
||||
scm_assert_foreign_object_type (shape_type, shape);
|
||||
|
||||
/* Access Scheme-specific shape structure. */
|
||||
guile_shape = SCM_SMOB_DATA (shape);
|
||||
guile_shape = scm_foreign_object_ref (shape, 0);
|
||||
|
||||
/* Find out if underlying shape exists and is a
|
||||
square; return answer as a Scheme boolean. */
|
||||
|
@ -297,26 +298,28 @@ static SCM square_p (SCM shape)
|
|||
@end lisp
|
||||
|
||||
Notice how easy it is to chain through from the @code{SCM shape}
|
||||
parameter that @code{square_p} receives --- which is a SMOB --- to the
|
||||
Scheme-specific structure inside the SMOB, and thence to the underlying
|
||||
C structure for the shape.
|
||||
parameter that @code{square_p} receives --- which is a foreign object
|
||||
--- to the Scheme-specific structure inside the foreign object, and
|
||||
thence to the underlying C structure for the shape.
|
||||
|
||||
In this code, @code{scm_assert_smob_type}, @code{SCM_SMOB_DATA}, and
|
||||
@code{scm_from_bool} are from the standard Guile API. We assume that
|
||||
@code{shape_tag} was given to us when we made the shape SMOB type, using
|
||||
@code{scm_make_smob_type}. The call to @code{scm_assert_smob_type}
|
||||
ensures that @var{shape} is indeed a shape. This is needed to guard
|
||||
against Scheme code using the @code{square?} procedure incorrectly, as
|
||||
in @code{(square? "hello")}; Scheme's latent typing means that usage
|
||||
errors like this must be caught at run time.
|
||||
In this code, @code{scm_assert_foreign_object_type},
|
||||
@code{scm_foreign_object_ref}, and @code{scm_from_bool} are from the
|
||||
standard Guile API. We assume that @code{shape_type} was given to us
|
||||
when we made the shape foreign object type, using
|
||||
@code{scm_make_foreign_object_type}. The call to
|
||||
@code{scm_assert_foreign_object_type} ensures that @var{shape} is indeed
|
||||
a shape. This is needed to guard against Scheme code using the
|
||||
@code{square?} procedure incorrectly, as in @code{(square? "hello")};
|
||||
Scheme's latent typing means that usage errors like this must be caught
|
||||
at run time.
|
||||
|
||||
Having written the C code for your primitives, you need to make them
|
||||
available as Scheme procedures by calling the @code{scm_c_define_gsubr}
|
||||
function. @code{scm_c_define_gsubr} (@pxref{Primitive Procedures}) takes arguments that
|
||||
specify the Scheme-level name for the primitive and how many required,
|
||||
optional and rest arguments it can accept. The @code{square?} primitive
|
||||
always requires exactly one argument, so the call to make it available
|
||||
in Scheme reads like this:
|
||||
function. @code{scm_c_define_gsubr} (@pxref{Primitive Procedures})
|
||||
takes arguments that specify the Scheme-level name for the primitive and
|
||||
how many required, optional and rest arguments it can accept. The
|
||||
@code{square?} primitive always requires exactly one argument, so the
|
||||
call to make it available in Scheme reads like this:
|
||||
|
||||
@lisp
|
||||
scm_c_define_gsubr ("square?", 1, 0, 0, square_p);
|
||||
|
@ -384,7 +387,7 @@ do lots of initialization and setup stuff
|
|||
|
||||
@itemize @bullet
|
||||
@item
|
||||
define all SMOB types
|
||||
define all foreign object types
|
||||
@item
|
||||
export primitives to Scheme using @code{scm_c_define_gsubr}
|
||||
@item
|
||||
|
@ -397,13 +400,13 @@ In other words, you move the guts of what was previously in your
|
|||
then add a @code{scm_boot_guile} call, with @code{inner_main} as a
|
||||
parameter, to the end of @code{main}.
|
||||
|
||||
Assuming that you are using SMOBs and have written primitive code as
|
||||
described in the preceding subsections, you also need to insert calls to
|
||||
declare your new SMOBs and export the primitives to Scheme. These
|
||||
declarations must happen @emph{inside} the dynamic scope of the
|
||||
@code{scm_boot_guile} call, but also @emph{before} any code is run that
|
||||
could possibly use them --- the beginning of @code{inner_main} is an
|
||||
ideal place for this.
|
||||
Assuming that you are using foreign objects and have written primitive
|
||||
code as described in the preceding subsections, you also need to insert
|
||||
calls to declare your new foreign objects and export the primitives to
|
||||
Scheme. These declarations must happen @emph{inside} the dynamic scope
|
||||
of the @code{scm_boot_guile} call, but also @emph{before} any code is
|
||||
run that could possibly use them --- the beginning of @code{inner_main}
|
||||
is an ideal place for this.
|
||||
|
||||
|
||||
@node Dia Advanced
|
||||
|
@ -425,7 +428,8 @@ move the code that lays out and displays Dia objects from C to Scheme.
|
|||
|
||||
As you follow this path, it naturally becomes less useful to maintain a
|
||||
distinction between Dia's original non-Guile-related source code, and
|
||||
its later code implementing SMOBs and primitives for the Scheme world.
|
||||
its later code implementing foreign objects and primitives for the
|
||||
Scheme world.
|
||||
|
||||
For example, suppose that the original source code had a
|
||||
@code{dia_change_fill_pattern} function:
|
||||
|
@ -440,8 +444,8 @@ void dia_change_fill_pattern (struct dia_shape * shape,
|
|||
|
||||
During initial Guile integration, you add a @code{change_fill_pattern}
|
||||
primitive for Scheme purposes, which accesses the underlying structures
|
||||
from its SMOB values and uses @code{dia_change_fill_pattern} to do the
|
||||
real work:
|
||||
from its foreign object values and uses @code{dia_change_fill_pattern}
|
||||
to do the real work:
|
||||
|
||||
@lisp
|
||||
SCM change_fill_pattern (SCM shape, SCM pattern)
|
||||
|
@ -487,22 +491,23 @@ So further Guile integration progressively @emph{reduces} the amount of
|
|||
functional C code that you have to maintain over the long term.
|
||||
|
||||
A similar argument applies to data representation. In the discussion of
|
||||
SMOBs earlier, issues arose because of the different memory management
|
||||
and lifetime models that normally apply to data structures in C and in
|
||||
Scheme. However, with further Guile integration, you can resolve this
|
||||
issue in a more radical way by allowing all your data structures to be
|
||||
under the control of the garbage collector, and kept alive by references
|
||||
from the Scheme world. Instead of maintaining an array or linked list
|
||||
of shapes in C, you would instead maintain a list in Scheme.
|
||||
foreign objects earlier, issues arose because of the different memory
|
||||
management and lifetime models that normally apply to data structures in
|
||||
C and in Scheme. However, with further Guile integration, you can
|
||||
resolve this issue in a more radical way by allowing all your data
|
||||
structures to be under the control of the garbage collector, and kept
|
||||
alive by references from the Scheme world. Instead of maintaining an
|
||||
array or linked list of shapes in C, you would instead maintain a list
|
||||
in Scheme.
|
||||
|
||||
Rather like the coalescing of @code{dia_change_fill_pattern} and
|
||||
@code{change_fill_pattern}, the practical upshot of such a change is
|
||||
that you would no longer have to keep the @code{dia_shape} and
|
||||
@code{dia_guile_shape} structures separate, and so wouldn't need to
|
||||
worry about the pointers between them. Instead, you could change the
|
||||
SMOB definition to wrap the @code{dia_shape} structure directly, and
|
||||
send @code{dia_guile_shape} off to the scrap yard. Cut out the middle
|
||||
man!
|
||||
foreign object definition to wrap the @code{dia_shape} structure
|
||||
directly, and send @code{dia_guile_shape} off to the scrap yard. Cut
|
||||
out the middle man!
|
||||
|
||||
Finally, we come to the holy grail of Guile's free software / extension
|
||||
language approach. Once you have a Scheme representation for
|
||||
|
|
|
@ -1,670 +0,0 @@
|
|||
@c -*-texinfo-*-
|
||||
@c This is part of the GNU Guile Reference Manual.
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010, 2011, 2013, 2014
|
||||
@c Free Software Foundation, Inc.
|
||||
@c See the file guile.texi for copying conditions.
|
||||
|
||||
@node Defining New Types (Smobs)
|
||||
@section Defining New Types (Smobs)
|
||||
|
||||
@dfn{Smobs} are Guile's mechanism for adding new primitive types to
|
||||
the system. The term ``smob'' was coined by Aubrey Jaffer, who says
|
||||
it comes from ``small object'', referring to the fact that they are
|
||||
quite limited in size: they can hold just one pointer to a larger
|
||||
memory block plus 16 extra bits.
|
||||
|
||||
To define a new smob type, the programmer provides Guile with some
|
||||
essential information about the type --- how to print it, how to
|
||||
garbage collect it, and so on --- and Guile allocates a fresh type tag
|
||||
for it. The programmer can then use @code{scm_c_define_gsubr} to make
|
||||
a set of C functions visible to Scheme code that create and operate on
|
||||
these objects.
|
||||
|
||||
(You can find a complete version of the example code used in this
|
||||
section in the Guile distribution, in @file{doc/example-smob}. That
|
||||
directory includes a makefile and a suitable @code{main} function, so
|
||||
you can build a complete interactive Guile shell, extended with the
|
||||
datatypes described here.)
|
||||
|
||||
@menu
|
||||
* Describing a New Type::
|
||||
* Creating Smob Instances::
|
||||
* Type checking::
|
||||
* Garbage Collecting Smobs::
|
||||
* Remembering During Operations::
|
||||
* Double Smobs::
|
||||
* The Complete Example::
|
||||
@end menu
|
||||
|
||||
@node Describing a New Type
|
||||
@subsection Describing a New Type
|
||||
|
||||
To define a new type, the programmer must write two functions to
|
||||
manage instances of the type:
|
||||
|
||||
@table @code
|
||||
@item print
|
||||
Guile will apply this function to each instance of the new type to print
|
||||
the value, as for @code{display} or @code{write}. The default print
|
||||
function prints @code{#<NAME ADDRESS>} where @code{NAME} is the first
|
||||
argument passed to @code{scm_make_smob_type}.
|
||||
|
||||
@item equalp
|
||||
If Scheme code asks the @code{equal?} function to compare two instances
|
||||
of the same smob type, Guile calls this function. It should return
|
||||
@code{SCM_BOOL_T} if @var{a} and @var{b} should be considered
|
||||
@code{equal?}, or @code{SCM_BOOL_F} otherwise. If @code{equalp} is
|
||||
@code{NULL}, @code{equal?} will assume that two instances of this type are
|
||||
never @code{equal?} unless they are @code{eq?}.
|
||||
|
||||
@end table
|
||||
|
||||
When the only resource associated with a smob is memory managed by the
|
||||
garbage collector---i.e., memory allocated with the @code{scm_gc_malloc}
|
||||
functions---this is sufficient. However, when a smob is associated with
|
||||
other kinds of resources, it may be necessary to define one of the
|
||||
following functions, or both:
|
||||
|
||||
@table @code
|
||||
@item mark
|
||||
Guile will apply this function to each instance of the new type it
|
||||
encounters during garbage collection. This function is responsible for
|
||||
telling the collector about any other @code{SCM} values that the object
|
||||
has stored, and that are in memory regions not already scanned by the
|
||||
garbage collector. @xref{Garbage Collecting Smobs}, for more details.
|
||||
|
||||
@item free
|
||||
Guile will apply this function to each instance of the new type that is
|
||||
to be deallocated. The function should release all resources held by
|
||||
the object. This is analogous to the Java finalization method---it is
|
||||
invoked at an unspecified time (when garbage collection occurs) after
|
||||
the object is dead. @xref{Garbage Collecting Smobs}, for more details.
|
||||
|
||||
This function operates while the heap is in an inconsistent state and
|
||||
must therefore be careful. @xref{Smobs}, for details about what this
|
||||
function is allowed to do.
|
||||
@end table
|
||||
|
||||
To actually register the new smob type, call @code{scm_make_smob_type}.
|
||||
It returns a value of type @code{scm_t_bits} which identifies the new
|
||||
smob type.
|
||||
|
||||
The four special functions described above are registered by calling
|
||||
one of @code{scm_set_smob_mark}, @code{scm_set_smob_free},
|
||||
@code{scm_set_smob_print}, or @code{scm_set_smob_equalp}, as
|
||||
appropriate. Each function is intended to be used at most once per
|
||||
type, and the call should be placed immediately following the call to
|
||||
@code{scm_make_smob_type}.
|
||||
|
||||
There can only be at most 256 different smob types in the system.
|
||||
Instead of registering a huge number of smob types (for example, one
|
||||
for each relevant C struct in your application), it is sometimes
|
||||
better to register just one and implement a second layer of type
|
||||
dispatching on top of it. This second layer might use the 16 extra
|
||||
bits to extend its type, for example.
|
||||
|
||||
Here is how one might declare and register a new type representing
|
||||
eight-bit gray-scale images:
|
||||
|
||||
@example
|
||||
#include <libguile.h>
|
||||
|
||||
struct image @{
|
||||
int width, height;
|
||||
char *pixels;
|
||||
|
||||
/* The name of this image */
|
||||
SCM name;
|
||||
|
||||
/* A function to call when this image is
|
||||
modified, e.g., to update the screen,
|
||||
or SCM_BOOL_F if no action necessary */
|
||||
SCM update_func;
|
||||
@};
|
||||
|
||||
static scm_t_bits image_tag;
|
||||
|
||||
void
|
||||
init_image_type (void)
|
||||
@{
|
||||
image_tag = scm_make_smob_type ("image", sizeof (struct image));
|
||||
scm_set_smob_mark (image_tag, mark_image);
|
||||
scm_set_smob_free (image_tag, free_image);
|
||||
scm_set_smob_print (image_tag, print_image);
|
||||
@}
|
||||
@end example
|
||||
|
||||
|
||||
@node Creating Smob Instances
|
||||
@subsection Creating Smob Instances
|
||||
|
||||
Normally, smobs can have one @emph{immediate} word of data. This word
|
||||
stores either a pointer to an additional memory block that holds the
|
||||
real data, or it might hold the data itself when it fits. The word is
|
||||
large enough for a @code{SCM} value, a pointer to @code{void}, or an
|
||||
integer that fits into a @code{size_t} or @code{ssize_t}.
|
||||
|
||||
You can also create smobs that have two or three immediate words, and
|
||||
when these words suffice to store all data, it is more efficient to use
|
||||
these super-sized smobs instead of using a normal smob plus a memory
|
||||
block. @xref{Double Smobs}, for their discussion.
|
||||
|
||||
Guile provides functions for managing memory which are often helpful
|
||||
when implementing smobs. @xref{Memory Blocks}.
|
||||
|
||||
To retrieve the immediate word of a smob, you use the macro
|
||||
@code{SCM_SMOB_DATA}. It can be set with @code{SCM_SET_SMOB_DATA}.
|
||||
The 16 extra bits can be accessed with @code{SCM_SMOB_FLAGS} and
|
||||
@code{SCM_SET_SMOB_FLAGS}.
|
||||
|
||||
The two macros @code{SCM_SMOB_DATA} and @code{SCM_SET_SMOB_DATA} treat
|
||||
the immediate word as if it were of type @code{scm_t_bits}, which is
|
||||
an unsigned integer type large enough to hold a pointer to
|
||||
@code{void}. Thus you can use these macros to store arbitrary
|
||||
pointers in the smob word.
|
||||
|
||||
When you want to store a @code{SCM} value directly in the immediate
|
||||
word of a smob, you should use the macros @code{SCM_SMOB_OBJECT} and
|
||||
@code{SCM_SET_SMOB_OBJECT} to access it.
|
||||
|
||||
Creating a smob instance can be tricky when it consists of multiple
|
||||
steps that allocate resources. Most of the time, this is mainly about
|
||||
allocating memory to hold associated data structures. Using memory
|
||||
managed by the garbage collector simplifies things: the garbage
|
||||
collector will automatically scan those data structures for pointers,
|
||||
and reclaim them when they are no longer referenced.
|
||||
|
||||
Continuing the example from above, if the global variable
|
||||
@code{image_tag} contains a tag returned by @code{scm_make_smob_type},
|
||||
here is how we could construct a smob whose immediate word contains a
|
||||
pointer to a freshly allocated @code{struct image}:
|
||||
|
||||
@example
|
||||
SCM
|
||||
make_image (SCM name, SCM s_width, SCM s_height)
|
||||
@{
|
||||
SCM smob;
|
||||
struct image *image;
|
||||
int width = scm_to_int (s_width);
|
||||
int height = scm_to_int (s_height);
|
||||
|
||||
/* Step 1: Allocate the memory block.
|
||||
*/
|
||||
image = (struct image *)
|
||||
scm_gc_malloc (sizeof (struct image), "image");
|
||||
|
||||
/* Step 2: Initialize it with straight code.
|
||||
*/
|
||||
image->width = width;
|
||||
image->height = height;
|
||||
image->pixels = NULL;
|
||||
image->name = SCM_BOOL_F;
|
||||
image->update_func = SCM_BOOL_F;
|
||||
|
||||
/* Step 3: Create the smob.
|
||||
*/
|
||||
smob = scm_new_smob (image_tag, image);
|
||||
|
||||
/* Step 4: Finish the initialization.
|
||||
*/
|
||||
image->name = name;
|
||||
image->pixels =
|
||||
scm_gc_malloc_pointerless (width * height, "image pixels");
|
||||
|
||||
return smob;
|
||||
@}
|
||||
@end example
|
||||
|
||||
We use @code{scm_gc_malloc_pointerless} for the pixel buffer to tell the
|
||||
garbage collector not to scan it for pointers. Calls to
|
||||
@code{scm_gc_malloc}, @code{scm_new_smob}, and
|
||||
@code{scm_gc_malloc_pointerless} raise an exception in out-of-memory
|
||||
conditions; the garbage collector is able to reclaim previously
|
||||
allocated memory if that happens.
|
||||
|
||||
|
||||
@node Type checking
|
||||
@subsection Type checking
|
||||
|
||||
Functions that operate on smobs should check that the passed
|
||||
@code{SCM} value indeed is a suitable smob before accessing its data.
|
||||
They can do this with @code{scm_assert_smob_type}.
|
||||
|
||||
For example, here is a simple function that operates on an image smob,
|
||||
and checks the type of its argument.
|
||||
|
||||
@example
|
||||
SCM
|
||||
clear_image (SCM image_smob)
|
||||
@{
|
||||
int area;
|
||||
struct image *image;
|
||||
|
||||
scm_assert_smob_type (image_tag, image_smob);
|
||||
|
||||
image = (struct image *) SCM_SMOB_DATA (image_smob);
|
||||
area = image->width * image->height;
|
||||
memset (image->pixels, 0, area);
|
||||
|
||||
/* Invoke the image's update function.
|
||||
*/
|
||||
if (scm_is_true (image->update_func))
|
||||
scm_call_0 (image->update_func);
|
||||
|
||||
scm_remember_upto_here_1 (image_smob);
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
@}
|
||||
@end example
|
||||
|
||||
See @ref{Remembering During Operations} for an explanation of the call
|
||||
to @code{scm_remember_upto_here_1}.
|
||||
|
||||
|
||||
@node Garbage Collecting Smobs
|
||||
@subsection Garbage Collecting Smobs
|
||||
|
||||
Once a smob has been released to the tender mercies of the Scheme
|
||||
system, it must be prepared to survive garbage collection. In the
|
||||
example above, all the memory associated with the smob is managed by the
|
||||
garbage collector because we used the @code{scm_gc_} allocation
|
||||
functions. Thus, no special care must be taken: the garbage collector
|
||||
automatically scans them and reclaims any unused memory.
|
||||
|
||||
However, when data associated with a smob is managed in some other
|
||||
way---e.g., @code{malloc}'d memory or file descriptors---it is possible
|
||||
to specify a @emph{free} function to release those resources when the
|
||||
smob is reclaimed, and a @emph{mark} function to mark Scheme objects
|
||||
otherwise invisible to the garbage collector.
|
||||
|
||||
As described in more detail elsewhere (@pxref{Conservative GC}), every
|
||||
object in the Scheme system has a @dfn{mark bit}, which the garbage
|
||||
collector uses to tell live objects from dead ones. When collection
|
||||
starts, every object's mark bit is clear. The collector traces pointers
|
||||
through the heap, starting from objects known to be live, and sets the
|
||||
mark bit on each object it encounters. When it can find no more
|
||||
unmarked objects, the collector walks all objects, live and dead, frees
|
||||
those whose mark bits are still clear, and clears the mark bit on the
|
||||
others.
|
||||
|
||||
The two main portions of the collection are called the @dfn{mark phase},
|
||||
during which the collector marks live objects, and the @dfn{sweep
|
||||
phase}, during which the collector frees all unmarked objects.
|
||||
|
||||
The mark bit of a smob lives in a special memory region. When the
|
||||
collector encounters a smob, it sets the smob's mark bit, and uses the
|
||||
smob's type tag to find the appropriate @emph{mark} function for that
|
||||
smob. It then calls this @emph{mark} function, passing it the smob as
|
||||
its only argument.
|
||||
|
||||
The @emph{mark} function is responsible for marking any other Scheme
|
||||
objects the smob refers to. If it does not do so, the objects' mark
|
||||
bits will still be clear when the collector begins to sweep, and the
|
||||
collector will free them. If this occurs, it will probably break, or at
|
||||
least confuse, any code operating on the smob; the smob's @code{SCM}
|
||||
values will have become dangling references.
|
||||
|
||||
To mark an arbitrary Scheme object, the @emph{mark} function calls
|
||||
@code{scm_gc_mark}.
|
||||
|
||||
Thus, here is how we might write @code{mark_image}---again this is not
|
||||
needed in our example since we used the @code{scm_gc_} allocation
|
||||
routines, so this is just for the sake of illustration:
|
||||
|
||||
@example
|
||||
@group
|
||||
SCM
|
||||
mark_image (SCM image_smob)
|
||||
@{
|
||||
/* Mark the image's name and update function. */
|
||||
struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
|
||||
|
||||
scm_gc_mark (image->name);
|
||||
scm_gc_mark (image->update_func);
|
||||
|
||||
return SCM_BOOL_F;
|
||||
@}
|
||||
@end group
|
||||
@end example
|
||||
|
||||
Note that, even though the image's @code{update_func} could be an
|
||||
arbitrarily complex structure (representing a procedure and any values
|
||||
enclosed in its environment), @code{scm_gc_mark} will recurse as
|
||||
necessary to mark all its components. Because @code{scm_gc_mark} sets
|
||||
an object's mark bit before it recurses, it is not confused by
|
||||
circular structures.
|
||||
|
||||
As an optimization, the collector will mark whatever value is returned
|
||||
by the @emph{mark} function; this helps limit depth of recursion during
|
||||
the mark phase. Thus, the code above should really be written as:
|
||||
@example
|
||||
@group
|
||||
SCM
|
||||
mark_image (SCM image_smob)
|
||||
@{
|
||||
/* Mark the image's name and update function. */
|
||||
struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
|
||||
|
||||
scm_gc_mark (image->name);
|
||||
return image->update_func;
|
||||
@}
|
||||
@end group
|
||||
@end example
|
||||
|
||||
|
||||
Finally, when the collector encounters an unmarked smob during the sweep
|
||||
phase, it uses the smob's tag to find the appropriate @emph{free}
|
||||
function for the smob. It then calls that function, passing it the smob
|
||||
as its only argument.
|
||||
|
||||
The @emph{free} function must release any resources used by the smob.
|
||||
However, it must not free objects managed by the collector; the
|
||||
collector will take care of them. For historical reasons, the return
|
||||
type of the @emph{free} function should be @code{size_t}, an unsigned
|
||||
integral type; the @emph{free} function should always return zero.
|
||||
|
||||
Here is how we might write the @code{free_image} function for the image
|
||||
smob type---again for the sake of illustration, since our example does
|
||||
not need it thanks to the use of the @code{scm_gc_} allocation routines:
|
||||
@example
|
||||
size_t
|
||||
free_image (SCM image_smob)
|
||||
@{
|
||||
struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
|
||||
|
||||
scm_gc_free (image->pixels,
|
||||
image->width * image->height,
|
||||
"image pixels");
|
||||
scm_gc_free (image, sizeof (struct image), "image");
|
||||
|
||||
return 0;
|
||||
@}
|
||||
@end example
|
||||
|
||||
During the sweep phase, the garbage collector will clear the mark bits
|
||||
on all live objects. The code which implements a smob need not do this
|
||||
itself.
|
||||
|
||||
@cindex finalizer
|
||||
@cindex finalization
|
||||
|
||||
Note that the free function can be called in any context. In
|
||||
particular, if your Guile is built with support for threads, the
|
||||
finalizer will be called from a dedicated finalization thread. This
|
||||
ensures that the finalization doesn't run within the critical section of
|
||||
any other thread known to Guile. It also lowers latency, as your Guile
|
||||
program doesn't have to wait for finalizers to run. However, if your
|
||||
Guile is built without threads, the finalizers may be called within the
|
||||
critical section of some other piece of code.
|
||||
|
||||
In either case, finalizers (free functions) run concurrently with the
|
||||
main program, and so they need to be thread-safe. If for some reason
|
||||
this is impossible, perhaps because you are embedding Guile in some
|
||||
application that is not itself thread-safe, you have a few options. One
|
||||
is to use guardians instead of free functions, and arrange to pump the
|
||||
guardians for finalizable objects. @xref{Guardians}, for more
|
||||
information. The other option is to disable automatic finalization
|
||||
entirely, and arrange to call @code{scm_run_finalizers ()} at
|
||||
appropriate points. @xref{Smobs}, for more on these interfaces.
|
||||
|
||||
There is no way for smob code to be notified when collection is
|
||||
complete.
|
||||
|
||||
It is usually a good idea to minimize the amount of processing done
|
||||
during garbage collection; keep the @emph{mark} and @emph{free}
|
||||
functions very simple. Since collections occur at unpredictable times,
|
||||
it is easy for any unusual activity to interfere with normal code.
|
||||
|
||||
@node Remembering During Operations
|
||||
@subsection Remembering During Operations
|
||||
@cindex remembering
|
||||
|
||||
@c FIXME: Remove this section?
|
||||
|
||||
It's important that a smob is visible to the garbage collector
|
||||
whenever its contents are being accessed. Otherwise it could be freed
|
||||
while code is still using it.
|
||||
|
||||
For example, consider a procedure to convert image data to a list of
|
||||
pixel values.
|
||||
|
||||
@example
|
||||
SCM
|
||||
image_to_list (SCM image_smob)
|
||||
@{
|
||||
struct image *image;
|
||||
SCM lst;
|
||||
int i;
|
||||
|
||||
scm_assert_smob_type (image_tag, image_smob);
|
||||
|
||||
image = (struct image *) SCM_SMOB_DATA (image_smob);
|
||||
lst = SCM_EOL;
|
||||
for (i = image->width * image->height - 1; i >= 0; i--)
|
||||
lst = scm_cons (scm_from_char (image->pixels[i]), lst);
|
||||
|
||||
scm_remember_upto_here_1 (image_smob);
|
||||
return lst;
|
||||
@}
|
||||
@end example
|
||||
|
||||
In the loop, only the @code{image} pointer is used and the C compiler
|
||||
has no reason to keep the @code{image_smob} value anywhere. If
|
||||
@code{scm_cons} results in a garbage collection, @code{image_smob} might
|
||||
not be on the stack or anywhere else and could be freed, leaving the
|
||||
loop accessing freed data. The use of @code{scm_remember_upto_here_1}
|
||||
prevents this, by creating a reference to @code{image_smob} after all
|
||||
data accesses.
|
||||
|
||||
There's no need to do the same for @code{lst}, since that's the return
|
||||
value and the compiler will certainly keep it in a register or
|
||||
somewhere throughout the routine.
|
||||
|
||||
The @code{clear_image} example previously shown (@pxref{Type checking})
|
||||
also used @code{scm_remember_upto_here_1} for this reason.
|
||||
|
||||
It's only in quite rare circumstances that a missing
|
||||
@code{scm_remember_upto_here_1} will bite, but when it happens the
|
||||
consequences are serious. Fortunately the rule is simple: whenever
|
||||
calling a Guile library function or doing something that might, ensure
|
||||
that the @code{SCM} of a smob is referenced past all accesses to its
|
||||
insides. Do this by adding an @code{scm_remember_upto_here_1} if
|
||||
there are no other references.
|
||||
|
||||
In a multi-threaded program, the rule is the same. As far as a given
|
||||
thread is concerned, a garbage collection still only occurs within a
|
||||
Guile library function, not at an arbitrary time. (Guile waits for all
|
||||
threads to reach one of its library functions, and holds them there
|
||||
while the collector runs.)
|
||||
|
||||
@node Double Smobs
|
||||
@subsection Double Smobs
|
||||
|
||||
@c FIXME: Remove this section?
|
||||
|
||||
Smobs are called smob because they are small: they normally have only
|
||||
room for one @code{void*} or @code{SCM} value plus 16 bits. The
|
||||
reason for this is that smobs are directly implemented by using the
|
||||
low-level, two-word cells of Guile that are also used to implement
|
||||
pairs, for example. (@pxref{Data Representation} for the
|
||||
details.) One word of the two-word cells is used for
|
||||
@code{SCM_SMOB_DATA} (or @code{SCM_SMOB_OBJECT}), the other contains
|
||||
the 16-bit type tag and the 16 extra bits.
|
||||
|
||||
In addition to the fundamental two-word cells, Guile also has
|
||||
four-word cells, which are appropriately called @dfn{double cells}.
|
||||
You can use them for @dfn{double smobs} and get two more immediate
|
||||
words of type @code{scm_t_bits}.
|
||||
|
||||
A double smob is created with @code{scm_new_double_smob}. Its immediate
|
||||
words can be retrieved as @code{scm_t_bits} with @code{SCM_SMOB_DATA_2}
|
||||
and @code{SCM_SMOB_DATA_3} in addition to @code{SCM_SMOB_DATA}.
|
||||
Unsurprisingly, the words can be set to @code{scm_t_bits} values with
|
||||
@code{SCM_SET_SMOB_DATA_2} and @code{SCM_SET_SMOB_DATA_3}.
|
||||
|
||||
Of course there are also @code{SCM_SMOB_OBJECT_2},
|
||||
@code{SCM_SMOB_OBJECT_3}, @code{SCM_SET_SMOB_OBJECT_2}, and
|
||||
@code{SCM_SET_SMOB_OBJECT_3}.
|
||||
|
||||
@node The Complete Example
|
||||
@subsection The Complete Example
|
||||
|
||||
Here is the complete text of the implementation of the image datatype,
|
||||
as presented in the sections above. We also provide a definition for
|
||||
the smob's @emph{print} function, and make some objects and functions
|
||||
static, to clarify exactly what the surrounding code is using.
|
||||
|
||||
As mentioned above, you can find this code in the Guile distribution, in
|
||||
@file{doc/example-smob}. That directory includes a makefile and a
|
||||
suitable @code{main} function, so you can build a complete interactive
|
||||
Guile shell, extended with the datatypes described here.)
|
||||
|
||||
@example
|
||||
/* file "image-type.c" */
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <libguile.h>
|
||||
|
||||
static scm_t_bits image_tag;
|
||||
|
||||
struct image @{
|
||||
int width, height;
|
||||
char *pixels;
|
||||
|
||||
/* The name of this image */
|
||||
SCM name;
|
||||
|
||||
/* A function to call when this image is
|
||||
modified, e.g., to update the screen,
|
||||
or SCM_BOOL_F if no action necessary */
|
||||
SCM update_func;
|
||||
@};
|
||||
|
||||
static SCM
|
||||
make_image (SCM name, SCM s_width, SCM s_height)
|
||||
@{
|
||||
SCM smob;
|
||||
struct image *image;
|
||||
int width = scm_to_int (s_width);
|
||||
int height = scm_to_int (s_height);
|
||||
|
||||
/* Step 1: Allocate the memory block.
|
||||
*/
|
||||
image = (struct image *)
|
||||
scm_gc_malloc (sizeof (struct image), "image");
|
||||
|
||||
/* Step 2: Initialize it with straight code.
|
||||
*/
|
||||
image->width = width;
|
||||
image->height = height;
|
||||
image->pixels = NULL;
|
||||
image->name = SCM_BOOL_F;
|
||||
image->update_func = SCM_BOOL_F;
|
||||
|
||||
/* Step 3: Create the smob.
|
||||
*/
|
||||
smob = scm_new_smob (image_tag, image);
|
||||
|
||||
/* Step 4: Finish the initialization.
|
||||
*/
|
||||
image->name = name;
|
||||
image->pixels =
|
||||
scm_gc_malloc (width * height, "image pixels");
|
||||
|
||||
return smob;
|
||||
@}
|
||||
|
||||
SCM
|
||||
clear_image (SCM image_smob)
|
||||
@{
|
||||
int area;
|
||||
struct image *image;
|
||||
|
||||
scm_assert_smob_type (image_tag, image_smob);
|
||||
|
||||
image = (struct image *) SCM_SMOB_DATA (image_smob);
|
||||
area = image->width * image->height;
|
||||
memset (image->pixels, 0, area);
|
||||
|
||||
/* Invoke the image's update function.
|
||||
*/
|
||||
if (scm_is_true (image->update_func))
|
||||
scm_call_0 (image->update_func);
|
||||
|
||||
scm_remember_upto_here_1 (image_smob);
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
@}
|
||||
|
||||
static SCM
|
||||
mark_image (SCM image_smob)
|
||||
@{
|
||||
/* Mark the image's name and update function. */
|
||||
struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
|
||||
|
||||
scm_gc_mark (image->name);
|
||||
return image->update_func;
|
||||
@}
|
||||
|
||||
static size_t
|
||||
free_image (SCM image_smob)
|
||||
@{
|
||||
struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
|
||||
|
||||
scm_gc_free (image->pixels,
|
||||
image->width * image->height,
|
||||
"image pixels");
|
||||
scm_gc_free (image, sizeof (struct image), "image");
|
||||
|
||||
return 0;
|
||||
@}
|
||||
|
||||
static int
|
||||
print_image (SCM image_smob, SCM port, scm_print_state *pstate)
|
||||
@{
|
||||
struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
|
||||
|
||||
scm_puts ("#<image ", port);
|
||||
scm_display (image->name, port);
|
||||
scm_puts (">", port);
|
||||
|
||||
/* non-zero means success */
|
||||
return 1;
|
||||
@}
|
||||
|
||||
void
|
||||
init_image_type (void)
|
||||
@{
|
||||
image_tag = scm_make_smob_type ("image", sizeof (struct image));
|
||||
scm_set_smob_mark (image_tag, mark_image);
|
||||
scm_set_smob_free (image_tag, free_image);
|
||||
scm_set_smob_print (image_tag, print_image);
|
||||
|
||||
scm_c_define_gsubr ("clear-image", 1, 0, 0, clear_image);
|
||||
scm_c_define_gsubr ("make-image", 3, 0, 0, make_image);
|
||||
@}
|
||||
@end example
|
||||
|
||||
Here is a sample build and interaction with the code from the
|
||||
@file{example-smob} directory, on the author's machine:
|
||||
|
||||
@example
|
||||
zwingli:example-smob$ make CC=gcc
|
||||
gcc `pkg-config --cflags guile-@value{EFFECTIVE-VERSION}` -c image-type.c -o image-type.o
|
||||
gcc `pkg-config --cflags guile-@value{EFFECTIVE-VERSION}` -c myguile.c -o myguile.o
|
||||
gcc image-type.o myguile.o `pkg-config --libs guile-@value{EFFECTIVE-VERSION}` -o myguile
|
||||
zwingli:example-smob$ ./myguile
|
||||
guile> make-image
|
||||
#<primitive-procedure make-image>
|
||||
guile> (define i (make-image "Whistler's Mother" 100 100))
|
||||
guile> i
|
||||
#<image Whistler's Mother>
|
||||
guile> (clear-image i)
|
||||
guile> (clear-image 4)
|
||||
ERROR: In procedure clear-image in expression (clear-image 4):
|
||||
ERROR: Wrong type (expecting image): 4
|
||||
ABORT: (wrong-type-arg)
|
||||
|
||||
Type "(backtrace)" to get more information.
|
||||
guile>
|
||||
@end example
|
|
@ -1,6 +1,6 @@
|
|||
@c -*-texinfo-*-
|
||||
@c This is part of the GNU Guile Reference Manual.
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2012
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2012, 2014
|
||||
@c Free Software Foundation, Inc.
|
||||
@c See the file guile.texi for copying conditions.
|
||||
|
||||
|
@ -61,10 +61,10 @@ implemented by the C function @code{clear_image}:
|
|||
#include <libguile.h>
|
||||
|
||||
SCM_DEFINE (clear_image, "clear-image", 1, 0, 0,
|
||||
(SCM image_smob),
|
||||
(SCM image),
|
||||
"Clear the image.")
|
||||
@{
|
||||
/* C code to clear the image in @code{image_smob}... */
|
||||
/* C code to clear the image in @code{image}... */
|
||||
@}
|
||||
|
||||
void
|
||||
|
@ -78,9 +78,9 @@ init_image_type ()
|
|||
The @code{SCM_DEFINE} declaration says that the C function
|
||||
@code{clear_image} implements a Scheme function called
|
||||
@code{clear-image}, which takes one required argument (of type
|
||||
@code{SCM} and named @code{image_smob}), no optional arguments, and no
|
||||
rest argument. The string @code{"Clear the image."} provides a short
|
||||
help text for the function, it is called a @dfn{docstring}.
|
||||
@code{SCM} and named @code{image}), no optional arguments, and no rest
|
||||
argument. The string @code{"Clear the image."} provides a short help
|
||||
text for the function, it is called a @dfn{docstring}.
|
||||
|
||||
@code{SCM_DEFINE} macro also defines a static array of characters
|
||||
initialized to the Scheme name of the function. In this case,
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
@c -*-texinfo-*-
|
||||
@c This is part of the GNU Guile Reference Manual.
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2011
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2011, 2014
|
||||
@c Free Software Foundation, Inc.
|
||||
@c See the file guile.texi for copying conditions.
|
||||
|
||||
|
@ -112,11 +112,11 @@ For example, here is how you might define a new subr called
|
|||
#include <libguile.h>
|
||||
|
||||
SCM_DEFINE (clear_image, "clear-image", 1, 0, 0,
|
||||
(SCM image_smob),
|
||||
(SCM image),
|
||||
"Clear the image.")
|
||||
#define FUNC_NAME s_clear_image
|
||||
@{
|
||||
/* C code to clear the image in @code{image_smob}... */
|
||||
/* C code to clear the image in @code{image}... */
|
||||
@}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
@ -131,8 +131,8 @@ init_image_type ()
|
|||
The @code{SCM_DEFINE} declaration says that the C function
|
||||
@code{clear_image} implements a Scheme subr called @code{clear-image},
|
||||
which takes one required argument (of type @code{SCM} and named
|
||||
@code{image_smob}), no optional arguments, and no rest argument.
|
||||
@xref{Doc Snarfing}, for info on the docstring.
|
||||
@code{image}), no optional arguments, and no rest argument. @xref{Doc
|
||||
Snarfing}, for info on the docstring.
|
||||
|
||||
This works in concert with @code{FUNC_NAME} to also define a static
|
||||
array of characters named @code{s_clear_image}, initialized to the
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
#ifndef SCM_LIBGUILE_H
|
||||
#define SCM_LIBGUILE_H
|
||||
|
||||
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public License
|
||||
|
@ -52,6 +52,7 @@ extern "C" {
|
|||
#include "libguile/finalizers.h"
|
||||
#include "libguile/fluids.h"
|
||||
#include "libguile/foreign.h"
|
||||
#include "libguile/foreign-object.h"
|
||||
#include "libguile/fports.h"
|
||||
#include "libguile/gc.h"
|
||||
#include "libguile/generalized-arrays.h"
|
||||
|
|
|
@ -148,6 +148,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
|
|||
finalizers.c \
|
||||
fluids.c \
|
||||
foreign.c \
|
||||
foreign-object.c \
|
||||
fports.c \
|
||||
frames.c \
|
||||
gc-malloc.c \
|
||||
|
@ -587,6 +588,7 @@ modinclude_HEADERS = \
|
|||
filesys.h \
|
||||
fluids.h \
|
||||
foreign.h \
|
||||
foreign-object.h \
|
||||
fports.h \
|
||||
frames.h \
|
||||
gc.h \
|
||||
|
|
229
libguile/foreign-object.c
Normal file
229
libguile/foreign-object.c
Normal file
|
@ -0,0 +1,229 @@
|
|||
/* Copyright (C) 2014 Free Software Foundation, Inc.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation; either version 3 of
|
||||
* the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||||
* 02110-1301 USA
|
||||
*/
|
||||
|
||||
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
#include "libguile/_scm.h"
|
||||
#include "libguile/goops.h"
|
||||
#include "libguile/foreign-object.h"
|
||||
|
||||
|
||||
|
||||
|
||||
static SCM make_fobj_type_var;
|
||||
|
||||
static void
|
||||
init_make_fobj_type_var (void)
|
||||
{
|
||||
make_fobj_type_var = scm_c_private_lookup ("system foreign-object",
|
||||
"make-foreign-object-type");
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_make_foreign_object_type (SCM name, SCM slot_names,
|
||||
scm_t_struct_finalize finalizer)
|
||||
{
|
||||
SCM type;
|
||||
|
||||
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
|
||||
scm_i_pthread_once (&once, init_make_fobj_type_var);
|
||||
|
||||
type = scm_call_2 (scm_variable_ref (make_fobj_type_var), name, slot_names);
|
||||
|
||||
if (finalizer)
|
||||
SCM_SET_VTABLE_INSTANCE_FINALIZER (type, finalizer);
|
||||
|
||||
return type;
|
||||
}
|
||||
|
||||
void
|
||||
scm_assert_foreign_object_type (SCM type, SCM val)
|
||||
{
|
||||
if (!SCM_IS_A_P (val, type))
|
||||
scm_error (scm_arg_type_key, NULL, "Wrong type (expecting ~A): ~S",
|
||||
scm_list_2 (scm_class_name (type), val), scm_list_1 (val));
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_make_foreign_object_0 (SCM type)
|
||||
{
|
||||
return scm_make_foreign_object_n (type, 0, NULL);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_make_foreign_object_1 (SCM type, void *val0)
|
||||
{
|
||||
return scm_make_foreign_object_n (type, 1, &val0);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_make_foreign_object_2 (SCM type, void *val0, void *val1)
|
||||
{
|
||||
void *vals[2];
|
||||
|
||||
vals[0] = val0;
|
||||
vals[1] = val1;
|
||||
|
||||
return scm_make_foreign_object_n (type, 2, vals);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_make_foreign_object_3 (SCM type, void *val0, void *val1, void *val2)
|
||||
{
|
||||
void *vals[3];
|
||||
|
||||
vals[0] = val0;
|
||||
vals[1] = val1;
|
||||
vals[2] = val2;
|
||||
|
||||
return scm_make_foreign_object_n (type, 3, vals);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_make_foreign_object_n (SCM type, size_t n, void *vals[])
|
||||
#define FUNC_NAME "make-foreign-object"
|
||||
{
|
||||
SCM obj;
|
||||
SCM layout;
|
||||
size_t i;
|
||||
const char *layout_chars;
|
||||
|
||||
SCM_VALIDATE_VTABLE (SCM_ARG1, type);
|
||||
|
||||
layout = SCM_VTABLE_LAYOUT (type);
|
||||
|
||||
if (scm_i_symbol_length (layout) / 2 < n)
|
||||
scm_out_of_range (FUNC_NAME, scm_from_size_t (n));
|
||||
|
||||
layout_chars = scm_i_symbol_chars (layout);
|
||||
for (i = 0; i < n; i++)
|
||||
if (layout_chars[i * 2] != 'u')
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, layout, "'u' field");
|
||||
|
||||
obj = scm_c_make_structv (type, 0, 0, NULL);
|
||||
|
||||
for (i = 0; i < n; i++)
|
||||
SCM_STRUCT_DATA_SET (obj, i, (scm_t_bits) vals[i]);
|
||||
|
||||
return obj;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
scm_t_bits
|
||||
scm_foreign_object_unsigned_ref (SCM obj, size_t n)
|
||||
#define FUNC_NAME "foreign-object-ref"
|
||||
{
|
||||
SCM layout;
|
||||
|
||||
SCM_VALIDATE_STRUCT (SCM_ARG1, obj);
|
||||
|
||||
layout = SCM_STRUCT_LAYOUT (obj);
|
||||
if (scm_i_symbol_length (layout) / 2 < n)
|
||||
scm_out_of_range (FUNC_NAME, scm_from_size_t (n));
|
||||
|
||||
if (scm_i_symbol_ref (layout, n * 2) != 'u')
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, layout, "'u' field");
|
||||
|
||||
return SCM_STRUCT_DATA_REF (obj, n);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
void
|
||||
scm_foreign_object_unsigned_set_x (SCM obj, size_t n, scm_t_bits val)
|
||||
#define FUNC_NAME "foreign-object-set!"
|
||||
{
|
||||
SCM layout;
|
||||
|
||||
SCM_VALIDATE_STRUCT (SCM_ARG1, obj);
|
||||
|
||||
layout = SCM_STRUCT_LAYOUT (obj);
|
||||
if (scm_i_symbol_length (layout) / 2 < n)
|
||||
scm_out_of_range (FUNC_NAME, scm_from_size_t (n));
|
||||
|
||||
if (scm_i_symbol_ref (layout, n * 2) != 'u')
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, layout, "'u' field");
|
||||
|
||||
SCM_STRUCT_DATA_SET (obj, n, val);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
scm_t_signed_bits
|
||||
scm_foreign_object_signed_ref (SCM obj, size_t n)
|
||||
{
|
||||
scm_t_bits bits = scm_foreign_object_unsigned_ref (obj, n);
|
||||
return (scm_t_signed_bits) bits;
|
||||
}
|
||||
|
||||
void
|
||||
scm_foreign_object_signed_set_x (SCM obj, size_t n, scm_t_signed_bits val)
|
||||
{
|
||||
scm_t_bits bits = (scm_t_bits) val;
|
||||
scm_foreign_object_unsigned_set_x (obj, n, bits);
|
||||
}
|
||||
|
||||
void*
|
||||
scm_foreign_object_ref (SCM obj, size_t n)
|
||||
{
|
||||
scm_t_bits bits = scm_foreign_object_unsigned_ref (obj, n);
|
||||
return (void *) bits;
|
||||
}
|
||||
|
||||
void
|
||||
scm_foreign_object_set_x (SCM obj, size_t n, void *val)
|
||||
{
|
||||
scm_t_bits bits = (scm_t_bits) val;
|
||||
scm_foreign_object_unsigned_set_x (obj, n, bits);
|
||||
}
|
||||
|
||||
static void
|
||||
invoke_finalizer (void *obj, void *data)
|
||||
{
|
||||
scm_call_1 (PTR2SCM (data), PTR2SCM (obj));
|
||||
}
|
||||
|
||||
static SCM
|
||||
sys_add_finalizer_x (SCM obj, SCM finalizer)
|
||||
#define FUNC_NAME "%add-finalizer!"
|
||||
{
|
||||
SCM_VALIDATE_PROC (SCM_ARG2, finalizer);
|
||||
|
||||
scm_i_add_finalizer (SCM2PTR (obj), invoke_finalizer, SCM2PTR (finalizer));
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
static void
|
||||
scm_init_foreign_object (void)
|
||||
{
|
||||
scm_c_define_gsubr ("%add-finalizer!", 2, 0, 0,
|
||||
(scm_t_subr) sys_add_finalizer_x);
|
||||
}
|
||||
|
||||
void
|
||||
scm_register_foreign_object (void)
|
||||
{
|
||||
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
|
||||
"scm_init_foreign_object",
|
||||
(scm_t_extension_init_func)scm_init_foreign_object,
|
||||
NULL);
|
||||
}
|
62
libguile/foreign-object.h
Normal file
62
libguile/foreign-object.h
Normal file
|
@ -0,0 +1,62 @@
|
|||
#ifndef SCM_FOREIGN_OBJECT_H
|
||||
#define SCM_FOREIGN_OBJECT_H
|
||||
|
||||
/* Copyright (C) 2014 Free Software Foundation, Inc.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation; either version 3 of
|
||||
* the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||||
* 02110-1301 USA
|
||||
*/
|
||||
|
||||
|
||||
|
||||
#include "libguile/__scm.h"
|
||||
#include "libguile/print.h"
|
||||
|
||||
|
||||
|
||||
|
||||
SCM_API SCM scm_make_foreign_object_type (SCM name, SCM slot_names,
|
||||
scm_t_struct_finalize finalizer);
|
||||
|
||||
SCM_API void scm_assert_foreign_object_type (SCM type, SCM val);
|
||||
|
||||
/* All objects of a given foreign object type have the same number of
|
||||
fields. When constructing a foreign object, you don't have to pass
|
||||
initializers for all of the fields; it is always OK to call
|
||||
scm_make_foreign_object_0 and initialize the fields by hand with
|
||||
scm_foreign_object_set_x or other setters. The initial value of
|
||||
fields that haven't been explicitly given a value is 0. */
|
||||
SCM_API SCM scm_make_foreign_object_0 (SCM type);
|
||||
SCM_API SCM scm_make_foreign_object_1 (SCM type, void *val0);
|
||||
SCM_API SCM scm_make_foreign_object_2 (SCM type, void *val0, void *val1);
|
||||
SCM_API SCM scm_make_foreign_object_3 (SCM type, void *val0, void *val1,
|
||||
void *val2);
|
||||
SCM_API SCM scm_make_foreign_object_n (SCM type, size_t n, void *vals[]);
|
||||
|
||||
SCM_API void* scm_foreign_object_ref (SCM obj, size_t n);
|
||||
SCM_API void scm_foreign_object_set_x (SCM obj, size_t n, void *val);
|
||||
|
||||
SCM_API scm_t_bits scm_foreign_object_unsigned_ref (SCM obj, size_t n);
|
||||
SCM_API void scm_foreign_object_unsigned_set_x (SCM obj, size_t n,
|
||||
scm_t_bits val);
|
||||
|
||||
SCM_API scm_t_signed_bits scm_foreign_object_signed_ref (SCM obj, size_t n);
|
||||
SCM_API void scm_foreign_object_signed_set_x (SCM obj, size_t n,
|
||||
scm_t_signed_bits val);
|
||||
|
||||
SCM_INTERNAL void scm_register_foreign_object (void);
|
||||
|
||||
|
||||
#endif /* SCM_FOREIGN_OBJECT_H */
|
|
@ -640,7 +640,7 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
|
|||
get_n_set = SCM_CDR (get_n_set), slots = SCM_CDR (slots))
|
||||
{
|
||||
SCM slot_name = SCM_CAR (slots);
|
||||
SCM slot_value = SCM_PACK (0);
|
||||
SCM slot_value = SCM_GOOPS_UNBOUND;
|
||||
|
||||
if (!scm_is_null (SCM_CDR (slot_name)))
|
||||
{
|
||||
|
@ -664,12 +664,12 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
|
|||
slot_value = scm_i_get_keyword (tmp,
|
||||
initargs,
|
||||
n_initargs,
|
||||
SCM_PACK (0),
|
||||
SCM_GOOPS_UNBOUND,
|
||||
FUNC_NAME);
|
||||
}
|
||||
}
|
||||
|
||||
if (SCM_UNPACK (slot_value))
|
||||
if (!SCM_GOOPS_UNBOUNDP (slot_value))
|
||||
/* set slot to provided value */
|
||||
set_slot_value (class, obj, SCM_CAR (get_n_set), slot_value);
|
||||
else
|
||||
|
@ -677,14 +677,10 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
|
|||
/* set slot to its :init-form if it exists */
|
||||
tmp = SCM_CADAR (get_n_set);
|
||||
if (scm_is_true (tmp))
|
||||
{
|
||||
slot_value = get_slot_value (class, obj, SCM_CAR (get_n_set));
|
||||
if (SCM_GOOPS_UNBOUNDP (slot_value))
|
||||
set_slot_value (class,
|
||||
obj,
|
||||
SCM_CAR (get_n_set),
|
||||
scm_call_0 (tmp));
|
||||
}
|
||||
set_slot_value (class,
|
||||
obj,
|
||||
SCM_CAR (get_n_set),
|
||||
scm_call_0 (tmp));
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -395,6 +395,7 @@ scm_i_init_guile (void *base)
|
|||
scm_bootstrap_vm ();
|
||||
scm_register_r6rs_ports ();
|
||||
scm_register_foreign ();
|
||||
scm_register_foreign_object ();
|
||||
scm_register_srfi_1 ();
|
||||
scm_register_srfi_60 ();
|
||||
scm_register_poll ();
|
||||
|
|
|
@ -381,6 +381,7 @@ SYSTEM_SOURCES = \
|
|||
system/vm/disassembler.scm \
|
||||
system/vm/vm.scm \
|
||||
system/foreign.scm \
|
||||
system/foreign-object.scm \
|
||||
system/xref.scm \
|
||||
system/repl/debug.scm \
|
||||
system/repl/error-handling.scm \
|
||||
|
|
88
module/system/foreign-object.scm
Normal file
88
module/system/foreign-object.scm
Normal file
|
@ -0,0 +1,88 @@
|
|||
;;; Wrapping foreign objects in Scheme
|
||||
|
||||
;;; Copyright (C) 2014 Free Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This library is free software; you can redistribute it and/or
|
||||
;;; modify it under the terms of the GNU Lesser General Public
|
||||
;;; License as published by the Free Software Foundation; either
|
||||
;;; version 3 of the License, or (at your option) any later version.
|
||||
;;;
|
||||
;;; This library is distributed in the hope that it will be useful,
|
||||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;;; Lesser General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU Lesser General Public
|
||||
;;; License along with this library; if not, write to the Free Software
|
||||
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
;;;
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(define-module (system foreign-object)
|
||||
#:use-module (oop goops)
|
||||
#:export (make-foreign-object-type
|
||||
define-foreign-object-type))
|
||||
|
||||
(eval-when (eval load expand)
|
||||
(load-extension (string-append "libguile-" (effective-version))
|
||||
"scm_init_foreign_object"))
|
||||
|
||||
(define-class <finalizer-class> (<class>)
|
||||
(finalizer #:init-keyword #:finalizer #:init-value #f
|
||||
#:getter finalizer))
|
||||
|
||||
(define-method (allocate-instance (class <finalizer-class>) initargs)
|
||||
(let ((instance (next-method))
|
||||
(finalizer (finalizer class)))
|
||||
(when finalizer
|
||||
(%add-finalizer! instance finalizer))
|
||||
instance))
|
||||
|
||||
(define (getter-method class slot-name existing)
|
||||
(let ((getter (ensure-generic existing slot-name))
|
||||
(slot-def (or (assq slot-name (slot-ref class 'getters-n-setters))
|
||||
(slot-missing class slot-name))))
|
||||
(add-method! getter (compute-getter-method class slot-def))
|
||||
getter))
|
||||
|
||||
(define* (make-foreign-object-type name slots #:key finalizer)
|
||||
(unless (symbol? name)
|
||||
(error "type name should be a symbol" name))
|
||||
(unless (or (not finalizer) (procedure? finalizer))
|
||||
(error "finalizer should be a procedure" finalizer))
|
||||
(let ((dslots (map (lambda (slot)
|
||||
(unless (symbol? slot)
|
||||
(error "slot name should be a symbol" slot))
|
||||
(list slot #:class <foreign-slot>
|
||||
#:init-keyword (symbol->keyword slot)
|
||||
#:init-value 0))
|
||||
slots)))
|
||||
(if finalizer
|
||||
(make-class '() dslots #:name name
|
||||
#:finalizer finalizer #:metaclass <finalizer-class>)
|
||||
(make-class '() dslots #:name name))))
|
||||
|
||||
(define-syntax define-foreign-object-type
|
||||
(lambda (x)
|
||||
(define (kw-apply slots)
|
||||
(syntax-case slots ()
|
||||
(() #'())
|
||||
((slot . slots)
|
||||
(let ((kw (symbol->keyword (syntax->datum #'slot))))
|
||||
#`(#,kw slot . #,(kw-apply #'slots))))))
|
||||
|
||||
(syntax-case x ()
|
||||
((_ name constructor (slot ...) kwarg ...)
|
||||
#`(begin
|
||||
(define name
|
||||
(make-foreign-object-type 'name '(slot ...) kwarg ...))
|
||||
(define slot
|
||||
(getter-method name 'slot (and (defined? 'slot) slot)))
|
||||
...
|
||||
(define constructor
|
||||
(lambda (slot ...)
|
||||
(make name #,@(kw-apply #'(slot ...))))))))))
|
|
@ -129,6 +129,17 @@ TESTS += test-ffi
|
|||
|
||||
endif HAVE_SHARED_LIBRARIES
|
||||
|
||||
# test-foreign-object-scm
|
||||
check_SCRIPTS += test-foreign-object-scm
|
||||
TESTS += test-foreign-object-scm
|
||||
|
||||
# test-foreign-object-c
|
||||
test_foreign_object_c_SOURCES = test-foreign-object-c.c
|
||||
test_foreign_object_c_CFLAGS = ${test_cflags}
|
||||
test_foreign_object_c_LDADD = $(LIBGUILE_LDADD)
|
||||
check_PROGRAMS += test-foreign-object-c
|
||||
TESTS += test-foreign-object-c
|
||||
|
||||
# test-list
|
||||
test_list_SOURCES = test-list.c
|
||||
test_list_CFLAGS = ${test_cflags}
|
||||
|
|
115
test-suite/standalone/test-foreign-object-c.c
Normal file
115
test-suite/standalone/test-foreign-object-c.c
Normal file
|
@ -0,0 +1,115 @@
|
|||
/* test-foreign-object-c.c - exercise C foreign object interface */
|
||||
|
||||
/* Copyright (C) 2014 Free Software Foundation, Inc.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation; either version 3 of
|
||||
* the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||||
* 02110-1301 USA
|
||||
*/
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
#include <libguile.h>
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
enum
|
||||
{
|
||||
CSTR_SLOT_ADDR,
|
||||
CSTR_SLOT_LEN,
|
||||
CSTR_SLOT_COUNT
|
||||
};
|
||||
|
||||
static void
|
||||
finalizer (SCM obj)
|
||||
{
|
||||
free (scm_foreign_object_ref (obj, CSTR_SLOT_ADDR));
|
||||
}
|
||||
|
||||
static SCM
|
||||
make_cstr_from_static (SCM type, const char *str)
|
||||
{
|
||||
char *ours = strdup (str);
|
||||
|
||||
if (!ours)
|
||||
abort ();
|
||||
|
||||
return scm_make_foreign_object_2 (type, ours, (void *) strlen (ours));
|
||||
}
|
||||
|
||||
static int
|
||||
cstr_equals_static_p (SCM cstr, const char *str)
|
||||
{
|
||||
const char *addr;
|
||||
size_t len;
|
||||
|
||||
addr = scm_foreign_object_ref (cstr, CSTR_SLOT_ADDR);
|
||||
len = scm_foreign_object_unsigned_ref (cstr, CSTR_SLOT_LEN);
|
||||
|
||||
if (strlen (str) != len)
|
||||
return 0;
|
||||
|
||||
return strncmp (addr, str, len) == 0;
|
||||
}
|
||||
|
||||
static void
|
||||
test_scm_foreign_object (void)
|
||||
{
|
||||
SCM type_name, slot_names, type, cstr;
|
||||
|
||||
type_name = scm_from_utf8_symbol ("<cstr>");
|
||||
slot_names = scm_list_2 (scm_from_utf8_symbol ("addr"),
|
||||
scm_from_utf8_symbol ("len"));
|
||||
type = scm_make_foreign_object_type (type_name, slot_names, finalizer);
|
||||
|
||||
cstr = make_cstr_from_static (type, "Hello, world!");
|
||||
scm_assert_foreign_object_type (type, cstr);
|
||||
|
||||
if (!cstr_equals_static_p (cstr, "Hello, world!"))
|
||||
{
|
||||
fprintf (stderr, "fail: test-foreign-object 1\n");
|
||||
exit (EXIT_FAILURE);
|
||||
}
|
||||
|
||||
{
|
||||
int i;
|
||||
for (i = 0; i < 5000; i++)
|
||||
cstr = make_cstr_from_static (type, "Hello, world!");
|
||||
cstr = SCM_BOOL_F;
|
||||
}
|
||||
|
||||
scm_gc ();
|
||||
scm_gc ();
|
||||
scm_gc ();
|
||||
|
||||
/* Allow time for the finalizer thread to run. */
|
||||
scm_usleep (scm_from_uint (50 * 1000));
|
||||
}
|
||||
|
||||
static void
|
||||
tests (void *data, int argc, char **argv)
|
||||
{
|
||||
test_scm_foreign_object ();
|
||||
}
|
||||
|
||||
int
|
||||
main (int argc, char *argv[])
|
||||
{
|
||||
scm_boot_guile (argc, argv, tests, NULL);
|
||||
return 0;
|
||||
}
|
119
test-suite/standalone/test-foreign-object-scm
Executable file
119
test-suite/standalone/test-foreign-object-scm
Executable file
|
@ -0,0 +1,119 @@
|
|||
#!/bin/sh
|
||||
exec guile -q -s "$0" "$@"
|
||||
!#
|
||||
;;; test-foreign-object-scm --- Foreign object interface. -*- Scheme -*-
|
||||
;;;
|
||||
;;; Copyright (C) 2014 Free Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This library is free software; you can redistribute it and/or
|
||||
;;; modify it under the terms of the GNU Lesser General Public
|
||||
;;; License as published by the Free Software Foundation; either
|
||||
;;; version 3 of the License, or (at your option) any later version.
|
||||
;;;
|
||||
;;; This library is distributed in the hope that it will be useful,
|
||||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;;; Lesser General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU Lesser General Public
|
||||
;;; License along with this library; if not, write to the Free Software
|
||||
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
(use-modules (system foreign)
|
||||
(system foreign-object)
|
||||
(rnrs bytevectors)
|
||||
(oop goops))
|
||||
|
||||
(define (libc-ptr name)
|
||||
(catch #t
|
||||
(lambda () (dynamic-pointer name (dynamic-link)))
|
||||
(lambda (k . args)
|
||||
(print-exception (current-error-port) #f k args)
|
||||
(write "Skipping test.\n" (current-error-port))
|
||||
(exit 0))))
|
||||
|
||||
(define malloc (pointer->procedure '* (libc-ptr "malloc") (list size_t)))
|
||||
(define memcpy (pointer->procedure void (libc-ptr "memcpy") (list '* '* size_t)))
|
||||
(define free (pointer->procedure void (libc-ptr "free") '(*)))
|
||||
|
||||
(define (finalize-cstr cstr)
|
||||
(free (make-pointer (addr cstr))))
|
||||
|
||||
(define-foreign-object-type <cstr> make-cstr (addr len)
|
||||
#:finalizer finalize-cstr)
|
||||
|
||||
(define (cstr->string cstr)
|
||||
(pointer->string (make-pointer (addr cstr)) (len cstr) "UTF-8"))
|
||||
|
||||
(define* (string->cstr str #:optional (k make-cstr))
|
||||
(let* ((bv (string->utf8 str))
|
||||
(len (bytevector-length bv))
|
||||
(mem (malloc len)))
|
||||
(when (null-pointer? mem)
|
||||
(error "Out of memory."))
|
||||
(memcpy mem (bytevector->pointer bv) len)
|
||||
(k (pointer-address mem) len)))
|
||||
|
||||
(define-method (write (cstr <cstr>) port)
|
||||
(format port "<<cstr> ~s>" (cstr->string cstr)))
|
||||
|
||||
(define-method (display (cstr <cstr>) port)
|
||||
(display (cstr->string cstr) port))
|
||||
|
||||
(define-method (+ (a <cstr>) (b <cstr>))
|
||||
(string->cstr (string-append (cstr->string a) (cstr->string b))))
|
||||
|
||||
(define-method (equal? (a <cstr>) (b <cstr>))
|
||||
(equal? (cstr->string a) (cstr->string b)))
|
||||
|
||||
(define failed? #f)
|
||||
(define-syntax test
|
||||
(syntax-rules ()
|
||||
((_ exp res)
|
||||
(let ((expected res)
|
||||
(actual exp))
|
||||
(if (not (equal? actual expected))
|
||||
(begin
|
||||
(set! failed? #t)
|
||||
(format (current-error-port)
|
||||
"bad return from expression `~a': expected ~A; got ~A~%"
|
||||
'exp expected actual)))))))
|
||||
|
||||
(test (string->cstr "Hello, world!")
|
||||
(+ (string->cstr "Hello, ") (string->cstr "world!")))
|
||||
|
||||
;; GOOPS construction syntax instead of make-cstr.
|
||||
(test (string->cstr "Hello, world!")
|
||||
(string->cstr "Hello, world!"
|
||||
(lambda (addr len)
|
||||
(make <cstr> #:addr addr #:len len))))
|
||||
|
||||
;; Subclassing.
|
||||
(define-class <wrapped-cstr> (<cstr>)
|
||||
(wrapped-string #:init-keyword #:wrapped-string
|
||||
#:getter wrapped-string
|
||||
#:init-form (error "missing #:wrapped-string")))
|
||||
|
||||
(define (string->wrapped-cstr string)
|
||||
(string->cstr string (lambda (addr len)
|
||||
(make <wrapped-cstr> #:addr addr #:len len
|
||||
#:wrapped-string string))))
|
||||
|
||||
(let ((wrapped-cstr (string->wrapped-cstr "Hello, world!")))
|
||||
;; Tests that <cst> methods work on <wrapped-cstr>.
|
||||
(test "Hello, world!" (cstr->string wrapped-cstr))
|
||||
;; Test the additional #:wrapped-string slot.
|
||||
(test "Hello, world!" (wrapped-string wrapped-cstr)))
|
||||
|
||||
(gc) (gc) (gc)
|
||||
|
||||
;; Sleep 50 milliseconds to allow the finalization thread to run.
|
||||
(usleep #e50e3)
|
||||
|
||||
;; But we don't really know if it ran. Oh well.
|
||||
|
||||
(exit (if failed? 1 0))
|
||||
|
||||
;; Local Variables:
|
||||
;; mode: scheme
|
||||
;; End:
|
|
@ -1,6 +1,6 @@
|
|||
;;;; goops.test --- test suite for GOOPS -*- scheme -*-
|
||||
;;;;
|
||||
;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 2012 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 2012, 2014 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -474,9 +474,9 @@
|
|||
(x bar)
|
||||
(set! (x bar) 2)
|
||||
(equal? (reverse z)
|
||||
'(before-ref before-set! 1 before-ref after-ref
|
||||
after-set! 1 1 before-ref after-ref
|
||||
before-set! 2 before-ref after-ref after-set! 2 2)))
|
||||
'(before-set! 1 before-ref after-ref
|
||||
after-set! 1 1 before-ref after-ref
|
||||
before-set! 2 before-ref after-ref after-set! 2 2)))
|
||||
(current-module))))
|
||||
|
||||
(use-modules (oop goops composite-slot))
|
||||
|
@ -527,3 +527,38 @@
|
|||
exception:no-applicable-method
|
||||
(eval '(quxy 1)
|
||||
(current-module))))
|
||||
|
||||
(with-test-prefix "foreign slots"
|
||||
(define-class <foreign-test> ()
|
||||
(a #:init-keyword #:a #:class <foreign-slot>
|
||||
#:accessor test-a)
|
||||
(b #:init-keyword #:b #:init-form 3 #:class <foreign-slot>
|
||||
#:accessor test-b))
|
||||
|
||||
(pass-if-equal "constructing, no initargs"
|
||||
'(0 3)
|
||||
(let ((x (make <foreign-test>)))
|
||||
(list (slot-ref x 'a)
|
||||
(slot-ref x 'b))))
|
||||
|
||||
(pass-if-equal "constructing, initargs"
|
||||
'(1 2)
|
||||
(let ((x (make <foreign-test> #:a 1 #:b 2)))
|
||||
(list (slot-ref x 'a)
|
||||
(slot-ref x 'b))))
|
||||
|
||||
(pass-if-equal "getters"
|
||||
'(0 3)
|
||||
(let ((x (make <foreign-test>)))
|
||||
(list (test-a x) (test-b x))))
|
||||
|
||||
(pass-if-equal "setters"
|
||||
'(10 20)
|
||||
(let ((x (make <foreign-test>)))
|
||||
(set! (test-a x) 10)
|
||||
(set! (test-b x) 20)
|
||||
(list (test-a x) (test-b x))))
|
||||
|
||||
(pass-if-exception "out of range"
|
||||
exception:out-of-range
|
||||
(make <foreign-test> #:a (ash 1 64))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue