X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Foctets.lisp;h=f743a4b5b0c3b9600819af0b251f20510c057782;hb=7fb597b585fc715537ea644f7d84440eca217ca1;hp=c49921176df31d369383a0812c97ce0ac71a18e3;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/code/octets.lisp b/src/code/octets.lisp index c499211..f743a4b 100644 --- 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 @@ -629,22 +636,44 @@ 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 #!-win32 (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)))