X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/843524cc2079e6fb23554eac366a87faf0d720f3..fbf0c8c7b194202e01338f8b5324126bf73af4c9:/libguile/async.c diff --git a/libguile/async.c b/libguile/async.c index 09cf9c73a..2728537b3 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -1,15 +1,15 @@ /* Copyright (C) 1995, 96, 97, 98, 2000 Free Software Foundation, Inc. - * + * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -46,14 +46,14 @@ #include #include -#include "_scm.h" -#include "eval.h" -#include "throw.h" -#include "root.h" -#include "smob.h" +#include "libguile/_scm.h" +#include "libguile/eval.h" +#include "libguile/throw.h" +#include "libguile/root.h" +#include "libguile/smob.h" -#include "validate.h" -#include "async.h" +#include "libguile/validate.h" +#include "libguile/async.h" #ifdef HAVE_STRING_H #include @@ -71,7 +71,7 @@ * * Setting the mark guarantees future execution of the thunk. More * than one set may be satisfied by a single execution. - * + * * scm_tick_clock decremented once per SCM_ALLOW_INTS. * Async execution triggered by SCM_ALLOW_INTS when scm_tick_clock drops to 0. * Async execution prevented by scm_mask_ints != 0. @@ -110,7 +110,18 @@ static unsigned int scm_desired_switch_rate = 0; int scm_asyncs_pending_p = 0; #endif -static long scm_tc16_async; +static scm_bits_t tc16_async; + + + +/* cmm: this has SCM_ prefix because SCM_MAKE_VALIDATE expects it. + this is ugly. */ +#define SCM_ASYNCP(X) SCM_TYP16_PREDICATE (tc16_async, X) +#define VALIDATE_ASYNC(pos,a) SCM_MAKE_VALIDATE(pos, a, ASYNCP) + +#define ASYNC_GOT_IT(X) (SCM_CELL_WORD_0 (X) >> 16) +#define SET_ASYNC_GOT_IT(X, V) (SCM_SET_CELL_WORD_0 ((X), SCM_TYP16 (X) | ((V) << 16))) +#define ASYNC_THUNK(X) SCM_CELL_OBJECT_1 (X) @@ -122,25 +133,14 @@ scm_asyncs_pending () pos = scm_asyncs; while (pos != SCM_EOL) { - SCM a; - struct scm_async * it; - a = SCM_CAR (pos); - it = SCM_ASYNC (a); - if (it->got_it) + SCM a = SCM_CAR (pos); + if (ASYNC_GOT_IT (a)) return 1; pos = SCM_CDR (pos); } return 0; } -#if 0 -static SCM -scm_sys_tick_async_thunk (void) -{ - scm_deliver_signal (SCM_TICK_SIGNAL); - return SCM_BOOL_F; -} -#endif void scm_async_click () @@ -186,7 +186,7 @@ scm_async_click () scm_async_clock = 1; return;; } - + if (!scm_tick_rate) { unsigned int r; @@ -219,11 +219,6 @@ scm_async_click () } } - /* - if (owe_tick) - scm_async_mark (system_signal_asyncs[SCM_SIG_ORD(SCM_TICK_SIGNAL)]); - */ - SCM_DEFER_INTS; if (scm_tick_rate && scm_switch_rate) { @@ -284,25 +279,23 @@ scm_async_click () static SCM -mark_async (SCM obj) +async_mark (SCM obj) { - struct scm_async * it; - it = SCM_ASYNC (obj); - return it->thunk; + return ASYNC_THUNK (obj); } -SCM_DEFINE (scm_async, "async", 1, 0, 0, +SCM_DEFINE (scm_async, "async", 1, 0, 0, (SCM thunk), "") #define FUNC_NAME s_scm_async { - SCM_RETURN_NEWSMOB2 (scm_tc16_async, 0, SCM_UNPACK (thunk)); + SCM_RETURN_NEWSMOB (tc16_async, SCM_UNPACK (thunk)); } #undef FUNC_NAME -SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0, +SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0, (SCM thunk), "") #define FUNC_NAME s_scm_system_async @@ -319,37 +312,35 @@ SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_async_mark, "async-mark", 1, 0, 0, +SCM_DEFINE (scm_async_mark, "async-mark", 1, 0, 0, (SCM a), "") #define FUNC_NAME s_scm_async_mark { - struct scm_async * it; - SCM_VALIDATE_ASYNC_COPY (1,a,it); + VALIDATE_ASYNC (1, a); #ifdef GUILE_OLD_ASYNC_CLICK - it->got_it = 1; + SET_ASYNC_GOT_IT (a, 1); #else - scm_asyncs_pending_p = it->got_it = 1; + SET_ASYNC_GOT_IT (a, scm_asyncs_pending_p = 1); #endif return SCM_UNSPECIFIED; } #undef FUNC_NAME -SCM_DEFINE (scm_system_async_mark, "system-async-mark", 1, 0, 0, +SCM_DEFINE (scm_system_async_mark, "system-async-mark", 1, 0, 0, (SCM a), "") #define FUNC_NAME s_scm_system_async_mark { - struct scm_async *it; - SCM_VALIDATE_ASYNC_COPY (1, a, it); + VALIDATE_ASYNC (1, a); SCM_REDEFER_INTS; #ifdef GUILE_OLD_ASYNC_CLICK - it->got_it = 1; + SET_ASYNC_GOT_IT (a, 1); scm_async_rate = 1 + scm_async_rate - scm_async_clock; scm_async_clock = 1; #else - scm_asyncs_pending_p = it->got_it = 1; + SET_ASYNC_GOT_IT (a, scm_asyncs_pending_p = 1); #endif SCM_REALLOW_INTS; return SCM_UNSPECIFIED; @@ -357,7 +348,7 @@ SCM_DEFINE (scm_system_async_mark, "system-async-mark", 1, 0, 0, #undef FUNC_NAME -SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0, +SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0, (SCM list_of_a), "") #define FUNC_NAME s_scm_run_asyncs @@ -371,15 +362,14 @@ SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0, while (! SCM_NULLP (list_of_a)) { SCM a; - struct scm_async * it; SCM_VALIDATE_CONS (1, list_of_a); a = SCM_CAR (list_of_a); - SCM_VALIDATE_ASYNC_COPY (SCM_ARG1,a,it); + VALIDATE_ASYNC (SCM_ARG1, a); scm_mask_ints = 1; - if (it->got_it) + if (ASYNC_GOT_IT (a)) { - it->got_it = 0; - scm_apply (it->thunk, SCM_EOL, SCM_EOL); + SET_ASYNC_GOT_IT (a, 0); + scm_apply (ASYNC_THUNK (a), SCM_EOL, SCM_EOL); } scm_mask_ints = 0; list_of_a = SCM_CDR (list_of_a); @@ -391,11 +381,12 @@ SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0, -SCM_DEFINE (scm_noop, "noop", 0, 0, 1, +SCM_DEFINE (scm_noop, "noop", 0, 0, 1, (SCM args), "") #define FUNC_NAME s_scm_noop { + SCM_VALIDATE_REST_ARGUMENT (args); return (SCM_NULLP (args) ? SCM_BOOL_F : SCM_CAR (args)); } #undef FUNC_NAME @@ -405,7 +396,7 @@ SCM_DEFINE (scm_noop, "noop", 0, 0, 1, #ifdef GUILE_OLD_ASYNC_CLICK -SCM_DEFINE (scm_set_tick_rate, "set-tick-rate", 1, 0, 0, +SCM_DEFINE (scm_set_tick_rate, "set-tick-rate", 1, 0, 0, (SCM n), "") #define FUNC_NAME s_scm_set_tick_rate @@ -422,7 +413,7 @@ SCM_DEFINE (scm_set_tick_rate, "set-tick-rate", 1, 0, 0, -SCM_DEFINE (scm_set_switch_rate, "set-switch-rate", 1, 0, 0, +SCM_DEFINE (scm_set_switch_rate, "set-switch-rate", 1, 0, 0, (SCM n), "") #define FUNC_NAME s_scm_set_switch_rate @@ -437,32 +428,10 @@ SCM_DEFINE (scm_set_switch_rate, "set-switch-rate", 1, 0, 0, #undef FUNC_NAME #endif - - -/* points to the GC system-async, so that scm_gc_end can find it. */ -SCM scm_gc_async; - -/* the vcell for gc-thunk. */ -static SCM scm_gc_vcell; - -/* the thunk installed in the GC system-async, which is marked at the - end of garbage collection. */ -static SCM -scm_sys_gc_async_thunk (void) -{ - if (SCM_NFALSEP (scm_gc_vcell)) - { - SCM proc = SCM_CDR (scm_gc_vcell); - - if (SCM_NFALSEP (proc) && !SCM_UNBNDP (proc)) - scm_apply (proc, SCM_EOL, SCM_EOL); - } - return SCM_UNSPECIFIED; -} -SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0, +SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0, (), "") #define FUNC_NAME s_scm_unmask_signals @@ -473,7 +442,7 @@ SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0, #undef FUNC_NAME -SCM_DEFINE (scm_mask_signals, "mask-signals", 0, 0, 0, +SCM_DEFINE (scm_mask_signals, "mask-signals", 0, 0, 0, (), "") #define FUNC_NAME s_scm_mask_signals @@ -488,14 +457,13 @@ SCM_DEFINE (scm_mask_signals, "mask-signals", 0, 0, 0, void scm_init_async () { - SCM a_thunk; - scm_tc16_async = scm_make_smob_type_mfpe ("async", 0, - mark_async, NULL, NULL, NULL); - scm_gc_vcell = scm_sysintern ("gc-thunk", SCM_BOOL_F); - a_thunk = scm_make_gsubr ("%gc-thunk", 0, 0, 0, scm_sys_gc_async_thunk); - scm_gc_async = scm_system_async (a_thunk); - -#include "async.x" + scm_asyncs = SCM_EOL; + tc16_async = scm_make_smob_type ("async", 0); + scm_set_smob_mark (tc16_async, async_mark); + +#ifndef SCM_MAGIC_SNARFER +#include "libguile/async.x" +#endif } /*