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 #ifdef HAVE_UNISTD_H
  27 #include <unistd.h>
  28 #endif
  29 #include <fcntl.h>
  30
  31 #include <full-write.h>
  32
  33 #include "libguile/bdw-gc.h"
  34 #include "libguile/_scm.h"
  35 #include "libguile/finalizers.h"
  36 #include "libguile/gc.h"
  37 #include "libguile/threads.h"
  38
  39 \f
  40
  41 static size_t finalization_count;
  42
  43
  44 \f
  45
  46 #ifndef HAVE_GC_SET_FINALIZER_NOTIFIER
  47 static void
  48 GC_set_finalizer_notifier (void (*notifier) (void))
  49 {
  50   GC_finalizer_notifier = notifier;
  51 }
  52 #endif
  53
  54
  55 \f
  56
  57 void
  58 scm_i_set_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
  59 {
  60   GC_finalization_proc prev;
  61   void *prev_data;
  62   GC_REGISTER_FINALIZER_NO_ORDER (obj, proc, data, &prev, &prev_data);
  63 }
  64
  65 struct scm_t_chained_finalizer
  66 {
  67   int resuscitating_p;
  68   scm_t_finalizer_proc proc;
  69   void *data;
  70   scm_t_finalizer_proc prev;
  71   void *prev_data;
  72 };
  73
  74 static void
  75 chained_finalizer (void *obj, void *data)
  76 {
  77   struct scm_t_chained_finalizer *chained_data = data;
  78   if (chained_data->resuscitating_p)
  79     {
  80       if (chained_data->prev)
  81         scm_i_set_finalizer (obj, chained_data->prev, chained_data->prev_data);
  82       chained_data->proc (obj, chained_data->data);
  83     }
  84   else
  85     {
  86       chained_data->proc (obj, chained_data->data);
  87       if (chained_data->prev)
  88         chained_data->prev (obj, chained_data->prev_data);
  89     }
  90 }
  91
  92 void
  93 scm_i_add_resuscitator (void *obj, scm_t_finalizer_proc proc, void *data)
  94 {
  95   struct scm_t_chained_finalizer *chained_data;
  96   chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
  97   chained_data->resuscitating_p = 1;
  98   chained_data->proc = proc;
  99   chained_data->data = data;
 100   GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
 101                                   &chained_data->prev,
 102                                   &chained_data->prev_data);
 103 }
 104
 105 static void
 106 shuffle_resuscitators_to_front (struct scm_t_chained_finalizer *cd)
 107 {
 108   while (cd->prev == chained_finalizer)
 109     {
 110       struct scm_t_chained_finalizer *prev = cd->prev_data;
 111       scm_t_finalizer_proc proc = cd->proc;
 112       void *data = cd->data;
 113
 114       if (!prev->resuscitating_p)
 115         break;
 116
 117       cd->resuscitating_p = 1;
 118       cd->proc = prev->proc;
 119       cd->data = prev->data;
 120
 121       prev->resuscitating_p = 0;
 122       prev->proc = proc;
 123       prev->data = data;
 124
 125       cd = prev;
 126     }
 127 }
 128
 129 void
 130 scm_i_add_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
 131 {
 132   struct scm_t_chained_finalizer *chained_data;
 133   chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
 134   chained_data->resuscitating_p = 0;
 135   chained_data->proc = proc;
 136   chained_data->data = data;
 137   GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
 138                                   &chained_data->prev,
 139                                   &chained_data->prev_data);
 140   shuffle_resuscitators_to_front (chained_data);
 141 }
 142
 143
 144 \f
 145
 146 static SCM finalizer_async_cell;
 147
 148 static SCM
 149 run_finalizers_async_thunk (void)
 150 {
 151   finalization_count += GC_invoke_finalizers ();
 152   return SCM_UNSPECIFIED;
 153 }
 154
 155
 156 /* The function queue_finalizer_async is run by the GC when there are
 157  * objects to finalize.  It will enqueue an asynchronous call to
 158  * GC_invoke_finalizers() at the next SCM_TICK in this thread.
 159  */
 160 static void
 161 queue_finalizer_async (void)
 162 {
 163   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 164   static scm_i_pthread_mutex_t lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 165
 166   scm_i_pthread_mutex_lock (&lock);
 167   /* If t is NULL, that could be because we're allocating in
 168      threads.c:guilify_self_1.  In that case, rely on the
 169      GC_invoke_finalizers call there after the thread spins up.  */
 170   if (t && scm_is_false (SCM_CDR (finalizer_async_cell)))
 171     {
 172       SCM_SETCDR (finalizer_async_cell, t->active_asyncs);
 173       t->active_asyncs = finalizer_async_cell;
 174       t->pending_asyncs = 1;
 175     }
 176   scm_i_pthread_mutex_unlock (&lock);
 177 }
 178
 179
 180 \f
 181
 182 #if SCM_USE_PTHREAD_THREADS
 183
 184 static int finalization_pipe[2];
 185 static scm_i_pthread_mutex_t finalization_thread_lock =
 186   SCM_I_PTHREAD_MUTEX_INITIALIZER;
 187 static pthread_t finalization_thread;
 188
 189 static void
 190 notify_finalizers_to_run (void)
 191 {
 192   char byte = 0;
 193   full_write (finalization_pipe[1], &byte, 1);
 194 }
 195
 196 static void
 197 notify_about_to_fork (void)
 198 {
 199   char byte = 1;
 200   full_write (finalization_pipe[1], &byte, 1);
 201 }
 202
 203 struct finalization_pipe_data
 204 {
 205   char byte;
 206   ssize_t n;
 207   int err;
 208 };
 209
 210 static void*
 211 read_finalization_pipe_data (void *data)
 212 {
 213   struct finalization_pipe_data *fdata = data;
 214
 215   fdata->n = read (finalization_pipe[0], &fdata->byte, 1);
 216   fdata->err = errno;
 217
 218   return NULL;
 219 }
 220
 221 static void*
 222 finalization_thread_proc (void *unused)
 223 {
 224   while (1)
 225     {
 226       struct finalization_pipe_data data;
 227
 228       scm_without_guile (read_finalization_pipe_data, &data);
 229
 230       if (data.n <= 0 && data.err != EINTR)
 231         {
 232           perror ("error in finalization thread");
 233           return NULL;
 234         }
 235
 236       switch (data.byte)
 237         {
 238         case 0:
 239           finalization_count += GC_invoke_finalizers ();
 240           break;
 241         case 1:
 242           return NULL;
 243         default:
 244           abort ();
 245         }
 246     }
 247 }
 248
 249 static void*
 250 run_finalization_thread (void *arg)
 251 {
 252   return scm_with_guile (finalization_thread_proc, arg);
 253 }
 254
 255 static void
 256 start_finalization_thread (void)
 257 {
 258   scm_i_pthread_mutex_lock (&finalization_thread_lock);
 259   if (!finalization_thread)
 260     /* Use the raw pthread API and scm_with_guile, because we don't want
 261        to block on any lock that scm_spawn_thread might want to take,
 262        and we don't want to inherit the dynamic state (fluids) of the
 263        caller.  */
 264     if (pthread_create (&finalization_thread, NULL,
 265                         run_finalization_thread, NULL))
 266       perror ("error creating finalization thread");
 267   scm_i_pthread_mutex_unlock (&finalization_thread_lock);
 268 }
 269
 270 static void
 271 stop_finalization_thread (void)
 272 {
 273   scm_i_pthread_mutex_lock (&finalization_thread_lock);
 274   if (finalization_thread)
 275     {
 276       notify_about_to_fork ();
 277       if (pthread_join (finalization_thread, NULL))
 278         perror ("joining finalization thread");
 279       finalization_thread = 0;
 280     }
 281   scm_i_pthread_mutex_unlock (&finalization_thread_lock);
 282 }
 283
 284 static void
 285 spawn_finalizer_thread (void)
 286 {
 287   GC_set_finalizer_notifier (notify_finalizers_to_run);
 288   start_finalization_thread ();
 289 }
 290
 291 #endif /* SCM_USE_PTHREAD_THREADS */
 292
 293
 294 \f
 295
 296 void
 297 scm_i_finalizer_pre_fork (void)
 298 {
 299 #if SCM_USE_PTHREAD_THREADS
 300   stop_finalization_thread ();
 301   GC_set_finalizer_notifier (spawn_finalizer_thread);
 302 #endif
 303 }
 304
 305
 306 \f
 307
 308 void
 309 scm_init_finalizers (void)
 310 {
 311   /* When the async is to run, the cdr of the pair gets set to the
 312      asyncs queue of the current thread.  */
 313   finalizer_async_cell =
 314     scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
 315                                 run_finalizers_async_thunk),
 316               SCM_BOOL_F);
 317   GC_set_finalizer_notifier (queue_finalizer_async);
 318 }
 319
 320 void
 321 scm_init_finalizer_thread (void)
 322 {
 323 #if SCM_USE_PTHREAD_THREADS
 324   if (pipe2 (finalization_pipe, O_CLOEXEC) != 0)
 325     scm_syserror (NULL);
 326   GC_set_finalizer_notifier (spawn_finalizer_thread);
 327 #endif
 328 }