/[guile]/guile/guile-core/libguile/async.c
ViewVC logotype

Diff of /guile/guile-core/libguile/async.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.65 by mvo, Sat Oct 5 13:06:58 2002 UTC revision 1.66 by mvo, Wed Oct 9 22:44:02 2002 UTC
# Line 49  Line 49 
49  #include "libguile/root.h"  #include "libguile/root.h"
50  #include "libguile/smob.h"  #include "libguile/smob.h"
51  #include "libguile/lang.h"  #include "libguile/lang.h"
52    #include "libguile/dynwind.h"
53  #include "libguile/deprecation.h"  #include "libguile/deprecation.h"
54    
55  #include "libguile/validate.h"  #include "libguile/validate.h"
# Line 61  Line 62 
62  #include <unistd.h>  #include <unistd.h>
63  #endif  #endif
64    
65    /* This is not used for anything except checking that DEFER_INTS and
66       ALLOW_INTS are used properly.
67     */
68    int scm_ints_disabled = 1;
69    
70    
71  /* {Asynchronous Events}  /* {Asynchronous Events}
# Line 91  Line 96 
96   * implement yourself.   * implement yourself.
97   */   */
98    
 /* True between SCM_DEFER_INTS and SCM_ALLOW_INTS, and  
  * when the interpreter is not running at all.  
  */  
 int scm_ints_disabled = 1;  
 unsigned int scm_mask_ints = 1;  
99    
100    
101    
# Line 149  SCM_DEFINE (scm_run_asyncs, "run-asyncs" Line 149  SCM_DEFINE (scm_run_asyncs, "run-asyncs"
149        SCM_VALIDATE_CONS (1, list_of_a);        SCM_VALIDATE_CONS (1, list_of_a);
150        a = SCM_CAR (list_of_a);        a = SCM_CAR (list_of_a);
151        VALIDATE_ASYNC (SCM_ARG1, a);        VALIDATE_ASYNC (SCM_ARG1, a);
       scm_mask_ints = 1;  
152        if (ASYNC_GOT_IT (a))        if (ASYNC_GOT_IT (a))
153          {          {
154            SET_ASYNC_GOT_IT (a, 0);            SET_ASYNC_GOT_IT (a, 0);
155            scm_call_0 (ASYNC_THUNK (a));            scm_call_0 (ASYNC_THUNK (a));
156          }          }
       scm_mask_ints = 0;  
