1.0.0.22: Extensible sequences. (EXPERIMENTAL: Do Not Use As Food)

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

diff --git a/src/code/octets.lisp b/src/code/octets.lisp
index c499211..247f685 100644 (file)
--- a/src/code/octets.lisp
+++ b/src/code/octets.lisp
@@ -174,7 +174,7 @@ one-past-the-end"
 
 (defmacro define-unibyte-mapper (byte-char-name code-byte-name &rest exceptions)
   `(progn
-    (declaim (inline ,byte-char-name ,code-byte-name))
+    (declaim (inline ,byte-char-name))
     (defun ,byte-char-name (byte)
       (declare (optimize speed (safety 0))
                (type (unsigned-byte 8) byte))
@@ -186,16 +186,23 @@ one-past-the-end"
                                                         exception
                                                         byte))))
             byte))
+    ;; This used to be inlined, but it caused huge slowdowns in SBCL builds,
+    ;; bloated the core by about 700k on x86-64. Removing the inlining
+    ;; didn't seem to have any performance effect. -- JES, 2005-10-15
     (defun ,code-byte-name (code)
       (declare (optimize speed (safety 0))
                (type char-code code))
+      ;; FIXME: I'm not convinced doing this with CASE is a good idea as
+      ;; long as it's just macroexpanded into a stupid COND. Consider
+      ;; for example the output of (DISASSEMBLE 'SB-IMPL::CODE->CP1250-MAPPER)
+      ;; -- JES, 2005-10-15
       (case code
-        (,(mapcar #'car exceptions) nil)
         ,@(mapcar (lambda (exception)
                     (destructuring-bind (byte code) exception
                       `(,code ,byte)))
                   exceptions)
-        (otherwise code)))))
+        (,(mapcar #'car exceptions) nil)
+        (otherwise (if (< code 256) code nil))))))
 
 #!+sb-unicode
 (define-unibyte-mapper
@@ -214,6 +221,7 @@ one-past-the-end"
 (defun get-latin-bytes (mapper external-format string pos end)
   (declare (ignore end))
   (let ((code (funcall mapper (char-code (char string pos)))))
+    (declare (type (or null char-code) code))
     (values (cond
               ((and code (< code 256)) code)
               (t
@@ -629,22 +637,63 @@ 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*
+      ;; On non-unicode, use iso-8859-1 instead of detecting it from
+      ;; the locale settings. Defaulting to an external-format which
+      ;; can represent characters that the CHARACTER type can't
+      ;; doesn't seem very sensible.
+      #!-sb-unicode
+      (setf *default-external-format* :latin-1)
+      (let ((external-format #!-win32 (intern (or (sb!alien:alien-funcall
+                                                    (extern-alien
+                                                      "nl_langinfo"
+                                                      (function (c-string :external-format :latin-1)
+                                                                int))
+                                                    sb!unix:codeset)
+                                                  "LATIN-1")
+                                              "KEYWORD")
+                             #!+win32 (sb!win32::ansi-codepage)))
+        (/show0 "cold-printing defaulted external-format:")
+        #!+sb-show
+        (cold-print external-format)
+        (/show0 "matching to known aliases")
+        (dolist (entry *external-formats*
+                 (progn
+                   ;;; FIXME! This WARN would try to do printing
+                   ;;; before the streams have been initialized,
+                   ;;; causing an infinite erroring loop. We should
+                   ;;; either print it by calling to C, or delay the
+                   ;;; warning until later. Since we're in freeze
+                   ;;; right now, and the warning isn't really
+                   ;;; essential, I'm doing what's least likely to
+                   ;;; cause damage, and commenting it out. This
+                   ;;; should be revisited after 0.9.17. -- JES,
+                   ;;; 2006-09-21
+                   #+nil
+                   (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)))