libguile/finalizers.c

   1 /* Copyright (C) 2012, 2013, 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 #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 int automatic_finalization_p = 1;
  42
  43 static size_t finalization_count;
  44
  45
  46 \f
  47
  48 void
  49 scm_i_set_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
  50 {
  51   GC_finalization_proc prev;
  52   void *prev_data;
  53   GC_REGISTER_FINALIZER_NO_ORDER (obj, proc, data, &prev, &prev_data);
  54 }
  55
  56 struct scm_t_chained_finalizer
  57 {
  58   int resuscitating_p;
  59   scm_t_finalizer_proc proc;
  60   void *data;
  61   scm_t_finalizer_proc prev;
  62   void *prev_data;
  63 };
  64
  65 static void
  66 chained_finalizer (void *obj, void *data)
  67 {
  68   struct scm_t_chained_finalizer *chained_data = data;
  69   if (chained_data->resuscitating_p)
  70     {
  71       if (chained_data->prev)
  72         scm_i_set_finalizer (obj, chained_data->prev, chained_data->prev_data);
  73       chained_data->proc (obj, chained_data->data);
  74     }
  75   else
  76     {
  77       chained_data->proc (obj, chained_data->data);
  78       if (chained_data->prev)
  79         chained_data->prev (obj, chained_data->prev_data);
  80     }
  81 }
  82
  83 void
  84 scm_i_add_resuscitator (void *obj, scm_t_finalizer_proc proc, void *data)
  85 {
  86   struct scm_t_chained_finalizer *chained_data;
  87   chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
  88   chained_data->resuscitating_p = 1;
  89   chained_data->proc = proc;
  90   chained_data->data = data;
  91   GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
  92                                   &chained_data->prev,
  93                                   &chained_data->prev_data);
  94 }
  95
  96 static void
  97 shuffle_resuscitators_to_front (struct scm_t_chained_finalizer *cd)
  98 {
  99   while (cd->prev == chained_finalizer)
 100     {
 101       struct scm_t_chained_finalizer *prev = cd->prev_data;
 102       scm_t_finalizer_proc proc = cd->proc;
 103       void *data = cd->data;
 104
 105       if (!prev->resuscitating_p)
 106         break;
 107
 108       cd->resuscitating_p = 1;
 109       cd->proc = prev->proc;
 110       cd->data = prev->data;
 111
 112       prev->resuscitating_p = 0;
 113       prev->proc = proc;
 114       prev->data = data;
 115
 116       cd = prev;
 117     }
 118 }
 119
 120 void
 121 scm_i_add_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
 122 {
 123   struct scm_t_chained_finalizer *chained_data;
 124   chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
 125   chained_data->resuscitating_p = 0;
 126   chained_data->proc = proc;
 127   chained_data->data = data;
 128   GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
 129                                   &chained_data->prev,
 130                                   &chained_data->prev_data);
 131   shuffle_resuscitators_to_front (chained_data);
 132 }
 133
 134
 135 \f
 136
 137 static SCM finalizer_async_cell;
 138
 139 static SCM
 140 run_finalizers_async_thunk (void)
 141 {
 142   scm_run_finalizers ();
 143   return SCM_UNSPECIFIED;
 144 }
 145
 146
 147 /* The function queue_finalizer_async is run by the GC when there are
 148  * objects to finalize.  It will enqueue an asynchronous call to
 149  * GC_invoke_finalizers() at the next SCM_TICK in this thread.
 150  */
 151 static void
 152 queue_finalizer_async (void)
 153 {
 154   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 155   static scm_i_pthread_mutex_t lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 156
 157   scm_i_pthread_mutex_lock (&lock);
 158   /* If t is NULL, that could be because we're allocating in
 159      threads.c:guilify_self_1.  In that case, rely on the
 160      GC_invoke_finalizers call there after the thread spins up.  */
 161   if (t && scm_is_false (SCM_CDR (finalizer_async_cell)))
 162     {
 163       SCM_SETCDR (finalizer_async_cell, t->active_asyncs);
 164       t->active_asyncs = finalizer_async_cell;
 165       t->pending_asyncs = 1;
 166     }
 167   scm_i_pthread_mutex_unlock (&lock);
 168 }
 169
 170
 171 \f
 172
 173 #if SCM_USE_PTHREAD_THREADS
 174
 175 static int finalization_pipe[2];
 176 static scm_i_pthread_mutex_t finalization_thread_lock =
 177   SCM_I_PTHREAD_MUTEX_INITIALIZER;
 178 static pthread_t finalization_thread;
 179 static int finalization_thread_is_running = 0;
 180
 181 static void
 182 notify_finalizers_to_run (void)
 183 {
 184   char byte = 0;
 185   full_write (finalization_pipe[1], &byte, 1);
 186 }
 187
 188 static void
 189 notify_about_to_fork (void)
 190 {
 191   char byte = 1;
 192   full_write (finalization_pipe[1], &byte, 1);
 193 }
 194
 195 struct finalization_pipe_data
 196 {
 197   char byte;
 198   ssize_t n;
 199   int err;
 200 };
 201
 202 static void*
 203 read_finalization_pipe_data (void *data)
 204 {
 205   struct finalization_pipe_data *fdata = data;
 206
 207   fdata->n = read (finalization_pipe[0], &fdata->byte, 1);
 208   fdata->err = errno;
 209
 210   return NULL;
 211 }
 212
 213 static void*
 214 finalization_thread_proc (void *unused)
 215 {
 216   while (1)
 217     {
 218       struct finalization_pipe_data data;
 219
 220       scm_without_guile (read_finalization_pipe_data, &data);
 221
 222       if (data.n <= 0 && data.err != EINTR)
 223         {
 224           perror ("error in finalization thread");
 225           return NULL;
 226         }
 227
 228       switch (data.byte)
 229         {
 230         case 0:
 231           scm_run_finalizers ();
 232           break;
 233         case 1:
 234           return NULL;
 235         default:
 236           abort ();
 237         }
 238     }
 239 }
 240
 241 static void*
 242 run_finalization_thread (void *arg)
 243 {
 244   return scm_with_guile (finalization_thread_proc, arg);
 245 }
 246
 247 static void
 248 start_finalization_thread (void)
 249 {
 250   scm_i_pthread_mutex_lock (&finalization_thread_lock);
 251   if (!finalization_thread_is_running)
 252     {
 253       /* Use the raw pthread API and scm_with_guile, because we don't want
 254          to block on any lock that scm_spawn_thread might want to take,
 255          and we don't want to inherit the dynamic state (fluids) of the
 256          caller.  */
 257       if (pthread_create (&finalization_thread, NULL,
 258                           run_finalization_thread, NULL))
 259         perror ("error creating finalization thread");
 260       else
 261         finalization_thread_is_running = 1;
 262     }
 263   scm_i_pthread_mutex_unlock (&finalization_thread_lock);
 264 }
 265
 266 static void
 267 stop_finalization_thread (void)
 268 {
 269   scm_i_pthread_mutex_lock (&finalization_thread_lock);
 270   if (finalization_thread_is_running)
 271     {
 272       notify_about_to_fork ();
 273       if (pthread_join (finalization_thread, NULL))
 274         perror ("joining finalization thread");
 275       finalization_thread_is_running = 0;
 276     }
 277   scm_i_pthread_mutex_unlock (&finalization_thread_lock);
 278 }
 279
 280 static void
 281 spawn_finalizer_thread (void)
 282 {
 283   GC_set_finalizer_notifier (notify_finalizers_to_run);
 284   start_finalization_thread ();
 285 }
 286
 287 #endif /* SCM_USE_PTHREAD_THREADS */
 288
 289
 290 \f
 291
 292 void
 293 scm_i_finalizer_pre_fork (void)
 294 {
 295 #if SCM_USE_PTHREAD_THREADS
 296   if (automatic_finalization_p)
 297     {
 298       stop_finalization_thread ();
 299       GC_set_finalizer_notifier (spawn_finalizer_thread);
 300     }
 301 #endif
 302 }
 303
 304
 305 \f
 306
 307 static void*
 308 weak_pointer_ref (void *weak_pointer)
 309 {
 310   return *(void **) weak_pointer;
 311 }
 312
 313 static void
 314 weak_gc_finalizer (void *ptr, void *data)
 315 {
 316   void **weak = ptr;
 317   void *val;
 318   void (*callback) (SCM) = weak[1];
 319
 320   val = GC_call_with_alloc_lock (weak_pointer_ref, &weak[0]);
 321
 322   if (!val)
 323     return;
 324
 325   callback (SCM_PACK_POINTER (val));
 326
 327   scm_i_set_finalizer (ptr, weak_gc_finalizer, data);
 328 }
 329
 330 /* CALLBACK will be called on OBJ, as long as OBJ is accessible.  It
 331    will be called from a finalizer, which may be from an async or from
 332    another thread.
 333
 334    As an implementation detail, the way this works is that we allocate
 335    a fresh pointer-less object holding two words.  We know that this
 336    object should get collected the next time GC is run, so we attach a
 337    finalizer to it so that we get a callback after GC happens.
 338
 339    The first word of the object holds a weak reference to OBJ, and the
 340    second holds the callback pointer.  When the callback is called, we
 341    check if the weak reference on OBJ still holds.  If it doesn't hold,
 342    then OBJ is no longer accessible, and we're done.  Otherwise we call
 343    the callback and re-register a finalizer for our two-word GC object,
 344    effectively resuscitating the object so that we will get a callback
 345    on the next GC.
 346
 347    We could use the scm_after_gc_hook, but using a finalizer has the
 348    advantage of potentially running in another thread, decreasing pause
 349    time.  */
 350 void
 351 scm_i_register_weak_gc_callback (SCM obj, void (*callback) (SCM))
 352 {
 353   void **weak = GC_MALLOC_ATOMIC (sizeof (void*) * 2);
 354
 355   weak[0] = SCM_UNPACK_POINTER (obj);
 356   weak[1] = (void*)callback;
 357   GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj));
 358
 359   scm_i_set_finalizer (weak, weak_gc_finalizer, NULL);
 360 }
 361
 362
 363 int
 364 scm_set_automatic_finalization_enabled (int enabled_p)
 365 {
 366   int was_enabled_p = automatic_finalization_p;
 367
 368   if (enabled_p == was_enabled_p)
 369     return was_enabled_p;
 370
 371   if (!scm_initialized_p)
 372     {
 373       automatic_finalization_p = enabled_p;
 374       return was_enabled_p;
 375     }
 376
 377   if (enabled_p)
 378     {
 379 #if SCM_USE_PTHREAD_THREADS
 380       if (pipe2 (finalization_pipe, O_CLOEXEC) != 0)
 381         scm_syserror (NULL);
 382       GC_set_finalizer_notifier (spawn_finalizer_thread);
 383 #else
 384       GC_set_finalizer_notifier (queue_finalizer_async);
 385 #endif
 386     }
 387   else
 388     {
 389       GC_set_finalizer_notifier (0);
 390
 391 #if SCM_USE_PTHREAD_THREADS
 392       stop_finalization_thread ();
 393       close (finalization_pipe[0]);
 394       close (finalization_pipe[1]);
 395       finalization_pipe[0] = -1;
 396       finalization_pipe[1] = -1;
 397 #endif
 398     }
 399
 400   automatic_finalization_p = enabled_p;
 401
 402   return was_enabled_p;
 403 }
 404
 405 int
 406 scm_run_finalizers (void)
 407 {
 408   int finalized = GC_invoke_finalizers ();
 409
 410   finalization_count += finalized;
 411
 412   return finalized;
 413 }
 414
 415
 416 \f
 417
 418 void
 419 scm_init_finalizers (void)
 420 {
 421   /* When the async is to run, the cdr of the pair gets set to the
 422      asyncs queue of the current thread.  */
 423   finalizer_async_cell =
 424     scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
 425                                 run_finalizers_async_thunk),
 426               SCM_BOOL_F);
 427
 428   if (automatic_finalization_p)
 429     GC_set_finalizer_notifier (queue_finalizer_async);
 430 }
 431
 432 void
 433 scm_init_finalizer_thread (void)
 434 {
 435 #if SCM_USE_PTHREAD_THREADS
 436   if (automatic_finalization_p)
 437     {
 438       if (pipe2 (finalization_pipe, O_CLOEXEC) != 0)
 439         scm_syserror (NULL);
 440       GC_set_finalizer_notifier (spawn_finalizer_thread);
 441     }
 442 #endif
 443 }