mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-19 03:00:25 +02:00
Code Activity

Revert foreign objects.

Browse source 
For a long time the API failed to reach consensus among maintainers.
See <https://lists.gnu.org/archive/html/guile-devel/2015-11/msg00005.html>
and <https://lists.gnu.org/archive/html/guile-devel/2014-04/msg00069.html>.

This revert intends to break the deadlock and help further discussion to
take place with less pressure.

* libguile/foreign-object.c, libguile/foreign-object.h: Remove.
* libguile/Makefile.am (libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES)
(modinclude_HEADERS): Adjust accordingly.
* libguile/init.c (scm_i_init_guile): Remove call to
'scm_register_foreign_object'.
* libguile.h: Remove inclusion of "libguile/foreign-object.h".
* module/system/foreign-object.scm: Remove.
* module/Makefile.am (SYSTEM_SOURCES): Adjust accordingly.
* test-suite/standalone/test-foreign-object-c.c,
test-suite/standalone/test-foreign-object-scm: Remove.
* test-suite/standalone/Makefile.am (check_SCRIPTS, check_PROGRAMS)
(TESTS): Adjust accordingly.
(test_foreign_object_c_SOURCES, test_foreign_object_c_CFLAGS)
(test_foreign_object_c_LDADD): Remove.
* doc/ref/libguile-foreign-objects.texi: Remove.
* doc/ref/api-foreign-objects.texi: Remove.
* doc/ref/libguile-smobs.texi: New file.
* doc/ref/Makefile.am (guile_TEXINFOS): Adjust accordingly.
* doc/ref/api-control.texi, doc/ref/api-smobs.texi,
doc/ref/api-utility.texi, doc/ref/guile.texi,
doc/ref/libguile-concepts.texi, doc/ref/libguile-program.texi:
Revert d9a4a1cd and 6e4630e0.
This commit is contained in:
Ludovic Courtès 2016-02-01 22:13:30 +01:00
parent c5dac3595f
commit ff98cbb643
20 changed files with 809 additions and 1384 deletions
Download patch file Download diff file Expand all files Collapse all files

3
doc/ref/Makefile.am
View file

@ -33,7 +33,6 @@ 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 +82,7 @@ guile_TEXINFOS = preface.texi \
compiler.texi \
fdl.texi \
libguile-concepts.texi \
libguile-foreign-objects.texi \
libguile-smobs.texi \
libguile-snarf.texi \
libguile-linking.texi \
libguile-extensions.texi \

14
doc/ref/api-control.texi
View file

@ -1184,13 +1184,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{Foreign Object Memory
Management}).
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}).
@end deftypefn

125
doc/ref/api-foreign-objects.texi
View file

@ -1,125 +0,0 @@
@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:

72
doc/ref/api-smobs.texi
View file

@ -9,17 +9,9 @@
@cindex smob
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.
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.
@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
@ -34,8 +26,9 @@ 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. 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, 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
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}.
@ -67,30 +60,51 @@ 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{Foreign Object Memory
Management}, for a discussion on finalizers and concurrency. If you are
Smob free functions must be thread-safe. @xref{Garbage Collecting
Smobs}, 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. @xref{Foreign Objects}.
@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
@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 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.
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}.}.
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

14
doc/ref/api-utility.texi
View file

@ -163,14 +163,12 @@ same.
into an infinite loop if asked to compare two circular lists or
similar.
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?}.
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?}.
@end deffn

10
doc/ref/guile.texi
View file

@ -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{foreign objects}.
possible and is done by defining @dfn{smobs}.
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 Foreign Object Types:: Adding new types to Guile.
* Defining New Types (Smobs):: 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-foreign-objects.texi
@include libguile-smobs.texi
@include libguile-snarf.texi
@include libguile-program.texi
@include libguile-autoconf.texi
@ -299,8 +299,7 @@ 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.
* Foreign Objects:: Defining new data types in C.
* Smobs:: Use foreign objects instead.
* Smobs:: Defining new data types in C.
* Procedures:: Procedures.
* Macros:: Extending the syntax of Scheme.
* Utility Functions:: General utility functions.
@ -328,7 +327,6 @@ 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

16
doc/ref/libguile-concepts.texi
View file

@ -241,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 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.
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.
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. @xref{Foreign Object Memory Management}.
reference. For a typical example of its use, see @ref{Remembering
During Operations}.
@node Control Flow
@subsection Control Flow

493
doc/ref/libguile-foreign-objects.texi
View file

@ -1,493 +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 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.

147
doc/ref/libguile-program.texi
View file

