X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=64182a29f5eab24965a5151f6c8748593c3114e6;hb=c0578d9893429c9c0da80ea5920360e4621fddab;hp=d23bc01b523754da7ed6320ad469b99cc5504ea8;hpb=b77ebf21b137cd0debcb7a2a1f52b093ce28ee02;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index d23bc01..64182a2 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -191,7 +191,7 @@
            (setf (lvar-dynamic-extent old) nil)
            (unless (lvar-dynamic-extent new)
              (setf (lvar-dynamic-extent new) it)
-             (setf (cleanup-info it) (substitute new old (cleanup-info it)))))
+             (setf (cleanup-info it) (subst new old (cleanup-info it)))))
          (when (lvar-dynamic-extent new)
            (do-uses (node new)
              (node-ends-block node))))
@@ -1141,6 +1141,14 @@
                    (eq (defined-fun-functional defined-fun) fun))
           (remhash name *free-funs*))))))
 
+;;; Return functional for DEFINED-FUN which has been converted in policy
+;;; corresponding to the current one, or NIL if no such functional exists.
+(defun defined-fun-functional (defined-fun)
+  (let ((policy (lexenv-%policy *lexenv*)))
+    (dolist (functional (defined-fun-functionals defined-fun))
+      (when (equal policy (lexenv-%policy (functional-lexenv functional)))
+        (return functional)))))
+
 ;;; Do stuff to delete the semantic attachments of a REF node. When
 ;;; this leaves zero or one reference, we do a type dispatch off of
 ;;; the leaf to determine if a special action is appropriate.
@@ -1677,10 +1685,26 @@
                                  ((atom y) (file-coalesce-p y))
                                (unless (file-coalesce-p (car y))
                                  (return nil)))))
-                       ;; We *could* coalesce base-strings as well, but we'd need
-                       ;; a separate hash-table for that, since we are not allowed to
-                       ;; coalesce base-strings with non-base-strings.
-                       (typep x '(or (vector character) bit-vector)))))
+                       ;; We *could* coalesce base-strings as well,
+                       ;; but we'd need a separate hash-table for
+                       ;; that, since we are not allowed to coalesce
+                       ;; base-strings with non-base-strings.
+                       (typep x
+                              '(or bit-vector
+                                ;; in the cross-compiler, we coalesce
+                                ;; all strings with the same contents,
+                                ;; because we will end up dumping them
+                                ;; as base-strings anyway.  In the
+                                ;; real compiler, we're not allowed to
+                                ;; coalesce regardless of string
+                                ;; specialized element type, so we
+                                ;; KLUDGE by coalescing only character
+                                ;; strings (the common case) and
+                                ;; punting on the other types.
+                                #+sb-xc-host
+                                string
+                                #-sb-xc-host
+                                (vector character))))))
              (coalescep (x)
                (if faslp (file-coalesce-p x) (core-coalesce-p x))))
       (if (and (boundp '*constants*) (coalescep object))