Rename compute-code-from-fn to compute-code-from-lip, except for sparc.

[sbcl.git] / src / code / octets.lisp

diff --git a/src/code/octets.lisp b/src/code/octets.lisp
index b68d59c..751a039 100644 (file)
--- a/src/code/octets.lisp
+++ b/src/code/octets.lisp
@@ -629,22 +629,44 @@ one-past-the-end"
 \f
 ;;;; external formats
 
+(defvar *default-external-format* nil)
+
 (defun default-external-format ()
-  (intern (or (sb!alien:alien-funcall
-               (extern-alien "nl_langinfo"
-                             (function c-string int))
-               sb!unix:codeset)
-              "LATIN-1")
-          "KEYWORD"))
+  (or *default-external-format*
+      (let ((external-format (intern (or (sb!alien:alien-funcall
+                                          (extern-alien
+                                           "nl_langinfo"
+                                           (function c-string int))
+                                          sb!unix:codeset)
+                                         "LATIN-1")
+                                     "KEYWORD")))
+        (/show0 "cold-printing defaulted external-format:")
+        #!+sb-show
+        (cold-print external-format)
+        (/show0 "matching to known aliases")
+        (dolist (entry *external-formats*
+                 (progn
+                   (warn "Invalid external-format ~A; using LATIN-1"
+                         external-format)
+                   (setf external-format :latin-1)))
+          (/show0 "cold printing known aliases:")
+          #!+sb-show
+          (dolist (alias (first entry)) (cold-print alias))
+          (/show0 "done cold-printing known aliases")
+          (when (member external-format (first entry))
+            (/show0 "matched")
+            (return)))
+        (/show0 "/default external format ok")
+        (setf *default-external-format* external-format))))
 
 ;;; FIXME: OAOOM here vrt. DEFINE-EXTERNAL-FORMAT in fd-stream.lisp
 (defparameter *external-format-functions*
   '(((:ascii :us-ascii :ansi_x3.4-1968 :iso-646 :iso-646-us :|646|)
      ascii->string-aref string->ascii)
-    ((:latin1 :latin-1 :iso-8859-1)
+    ((:latin1 :latin-1 :iso-8859-1 :iso8859-1)
      latin1->string-aref string->latin1)
     #!+sb-unicode
-    ((:latin9 :latin-9 :iso-8859-15)
+    ((:latin9 :latin-9 :iso-8859-15 :iso8859-15)
      latin9->string-aref string->latin9)
     ((:utf8 :utf-8)
      utf8->string-aref string->utf8)))