libguile/finalizers.c

   1 /* Copyright (C) 2012 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 size_t finalization_count;
  35
  36
  37 \f
  38
  39 void
  40 scm_i_set_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
  41 {
  42   GC_finalization_proc prev;
  43   void *prev_data;
  44   GC_REGISTER_FINALIZER_NO_ORDER (obj, proc, data, &prev, &prev_data);
  45 }
  46
  47 struct scm_t_chained_finalizer
  48 {
  49   int resuscitating_p;
  50   scm_t_finalizer_proc proc;
  51   void *data;
  52   scm_t_finalizer_proc prev;
  53   void *prev_data;
  54 };
  55
  56 static void
  57 chained_finalizer (void *obj, void *data)
  58 {
  59   struct scm_t_chained_finalizer *chained_data = data;
  60   if (chained_data->resuscitating_p)
  61     {
  62       if (chained_data->prev)
  63         scm_i_set_finalizer (obj, chained_data->prev, chained_data->prev_data);
  64       chained_data->proc (obj, chained_data->data);
  65     }
  66   else
  67     {
  68       chained_data->proc (obj, chained_data->data);
  69       if (chained_data->prev)
  70         chained_data->prev (obj, chained_data->prev_data);
  71     }
  72 }
  73
  74 void
  75 scm_i_add_resuscitator (void *obj, scm_t_finalizer_proc proc, void *data)
  76 {
  77   struct scm_t_chained_finalizer *chained_data;
  78   chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
  79   chained_data->resuscitating_p = 1;
  80   chained_data->proc = proc;
  81   chained_data->data = data;
  82   GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
  83                                   &chained_data->prev,
  84                                   &chained_data->prev_data);
  85 }
  86
  87 static void
  88 shuffle_resuscitators_to_front (struct scm_t_chained_finalizer *cd)
  89 {
  90   while (cd->prev == chained_finalizer)
  91     {
  92       struct scm_t_chained_finalizer *prev = cd->prev_data;
  93       scm_t_finalizer_proc proc = cd->proc;
  94       void *data = cd->data;
  95
  96       if (!prev->resuscitating_p)
  97         break;
  98
  99       cd->resuscitating_p = 1;
 100       cd->proc = prev->proc;
 101       cd->data = prev->data;
 102
 103       prev->resuscitating_p = 0;
 104       prev->proc = proc;
 105       prev->data = data;
 106
 107       cd = prev;
 108     }
 109 }
 110
 111 void
 112 scm_i_add_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
 113 {
 114   struct scm_t_chained_finalizer *chained_data;
 115   chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
 116   chained_data->resuscitating_p = 0;
 117   chained_data->proc = proc;
 118   chained_data->data = data;
 119   GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
 120                                   &chained_data->prev,
 121                                   &chained_data->prev_data);
 122   shuffle_resuscitators_to_front (chained_data);
 123 }
 124
 125
 126 \f
 127
 128 static SCM finalizer_async_cell;
 129
 130 static SCM
 131 run_finalizers_async_thunk (void)
 132 {
 133   finalization_count += GC_invoke_finalizers ();
 134   return SCM_UNSPECIFIED;
 135 }
 136
 137
 138 /* The function queue_finalizer_async is run by the GC when there are
 139  * objects to finalize.  It will enqueue an asynchronous call to
 140  * GC_invoke_finalizers() at the next SCM_TICK in this thread.
 141  */
 142 static void
 143 queue_finalizer_async (void)
 144 {
 145   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 146   static scm_i_pthread_mutex_t lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 147
 148   scm_i_pthread_mutex_lock (&lock);
 149   /* If t is NULL, that could be because we're allocating in
 150      threads.c:guilify_self_1.  In that case, rely on the
 151      GC_invoke_finalizers call there after the thread spins up.  */
 152   if (t && scm_is_false (SCM_CDR (finalizer_async_cell)))
 153     {
 154       SCM_SETCDR (finalizer_async_cell, t->active_asyncs);
 155       t->active_asyncs = finalizer_async_cell;
 156       t->pending_asyncs = 1;
 157     }
 158   scm_i_pthread_mutex_unlock (&lock);
 159 }
 160
 161
 162 \f
 163
 164 #ifndef HAVE_GC_SET_FINALIZER_NOTIFIER
 165 static void
 166 GC_set_finalizer_notifier (void (*notifier) (void))
 167 {
 168   GC_finalizer_notifier = notifier;
 169 }
 170 #endif
 171
 172 void
 173 scm_init_finalizers (void)
 174 {
 175   /* When the async is to run, the cdr of the pair gets set to the
 176      asyncs queue of the current thread.  */
 177   finalizer_async_cell =
 178     scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
 179                                 run_finalizers_async_thunk),
 180               SCM_BOOL_F);
 181   GC_set_finalizer_notifier (queue_finalizer_async);
 182 }