@ -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 Objects:: How to represent Dia data in Scheme.
* Dia Smobs:: 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{foreign object}
interface to create a new Scheme data type for your objects.
strings, you will probably want to use Guile's @dfn{SMOB} 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,18 +129,17 @@ 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{foreign objects} and @dfn{primitives} to the Scheme
world.
declares your @dfn{SMOBs} and @dfn{primitives} to the Scheme world.
The following subsections expand on these four points in turn.
@node Dia Objects
@node Dia Smobs
@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 foreign objects come in, and with them issues of
level. This is where the idea of SMOBs comes in, and with it issues of
lifetime management and garbage collection.
To get more concrete about this, let's look again at the example we gave
@ -190,21 +189,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 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.
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.
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 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.
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.
So, to summarize the steps involved in this resolution of the problem
(and assuming that the underlying C structure for a shape is
@ -239,33 +238,33 @@ struct dia_shape
underlying shape is deleted.
@item
Wrap @code{struct dia_guile_shape} as a foreign object type.
Wrap @code{struct dia_guile_shape} as a SMOB type.
@item
Whenever you need to represent a C shape onto the Scheme level, create a
foreign object instance for it, and pass that.
SMOB instance for it, and pass that.
@item
In primitive code that receives a shape foreign object instance, check the
In primitive code that receives a shape SMOB 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 foreign object values and
their Scheme-specific structures are under the control of the garbage
As far as memory management is concerned, the SMOB 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 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.
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.
For full documentation on defining and using foreign object types, see
@ref{Defining New Foreign Object Types}.
For full documentation on defining and using SMOB types, see
@ref{Defining New Types (Smobs)}.
@node Dia Primitives
@ -284,11 +283,11 @@ static SCM square_p (SCM shape)
@{
struct dia_guile_shape * guile_shape;
/* Check that arg is really a shape object. */
scm_assert_foreign_object_type (shape_type, shape);
/* Check that arg is really a shape SMOB. */
scm_assert_smob_type (shape_tag, shape);
/* Access Scheme-specific shape structure. */
guile_shape = scm_foreign_object_ref (shape, 0);
guile_shape = SCM_SMOB_DATA (shape);
/* Find out if underlying shape exists and is a
square; return answer as a Scheme boolean. */
@ -298,28 +297,26 @@ 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 foreign object
--- to the Scheme-specific structure inside the foreign object, and
thence to the underlying C structure for the 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.
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.
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.
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);
@ -387,7 +384,7 @@ do lots of initialization and setup stuff
@itemize @bullet
@item
define all foreign object types
define all SMOB types
@item
export primitives to Scheme using @code{scm_c_define_gsubr}
@item
@ -400,13 +397,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 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.
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.
@node Dia Advanced
@ -428,8 +425,7 @@ 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 foreign objects and primitives for the
Scheme world.
its later code implementing SMOBs and primitives for the Scheme world.
For example, suppose that the original source code had a
@code{dia_change_fill_pattern} function:
@ -444,8 +440,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 foreign object values and uses @code{dia_change_fill_pattern}
to do the real work:
from its SMOB values and uses @code{dia_change_fill_pattern} to do the
real work:
@lisp
SCM change_fill_pattern (SCM shape, SCM pattern)
@ -491,23 +487,22 @@ 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
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.
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.
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
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!
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!
Finally, we come to the holy grail of Guile's free software / extension
language approach. Once you have a Scheme representation for

669
doc/ref/libguile-smobs.texi Normal file
View file

@ -0,0 +1,669 @@
@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 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 (free functions) 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 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
libguile.h
View file

@ -52,7 +52,6 @@ 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/gdbint.h"

2
libguile/Makefile.am
View file

@ -147,7 +147,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
finalizers.c \
fluids.c \
foreign.c \
foreign-object.c \
fports.c \
frames.c \
gc-malloc.c \
@ -577,7 +576,6 @@ modinclude_HEADERS = \
filesys.h \
fluids.h \
foreign.h \
foreign-object.h \
fports.h \
frames.h \
gc.h \

229
libguile/foreign-object.c
View file

@ -1,229 +0,0 @@
/* 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
View file

@ -1,62 +0,0 @@
#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 */

1
libguile/init.c
View file

@ -401,7 +401,6 @@ 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 ();

1
module/Makefile.am
View file

@ -354,7 +354,6 @@ SYSTEM_SOURCES = \
system/vm/trap-state.scm \
system/vm/vm.scm \
system/foreign.scm \
system/foreign-object.scm \
system/xref.scm \
system/repl/debug.scm \
system/repl/error-handling.scm \

89
module/system/foreign-object.scm
View file

@ -1,89 +0,0 @@
;;; Wrapping foreign objects in Scheme
;;; Copyright (C) 2014, 2015 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 <foreign-class> (<class>))
(define-class <foreign-class-with-finalizer> (<foreign-class>)
(finalizer #:init-keyword #:finalizer #:init-value #f
#:getter finalizer))
(define-method (allocate-instance (class <foreign-class-with-finalizer>)
initargs)
(let ((instance (next-method))
(finalizer (finalizer class)))
(when finalizer
(%add-finalizer! instance finalizer))
instance))
(define* (make-foreign-object-type name slots #:key finalizer
(getters (map (const #f) slots)))
(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 getter)
(unless (symbol? slot)
(error "slot name should be a symbol" slot))
(cons* slot #:class <foreign-slot>
#:init-keyword (symbol->keyword slot)
#:init-value 0
(if getter (list #:getter getter) '())))
slots
getters)))
(if finalizer
(make-class '() dslots #:name name
#:finalizer finalizer
#:metaclass <foreign-class-with-finalizer>)
(make-class '() dslots #:name name
#:metaclass <foreign-class>))))
(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 slot (ensure-generic 'slot (and (defined? 'slot) slot)))
...
(define name
(make-foreign-object-type 'name '(slot ...) kwarg ...
#:getters (list slot ...)))
(define constructor
(lambda (slot ...)
(make name #,@(kw-apply #'(slot ...))))))))))

11
test-suite/standalone/Makefile.am
View file

@ -132,17 +132,6 @@ 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
View file

@ -1,115 +0,0 @@
/* 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
View file

@ -1,119 +0,0 @@
#!/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: