* Symbol SI:*INTERRUPT-DISABLE* changes name to SI:*INTERRUPTS-DISABLED*.

* Implement WITHOUT-INTERRUPTS similarly to SBCL.
* Implement WITH-LOCK disabling interrupts in the lock release phase.

src/CHANGELOG

@@ -44,6 +44,13 @@ ECL 9.9.1:
 	(ext:weak-pointer-value weak-pointer) => value
    and it defines a new built-in type, EXT:WEAK-POINTER
 
+ - ECL now implements WITHOUT-INTERRUPTS similarly to SBCL. It creates three
+   local macros, ALLOW-WITH-INTERRUPTS and WITH-LOCAL-INTERRUPTS, and an
+   additional one WITH-RESTORED-INTERRUPTS, which executes the forms with
+   the value of interrupts of the forms that surround WITHOUT-INTERRUPTS.
+
+ - Symbol SI:*INTERRUPT-DISABLE* changes name to SI:*INTERRUPTS-DISABLED*.
+
 * Bugs fixed:
 
  - WITH-LOCK might run into a race condition when the lock acquisition process
@@ -51,6 +58,8 @@ ECL 9.9.1:
 
  - The following functions are now interrupt safe: MP:MAKE-LOCK.
 
+ - The use of GIVEUP-LOCK in WITH-LOCK is now protected against interrupts.
+
 ;;; Local Variables: ***
 ;;; mode:text ***
 ;;; fill-column:79 ***

src/c/symbols_list.h

@@ -1053,7 +1053,7 @@ cl_symbols[] = {
 {SYS_ "*IGNORE-EOF-ON-TERMINAL-IO*", SI_SPECIAL, NULL, -1, Cnil},
 {SYS_ "*INDENT-FORMATTED-OUTPUT*", SI_SPECIAL, NULL, -1, Cnil},
 {SYS_ "*INIT-FUNCTION-PREFIX*", SI_SPECIAL, NULL, -1, Cnil},
-{SYS_ "*INTERRUPT-ENABLE*", SI_SPECIAL, NULL, 1, Ct},
+{SYS_ "*INTERRUPTS-ENABLED*", SI_SPECIAL, NULL, 1, Ct},
 {SYS_ "*KEEP-DEFINITIONS*", SI_SPECIAL, NULL, -1, Ct},
 {SYS_ "*LOAD-HOOKS*", SI_SPECIAL, NULL, -1, OBJNULL},
 {SYS_ "*LOAD-SEARCH-LIST*", SI_SPECIAL, NULL, -1, Cnil},
@@ -1808,5 +1808,7 @@ cl_symbols[] = {
 {EXT_ "MAKE-WEAK-POINTER", EXT_ORDINARY, si_make_weak_pointer, 1, OBJNULL},
 {EXT_ "WEAK-POINTER-VALUE", EXT_ORDINARY, si_weak_pointer_value, 1, OBJNULL},
 
+{SYS_ "*ALLOW-WITH-INTERRUPTS*", SI_ORDINARY, NULL, -1, Ct},
+
 /* Tag for end of list */
 {NULL, CL_ORDINARY, NULL, -1, OBJNULL}};

src/c/unixint.d

@@ -196,7 +196,7 @@ static bool
 interrupts_disabled_by_lisp(cl_env_ptr the_env)
 {
 	return (ecl_get_option(ECL_OPT_BOOTED) &&
-		ecl_symbol_value(@'si::*interrupt-enable*') == Cnil);
+		ecl_symbol_value(@'si::*interrupts-enabled*') == Cnil);
 }
 
 static void
@@ -661,7 +661,7 @@ init_unixint(int pass)
 					    cl_core.system_package);
 			si_Xmake_constant(name, MAKE_FIXNUM(known_signals[i].code));
 		}
