;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: SYSTEM -*- ;;;; ;;;; MP.LSP -- Multiprocessing capabilities. ;;;; Copyright (c) 2003, Juan Jose Garcia-Ripoll ;;;; ;;;; This program is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Library General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 2 of the License, or (at your option) any later version. ;;;; ;;;; See file '../Copyright' for full details. #-threads (defpackage "MP" (:use "CL" "SI") (:export "WITH-LOCK")) (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 ...))) " (ext:with-unique-names (outer-allow-with-interrupts outer-interrupts-enabled) `(multiple-value-prog1 (macrolet ((allow-with-interrupts (&body allow-forms) `(let ((si:*allow-with-interrupts* ,',outer-allow-with-interrupts)) ,@allow-forms)) (with-restored-interrupts (&body with-forms) `(let ((si:*interrupts-enabled* ,',outer-interrupts-enabled)) ,@with-forms)) (with-local-interrupts (&body with-forms) `(let* ((si:*allow-with-interrupts* ,',outer-allow-with-interrupts) (si:*interrupts-enabled* ,',outer-allow-with-interrupts)) (when ,',outer-allow-with-interrupts (si::check-pending-interrupts)) (locally ,@with-forms)))) (let* ((,outer-interrupts-enabled si:*interrupts-enabled*) (si:*interrupts-enabled* nil) (,outer-allow-with-interrupts si:*allow-with-interrupts*) (si:*allow-with-interrupts* nil)) (declare (ignorable ,outer-allow-with-interrupts ,outer-interrupts-enabled)) ,@body)) (when si:*interrupts-enabled* (si::check-pending-interrupts))))) (defmacro with-interrupts (&body body) "Executes BODY with deferrable interrupts conditionally enabled. If there are pending interrupts they take effect prior to executing BODY. As interrupts are normally allowed WITH-INTERRUPTS only makes sense if there is an outer WITHOUT-INTERRUPTS with a corresponding ALLOW-WITH-INTERRUPTS: interrupts are not enabled if any outer WITHOUT-INTERRUPTS is not accompanied by ALLOW-WITH-INTERRUPTS." (ext:with-unique-names (allowp enablep) ;; We could manage without ENABLEP here, but that would require ;; taking extra care not to ever have *ALLOW-WITH-INTERRUPTS* NIL ;; and *INTERRUPTS-ENABLED* T -- instead of risking future breakage ;; we take the tiny hit here. `(let* ((,allowp si:*allow-with-interrupts*) (,enablep si:*interrupts-enabled*) (si:*interrupts-enabled* (or ,enablep ,allowp))) (when (and ,allowp (not ,enablep)) (si::check-pending-interrupts)) (locally ,@body)))) (defmacro with-lock ((lock-form &rest options) &body body) #-threads `(progn ,@body) #+threads (ext:with-unique-names (lock interrupts) `(let ((,lock ,lock-form)) (without-interrupts (unwind-protect (with-restored-interrupts (mp::get-lock ,lock) (locally ,@body)) (mp::giveup-lock ,lock))))))