libguile/null-threads.c

   1 /* Copyright (C) 2002, 2006, 2008 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 #ifdef HAVE_CONFIG_H
  20 # include <config.h>
  21 #endif
  22
  23 #include <stdlib.h>
  24 #include "libguile/_scm.h"
  25
  26 #if SCM_USE_NULL_THREADS
  27
  28 #include "libguile/null-threads.h"
  29
  30 static scm_i_pthread_key_t *all_keys = NULL;
  31
  32 static void
  33 destroy_keys (void)
  34 {
  35   scm_i_pthread_key_t *key;
  36   int again;
  37
  38   do {
  39     again = 0;
  40     for (key = all_keys; key; key = key->next)
  41       if (key->value && key->destr_func)
  42         {
  43           void *v = key->value;
  44           key->value = NULL;
  45           key->destr_func (v);
  46           again = 1;
  47         }
  48   } while (again);
  49 }
  50
  51 int
  52 scm_i_pthread_key_create (scm_i_pthread_key_t *key,
  53                           void (*destr_func) (void *))
  54 {
  55   if (all_keys == NULL)
  56     atexit (destroy_keys);
  57
  58   key->next = all_keys;
  59   all_keys = key;
  60   key->value = NULL;
  61   key->destr_func = destr_func;
  62
  63   return 0;
  64 }
  65
  66 #endif /* SCM_USE_NULL_THREADS */
  67
  68
  69 /*
  70   Local Variables:
  71   c-file-style: "gnu"
  72   End:
  73 */