,@body))
;;; Called from the signal handler.
+#!-win32
(defun run-interruption ()
(let ((interruption (with-interruptions-lock (*current-thread*)
(pop (thread-interruptions *current-thread*)))))
first thing to do is usually a WITH-INTERRUPTS or a
WITHOUT-INTERRUPTS. Within a thread interrupts are queued, they are
run in same the order they were sent."
+ #!+win32
+ (declare (ignore thread))
+ #!+win32
+ (with-interrupt-bindings
+ (with-interrupts (funcall function)))
+ #!-win32
(let ((os-thread (thread-os-thread thread)))
(cond ((not os-thread)
(error 'interrupt-thread-error :thread thread))
* here. */
((SymbolValue(INTERRUPTS_ENABLED,thread) != NIL) ||
(SymbolValue(ALLOW_WITH_INTERRUPTS,thread) != NIL))) {
+#ifndef LISP_FEATURE_WIN32
sigset_t *context_sigmask = os_context_sigmask_addr(context);
if (!deferrables_blocked_in_sigset_p(context_sigmask)) {
- FSHOW((stderr, "/maybe_gc: calling POST_GC\n"));
thread_sigmask(SIG_SETMASK, context_sigmask, 0);
check_gc_signals_unblocked_or_lose();
+#endif
+ FSHOW((stderr, "/maybe_gc: calling POST_GC\n"));
funcall0(StaticSymbolFunction(POST_GC));
+#ifndef LISP_FEATURE_WIN32
} else {
FSHOW((stderr, "/maybe_gc: punting on POST_GC due to blockage\n"));
}
+#endif
}
undo_fake_foreign_function_call(context);
FSHOW((stderr, "/maybe_gc: returning\n"));
corruption_warning_and_maybe_lose(char *fmt, ...)
{
va_list ap;
+#ifndef LISP_FEATURE_WIN32
sigset_t oldset;
thread_sigmask(SIG_BLOCK, &blockable_sigset, &oldset);
+#endif
fprintf(stderr, "CORRUPTION WARNING");
va_start(ap, fmt);
print_message(fmt, ap);
fflush(stderr);
if (lose_on_corruption_p)
call_lossage_handler();
+#ifndef LISP_FEATURE_WIN32
else
thread_sigmask(SIG_SETMASK,&oldset,0);
+#endif
}
\f
/* internal error handler for when the Lisp error system doesn't exist
void
maybe_save_gc_mask_and_block_deferrables(sigset_t *sigset)
{
+#ifndef LISP_FEATURE_WIN32
struct thread *thread = arch_os_get_current_thread();
struct interrupt_data *data = thread->interrupt_data;
sigset_t oldset;
}
}
thread_sigmask(SIG_SETMASK,&oldset,0);
+#endif
}
/* Are we leaving WITH-GCING and already running with interrupts
void
check_interrupt_context_or_lose(os_context_t *context)
{
+#ifndef LISP_FEATURE_WIN32
struct thread *thread = arch_os_get_current_thread();
struct interrupt_data *data = thread->interrupt_data;
int interrupt_deferred_p = (data->pending_handler != 0);
* that run lisp code. */
check_gc_signals_unblocked_in_sigset_or_lose(sigset);
}
+#endif
}
/* When we catch an internal error, should we pass it back to Lisp to
* the os_context for the signal we're currently in the
* handler for. This should ensure that when we return from
* the handler the blocked signals are unblocked. */
+#ifndef LISP_FEATURE_WIN32
sigcopyset(os_context_sigmask_addr(context), &data->pending_mask);
+#endif
data->gc_blocked_deferrables = 0;
}
void
arrange_return_to_lisp_function(os_context_t *context, lispobj function)
{
+#ifndef LISP_FEATURE_WIN32
check_gc_signals_unblocked_in_sigset_or_lose
(os_context_sigmask_addr(context));
+#endif
#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
void * fun=native_pointer(function);
void *code = &(((struct simple_fun *) fun)->code);
(random 0.1))
(check-deferrables-unblocked-or-lose))
+#-win32
(with-test (:name (:timer :deferrables-unblocked :unwind))
(catch 'xxx
(make-and-schedule-and-wait (lambda ()
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.25.56"
+"1.0.25.57"