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
 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 static void*
 309 weak_pointer_ref (void *weak_pointer)
 310 {
 311   return *(void **) weak_pointer;
 312 }
 313
 314 static void
 315 weak_gc_finalizer (void *ptr, void *data)
 316 {
 317   void **weak = ptr;
 318   void *val;
 319   void (*callback) (SCM) = weak[1];
 320
 321   val = GC_call_with_alloc_lock (weak_pointer_ref, &weak[0]);
 322
 323   if (!val)
 324     return;
 325
 326   callback (SCM_PACK_POINTER (val));
 327
 328   scm_i_set_finalizer (ptr, weak_gc_finalizer, data);
 329 }
 330
 331 /* CALLBACK will be called on OBJ, as long as OBJ is accessible.  It
 332    will be called from a finalizer, which may be from an async or from
 333    another thread.
 334
 335    As an implementation detail, the way this works is that we allocate
 336    a fresh pointer-less object holding two words.  We know that this
 337    object should get collected the next time GC is run, so we attach a
 338    finalizer to it so that we get a callback after GC happens.
 339
 340    The first word of the object holds a weak reference to OBJ, and the
 341    second holds the callback pointer.  When the callback is called, we
 342    check if the weak reference on OBJ still holds.  If it doesn't hold,
 343    then OBJ is no longer accessible, and we're done.  Otherwise we call
 344    the callback and re-register a finalizer for our two-word GC object,
 345    effectively resuscitating the object so that we will get a callback
 346    on the next GC.
 347
 348    We could use the scm_after_gc_hook, but using a finalizer has the
 349    advantage of potentially running in another thread, decreasing pause
 350    time.  */
 351 void
 352 scm_i_register_weak_gc_callback (SCM obj, void (*callback) (SCM))
 353 {
 354   void **weak = GC_MALLOC_ATOMIC (sizeof (void*) * 2);
 355
 356   weak[0] = SCM_UNPACK_POINTER (obj);
 357   weak[1] = (void*)callback;
 358   GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj));
 359
 360   scm_i_set_finalizer (weak, weak_gc_finalizer, NULL);
 361 }
 362
 363
 364 \f
 365
 366 void
 367 scm_init_finalizers (void)
 368 {
 369   /* When the async is to run, the cdr of the pair gets set to the
 370      asyncs queue of the current thread.  */
 371   finalizer_async_cell =
 372     scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
 373                                 run_finalizers_async_thunk),
 374               SCM_BOOL_F);
 375   GC_set_finalizer_notifier (queue_finalizer_async);
 376 }
 377
 378 void
 379 scm_init_finalizer_thread (void)
 380 {
 381 #if SCM_USE_PTHREAD_THREADS
 382   if (pipe2 (finalization_pipe, O_CLOEXEC) != 0)
 383     scm_syserror (NULL);
 384   GC_set_finalizer_notifier (spawn_finalizer_thread);
 385 #endif
 386 }