- (with-unique-names (cfp)
- `(let ((,cfp (ash (sb!sys:sap-int (sb!vm::current-fp) ) -2)))
- (unless (and (mutex-value ,mutex)
- (SB!DI::control-stack-pointer-valid-p
- (sb!sys:int-sap (ash (mutex-value ,mutex) 2))))
- (get-mutex ,mutex ,cfp))
+ (with-unique-names (cfp inner-lock)
+ `(let ((,cfp (sb!kernel:current-fp))
+ (,inner-lock
+ (and (mutex-value ,mutex)
+ (sb!vm:control-stack-pointer-valid-p
+ (sb!sys:int-sap
+ (sb!kernel:get-lisp-obj-address (mutex-value ,mutex)))))))
+ (unless ,inner-lock
+ ;; this punning with MAKE-LISP-OBJ depends for its safety on
+ ;; the frame pointer being a lispobj-aligned integer. While
+ ;; it is, then MAKE-LISP-OBJ will always return a FIXNUM, so
+ ;; we're safe to do that. Should this ever change, this
+ ;; MAKE-LISP-OBJ could return something that looks like a
+ ;; pointer, but pointing into neverneverland, which will
+ ;; confuse GC completely. -- CSR, 2003-06-03
+ (get-mutex ,mutex (sb!kernel:make-lisp-obj (sb!sys:sap-int ,cfp))))