157        list_of_a = SCM_CDR (list_of_a);        list_of_a = SCM_CDR (list_of_a);
158      }      }
159    return SCM_BOOL_T;    return SCM_BOOL_T;
# Line 171  scm_async_click () Line 169  scm_async_click ()
169  {  {
170    SCM asyncs;    SCM asyncs;
171    
172    if (!scm_mask_ints)    if (scm_root->block_asyncs == 0)
173      {      {
174        while (!SCM_NULLP(asyncs = scm_active_asyncs))        while (!SCM_NULLP(asyncs = scm_root->active_asyncs))
175          {          {
176            scm_active_asyncs = SCM_EOL;            scm_root->active_asyncs = SCM_EOL;
177            do            do
178              {              {
179                SCM c = SCM_CDR (asyncs);                SCM c = SCM_CDR (asyncs);
# Line 264  SCM_DEFINE (scm_noop, "noop", 0, 0, 1, Line 262  SCM_DEFINE (scm_noop, "noop", 0, 0, 1,
262    
263    
264    
265    #if (SCM_DEBUG_DEPRECATED == 0)
266    
267  SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0,  SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0,
268              (),              (),
269              "Unmask signals. The returned value is not specified.")              "Unmask signals. The returned value is not specified.")
270  #define FUNC_NAME s_scm_unmask_signals  #define FUNC_NAME s_scm_unmask_signals
271  {  {
272    scm_mask_ints = 0;    scm_c_issue_deprecation_warning
273        ("'unmask-signals' is deprecated.  "
274         "Use 'call-with-blocked-asyncs' instead.");
275    
276      if (scm_root->block_asyncs == 0)
277        SCM_MISC_ERROR ("signals already unmasked", SCM_EOL);
278      scm_root->block_asyncs = 0;
279    return SCM_UNSPECIFIED;    return SCM_UNSPECIFIED;
280  }  }
281  #undef FUNC_NAME  #undef FUNC_NAME
# Line 280  SCM_DEFINE (scm_mask_signals, "mask-sign Line 286  SCM_DEFINE (scm_mask_signals, "mask-sign
286              "Mask signals. The returned value is not specified.")              "Mask signals. The returned value is not specified.")
287  #define FUNC_NAME s_scm_mask_signals  #define FUNC_NAME s_scm_mask_signals
288  {  {
289    scm_mask_ints = 1;    scm_c_issue_deprecation_warning
290        ("'mask-signals' is deprecated.  Use 'call-with-blocked-asyncs' instead.");
291    
292      if (scm_root->block_asyncs > 0)
293        SCM_MISC_ERROR ("signals already masked", SCM_EOL);
294      scm_root->block_asyncs = 1;
295    return SCM_UNSPECIFIED;    return SCM_UNSPECIFIED;
296  }  }
297  #undef FUNC_NAME  #undef FUNC_NAME
298    
299    #endif /* SCM_DEBUG_DEPRECATED == 0 */
300    
301    static void
302    increase_block (void *unused)
303    {
304      scm_root->block_asyncs++;
305    }
306    
307    static void
308    decrease_block (void *unused)
309    {
310      scm_root->block_asyncs--;
311    }
312    
313    SCM_DEFINE (scm_call_with_blocked_asyncs, "call-with-blocked-asyncs", 1, 0, 0,
314                (SCM proc),
315                "Call @var{proc} with no arguments and block the execution\n"
316                "of system asyncs by one level for the current thread while\n"
317                "it is running.  Return the value returned by @var{proc}.\n")
318    #define FUNC_NAME s_scm_call_with_blocked_asyncs
319    {
320      return scm_internal_dynamic_wind (increase_block,
321                                        (scm_t_inner) scm_call_0,
322                                        decrease_block,
323                                        proc, NULL);
324    }
325    #undef FUNC_NAME
326    
327    void *
328    scm_c_call_with_blocked_asyncs (void *(*proc) (void *data), void *data)
329    {
330      return scm_internal_dynamic_wind (increase_block,
331                                        (scm_t_inner) proc,
332                                        decrease_block,
333                                        data, NULL);
334    }
335    
336    
337    SCM_DEFINE (scm_call_with_unblocked_asyncs, "call-with-unblocked-asyncs", 1, 0, 0,
338                (SCM proc),
339                "Call @var{proc} with no arguments and unblock the execution\n"
340                "of system asyncs by one level for the current thread while\n"
341                "it is running.  Return the value returned by @var{proc}.\n")
342    #define FUNC_NAME s_scm_call_with_unblocked_asyncs
343    {
344      if (scm_root->block_asyncs == 0)
345        SCM_MISC_ERROR ("asyncs already unblocked", SCM_EOL);
346      return scm_internal_dynamic_wind (decrease_block,
347                                        (scm_t_inner) scm_call_0,
348                                        increase_block,
349                                        proc, NULL);
350    }
351    #undef FUNC_NAME
352    
353    void *
354    scm_c_call_with_unblocked_asyncs (void *(*proc) (void *data), void *data)
355    {
356      if (scm_root->block_asyncs == 0)
357        scm_misc_error ("scm_c_call_with_unblocked_asyncs",
358                        "asyncs already unblocked", SCM_EOL);
359      return scm_internal_dynamic_wind (decrease_block,
360                                         (scm_t_inner) proc,
361                                        increase_block,
362                                        data, NULL);
363    }
364    
365    
366    
367  void  void

Legend:
Removed from v.1.65  
changed lines
  Added in v.1.66

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26