[slime-cvs] CVS slime/contrib

[CVS User trittweiler]

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv637/contrib

Modified Files:
	swank-sbcl-exts.lisp ChangeLog 
Log Message:
	* swank-sbcl-exts.lisp (compute-enriched-decoded-arglist): Filter
	uninteresting arguments for SB-ASSEM:INST.


--- /project/slime/cvsroot/slime/contrib/swank-sbcl-exts.lisp	2008/12/31 12:31:31	1.2
+++ /project/slime/cvsroot/slime/contrib/swank-sbcl-exts.lisp	2009/07/15 19:37:25	1.3
@@ -18,24 +18,34 @@
 ;;;
 (defmethod compute-enriched-decoded-arglist ((operator-form (eql 'sb-assem:inst))
                                              argument-forms)
-  (if (null argument-forms)
-      (call-next-method)
-      (destructuring-bind (instruction &rest args) argument-forms
-        (declare (ignore args))
-        (let* ((instr-name
-                (if (arglist-dummy-p instruction)
-                    (string-upcase (arglist-dummy.string-representation instruction))
-                    (symbol-name instruction)))
-               (instr-fn (gethash instr-name sb-assem:*assem-instructions*)))
-          (if (not instr-fn)
-              (call-next-method)
-              (with-available-arglist (instr-arglist) (arglist instr-fn)
-                (let ((decoded-arglist (decode-arglist instr-arglist)))
-                  ;; The arglist of INST is (instruction ...INSTR-ARGLIST...).
-                  (push 'sb-assem::instruction (arglist.required-args decoded-arglist))
-                  (values decoded-arglist
-                          (list instr-name)
-                          t))))))))
+  (flet ((decode-instruction-arglist (instr-name instr-arglist)
+           (let ((decoded-arglist (decode-arglist instr-arglist)))
+             ;; The arglist of INST is (instruction ...INSTR-ARGLIST...).
+             (push 'sb-assem::instruction (arglist.required-args decoded-arglist))
+             (values decoded-arglist
+                     (list instr-name)
+                     t))))
+    (if (null argument-forms)
+        (call-next-method)
+        (destructuring-bind (instruction &rest args) argument-forms
+          (declare (ignore args))
+          (let* ((instr-name
+                  (if (arglist-dummy-p instruction)
+                      (string-upcase (arglist-dummy.string-representation instruction))
+                      (symbol-name instruction)))
+                 (instr-fn (gethash instr-name sb-assem:*assem-instructions*)))
+            (cond ((not instr-fn)
+                   (call-next-method))
+                  ((functionp instr-fn)
+                   (with-available-arglist (arglist) (arglist instr-fn)
+                     (decode-instruction-arglist instr-name arglist)))
+                  (t
+                   (assert (symbolp instr-fn))
+                   (with-available-arglist (arglist) (arglist instr-fn)
+                     ;; SB-ASSEM:INST invokes a symbolic INSTR-FN with
+                     ;; current segment and current vop implicitly.
+                     (decode-instruction-arglist instr-name (cddr arglist)))
+                   )))))))
 
 
 ) ; PROGN
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/07/12 08:01:19	1.225
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/07/15 19:37:25	1.226
@@ -1,3 +1,8 @@
+2009-07-15  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-sbcl-exts.lisp (compute-enriched-decoded-arglist): Filter
+	uninteresting arguments for SB-ASSEM:INST.
+
 2009-07-12  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-kawa.scm (swank-writer): Use set! for now, as the svn