[Sbcl-commits] CVS: sbcl/src/compiler ir1opt.lisp, 1.126, 1.127 node.lisp, 1.70, 1.71

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv15706/src/compiler

Modified Files:
	ir1opt.lisp node.lisp 
Log Message:
1.0.13.35: preserve source- and debug-name in IR1-OPTIMIZE-MV-CALL

 * Copying them from the original leaf before converting the
   replacement function.


Index: ir1opt.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1opt.lisp,v
retrieving revision 1.126
retrieving revision 1.127
diff -u -d -r1.126 -r1.127
--- ir1opt.lisp	9 Dec 2007 14:37:23 -0000	1.126
+++ ir1opt.lisp	15 Jan 2008 11:59:32 -0000	1.127
@@ -1717,10 +1717,13 @@
             (with-ir1-environment-from-node node
               (let* ((dums (make-gensym-list count))
                      (ignore (gensym))
+                     (leaf (ref-leaf ref))
                      (fun (ir1-convert-lambda
                            `(lambda (&optional ,@dums &rest ,ignore)
                               (declare (ignore ,ignore))
-                              (funcall ,(ref-leaf ref) ,@dums)))))
+                              (%funcall ,leaf ,@dums))
+                           :source-name (leaf-%source-name leaf)
+                           :debug-name (leaf-%debug-name leaf))))
                 (change-ref-leaf ref fun)
                 (aver (eq (basic-combination-kind node) :full))
                 (locall-analyze-component *current-component*)

Index: node.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/node.lisp,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -d -r1.70 -r1.71
--- node.lisp	1 Jan 2008 18:16:29 -0000	1.70
+++ node.lisp	15 Jan 2008 11:59:32 -0000	1.71
@@ -660,6 +660,9 @@
       ;; it looks as though it's never interesting to get debug names
       ;; from them, so it's moot. -- WHN)
       (leaf-source-name leaf)))
+(defun leaf-%debug-name (leaf)
+  (when (functional-p leaf)
+    (functional-%debug-name leaf)))
 
 ;;; The CONSTANT structure is used to represent known constant values.
 ;;; If NAME is not null, then it is the name of the named constant