From: Christophe R. <cr...@us...> - 2009-04-24 11:57:25
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv29478/src/compiler Modified Files: ir1report.lisp ir1tran.lisp Log Message: 1.0.27.35: minimize the potential for presenting hosts with choices By having minimal debug names for toplevel forms and component names, we avoid having arbitrary gensyms or, horror of horror, QUOTE: which is printed differently in different implementations... 2 commit messages follow: minimal debug names for cross-compiled top-level forms Otherwise we run the risk of getting arbitrary gensyms dumped as part of the debug name. bandage for ' vs QUOTE in two files Make FIND-COMPONENT-NAME in the XC (which names components, whose names are dumped in xc fasls) use only the first symbol in the context. That will be generally lame but avoids any current instances of QUOTE, which prints differently in different implementations when pretty-printing is off. Index: ir1report.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1report.lisp,v retrieving revision 1.27 retrieving revision 1.28 diff -u -d -r1.27 -r1.28 --- ir1report.lisp 24 Apr 2009 10:44:10 -0000 1.27 +++ ir1report.lisp 24 Apr 2009 11:57:13 -0000 1.28 @@ -432,12 +432,13 @@ (let ((ep (first (block-succ (component-head component))))) (aver ep) ; else no entry points?? (multiple-value-bind (form context) - (find-original-source - (node-source-path (block-start-node ep))) + (find-original-source (node-source-path (block-start-node ep))) (declare (ignore form)) (let ((*print-level* 2) (*print-pretty* nil)) - (format nil "~{~{~S~^ ~}~^ => ~}" context))))) + (format nil "~{~{~S~^ ~}~^ => ~}" + #+sb-xc-host (list (list (caar context))) + #-sb-xc-host context))))) ;;;; condition system interface Index: ir1tran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran.lisp,v retrieving revision 1.172 retrieving revision 1.173 diff -u -d -r1.172 -r1.173 --- ir1tran.lisp 24 Apr 2009 10:44:10 -0000 1.172 +++ ir1tran.lisp 24 Apr 2009 11:57:13 -0000 1.173 @@ -457,7 +457,7 @@ (let* ((forms (if for-value `(,form) `(,form nil))) (res (ir1-convert-lambda-body forms () - :debug-name (debug-name 'top-level-form form)))) + :debug-name (debug-name 'top-level-form #+sb-xc-host nil #-sb-xc-host form)))) (setf (functional-entry-fun res) res (functional-arg-documentation res) () (functional-kind res) :toplevel) @@ -707,8 +707,7 @@ (not (fun-lexically-notinline-p cmacro-fun-name))) (let ((res (careful-expand-macro cmacro-fun form))) (if (eq res form) - (ir1-convert-common-functoid start next result form - op) + (ir1-convert-common-functoid start next result form op) (ir1-convert start next result res))) (ir1-convert-common-functoid start next result form op))))))) |