[slime-cvs] CVS update: slime/swank-sbcl.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv6122

Modified Files:
	swank-sbcl.lisp 
Log Message:
(call-with-syntax-hooks, with-debootstrapping): Preserve compatability
with fairly recent SBCLs by checking for the presense of the
debootstrapping facilities at macroexpansion time.

Date: Fri Jun 25 01:06:20 2004
Author: heller

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.91 slime/swank-sbcl.lisp:1.92
--- slime/swank-sbcl.lisp:1.91	Sun Jun 20 14:37:05 2004
+++ slime/swank-sbcl.lisp	Fri Jun 25 01:06:20 2004
@@ -502,20 +502,28 @@
   (safe-source-location-for-emacs 
    (sb-di:frame-code-location (nth-frame index))))
 
+(defun frame-debug-vars (frame)
+  "Return a vector of debug-variables in frame."
+  (sb-di::debug-fun-debug-vars (sb-di:frame-debug-fun frame)))
+
+(defun debug-var-value (var frame location)
+  (ecase (sb-di:debug-var-validity var location)
+    (:valid (sb-di:debug-var-value var frame))
+    ((:invalid :unknown) ':<not-available>)))
+
 (defimplementation frame-locals (index)
   (let* ((frame (nth-frame index))
-	 (location (sb-di:frame-code-location frame))
-	 (debug-function (sb-di:frame-debug-fun frame))
-	 (debug-variables (sb-di::debug-fun-debug-vars debug-function)))
-    (declare (type (or null simple-vector) debug-variables))
-    (loop for v across debug-variables
-          collect (list
-                   :name (sb-di:debug-var-symbol v)
-                   :id (sb-di:debug-var-id v)
-                   :value (if (eq (sb-di:debug-var-validity v location)
-                                  :valid)
-                              (sb-di:debug-var-value v frame)
-                              '#:<not-available>)))))
+	 (loc (sb-di:frame-code-location frame))
+	 (vars (frame-debug-vars frame)))
+    (loop for v across vars collect
+          (list :name (sb-di:debug-var-symbol v)
+                :id (sb-di:debug-var-id v)
+                :value (debug-var-value v frame loc)))))
+
+(defimplementation frame-var-value (frame var)
+  (let* ((frame (nth-frame frame))
+         (dvar (aref (frame-debug-vars frame) var)))
+    (debug-var-value dvar frame (sb-di:frame-code-location frame))))
 
 (defimplementation frame-catch-tags (index)
   (mapcar #'car (sb-di:frame-catches (nth-frame index))))
@@ -704,12 +712,17 @@
 
 (defvar *debootstrap-packages* t)
 
+(defmacro with-debootstrapping (&body body)
+  (let ((not-found (find-symbol "BOOTSTRAP-PACKAGE-NOT-FOUND" "SB-INT"))
+        (debootstrap (find-symbol "DEBOOTSTRAP-PACKAGE" "SB-INT")))
+    (if (and not-found debootstrap)
+        `(handler-bind ((,not-found #',debootstrap)) , at body)
+        `(progn , at body))))
+
 (defimplementation call-with-syntax-hooks (fn)
   (cond ((and *debootstrap-packages* 
               (sbcl-package-p *package*))
-         (handler-bind ((sb-int:bootstrap-package-not-found 
-                         #'sb-int:debootstrap-package))
-           (funcall fn)))
+         (with-debootstrapping (funcall fn)))
         (t
          (funcall fn))))