0.pre7.122:
[sbcl.git] / src / code / debug-int.lisp
index 071a476..69182e8 100644 (file)
           (simple-string name))
   (let ((name-len (length name)))
     (position name variables
-             :test #'(lambda (x y)
-                       (let* ((y (debug-var-symbol-name y))
-                              (y-len (length y)))
-                         (declare (simple-string y))
-                         (and (>= y-len name-len)
-                              (string= x y :end1 name-len :end2 name-len))))
+             :test (lambda (x y)
+                     (let* ((y (debug-var-symbol-name y))
+                            (y-len (length y)))
+                       (declare (simple-string y))
+                       (and (>= y-len name-len)
+                            (string= x y :end1 name-len :end2 name-len))))
              :end (or end (length variables)))))
 
 ;;; Return a list representing the lambda-list for DEBUG-FUN. The
                            (declare (ignorable ,n-frame))
                            (symbol-macrolet ,(specs) ,form))
                         'function)))
-       #'(lambda (frame)
-           ;; This prevents these functions from being used in any
-           ;; location other than a function return location, so
-           ;; maybe this should only check whether frame's
-           ;; DEBUG-FUN is the same as loc's.
-           (unless (code-location= (frame-code-location frame) loc)
-             (debug-signal 'frame-fun-mismatch
-                           :code-location loc :form form :frame frame))
-           (funcall res frame))))))
+       (lambda (frame)
+         ;; This prevents these functions from being used in any
+         ;; location other than a function return location, so maybe
+         ;; this should only check whether FRAME's DEBUG-FUN is the
+         ;; same as LOC's.
+         (unless (code-location= (frame-code-location frame) loc)
+           (debug-signal 'frame-fun-mismatch
+                         :code-location loc :form form :frame frame))
+         (funcall res frame))))))
 \f
 ;;;; breakpoints
 
 (defun fun-end-starter-hook (starter-bpt debug-fun)
   (declare (type breakpoint starter-bpt)
           (type compiled-debug-fun debug-fun))
-  #'(lambda (frame breakpoint)
-      (declare (ignore breakpoint)
-              (type frame frame))
-      (let ((lra-sc-offset
-            (sb!c::compiled-debug-fun-return-pc
-             (compiled-debug-fun-compiler-debug-fun debug-fun))))
-       (multiple-value-bind (lra component offset)
-           (make-bogus-lra
-            (get-context-value frame
-                               lra-save-offset
-                               lra-sc-offset))
-         (setf (get-context-value frame
-                                  lra-save-offset
-                                  lra-sc-offset)
-               lra)
-         (let ((end-bpts (breakpoint-%info starter-bpt)))
-           (let ((data (breakpoint-data component offset)))
-             (setf (breakpoint-data-breakpoints data) end-bpts)
-             (dolist (bpt end-bpts)
-               (setf (breakpoint-internal-data bpt) data)))
-           (let ((cookie (make-fun-end-cookie lra debug-fun)))
-             (setf (gethash component *fun-end-cookies*) cookie)
-             (dolist (bpt end-bpts)
-               (let ((fun (breakpoint-cookie-fun bpt)))
-                 (when fun (funcall fun frame cookie))))))))))
+  (lambda (frame breakpoint)
+    (declare (ignore breakpoint)
+            (type frame frame))
+    (let ((lra-sc-offset
+          (sb!c::compiled-debug-fun-return-pc
+           (compiled-debug-fun-compiler-debug-fun debug-fun))))
+      (multiple-value-bind (lra component offset)
+         (make-bogus-lra
+          (get-context-value frame
+                             lra-save-offset
+                             lra-sc-offset))
+       (setf (get-context-value frame
+                                lra-save-offset
+                                lra-sc-offset)
+             lra)
+       (let ((end-bpts (breakpoint-%info starter-bpt)))
+         (let ((data (breakpoint-data component offset)))
+           (setf (breakpoint-data-breakpoints data) end-bpts)
+           (dolist (bpt end-bpts)
+             (setf (breakpoint-internal-data bpt) data)))
+         (let ((cookie (make-fun-end-cookie lra debug-fun)))
+           (setf (gethash component *fun-end-cookies*) cookie)
+           (dolist (bpt end-bpts)
+             (let ((fun (breakpoint-cookie-fun bpt)))
+               (when fun (funcall fun frame cookie))))))))))
 
 ;;; This takes a FUN-END-COOKIE and a frame, and it returns
 ;;; whether the cookie is still valid. A cookie becomes invalid when
 (defun deactivate-compiled-breakpoint (breakpoint)
   (if (eq (breakpoint-kind breakpoint) :fun-end)
       (let ((starter (breakpoint-start-helper breakpoint)))
-       (unless (find-if #'(lambda (bpt)
-                            (and (not (eq bpt breakpoint))
-                                 (eq (breakpoint-status bpt) :active)))
+       (unless (find-if (lambda (bpt)
+                          (and (not (eq bpt breakpoint))
+                               (eq (breakpoint-status bpt) :active)))
                         (breakpoint-%info starter))
          (deactivate-compiled-breakpoint starter)))
       (let* ((data (breakpoint-internal-data breakpoint))