libguile/null-threads.c

   1 /* Copyright (C) 2002 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42
  43 \f
  44
  45 #include "libguile/validate.h"
  46 #include "libguile/root.h"
  47 #include "libguile/stackchk.h"
  48 #include "libguile/async.h"
  49 #include <sys/time.h>
  50 #include <sys/types.h>
  51 #include <time.h>
  52 #include <stdio.h>
  53
  54 void *scm_null_threads_data;
  55
  56 static SCM main_thread;
  57
  58 typedef struct {
  59   int level;
  60 } scm_null_mutex;
  61
  62 typedef struct {
  63   int signalled;
  64 } scm_null_cond;
  65
  66 void
  67 scm_threads_init (SCM_STACKITEM *i)
  68 {
  69   scm_tc16_thread = scm_make_smob_type ("thread", 0);
  70   scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (scm_null_mutex));
  71   scm_tc16_condvar = scm_make_smob_type ("condition-variable",
  72                                          sizeof (scm_null_cond));
  73
  74   main_thread = scm_permanent_object (scm_cell (scm_tc16_thread, 0));
  75   scm_null_threads_data = NULL;
  76 }
  77
  78 #ifdef __ia64__
  79 # define SCM_MARK_BACKING_STORE() do {                                \
  80     ucontext_t ctx;                                                   \
  81     SCM_STACKITEM * top, * bot;                                       \
  82     getcontext (&ctx);                                                \
  83     scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext,           \
  84       ((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \
  85        / sizeof (SCM_STACKITEM)));                                    \
  86     bot = (SCM_STACKITEM *) __libc_ia64_register_backing_store_base;  \
  87     top = (SCM_STACKITEM *) ctx.uc_mcontext.sc_ar_bsp;                \
  88     scm_mark_locations (bot, top - bot); } while (0)
  89 #else
  90 # define SCM_MARK_BACKING_STORE()
  91 #endif
  92
  93 void
  94 scm_threads_mark_stacks (void)
  95 {
  96   /* Mark objects on the C stack. */
  97   SCM_FLUSH_REGISTER_WINDOWS;
  98   /* This assumes that all registers are saved into the jmp_buf */
  99   setjmp (scm_save_regs_gc_mark);
 100   scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
 101                       (   (size_t) (sizeof (SCM_STACKITEM) - 1 +
 102                                        sizeof scm_save_regs_gc_mark)
 103                           / sizeof (SCM_STACKITEM)));
 104
 105   {
 106     unsigned long stack_len = scm_stack_size (scm_stack_base);
 107 #ifdef SCM_STACK_GROWS_UP
 108     scm_mark_locations (scm_stack_base, stack_len);
 109 #else
 110     scm_mark_locations (scm_stack_base - stack_len, stack_len);
 111 #endif
 112   }
 113   SCM_MARK_BACKING_STORE();
 114 }
 115
 116 SCM
 117 scm_call_with_new_thread (SCM argl)
 118 #define FUNC_NAME s_call_with_new_thread
 119 {
 120   SCM_MISC_ERROR ("threads are not supported in this version of Guile",
 121                   SCM_EOL);
 122   return SCM_BOOL_F;
 123 }
 124 #undef FUNC_NAME
 125
 126 SCM
 127 scm_spawn_thread (scm_t_catch_body body, void *body_data,
 128                   scm_t_catch_handler handler, void *handler_data)
 129 {
 130   scm_misc_error ("scm_spawn_thread",
 131                   "threads are not supported in this version of Guile",
 132                   SCM_EOL);
 133   return SCM_BOOL_F;
 134 }
 135
 136 SCM
 137 scm_current_thread (void)
 138 {
 139   return main_thread;
 140 }
 141
 142 SCM
 143 scm_all_threads (void)
 144 {
 145   return scm_list_1 (main_thread);
 146 }
 147
 148 scm_root_state *
 149 scm_i_thread_root (SCM thread)
 150 {
 151   return (scm_root_state *)scm_null_threads_data;
 152 }
 153
 154 SCM
 155 scm_join_thread (SCM thread)
 156 #define FUNC_NAME s_join_thread
 157 {
 158   SCM_MISC_ERROR ("threads are not supported in this version of Guile",
 159                   SCM_EOL);
 160   return SCM_BOOL_F;
 161 }
 162 #undef FUNC_NAME
 163
 164 int
 165 scm_c_thread_exited_p (SCM thread)
 166 #define FUNC_NAME s_scm_thread_exited_p
 167 {
 168   return 0;
 169 }
 170 #undef FUNC_NAME
 171
 172 SCM
 173 scm_yield (void)
 174 {
 175   return SCM_BOOL_T;
 176 }
 177
 178 SCM
 179 scm_make_mutex (void)
 180 {
 181   SCM m = scm_make_smob (scm_tc16_mutex);
 182   scm_null_mutex *mx = SCM_MUTEX_DATA(m);
 183   mx->level = 0;
 184   return m;
 185 }
 186
 187 SCM
 188 scm_lock_mutex (SCM m)
 189 {
 190   scm_null_mutex *mx;
 191   SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
 192   mx = SCM_MUTEX_DATA(m);
 193   mx->level++;
 194   return SCM_BOOL_T;
 195 }
 196
 197 SCM
 198 scm_try_mutex (SCM m)
 199 {
 200   return scm_lock_mutex (m); /* will always succeed right away. */
 201 }
 202
 203 SCM
 204 scm_unlock_mutex (SCM m)
 205 {
 206   scm_null_mutex *mx;
 207   SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex);
 208   mx = SCM_MUTEX_DATA(m);
 209   if (mx->level == 0)
 210     scm_misc_error (s_unlock_mutex, "mutex is not locked", SCM_EOL);
 211   mx->level--;
 212   return SCM_BOOL_T;
 213 }
 214
 215 SCM
 216 scm_make_condition_variable (void)
 217 {
 218   scm_null_cond *cv;
 219   SCM c = scm_make_smob (scm_tc16_condvar);
 220   cv = SCM_CONDVAR_DATA (c);
 221   cv->signalled = 0;
 222   return c;
 223 }
 224
 225 /* Subtract the `struct timeval' values X and Y,
 226    storing the result in RESULT.  Might modify Y.
 227    Return 1 if the difference is negative or zero, otherwise 0.  */
 228
 229 static int
 230 timeval_subtract (result, x, y)
 231      struct timeval *result, *x, *y;
 232 {
 233   /* Perform the carry for the later subtraction by updating Y. */
 234   if (x->tv_usec < y->tv_usec) {
 235     int nsec = (y->tv_usec - x->tv_usec) / 1000000 + 1;
 236     y->tv_usec -= 1000000 * nsec;
 237     y->tv_sec += nsec;
 238   }
 239   if (x->tv_usec - y->tv_usec > 1000000) {
 240     int nsec = (x->tv_usec - y->tv_usec) / 1000000;
 241     y->tv_usec += 1000000 * nsec;
 242     y->tv_sec -= nsec;
 243   }
 244
 245   /* Compute the time remaining to wait.
 246      `tv_usec' is certainly positive. */
 247   result->tv_sec = x->tv_sec - y->tv_sec;
 248   result->tv_usec = x->tv_usec - y->tv_usec;
 249
 250   /* Return 1 if result is negative or zero. */
 251   return x->tv_sec < y->tv_sec
 252     || (result->tv_sec == 0 && result->tv_usec == 0);
 253 }
 254
 255 SCM
 256 scm_timed_wait_condition_variable (SCM c, SCM m, SCM t)
 257 #define FUNC_NAME s_wait_condition_variable
 258 {
 259   scm_null_cond *cv;
 260   struct timeval waittime;
 261
 262   SCM_ASSERT (SCM_CONDVARP (c),
 263               c,
 264               SCM_ARG1,
 265               s_wait_condition_variable);
 266   SCM_ASSERT (SCM_MUTEXP (m),
 267               m,
 268               SCM_ARG2,
 269               s_wait_condition_variable);
 270   if (!SCM_UNBNDP (t))
 271     {
 272       if (SCM_CONSP (t))
 273         {
 274           SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec);
 275           SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_usec);
 276         }
 277       else
 278         {
 279           SCM_VALIDATE_UINT_COPY (3, t, waittime.tv_sec);
 280           waittime.tv_usec = 0;
 281         }
 282     }
 283
 284   cv = SCM_CONDVAR_DATA (c);
 285
 286   scm_unlock_mutex (m);
 287   while (!cv->signalled)
 288     {
 289       if (SCM_UNBNDP (t))
 290         select (0, NULL, NULL, NULL, NULL);
 291       else
 292         {
 293           struct timeval now, then, diff;
 294           then = waittime;
 295           gettimeofday (&now, NULL);
 296           if (timeval_subtract (&diff, &then, &now))
 297             break;
 298           select (0, NULL, NULL, NULL, &diff);
 299         }
 300       SCM_ASYNC_TICK;
 301     }
 302   scm_lock_mutex (m);
 303   if (cv->signalled)
 304     {
 305       cv->signalled = 0;
 306       return SCM_BOOL_T;
 307     }
 308   return SCM_BOOL_F;
 309 }
 310 #undef FUNC_NAME
 311
 312 SCM
 313 scm_signal_condition_variable (SCM c)
 314 {
 315   scm_null_cond *cv;
 316   SCM_ASSERT (SCM_CONDVARP (c),
 317               c,
 318               SCM_ARG1,
 319               s_signal_condition_variable);
 320   cv = SCM_CONDVAR_DATA (c);
 321   cv->signalled = 1;
 322   return SCM_BOOL_T;
 323 }
 324
 325 SCM
 326 scm_broadcast_condition_variable (SCM c)
 327 {
 328   return scm_signal_condition_variable (c); /* only one thread anyway. */
 329 }
 330
 331 unsigned long
 332 scm_thread_usleep (unsigned long usec)
 333 {
 334   struct timeval timeout;
 335   timeout.tv_sec = 0;
 336   timeout.tv_usec = usec;
 337   select (0, NULL, NULL, NULL, &timeout);
 338   return 0;  /* Maybe we should calculate actual time slept,
 339                 but this is faster... :) */
 340 }
 341
 342 unsigned long
 343 scm_thread_sleep (unsigned long sec)
 344 {
 345   time_t now = time (NULL);
 346   struct timeval timeout;
 347   unsigned long slept;
 348   timeout.tv_sec = sec;
 349   timeout.tv_usec = 0;
 350   select (0, NULL, NULL, NULL, &timeout);
 351   slept = time (NULL) - now;
 352   return slept > sec ? 0 : sec - slept;
 353 }
 354
 355 /*
 356   Local Variables:
 357   c-file-style: "gnu"
 358   End:
 359 */