libguile/null-threads.c

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