libguile/finalizers.c

   1 /* Copyright (C) 2012, 2014 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16  * 02110-1301 USA
  17  */
  18
  19
  20 \f
  21
  22 #ifdef HAVE_CONFIG_H
  23 # include <config.h>
  24 #endif
  25
  26 #include "libguile/bdw-gc.h"
  27 #include "libguile/_scm.h"
  28 #include "libguile/finalizers.h"
  29 #include "libguile/gc.h"
  30 #include "libguile/threads.h"
  31
  32 \f
  33
  34 static int automatic_finalization_p = 1;
  35
  36 static size_t finalization_count;
  37
  38
  39 \f
  40
  41 void
  42 scm_i_set_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
  43 {
  44   GC_finalization_proc prev;
  45   void *prev_data;
  46   GC_REGISTER_FINALIZER_NO_ORDER (obj, proc, data, &prev, &prev_data);
  47 }
  48
  49 struct scm_t_chained_finalizer
  50 {
  51   int resuscitating_p;
  52   scm_t_finalizer_proc proc;
  53   void *data;
  54   scm_t_finalizer_proc prev;
  55   void *prev_data;
  56 };
  57
  58 static void
  59 chained_finalizer (void *obj, void *data)
  60 {
  61   struct scm_t_chained_finalizer *chained_data = data;
  62   if (chained_data->resuscitating_p)
  63     {
  64       if (chained_data->prev)
  65         scm_i_set_finalizer (obj, chained_data->prev, chained_data->prev_data);
  66       chained_data->proc (obj, chained_data->data);
  67     }
  68   else
  69     {
  70       chained_data->proc (obj, chained_data->data);
  71       if (chained_data->prev)
  72         chained_data->prev (obj, chained_data->prev_data);
  73     }
  74 }
  75
  76 void
  77 scm_i_add_resuscitator (void *obj, scm_t_finalizer_proc proc, void *data)
  78 {
  79   struct scm_t_chained_finalizer *chained_data;
  80   chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
  81   chained_data->resuscitating_p = 1;
  82   chained_data->proc = proc;
  83   chained_data->data = data;
  84   GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
  85                                   &chained_data->prev,
  86                                   &chained_data->prev_data);
  87 }
  88
  89 static void
  90 shuffle_resuscitators_to_front (struct scm_t_chained_finalizer *cd)
  91 {
  92   while (cd->prev == chained_finalizer)
  93     {
  94       struct scm_t_chained_finalizer *prev = cd->prev_data;
  95       scm_t_finalizer_proc proc = cd->proc;
  96       void *data = cd->data;
  97
  98       if (!prev->resuscitating_p)
  99         break;
 100
 101       cd->resuscitating_p = 1;
 102       cd->proc = prev->proc;
 103       cd->data = prev->data;
 104
 105       prev->resuscitating_p = 0;
 106       prev->proc = proc;
 107       prev->data = data;
 108
 109       cd = prev;
 110     }
 111 }
 112
 113 void
 114 scm_i_add_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
 115 {
 116   struct scm_t_chained_finalizer *chained_data;
 117   chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
 118   chained_data->resuscitating_p = 0;
 119   chained_data->proc = proc;
 120   chained_data->data = data;
 121   GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
 122                                   &chained_data->prev,
 123                                   &chained_data->prev_data);
 124   shuffle_resuscitators_to_front (chained_data);
 125 }
 126
 127
 128 \f
 129
 130 static SCM finalizer_async_cell;
 131
 132 static SCM
 133 run_finalizers_async_thunk (void)
 134 {
 135   scm_run_finalizers ();
 136   return SCM_UNSPECIFIED;
 137 }
 138
 139
 140 /* The function queue_finalizer_async is run by the GC when there are
 141  * objects to finalize.  It will enqueue an asynchronous call to
 142  * GC_invoke_finalizers() at the next SCM_TICK in this thread.
 143  */
 144 static void
 145 queue_finalizer_async (void)
 146 {
 147   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 148   static scm_i_pthread_mutex_t lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 149
 150   scm_i_pthread_mutex_lock (&lock);
 151   /* If t is NULL, that could be because we're allocating in
 152      threads.c:guilify_self_1.  In that case, rely on the
 153      GC_invoke_finalizers call there after the thread spins up.  */
 154   if (t && scm_is_false (SCM_CDR (finalizer_async_cell)))
 155     {
 156       SCM_SETCDR (finalizer_async_cell, t->active_asyncs);
 157       t->active_asyncs = finalizer_async_cell;
 158       t->pending_asyncs = 1;
 159     }
 160   scm_i_pthread_mutex_unlock (&lock);
 161 }
 162
 163
 164 \f
 165
 166 #ifndef HAVE_GC_SET_FINALIZER_NOTIFIER
 167 static void
 168 GC_set_finalizer_notifier (void (*notifier) (void))
 169 {
 170   GC_finalizer_notifier = notifier;
 171 }
 172 #endif
 173
 174
 175 \f
 176
 177 int
 178 scm_set_automatic_finalization_enabled (int enabled_p)
 179 {
 180   int was_enabled_p = automatic_finalization_p;
 181
 182   if (enabled_p == was_enabled_p)
 183     return was_enabled_p;
 184
 185   if (!scm_initialized_p)
 186     {
 187       automatic_finalization_p = enabled_p;
 188       return was_enabled_p;
 189     }
 190
 191   GC_set_finalizer_notifier (enabled_p ? queue_finalizer_async : 0);
 192
 193   automatic_finalization_p = enabled_p;
 194
 195   return was_enabled_p;
 196 }
 197
 198 int
 199 scm_run_finalizers (void)
 200 {
 201   int finalized = GC_invoke_finalizers ();
 202
 203   finalization_count += finalized;
 204
 205   return finalized;
 206 }
 207
 208
 209 \f
 210
 211 void
 212 scm_init_finalizers (void)
 213 {
 214   /* When the async is to run, the cdr of the pair gets set to the
 215      asyncs queue of the current thread.  */
 216   finalizer_async_cell =
 217     scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
 218                                 run_finalizers_async_thunk),
 219               SCM_BOOL_F);
 220
 221   if (automatic_finalization_p)
 222     GC_set_finalizer_notifier (queue_finalizer_async);
 223 }