-		ECL_SET(@'si::*interrupt-enable*', Ct);
+		ECL_SET(@'si::*interrupts-enabled*', Ct);
 #ifdef SIGFPE
 		if (ecl_get_option(ECL_OPT_TRAP_SIGFPE)) {
 			mysignal(SIGFPE, non_evil_signal_handler);

src/lsp/mp.lsp

@@ -18,6 +18,71 @@
 
 (in-package "MP")
 
+(defmacro without-interrupts (&body body)
+  #!+sb-doc
+  "Executes BODY with all deferrable interrupts disabled. Deferrable
+interrupts arriving during execution of the BODY take effect after BODY has
+been executed.
+
+Deferrable interrupts include most blockable POSIX signals, and
+SB-THREAD:INTERRUPT-THREAD. Does not interfere with garbage collection, and
+unlike in many traditional Lisps using userspace threads, in SBCL
+WITHOUT-INTERRUPTS does not inhibit scheduling of other threads.
+
+Binds ALLOW-WITH-INTERRUPTS, WITH-LOCAL-INTERRUPTS and WITH-RESTORED-INTERRUPTS
+as a local macros.
+
+WITH-RESTORED-INTERRUPTS executes the body with interrupts enabled if and only
+if the WITHOUT-INTERRUPTS was in an environment in which interrupts were allowed.
+
+ALLOW-WITH-INTERRUPTS allows the WITH-INTERRUPTS to take effect during the
+dynamic scope of its body, unless there is an outer WITHOUT-INTERRUPTS without
+a corresponding ALLOW-WITH-INTERRUPTS.
+
+WITH-LOCAL-INTERRUPTS executes its body with interrupts enabled provided that
+for there is an ALLOW-WITH-INTERRUPTS for every WITHOUT-INTERRUPTS surrounding
+the current one. WITH-LOCAL-INTERRUPTS is equivalent to:
+
+  (allow-with-interrupts (with-interrupts ...))
+
+Care must be taken not to let either ALLOW-WITH-INTERRUPTS or
+WITH-LOCAL-INTERRUPTS appear in a function that escapes from inside the
+WITHOUT-INTERRUPTS in:
+
+  (without-interrupts
+    ;; The body of the lambda would be executed with WITH-INTERRUPTS allowed
+    ;; regardless of the interrupt policy in effect when it is called.
+    (lambda () (allow-with-interrupts ...)))
+
+  (without-interrupts
+    ;; The body of the lambda would be executed with interrupts enabled
+    ;; regardless of the interrupt policy in effect when it is called.
+    (lambda () (with-local-interrupts ...)))
+"
+  (with-unique-names (outer-allow-with-interrupts outer-interrupts-enabled)
+    `(multiple-value-prog1
+         (macrolet ((allow-with-interrupts (&body allow-forms)
+                      `(let ((*allow-with-interrupts* ,',outer-allow-with-interrupts))
+                         ,@allow-forms))
+                    (with-restored-interrupts (&body with-forms)
+                      `(let ((*interrupts-enabled* ,',outer-interrupts-enabled))
+                         ,@with-forms))
+                    (with-local-interrupts (&body with-forms)
+                      `(let* ((*allow-with-interrupts* ,',outer-allow-with-interrupts)
+                              (*interrupts-enabled* ,',outer-allow-with-interrupts))
+                         (when ,',outer-allow-with-interrupts
+                           (si::check-pending-interrupts))
+                         (locally ,@with-forms))))
+           (let* ((,outer-interrupts-enabled *allow-with-interrupts*)
+                  (*interrupts-enabled* nil)
+                  (,outer-allow-with-interrupts *allow-with-interrupts*)
+                  (*allow-with-interrupts* nil))
+             (declare (ignorable ,outer-allow-with-interrupts
+                                 ,outer-interrupts-enabled))
+             ,@body))
+       (when *interrupts-enabled*
+         (si::check-pending-interrupts)))))
+
 (defmacro with-lock ((lock) &body body)
   #-threads
   `(progn ,@body)
@@ -26,18 +91,18 @@
   ;; the function. That means we lose the information and ignore that
   ;; the lock was actually acquired. Furthermore, a lock can be recursive
   ;; and mp:lock-holder is also not reliable.
+  ;;
+  ;; Next notice how we need to disable interrupts around the body and
+  ;; the get-lock statement, to ensure that the unlocking is done with
+  ;; interrupts disabled.
   #+threads
-  `(let* ((%the-lock ,lock)
-          (%count (mp:lock-count %the-lock)))
-     (unwind-protect
-          (progn
-            (mp::get-lock %the-lock)
-            ,@body)
-       (when (> (mp:lock-count %the-lock) %count)
-         (mp::giveup-lock %the-lock)))))
-
-(defmacro without-interrupts (&body body)
-  `(let ((si:*interrupt-enable* nil))
-    (multiple-value-prog1
-	(progn ,@body)
-      (si::check-pending-interrupts))))
+  (with-unique-names (lock count interrupts)
+    `(let* ((,lock ,lock)
+            (,count (mp:lock-count ,lock)))
+       (without-interrupts
+           (unwind-protect
+                (with-restored-interrupts
+                    (mp::get-lock ,lock)
+                  (locally ,@body))
+             (when (> (mp:lock-count ,lock) ,count)
+               (mp::giveup-lock ,lock)))))))