[slime-devel] Breakage with bleeding edge SBCL

[Nikodemus Siivola]

Current CVS HEAD SBCL breaks Slime again. I cheerfully submit that this
is "not SBCL's fault" as the interfaces that have changed were unexported 
and unsupported:

  1) SB-DEBUG::PRINT-CODE-LOCATION-SOURCE-FORM was replaced by
     SB-DEBUG::CODE-LOCATION-SOURCE-FORM; do the printing as you please.

  2) SB-DEBUG::PRINT-FRAME-CALL now takes a second required argument,
     the stream to print to.

The attached patch should fixes things for both bleeding edge and older 
versions, but still uses the unexported interfaces and is hence liable to 
break again. :/

Cheers,

  -- Nikodemus              Schemer: "Buddha is small, clean, and serious."
                   Lispnik: "Buddha is big, has hairy armpits, and laughs."
-------------- next part --------------
? diff
Index: swank-sbcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v
retrieving revision 1.119
diff -u -r1.119 swank-sbcl.lisp
--- swank-sbcl.lisp	28 Feb 2005 23:32:06 -0000	1.119
+++ swank-sbcl.lisp	2 Mar 2005 10:03:41 -0000
@@ -503,8 +503,26 @@
 	  collect f)))
 
 (defimplementation print-frame (frame stream)
-  (let ((*standard-output* stream))
-    (sb-debug::print-frame-call frame :verbosity 1 :number nil)))
+  (macrolet ((printer-form ()
+               ;; MEGAKLUDGE: As SBCL 0.8.20.1 fixed its debug IO style
+               ;; our usage of unexported interfaces came back to haunt
+               ;; us. And since we still use the same interfaces it will
+               ;; haunt us again.
+               (let ((print-sym (find-symbol "PRINT-FRAME-CALL" :sb-debug)))
+                 (if (fboundp print-sym)
+                     (let* ((args (sb-introspect:function-arglist print-sym))
+                          (key-pos (position '&key args)))
+                       (cond ((eql 2 key-pos)
+                              `(,print-sym frame stream))
+                             ((eql 1 key-pos)
+                              `(let ((*standard-output* stream))
+                                 (,print-sym frame)))
+                             (t
+                              (error "*THWAP* SBCL changes internals ~
+                                       again!"))))
+                     (error "You're in a twisty little maze of unsupported
+                              SBCL interfaces, all different.")))))
+    (printer-form)))
 
 (defun code-location-source-path (code-location)
   (let* ((location (sb-debug::maybe-block-start-location code-location))
@@ -528,6 +546,30 @@
 	 (consp info)
 	 (eq :emacs-buffer (car info)))))
 
+(defun print-code-location-source-form (code-location context)
+  (macrolet ((printer-form ()
+               ;; KLUDGE: These are both unexported interfaces, used
+               ;; by different versions of SBCL. ...sooner or later
+               ;; this will change again: hopefully by then we have
+               ;; figured out the interface we want to drive the
+               ;; debugger with and requested it from the SBCL
+               ;; folks.
+               (let ((print-code-sym
+                      (find-symbol "PRINT-CODE-LOCATION-SOURCE-FORM"
+                                   :sb-debug))
+                     (code-sym
+                      (find-symbol "CODE-LOCATION-SOURCE-FORM"
+                                   :sb-debug)))
+                 (cond ((fboundp print-code-sym)
+                        `(,print-code-sym code-location context))
+                       ((fboundp code-sym)
+                          `(,code-sym code-location context))
+                       (t
+                        (error 
+                         "*THWAP* SBCL changes its debugger interface ~
+                          again!"))))))
+    (printer-form)))
+
 (defun source-location-for-emacs (code-location)
   (let* ((debug-source (sb-di:code-location-debug-source code-location))
 	 (from (sb-di:debug-source-from debug-source))
@@ -554,8 +596,7 @@
       (:lisp
        (make-location
         (list :source-form (with-output-to-string (*standard-output*)
-                             (sb-debug::print-code-location-source-form
-                              code-location 100)))
+                             (print-code-location-source-form code-location 100)))
         (list :position 0))))))
 
 (defun safe-source-location-for-emacs (code-location)