diff --git a/src/CHANGELOG b/src/CHANGELOG index a9852fac0..84639c92e 100644 --- a/src/CHANGELOG +++ b/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 *** diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 10cf177f5..0279e8c7a 100644 --- a/src/c/symbols_list.h +++ b/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}}; diff --git a/src/c/unixint.d b/src/c/unixint.d index 6b654c242..e9c5d5ae5 100644 --- a/src/c/unixint.d +++ b/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); diff --git a/src/lsp/mp.lsp b/src/lsp/mp.lsp index 9e31ce613..4fd5e3007 100644 --- a/src/lsp/mp.lsp +++ b/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)))))))