1 /* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
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)
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.
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
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
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.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
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.
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. */
61 /* {Asynchronous Events}
64 * Async == thunk + mark.
66 * Setting the mark guarantees future execution of the thunk. More
67 * than one set may be satisfied by a single execution.
69 * scm_tick_clock decremented once per SCM_ALLOW_INTS.
70 * Async execution triggered by SCM_ALLOW_INTS when scm_tick_clock drops to 0.
71 * Async execution prevented by scm_mask_ints != 0.
73 * If the clock reaches 0 when scm_mask_ints != 0, then reset the clock
76 * If the clock reaches 0 any other time, run marked asyncs.
78 * From a unix signal handler, mark a corresponding async and set the clock
79 * to 1. Do SCM_REDEFER_INTS;/SCM_REALLOW_INTS so that if the signal handler is not
80 * called in the dynamic scope of a critical section, it is excecuted immediately.
82 * Overall, closely timed signals of a particular sort may be combined. Pending signals
83 * are delivered in a fixed priority order, regardless of arrival order.
87 /* True between SCM_DEFER_INTS and SCM_ALLOW_INTS, and
88 * when the interpreter is not running at all.
90 int scm_ints_disabled
= 1;
92 unsigned int scm_async_clock
= 20;
93 static unsigned int scm_async_rate
= 20;
94 unsigned int scm_mask_ints
= 1;
96 static unsigned int scm_tick_clock
= 0;
97 static unsigned int scm_tick_rate
= 0;
98 static unsigned int scm_desired_tick_rate
= 0;
99 static unsigned int scm_switch_clock
= 0;
100 static unsigned int scm_switch_rate
= 0;
101 static unsigned int scm_desired_switch_rate
= 0;
103 static long scm_tc16_async
;
108 scm_asyncs_pending ()
112 while (pos
!= SCM_EOL
)
115 struct scm_async
* it
;
126 static SCM scm_sys_tick_async_thunk
SCM_P ((void));
128 scm_sys_tick_async_thunk ()
130 scm_deliver_signal (SCM_TICK_SIGNAL
);
141 if (!scm_switch_rate
)
144 scm_switch_clock
= scm_switch_rate
= scm_desired_switch_rate
;
145 scm_desired_switch_rate
= 0;
149 owe_switch
= (scm_async_rate
>= scm_switch_clock
);
152 if (scm_desired_switch_rate
)
154 scm_switch_clock
= scm_switch_rate
= scm_desired_switch_rate
;
155 scm_desired_switch_rate
= 0;
158 scm_switch_clock
= scm_switch_rate
;
162 if (scm_desired_switch_rate
)
164 scm_switch_clock
= scm_switch_rate
= scm_desired_switch_rate
;
165 scm_desired_switch_rate
= 0;
168 scm_switch_clock
-= scm_async_rate
;
184 r
= scm_desired_tick_rate
;
187 scm_desired_tick_rate
= 0;
194 owe_tick
= (scm_async_rate
>= scm_tick_clock
);
197 scm_tick_clock
= scm_tick_rate
= scm_desired_tick_rate
;
198 scm_desired_tick_rate
= 0;
202 if (scm_desired_tick_rate
)
204 scm_tick_clock
= scm_tick_rate
= scm_desired_tick_rate
;
205 scm_desired_tick_rate
= 0;
208 scm_tick_clock
-= scm_async_rate
;
214 scm_async_mark (system_signal_asyncs[SCM_SIG_ORD(SCM_TICK_SIGNAL)]);
218 if (scm_tick_rate
&& scm_switch_rate
)
220 scm_async_rate
= min (scm_tick_clock
, scm_switch_clock
);
221 scm_async_clock
= scm_async_rate
;
223 else if (scm_tick_rate
)
225 scm_async_clock
= scm_async_rate
= scm_tick_clock
;
227 else if (scm_switch_rate
)
229 scm_async_clock
= scm_async_rate
= scm_switch_clock
;
232 scm_async_clock
= scm_async_rate
= 1 << 16;
236 scm_run_asyncs (scm_asyncs
);
239 if (scm_asyncs_pending ())
257 #if 0 /* Thread switching code should probably reside here, but the
258 async switching code doesn't seem to work, so it's put in the
259 SCM_ASYNC_TICK macro instead. /mdj */
260 SCM_THREAD_SWITCHING_CODE
;
266 static int print_async
SCM_P ((SCM exp
, SCM port
, scm_print_state
*pstate
));
269 print_async (exp
, port
, pstate
)
272 scm_print_state
*pstate
;
274 scm_puts ("#<async ", port
);
275 scm_intprint(exp
, 16, port
);
281 static SCM mark_async
SCM_P ((SCM obj
));
287 struct scm_async
* it
;
288 if (SCM_GC8MARKP (obj
))
290 SCM_SETGC8MARK (obj
);
291 it
= SCM_ASYNC (obj
);
296 static scm_sizet free_async
SCM_P ((SCM obj
));
302 struct scm_async
* it
;
303 it
= SCM_ASYNC (obj
);
304 scm_must_free ((char *)it
);
305 return (sizeof (*it
));
309 static scm_smobfuns async_smob
=
320 SCM_PROC(s_async
, "async", 1, 0, 0, scm_async
);
327 struct scm_async
* async
;
331 SCM_SETCDR (it
, SCM_EOL
);
332 async
= (struct scm_async
*)scm_must_malloc (sizeof (*async
), s_async
);
334 async
->thunk
= thunk
;
335 SCM_SETCDR (it
, (SCM
)async
);
336 SCM_SETCAR (it
, (SCM
)scm_tc16_async
);
341 SCM_PROC(s_system_async
, "system-async", 1, 0, 0, scm_system_async
);
344 scm_system_async (thunk
)
350 it
= scm_async (thunk
);
353 SCM_SETCAR (list
, it
);
354 SCM_SETCDR (list
, scm_asyncs
);
360 SCM_PROC(s_async_mark
, "async-mark", 1, 0, 0, scm_async_mark
);
366 struct scm_async
* it
;
367 SCM_ASSERT (SCM_NIMP (a
) && SCM_ASYNCP (a
), a
, SCM_ARG1
, s_async_mark
);
370 return SCM_UNSPECIFIED
;
374 SCM_PROC(s_system_async_mark
, "system-async-mark", 1, 0, 0, scm_system_async_mark
);
377 scm_system_async_mark (a
)
380 struct scm_async
* it
;
381 SCM_ASSERT (SCM_NIMP (a
) && SCM_ASYNCP (a
), a
, SCM_ARG1
, s_async_mark
);
385 scm_async_rate
= 1 + scm_async_rate
- scm_async_clock
;
388 return SCM_UNSPECIFIED
;
392 SCM_PROC(s_run_asyncs
, "run-asyncs", 1, 0, 0, scm_run_asyncs
);
395 scm_run_asyncs (list_of_a
)
403 while (pos
!= SCM_EOL
)
406 struct scm_async
* it
;
407 SCM_ASSERT (SCM_NIMP (pos
) && SCM_CONSP (pos
), pos
, SCM_ARG1
, s_run_asyncs
);
409 SCM_ASSERT (SCM_NIMP (a
) && SCM_ASYNCP (a
), a
, SCM_ARG1
, s_run_asyncs
);
415 scm_apply (it
->thunk
, SCM_EOL
, SCM_EOL
);
426 SCM_PROC(s_noop
, "noop", 0, 0, 1, scm_noop
);
432 return (SCM_NULLP (args
)
440 SCM_PROC(s_set_tick_rate
, "set-tick-rate", 1, 0, 0, scm_set_tick_rate
);
443 scm_set_tick_rate (n
)
447 SCM_ASSERT (SCM_INUMP (n
), n
, SCM_ARG1
, s_set_tick_rate
);
448 old_n
= scm_tick_rate
;
449 scm_desired_tick_rate
= SCM_INUM (n
);
450 scm_async_rate
= 1 + scm_async_rate
- scm_async_clock
;
452 return SCM_MAKINUM (old_n
);
458 SCM_PROC(s_set_switch_rate
, "set-switch-rate", 1, 0, 0, scm_set_switch_rate
);
461 scm_set_switch_rate (n
)
465 SCM_ASSERT (SCM_INUMP (n
), n
, SCM_ARG1
, s_set_switch_rate
);
466 old_n
= scm_switch_rate
;
467 scm_desired_switch_rate
= SCM_INUM (n
);
468 scm_async_rate
= 1 + scm_async_rate
- scm_async_clock
;
470 return SCM_MAKINUM (old_n
);
475 /* points to the GC system-async, so that scm_gc_end can find it. */
478 /* the vcell for gc-thunk. */
479 static SCM scm_gc_vcell
;
481 /* the thunk installed in the GC system-async, which is marked at the
482 end of garbage collection. */
484 scm_sys_gc_async_thunk (void)
486 if (SCM_NFALSEP (scm_gc_vcell
))
488 SCM proc
= SCM_CDR (scm_gc_vcell
);
490 if (SCM_NFALSEP (proc
) && !SCM_UNBNDP (proc
))
491 scm_apply (proc
, SCM_EOL
, SCM_EOL
);
493 return SCM_UNSPECIFIED
;
498 SCM_PROC(s_unmask_signals
, "unmask-signals", 0, 0, 0, scm_unmask_signals
);
501 scm_unmask_signals ()
504 return SCM_UNSPECIFIED
;
508 SCM_PROC(s_mask_signals
, "mask-signals", 0, 0, 0, scm_mask_signals
);
514 return SCM_UNSPECIFIED
;
523 scm_tc16_async
= scm_newsmob (&async_smob
);
525 scm_gc_vcell
= scm_sysintern ("gc-thunk", SCM_BOOL_F
);
526 a_thunk
= scm_make_gsubr ("%gc-thunk", 0, 0, 0, scm_sys_gc_async_thunk
);
527 scm_gc_async
= scm_system_async (a_thunk
);