From: Gabor Melis <mega@hotpop.com>
Date: Sun, 1 Mar 2009 15:57:08 +0000 (+0000)
Subject: 1.0.25.57: fix compilation on win32
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1b32a547d26cf078ba9f2948edeb27ff91e78f49;p=sbcl.git

1.0.25.57: fix compilation on win32
---

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 2d02713..359b0f3 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -922,6 +922,7 @@ return DEFAULT if given or else signal JOIN-THREAD-ERROR."
      ,@body))
 
 ;;; Called from the signal handler.
+#!-win32
 (defun run-interruption ()
   (let ((interruption (with-interruptions-lock (*current-thread*)
                         (pop (thread-interruptions *current-thread*)))))
@@ -946,6 +947,12 @@ enable interrupts (GET-MUTEX when contended, for instance) so the
 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))
diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c
index d01a4fc..057be12 100644
--- a/src/runtime/gc-common.c
+++ b/src/runtime/gc-common.c
@@ -2454,15 +2454,19 @@ maybe_gc(os_context_t *context)
          * 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"));
diff --git a/src/runtime/interr.c b/src/runtime/interr.c
index c13be45..f7da2d3 100644
--- a/src/runtime/interr.c
+++ b/src/runtime/interr.c
@@ -95,8 +95,10 @@ void
 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);
@@ -109,8 +111,10 @@ corruption_warning_and_maybe_lose(char *fmt, ...)
     fflush(stderr);
     if (lose_on_corruption_p)
         call_lossage_handler();
+#ifndef LISP_FEATURE_WIN32
     else
         thread_sigmask(SIG_SETMASK,&oldset,0);
+#endif
 }
 
 /* internal error handler for when the Lisp error system doesn't exist
diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index 0f9f70d..b6c5c0d 100644
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -309,6 +309,7 @@ check_interrupts_enabled_or_lose(os_context_t *context)
 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;
@@ -341,6 +342,7 @@ maybe_save_gc_mask_and_block_deferrables(sigset_t *sigset)
         }
     }
     thread_sigmask(SIG_SETMASK,&oldset,0);
+#endif
 }
 
 /* Are we leaving WITH-GCING and already running with interrupts
@@ -363,6 +365,7 @@ in_leaving_without_gcing_race_p(struct thread *thread)
 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);
@@ -411,6 +414,7 @@ check_interrupt_context_or_lose(os_context_t *context)
          * 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
@@ -745,7 +749,9 @@ interrupt_handle_pending(os_context_t *context)
          * 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;
     }
 
@@ -1170,8 +1176,10 @@ extern void call_into_lisp_tramp(void);
 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);
diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp
index 23029cb..3f16fa1 100644
--- a/tests/timer.impure.lisp
+++ b/tests/timer.impure.lisp
@@ -60,6 +60,7 @@
                               (random 0.1))
   (check-deferrables-unblocked-or-lose))
 
+#-win32
 (with-test (:name (:timer :deferrables-unblocked :unwind))
   (catch 'xxx
     (make-and-schedule-and-wait (lambda ()
diff --git a/version.lisp-expr b/version.lisp-expr
index bcfbb57..5965b92 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; 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"