[nongnu] externals/sly 57ffb2a 33/47: sbcl: fix access to &more vars in the debugger

[ELPA Syncer]

branch: externals/sly
commit 57ffb2a10f0541eb7e985a44ed730d57c6b6cb2a
Author: Stas Boukarev <stassats@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    sbcl: fix access to &more vars in the debugger
    
    * slynk/backend/sbcl.lisp: Rework.
    
    Cherry-picked-from: SLIME commit cd8cc3c95c3391b1f1cffa9e100336250a4509a7
    Co-authored-by: João Távora <joaotavora@gmail.com>
---
 slynk/backend/sbcl.lisp | 106 ++++++++++++++++++++++++------------------------
 1 file changed, 52 insertions(+), 54 deletions(-)

diff --git a/slynk/backend/sbcl.lisp b/slynk/backend/sbcl.lisp
index 9516569..487ef93 100644
--- a/slynk/backend/sbcl.lisp
+++ b/slynk/backend/sbcl.lisp
@@ -1395,14 +1395,28 @@ stack."
 
 (defun frame-debug-vars (frame)
   "Return a vector of debug-variables in frame."
-  (let ((all-vars (sb-di::debug-fun-debug-vars (sb-di:frame-debug-fun frame))))
-    (cond (*keep-non-valid-locals* all-vars)
-          (t (let ((loc (sb-di:frame-code-location frame)))
-               (remove-if (lambda (var)
-                            (ecase (sb-di:debug-var-validity var loc)
-                              (:valid nil)
-                              ((:invalid :unknown) t)))
-                          all-vars))))))
+  (let* ((all-vars (sb-di::debug-fun-debug-vars (sb-di:frame-debug-fun frame)))
+         (loc (sb-di:frame-code-location frame))
+         (vars (if *keep-non-valid-locals*
+                   all-vars
+                   (remove-if (lambda (var)
+                                (ecase (sb-di:debug-var-validity var loc)
+                                  (:valid nil)
+                                  ((:invalid :unknown) t)))
+                              all-vars)))
+         more-context
+         more-count)
+    (values (loop for v across vars
+                  unless 
+                  (case (debug-var-info v)
+                    (:more-context
+                     (setf more-context (debug-var-value v frame loc))
+                     t)
+                    (:more-count
+                     (setf more-count (debug-var-value v frame loc))
+                     t))
+                  collect v)
+            more-context more-count)))
 
 (defun debug-var-value (var frame location)
   (ecase (sb-di:debug-var-validity var location)
@@ -1417,59 +1431,43 @@ stack."
 
 (defimplementation frame-locals (index)
   (let* ((frame (nth-frame index))
-         (loc (sb-di:frame-code-location frame))
-         (vars (frame-debug-vars frame))
-         ;; Since SBCL 1.0.49.76 PREPROCESS-FOR-EVAL understands SB-DEBUG::MORE
-         ;; specially.
-         (more-name (or (find-symbol "MORE" :sb-debug) 'more))
-         (more-context nil)
-         (more-count nil))
-    (when vars
+         (loc (sb-di:frame-code-location frame)))
+    (multiple-value-bind (vars more-context more-count)
+        (frame-debug-vars frame)
       (let ((locals
-              (loop for v across vars
-                    unless 
-                    (case (debug-var-info v)
-                      (:more-context
-                       (setf more-context (debug-var-value v frame loc))
-                       t)
-                      (:more-count
-                       (setf more-count (debug-var-value v frame loc))
-                       t))
+              (loop for v in vars
                     collect
                     (list :name (sb-di:debug-var-symbol v)
                           :id (sb-di:debug-var-id v)
                           :value (debug-var-value v frame loc)))))
-        (when (and more-context more-count)
-          (setf locals (append locals
-                               (list
-                                (list :name more-name
-                                      :id 0
-                                      :value (multiple-value-list
-                                              (sb-c:%more-arg-values
-                                               more-context
-                                               0 more-count)))))))
-        locals))))
+        (if (and more-context more-count)
+            (append locals
+                    (list
+                     (list :name
+                           ;; Since SBCL 1.0.49.76 PREPROCESS-FOR-EVAL 
understands SB-DEBUG::MORE
+                           ;; specially.
+                           (or (find-symbol "MORE" :sb-debug) 'more)
+                           :id 0
+                           :value (multiple-value-list
+                                   (sb-c:%more-arg-values
+                                    more-context
+                                    0 more-count)))))
+            locals)))))
 
 (defimplementation frame-var-value (frame var)
-  (let* ((frame (nth-frame frame))
-         (vars (frame-debug-vars frame))
-         (loc (sb-di:frame-code-location frame))
-         (dvar (if (= var (length vars))
-                   ;; If VAR is out of bounds, it must be the fake var
-                   ;; we made up for &MORE.
-                   (let* ((context-var (find :more-context vars
-                                             :key #'debug-var-info))
-                          (more-context (debug-var-value context-var frame
-                                                         loc))
-                          (count-var (find :more-count vars
-                                           :key #'debug-var-info))
-                          (more-count (debug-var-value count-var frame loc)))
-                     (return-from frame-var-value
-                       (multiple-value-list (sb-c:%more-arg-values
-                                             more-context
-                                             0 more-count))))
-                   (aref vars var))))
-    (debug-var-value dvar frame loc)))
+  (let ((frame (nth-frame frame)))
+    (multiple-value-bind (vars more-context more-count)
+        (frame-debug-vars frame)
+      (let* ((loc (sb-di:frame-code-location frame))
+             (dvar (if (= var (length vars))
+                       ;; If VAR is out of bounds, it must be the fake var
+                       ;; we made up for &MORE.
+                       (return-from frame-var-value
+                         (multiple-value-list (sb-c:%more-arg-values
+                                               more-context
+                                               0 more-count)))
+                       (nth var vars))))
+        (debug-var-value dvar frame loc)))))
 
 (defimplementation frame-catch-tags (index)
   (mapcar #'car (sb-di:frame-catches (nth-frame index))))