This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=48ad85fb56bc022ac10f42cf07b5657d75b5b696 The branch, stable-2.0 has been updated via 48ad85fb56bc022ac10f42cf07b5657d75b5b696 (commit) via fa1a30726dc28c58cb01594ae6df27e80d4c2f00 (commit) from e0da53b4fe4abee2cdcd97fe46eeefcaab1da631 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 48ad85fb56bc022ac10f42cf07b5657d75b5b696 Author: Andy Wingo <[email protected]> Date: Sun Apr 27 11:02:35 2014 +0200 Fix foreign slot initialization and access * libguile/goops.c (scm_sys_initialize_object): Refactor initialization so that we don't ref uninitialized slots before initializing them. This allows foreign slots, whose initial value is 0, to be initialized via #:init-form. * module/oop/goops.scm (@slot-ref, @slot-set!): Remove definitions. Change callers to use struct-ref and struct-set!. slot-ref and slot-set! were only marginally more efficient and were much more dangerous. This change allows the standard accessors to work on foreign slots; that was not the case before, as the 'u' fields of the struct were read as if they were 'p' slots. * module/language/tree-il/compile-glil.scm (lambda): Remove support for compiling @slot-ref/@slot-set!. These were private to GOOPS. * test-suite/tests/goops.test ("active-slot"): Update to not expect a ref before initialization. ("foreign slots"): Add tests. commit fa1a30726dc28c58cb01594ae6df27e80d4c2f00 Author: Andy Wingo <[email protected]> Date: Thu Apr 17 15:29:13 2014 +0200 Add interface to disable automatic finalization * libguile/finalizers.h: * libguile/finalizers.c (run_finalizers_async_thunk): Call the new scm_run_finalizers helper. (scm_set_automatic_finalization_enabled, scm_run_finalizers): New functions. (scm_init_finalizers): Only set a finalizer notifier if automatic finalization is enabled. * doc/ref/libguile-smobs.texi (Garbage Collecting Smobs): Add discussion of concurrency. * doc/ref/api-smobs.texi (Smobs): Document new functions. ----------------------------------------------------------------------- Summary of changes: doc/ref/api-smobs.texi | 32 +++++++++++++++++++- doc/ref/libguile-smobs.texi | 23 ++++++++++++++- libguile/finalizers.c | 47 ++++++++++++++++++++++++++++-- libguile/finalizers.h | 5 ++- libguile/goops.c | 20 +++++------- module/language/tree-il/compile-glil.scm | 4 +-- module/oop/goops.scm | 22 +++++--------- test-suite/tests/goops.test | 43 ++++++++++++++++++++++++-- 8 files changed, 157 insertions(+), 39 deletions(-) diff --git a/doc/ref/api-smobs.texi b/doc/ref/api-smobs.texi index 345bf7c..cfabd39 100644 --- a/doc/ref/api-smobs.texi +++ b/doc/ref/api-smobs.texi @@ -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, 2009, 2013 +@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. @@ -60,6 +60,36 @@ 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 +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 @deftypefn {C Function} void scm_set_smob_mark (scm_t_bits tc, SCM (*mark) (SCM obj)) diff --git a/doc/ref/libguile-smobs.texi b/doc/ref/libguile-smobs.texi index 572bcf3..f12ab13 100644 --- a/doc/ref/libguile-smobs.texi +++ b/doc/ref/libguile-smobs.texi @@ -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, 2010, 2011, 2013 +@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. @@ -385,6 +385,27 @@ 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. diff --git a/libguile/finalizers.c b/libguile/finalizers.c index a179479..6abc700 100644 --- a/libguile/finalizers.c +++ b/libguile/finalizers.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2012 Free Software Foundation, Inc. +/* Copyright (C) 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 License @@ -31,6 +31,8 @@ +static int automatic_finalization_p = 1; + static size_t finalization_count; @@ -130,7 +132,7 @@ static SCM finalizer_async_cell; static SCM run_finalizers_async_thunk (void) { - finalization_count += GC_invoke_finalizers (); + scm_run_finalizers (); return SCM_UNSPECIFIED; } @@ -169,6 +171,43 @@ GC_set_finalizer_notifier (void (*notifier) (void)) } #endif + + + +int +scm_set_automatic_finalization_enabled (int enabled_p) +{ + int was_enabled_p = automatic_finalization_p; + + if (enabled_p == was_enabled_p) + return was_enabled_p; + + if (!scm_initialized_p) + { + automatic_finalization_p = enabled_p; + return was_enabled_p; + } + + GC_set_finalizer_notifier (enabled_p ? queue_finalizer_async : 0); + + automatic_finalization_p = enabled_p; + + return was_enabled_p; +} + +int +scm_run_finalizers (void) +{ + int finalized = GC_invoke_finalizers (); + + finalization_count += finalized; + + return finalized; +} + + + + void scm_init_finalizers (void) { @@ -178,5 +217,7 @@ scm_init_finalizers (void) scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0, run_finalizers_async_thunk), SCM_BOOL_F); - GC_set_finalizer_notifier (queue_finalizer_async); + + if (automatic_finalization_p) + GC_set_finalizer_notifier (queue_finalizer_async); } diff --git a/libguile/finalizers.h b/libguile/finalizers.h index bad96e1..12ccbb6 100644 --- a/libguile/finalizers.h +++ b/libguile/finalizers.h @@ -1,7 +1,7 @@ #ifndef SCM_FINALIZERS_H #define SCM_FINALIZERS_H -/* Copyright (C) 2012 Free Software Foundation, Inc. +/* Copyright (C) 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 License @@ -34,6 +34,9 @@ SCM_INTERNAL void scm_i_add_finalizer (void *obj, scm_t_finalizer_proc, SCM_INTERNAL void scm_i_add_resuscitator (void *obj, scm_t_finalizer_proc, void *data); +SCM_API int scm_set_automatic_finalization_enabled (int enabled_p); +SCM_API int scm_run_finalizers (void); + SCM_INTERNAL void scm_init_finalizers (void); #endif /* SCM_FINALIZERS_H */ diff --git a/libguile/goops.c b/libguile/goops.c index 4a2e24d..884b4b6 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012 +/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2014 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -659,7 +659,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))) { @@ -683,12 +683,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 @@ -696,14 +696,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)); } } diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm index e4df6e1..7c926f2 100644 --- a/module/language/tree-il/compile-glil.scm +++ b/module/language/tree-il/compile-glil.scm @@ -1,6 +1,6 @@ ;;; TREE-IL -> GLIL compiler -;; Copyright (C) 2001,2008,2009,2010,2011,2012,2013 Free Software Foundation, Inc. +;; Copyright (C) 2001,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 @@ -113,8 +113,6 @@ (list . list) (vector . vector) ((class-of . 1) . class-of) - ((@slot-ref . 2) . slot-ref) - ((@slot-set! . 3) . slot-set) ((vector-ref . 2) . vector-ref) ((vector-set! . 3) . vector-set) ((variable-ref . 1) . variable-ref) diff --git a/module/oop/goops.scm b/module/oop/goops.scm index f2f61c5..b92c820 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006, 2009, 2010, 2011, 2014 Free Software Foundation, Inc. ;;;; Copyright (C) 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <[email protected]> ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -82,13 +82,7 @@ (eval-when (expand load eval) (use-modules ((language tree-il primitives) :select (add-interesting-primitive!))) - (add-interesting-primitive! 'class-of) - (define (@slot-ref o n) - (struct-ref o n)) - (define (@slot-set! o n v) - (struct-set! o n v)) - (add-interesting-primitive! '@slot-ref) - (add-interesting-primitive! '@slot-set!)) + (add-interesting-primitive! 'class-of)) ;; Then load the rest of GOOPS (use-modules (oop goops util) @@ -1121,7 +1115,7 @@ (lambda (o) (assert-bound (proc o) o))) ;; the idea is to compile the index into the procedure, for fastest -;; lookup. Also, @slot-ref and @slot-set! have their own bytecodes. +;; lookup. (eval-when (expand load eval) (define num-standard-pre-cache 20)) @@ -1133,9 +1127,9 @@ (define (make-one x) (define (body-trans form) (cond ((not (pair? form)) form) - ((eq? (car form) '@slot-ref) + ((eq? (car form) 'struct-ref) `(,(car form) ,(cadr form) ,x)) - ((eq? (car form) '@slot-set!) + ((eq? (car form) 'struct-set!) `(,(car form) ,(cadr form) ,x ,(cadddr form))) (else (map body-trans form)))) @@ -1148,16 +1142,16 @@ ((lambda (,n-var) (lambda ,args ,@body)) n))))))) (define-standard-accessor-method ((bound-check-get n) o) - (let ((x (@slot-ref o n))) + (let ((x (struct-ref o n))) (if (unbound? x) (slot-unbound o) x))) (define-standard-accessor-method ((standard-get n) o) - (@slot-ref o n)) + (struct-ref o n)) (define-standard-accessor-method ((standard-set n) o v) - (@slot-set! o n v)) + (struct-set! o n v)) ;;; compute-getters-n-setters ;;; diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index 1705ee8..d8a5ecf 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -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)))) hooks/post-receive -- GNU Guile
