libguile/finalizers.c

   1 /* Copyright (C) 2012, 2013 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 static int finalization_thread_is_running = 0;
 189
 190 static void
 191 notify_finalizers_to_run (void)
 192 {
 193   char byte = 0;
 194   full_write (finalization_pipe[1], &byte, 1);
 195 }
 196
 197 static void
 198 notify_about_to_fork (void)
 199 {
 200   char byte = 1;
 201   full_write (finalization_pipe[1], &byte, 1);
 202 }
 203
 204 struct finalization_pipe_data
 205 {
 206   char byte;
 207   ssize_t n;
 208   int err;
 209 };
 210
 211 static void*
 212 read_finalization_pipe_data (void *data)
 213 {
 214   struct finalization_pipe_data *fdata = data;
 215
 216   fdata->n = read (finalization_pipe[0], &fdata->byte, 1);
 217   fdata->err = errno;
 218
 219   return NULL;
 220 }
 221
 222 static void*
 223 finalization_thread_proc (void *unused)
 224 {
 225   while (1)
 226     {
 227       struct finalization_pipe_data data;
 228
 229       scm_without_guile (read_finalization_pipe_data, &data);
 230
 231       if (data.n <= 0 && data.err != EINTR)
 232         {
 233           perror ("error in finalization thread");
 234           return NULL;
 235         }
 236
 237       switch (data.byte)
 238         {
 239         case 0:
 240           finalization_count += GC_invoke_finalizers ();
 241           break;
 242         case 1:
 243           return NULL;
 244         default:
 245           abort ();
 246         }
 247     }
 248 }
 249
 250 static void*
 251 run_finalization_thread (void *arg)
 252 {
 253   return scm_with_guile (finalization_thread_proc, arg);
 254 }
 255
 256 static void
 257 start_finalization_thread (void)
 258 {
 259   scm_i_pthread_mutex_lock (&finalization_thread_lock);
 260   if (!finalization_thread_is_running)
 261     {
 262       /* Use the raw pthread API and scm_with_guile, because we don't want
 263          to block on any lock that scm_spawn_thread might want to take,
 264          and we don't want to inherit the dynamic state (fluids) of the
 265          caller.  */
 266       if (pthread_create (&finalization_thread, NULL,
 267                           run_finalization_thread, NULL))
 268         perror ("error creating finalization thread");
 269       else
 270         finalization_thread_is_running = 1;
 271     }
 272   scm_i_pthread_mutex_unlock (&finalization_thread_lock);
 273 }
 274
 275 static void
 276 stop_finalization_thread (void)
 277 {
 278   scm_i_pthread_mutex_lock (&finalization_thread_lock);
 279   if (finalization_thread_is_running)
 280     {
 281       notify_about_to_fork ();
 282       if (pthread_join (finalization_thread, NULL))
 283         perror ("joining finalization thread");
 284       finalization_thread_is_running = 0;
 285     }
 286   scm_i_pthread_mutex_unlock (&finalization_thread_lock);
 287 }
 288
 289 static void
 290 spawn_finalizer_thread (void)
 291 {
 292   GC_set_finalizer_notifier (notify_finalizers_to_run);
 293   start_finalization_thread ();
 294 }
 295
 296 #endif /* SCM_USE_PTHREAD_THREADS */
 297
 298
 299 \f
 300
 301 void
 302 scm_i_finalizer_pre_fork (void)
 303 {
 304 #if SCM_USE_PTHREAD_THREADS
 305   stop_finalization_thread ();
 306   GC_set_finalizer_notifier (spawn_finalizer_thread);
 307 #endif
 308 }
 309
 310
 311 \f
 312
 313 static void*
 314 weak_pointer_ref (void *weak_pointer)
 315 {
 316   return *(void **) weak_pointer;
 317 }
 318
 319 static void
 320 weak_gc_finalizer (void *ptr, void *data)
 321 {
 322   void **weak = ptr;
 323   void *val;
 324   void (*callback) (SCM) = weak[1];
 325
 326   val = GC_call_with_alloc_lock (weak_pointer_ref, &weak[0]);
 327
 328   if (!val)
 329     return;
 330
 331   callback (SCM_PACK_POINTER (val));
 332
 333   scm_i_set_finalizer (ptr, weak_gc_finalizer, data);
 334 }
 335
 336 /* CALLBACK will be called on OBJ, as long as OBJ is accessible.  It
 337    will be called from a finalizer, which may be from an async or from
 338    another thread.
 339
 340    As an implementation detail, the way this works is that we allocate
 341    a fresh pointer-less object holding two words.  We know that this
 342    object should get collected the next time GC is run, so we attach a
 343    finalizer to it so that we get a callback after GC happens.
 344
 345    The first word of the object holds a weak reference to OBJ, and the
 346    second holds the callback pointer.  When the callback is called, we
 347    check if the weak reference on OBJ still holds.  If it doesn't hold,
 348    then OBJ is no longer accessible, and we're done.  Otherwise we call
 349    the callback and re-register a finalizer for our two-word GC object,
 350    effectively resuscitating the object so that we will get a callback
 351    on the next GC.
 352
 353    We could use the scm_after_gc_hook, but using a finalizer has the
 354    advantage of potentially running in another thread, decreasing pause
 355    time.  */
 356 void
 357 scm_i_register_weak_gc_callback (SCM obj, void (*callback) (SCM))
 358 {
 359   void **weak = GC_MALLOC_ATOMIC (sizeof (void*) * 2);
 360
 361   weak[0] = SCM_UNPACK_POINTER (obj);
 362   weak[1] = (void*)callback;
 363   GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj));
 364
 365   scm_i_set_finalizer (weak, weak_gc_finalizer, NULL);
 366 }
 367
 368
 369 \f
 370
 371 void
 372 scm_init_finalizers (void)
 373 {
 374   /* When the async is to run, the cdr of the pair gets set to the
 375      asyncs queue of the current thread.  */
 376   finalizer_async_cell =
 377     scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
 378                                 run_finalizers_async_thunk),
 379               SCM_BOOL_F);
 380   GC_set_finalizer_notifier (queue_finalizer_async);
 381 }
 382
 383 void
 384 scm_init_finalizer_thread (void)
 385 {
 386 #if SCM_USE_PTHREAD_THREADS
 387   if (pipe2 (finalization_pipe, O_CLOEXEC) != 0)
 388     scm_syserror (NULL);
 389   GC_set_finalizer_notifier (spawn_finalizer_thread);
 390 #endif
 391 }