From cd3332a71793f4bccee403162ad0daf60ad51fb2 Mon Sep 17 00:00:00 2001
From: Juho Snellman <jsnell@iki.fi>
Date: Wed, 3 Aug 2005 13:02:40 +0000
Subject: [PATCH] 0.9.3.21: 	Merge sbcl-devel "patch: treatment of
 default external format"         by NIIMI Satoshi,
 2005-06-12

---
 src/code/cold-init.lisp |    1 +
 src/code/fd-stream.lisp |   57 +++++++++++++++++------------------------------
 src/code/octets.lisp    |   34 +++++++++++++++++++++++-----
 version.lisp-expr       |    2 +-
 4 files changed, 50 insertions(+), 44 deletions(-)

diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index b80bfd8..33378df 100644
--- a/src/code/cold-init.lisp
+++ b/src/code/cold-init.lisp
@@ -283,6 +283,7 @@ UNIX-like systems, UNIX-STATUS is used as the status code."
   (sb!thread::get-foreground))
 
 (defun reinit ()
+  (setf *default-external-format* nil)
   (without-interrupts
     (without-gcing
         (os-cold-init-or-reinit)
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 0ce1b1f..122809f 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -1378,26 +1378,7 @@
     (when (and character-stream-p
                (eq external-format :default))
       (/show0 "/getting default external format")
-      (setf external-format (default-external-format))
-      (/show0 "cold-printing defaulted external-format:")
-      #!+sb-show
-      (cold-print external-format)
-      (/show0 "matching to known aliases")
-      (dolist (entry *external-formats*
-                     (restart-case
-                         (error "Invalid external-format ~A"
-                                external-format)
-                      (use-default ()
-                        :report "Set external format to LATIN-1"
-                        (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 external-format (default-external-format)))
 
     (when input-p
       (when (or (not character-stream-p) bivalent-stream-p)
@@ -2036,23 +2017,25 @@
 ;;; This is called whenever a saved core is restarted.
 (defun stream-reinit ()
   (setf *available-buffers* nil)
-  (setf *stdin*
-        (make-fd-stream 0 :name "standard input" :input t :buffering :line))
-  (setf *stdout*
-        (make-fd-stream 1 :name "standard output" :output t :buffering :line))
-  (setf *stderr*
-        (make-fd-stream 2 :name "standard error" :output t :buffering :line))
-  (let* ((ttyname #.(coerce "/dev/tty" 'simple-base-string))
-         (tty (sb!unix:unix-open ttyname sb!unix:o_rdwr #o666)))
-    (if tty
-        (setf *tty*
-              (make-fd-stream tty
-                              :name "the terminal"
-                              :input t
-                              :output t
-                              :buffering :line
-                              :auto-close t))
-        (setf *tty* (make-two-way-stream *stdin* *stdout*))))
+  (with-output-to-string (*error-output*)
+    (setf *stdin*
+          (make-fd-stream 0 :name "standard input" :input t :buffering :line))
+    (setf *stdout*
+          (make-fd-stream 1 :name "standard output" :output t :buffering :line))
+    (setf *stderr*
+          (make-fd-stream 2 :name "standard error" :output t :buffering :line))
+    (let* ((ttyname #.(coerce "/dev/tty" 'simple-base-string))
+           (tty (sb!unix:unix-open ttyname sb!unix:o_rdwr #o666)))
+      (if tty
+          (setf *tty*
+                (make-fd-stream tty
+                                :name "the terminal"
+                                :input t
+                                :output t
+                                :buffering :line
+                                :auto-close t))
+          (setf *tty* (make-two-way-stream *stdin* *stdout*))))
+    (princ (get-output-stream-string *error-output*) *stderr*))
   (values))
 
 ;;;; miscellany
diff --git a/src/code/octets.lisp b/src/code/octets.lisp
index b68d59c..d0f2134 100644
--- a/src/code/octets.lisp
+++ b/src/code/octets.lisp
@@ -629,13 +629,35 @@ one-past-the-end"
 
 ;;;; 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*
diff --git a/version.lisp-expr b/version.lisp-expr
index a1334c5..71706ef 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.3.20"
+"0.9.3.21"
-- 
1.7.10.4