/[slime]/slime/swank-sbcl.lisp
ViewVC logotype

Diff of /slime/swank-sbcl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.284 by nsiivola, Thu Jun 16 08:28:45 2011 UTC revision 1.285 by nsiivola, Sun Jul 3 18:15:38 2011 UTC
# Line 1188  stack." Line 1188  stack."
1188      (:valid (sb-di:debug-var-value var frame))      (:valid (sb-di:debug-var-value var frame))
1189      ((:invalid :unknown) ':<not-available>)))      ((:invalid :unknown) ':<not-available>)))
1190    
1191    (defun debug-var-info (var)
1192      ;; Introduced by SBCL 1.0.49.76.
1193      (let ((s (find-symbol "DEBUG-VAR-INFO" :sb-di)))
1194        (when (and s (fboundp s))
1195          (funcall s var))))
1196    
1197  (defimplementation frame-locals (index)  (defimplementation frame-locals (index)
1198    (let* ((frame (nth-frame index))    (let* ((frame (nth-frame index))
1199           (loc (sb-di:frame-code-location frame))           (loc (sb-di:frame-code-location frame))
1200           (vars (frame-debug-vars frame)))           (vars (frame-debug-vars frame))
1201             ;; Since SBCL 1.0.49.76 PREPROCESS-FOR-EVAL understands SB-DEBUG::MORE
1202             ;; specially.
1203             (more-name (or (find-symbol "MORE" :sb-debug) 'more))
1204             (more-context nil)
1205             (more-count nil)
1206             (more-id 0))
1207      (when vars      (when vars
1208        (loop for v across vars collect        (let ((locals
1209              (list :name (sb-di:debug-var-symbol v)                (loop for v across vars
1210                    :id (sb-di:debug-var-id v)                      do (when (eq (sb-di:debug-var-symbol v) more-name)
1211                    :value (debug-var-value v frame loc))))))                           (incf more-id))
1212                           (case (debug-var-info v)
1213                             (:more-context
1214                              (setf more-context (debug-var-value v frame loc)))
1215                             (:more-count
1216                              (setf more-count (debug-var-value v frame loc))))
1217                        collect
1218                           (list :name (sb-di:debug-var-symbol v)
1219                                 :id (sb-di:debug-var-id v)
1220                                 :value (debug-var-value v frame loc)))))
1221            (when (and more-context more-count)
1222              (setf locals (append locals
1223                                   (list
1224                                    (list :name more-name
1225                                          :id more-id
1226                                          :value (multiple-value-list
1227                                                  (sb-c:%more-arg-values more-context
1228                                                                         0 more-count)))))))
1229            locals))))
1230    
1231  (defimplementation frame-var-value (frame var)  (defimplementation frame-var-value (frame var)
1232    (let* ((frame (nth-frame frame))    (let* ((frame (nth-frame frame))
1233           (dvar (aref (frame-debug-vars frame) var)))           (vars (frame-debug-vars frame))
1234      (debug-var-value dvar frame (sb-di:frame-code-location frame))))           (loc (sb-di:frame-code-location frame))
1235             (dvar (if (= var (length vars))
1236                       ;; If VAR is out of bounds, it must be the fake var we made up for
1237                       ;; &MORE.
1238                       (let* ((context-var (find :more-context vars :key #'debug-var-info))
1239                              (more-context (debug-var-value context-var frame loc))
1240                              (count-var (find :more-count vars :key #'debug-var-info))
1241                              (more-count (debug-var-value count-var frame loc)))
1242                         (return-from frame-var-value
1243                           (multiple-value-list (sb-c:%more-arg-values more-context
1244                                                                       0 more-count))))
1245                       (aref vars var))))
1246        (debug-var-value dvar frame loc)))
1247    
1248  (defimplementation frame-catch-tags (index)  (defimplementation frame-catch-tags (index)
1249    (mapcar #'car (sb-di:frame-catches (nth-frame index))))    (mapcar #'car (sb-di:frame-catches (nth-frame index))))

Legend:
Removed from v.1.284  
changed lines
  Added in v.1.285

  ViewVC Help
Powered by ViewVC 1.1.5