guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.11-11-g48ad8


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.11-11-g48ad85f
Date: Sun, 27 Apr 2014 12:48:31 +0000

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 <address@hidden>
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 <address@hidden>
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.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 
2013
address@hidden 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
address@hidden ()} yourself.
+
address@hidden {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
address@hidden before Guile has been
+initialized.
+
+Return the previous status of automatic finalization.
address@hidden deftypefn
+
address@hidden {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.
address@hidden 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.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 
2010, 2011, 2013
address@hidden 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.
 
address@hidden finalizer
address@hidden 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 <address@hidden>
 ;;;;
 ;;;; 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]