| 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 | |
| 53 | void *scm_null_threads_data; |
| 54 | |
| 55 | static SCM main_thread; |
| 56 | |
| 57 | void |
| 58 | scm_threads_init (SCM_STACKITEM *i) |
| 59 | { |
| 60 | main_thread = scm_permanent_object (scm_cell (scm_tc16_thread, 0)); |
| 61 | scm_null_threads_data = NULL; |
| 62 | } |
| 63 | |
| 64 | #ifdef __ia64__ |
| 65 | # define SCM_MARK_BACKING_STORE() do { \ |
| 66 | ucontext_t ctx; \ |
| 67 | SCM_STACKITEM * top, * bot; \ |
| 68 | getcontext (&ctx); \ |
| 69 | scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \ |
| 70 | ((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \ |
| 71 | / sizeof (SCM_STACKITEM))); \ |
| 72 | bot = (SCM_STACKITEM *) __libc_ia64_register_backing_store_base; \ |
| 73 | top = (SCM_STACKITEM *) ctx.uc_mcontext.sc_ar_bsp; \ |
| 74 | scm_mark_locations (bot, top - bot); } while (0) |
| 75 | #else |
| 76 | # define SCM_MARK_BACKING_STORE() |
| 77 | #endif |
| 78 | |
| 79 | void |
| 80 | scm_threads_mark_stacks (void) |
| 81 | { |
| 82 | /* Mark objects on the C stack. */ |
| 83 | SCM_FLUSH_REGISTER_WINDOWS; |
| 84 | /* This assumes that all registers are saved into the jmp_buf */ |
| 85 | setjmp (scm_save_regs_gc_mark); |
| 86 | scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, |
| 87 | ( (size_t) (sizeof (SCM_STACKITEM) - 1 + |
| 88 | sizeof scm_save_regs_gc_mark) |
| 89 | / sizeof (SCM_STACKITEM))); |
| 90 | |
| 91 | { |
| 92 | unsigned long stack_len = scm_stack_size (scm_stack_base); |
| 93 | #ifdef SCM_STACK_GROWS_UP |
| 94 | scm_mark_locations (scm_stack_base, stack_len); |
| 95 | #else |
| 96 | scm_mark_locations (scm_stack_base - stack_len, stack_len); |
| 97 | #endif |
| 98 | } |
| 99 | SCM_MARK_BACKING_STORE(); |
| 100 | } |
| 101 | |
| 102 | SCM |
| 103 | scm_call_with_new_thread (SCM argl) |
| 104 | #define FUNC_NAME s_call_with_new_thread |
| 105 | { |
| 106 | SCM_MISC_ERROR ("threads are not supported in this version of Guile", |
| 107 | SCM_EOL); |
| 108 | return SCM_BOOL_F; |
| 109 | } |
| 110 | #undef FUNC_NAME |
| 111 | |
| 112 | SCM |
| 113 | scm_spawn_thread (scm_t_catch_body body, void *body_data, |
| 114 | scm_t_catch_handler handler, void *handler_data) |
| 115 | { |
| 116 | scm_misc_error ("scm_spawn_thread", |
| 117 | "threads are not supported in this version of Guile", |
| 118 | SCM_EOL); |
| 119 | return SCM_BOOL_F; |
| 120 | } |
| 121 | |
| 122 | SCM |
| 123 | scm_current_thread (void) |
| 124 | { |
| 125 | return main_thread; |
| 126 | } |
| 127 | |
| 128 | SCM |
| 129 | scm_all_threads (void) |
| 130 | { |
| 131 | return scm_list_1 (main_thread); |
| 132 | } |
| 133 | |
| 134 | scm_root_state * |
| 135 | scm_i_thread_root (SCM thread) |
| 136 | { |
| 137 | return (scm_root_state *)scm_null_threads_data; |
| 138 | } |
| 139 | |
| 140 | SCM |
| 141 | scm_join_thread (SCM thread) |
| 142 | #define FUNC_NAME s_join_thread |
| 143 | { |
| 144 | SCM_MISC_ERROR ("threads are not supported in this version of Guile", |
| 145 | SCM_EOL); |
| 146 | return SCM_BOOL_F; |
| 147 | } |
| 148 | #undef FUNC_NAME |
| 149 | |
| 150 | SCM |
| 151 | scm_yield (void) |
| 152 | { |
| 153 | return SCM_BOOL_T; |
| 154 | } |
| 155 | |
| 156 | /* Block until a new async might have been queued. |
| 157 | */ |
| 158 | static void |
| 159 | block () |
| 160 | { |
| 161 | select (0, NULL, NULL, NULL, NULL); |
| 162 | } |
| 163 | |
| 164 | int |
| 165 | scm_null_mutex_init (scm_null_mutex *m) |
| 166 | { |
| 167 | m->locked = 0; |
| 168 | return 0; |
| 169 | } |
| 170 | |
| 171 | int |
| 172 | scm_null_mutex_lock (scm_null_mutex *m) |
| 173 | { |
| 174 | while (m->locked) |
| 175 | { |
| 176 | block (); |
| 177 | SCM_ASYNC_TICK; |
| 178 | } |
| 179 | m->locked = 1; |
| 180 | return 1; |
| 181 | } |
| 182 | |
| 183 | int |
| 184 | scm_null_mutex_unlock (scm_null_mutex *m) |
| 185 | { |
| 186 | if (m->locked == 0) |
| 187 | return 0; |
| 188 | m->locked = 0; |
| 189 | return 1; |
| 190 | } |
| 191 | |
| 192 | int |
| 193 | scm_null_mutex_destroy (scm_null_mutex *m) |
| 194 | { |
| 195 | return 1; |
| 196 | } |
| 197 | |
| 198 | SCM |
| 199 | scm_make_mutex (void) |
| 200 | { |
| 201 | SCM m = scm_make_smob (scm_tc16_mutex); |
| 202 | scm_null_mutex_init (SCM_MUTEX_DATA(m)); |
| 203 | return m; |
| 204 | } |
| 205 | |
| 206 | SCM |
| 207 | scm_lock_mutex (SCM m) |
| 208 | { |
| 209 | SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); |
| 210 | scm_null_mutex_lock (SCM_MUTEX_DATA(m)); |
| 211 | return SCM_BOOL_T; |
| 212 | } |
| 213 | |
| 214 | SCM |
| 215 | scm_unlock_mutex (SCM m) |
| 216 | { |
| 217 | SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex); |
| 218 | if (!scm_null_mutex_unlock (SCM_MUTEX_DATA(m))) |
| 219 | scm_misc_error (s_unlock_mutex, "mutex is not locked", SCM_EOL); |
| 220 | return SCM_BOOL_T; |
| 221 | } |
| 222 | |
| 223 | int |
| 224 | scm_null_condvar_init (scm_null_condvar *c) |
| 225 | { |
| 226 | c->signalled = 0; |
| 227 | return 0; |
| 228 | } |
| 229 | |
| 230 | int |
| 231 | scm_null_condvar_wait (scm_null_condvar *c, scm_null_mutex *m) |
| 232 | { |
| 233 | scm_null_mutex_unlock (m); |
| 234 | while (!c->signalled) |
| 235 | { |
| 236 | block (); |
| 237 | SCM_ASYNC_TICK; |
| 238 | } |
| 239 | scm_null_mutex_lock (m); |
| 240 | c->signalled = 0; |
| 241 | return 0; |
| 242 | } |
| 243 | |
| 244 | int |
| 245 | scm_null_condvar_signal (scm_null_condvar *c) |
| 246 | { |
| 247 | c->signalled = 1; |
| 248 | return 0; |
| 249 | } |
| 250 | |
| 251 | int |
| 252 | scm_null_condvar_destroy (scm_null_condvar *c) |
| 253 | { |
| 254 | return 1; |
| 255 | } |
| 256 | |
| 257 | SCM |
| 258 | scm_make_condition_variable (void) |
| 259 | { |
| 260 | SCM c = scm_make_smob (scm_tc16_condvar); |
| 261 | scm_null_condvar_init (SCM_CONDVAR_DATA (c)); |
| 262 | return c; |
| 263 | } |
| 264 | |
| 265 | SCM |
| 266 | scm_wait_condition_variable (SCM c, SCM m) |
| 267 | { |
| 268 | SCM_ASSERT (SCM_CONDVARP (c), |
| 269 | c, |
| 270 | SCM_ARG1, |
| 271 | s_wait_condition_variable); |
| 272 | SCM_ASSERT (SCM_MUTEXP (m), |
| 273 | m, |
| 274 | SCM_ARG2, |
| 275 | s_wait_condition_variable); |
| 276 | scm_null_condvar_wait (SCM_CONDVAR_DATA (c), SCM_MUTEX_DATA (m)); |
| 277 | return SCM_BOOL_T; |
| 278 | } |
| 279 | |
| 280 | SCM |
| 281 | scm_signal_condition_variable (SCM c) |
| 282 | { |
| 283 | SCM_ASSERT (SCM_CONDVARP (c), |
| 284 | c, |
| 285 | SCM_ARG1, |
| 286 | s_signal_condition_variable); |
| 287 | scm_null_condvar_signal (SCM_CONDVAR_DATA (c)); |
| 288 | return SCM_BOOL_T; |
| 289 | } |
| 290 | |
| 291 | unsigned long |
| 292 | scm_thread_usleep (unsigned long usec) |
| 293 | { |
| 294 | struct timeval timeout; |
| 295 | timeout.tv_sec = 0; |
| 296 | timeout.tv_usec = usec; |
| 297 | select (0, NULL, NULL, NULL, &timeout); |
| 298 | return 0; /* Maybe we should calculate actual time slept, |
| 299 | but this is faster... :) */ |
| 300 | } |
| 301 | |
| 302 | unsigned long |
| 303 | scm_thread_sleep (unsigned long sec) |
| 304 | { |
| 305 | time_t now = time (NULL); |
| 306 | struct timeval timeout; |
| 307 | unsigned long slept; |
| 308 | timeout.tv_sec = sec; |
| 309 | timeout.tv_usec = 0; |
| 310 | select (0, NULL, NULL, NULL, &timeout); |
| 311 | slept = time (NULL) - now; |
| 312 | return slept > sec ? 0 : sec - slept; |
| 313 | } |
| 314 | |
| 315 | /* |
| 316 | Local Variables: |
| 317 | c-file-style: "gnu" |
| 318 | End: |
| 319 | */ |