src/code/thread.lisp

   1 (in-package "SB!THREAD")
   2
   3 (sb!xc:defmacro with-recursive-lock ((mutex) &body body)
   4   (declare (ignore #!-sb-thread mutex))
   5   #!+sb-thread
   6   (with-unique-names (cfp)
   7     `(let ((,cfp (sb!kernel:current-fp)))
   8       (unless (and (mutex-value ,mutex)
   9                    (sb!vm:control-stack-pointer-valid-p
  10                     (sb!sys:int-sap
  11                      (sb!kernel:get-lisp-obj-address (mutex-value ,mutex)))))
  12         ;; this punning with MAKE-LISP-OBJ depends for its safety on
  13         ;; the frame pointer being a lispobj-aligned integer.  While
  14         ;; it is, then MAKE-LISP-OBJ will always return a FIXNUM, so
  15         ;; we're safe to do that.  Should this ever change, this
  16         ;; MAKE-LISP-OBJ could return something that looks like a
  17         ;; pointer, but pointing into neverneverland, which will
  18         ;; confuse GC completely.  -- CSR, 2003-06-03
  19         (get-mutex ,mutex (sb!kernel:make-lisp-obj (sb!sys:sap-int ,cfp))))
  20       (unwind-protect
  21            (progn ,@body)
  22         (when (sb!sys:sap= (sb!sys:int-sap
  23                             (sb!kernel:get-lisp-obj-address
  24                              (mutex-value ,mutex)))
  25                            ,cfp)
  26           (release-mutex ,mutex)))))
  27   #!-sb-thread
  28   `(progn ,@body))
  29