Index: /trunk/ccl/lib/chars.lisp
===================================================================
--- /trunk/ccl/lib/chars.lisp	(revision 5250)
+++ /trunk/ccl/lib/chars.lisp	(revision 5251)
@@ -280,18 +280,17 @@
 (defun char-name (c)
   "Return the name (a STRING) for a CHARACTER object."
-  (dolist (e *name-char-alist*)
-    (declare (list e))    
-    (when (eq c (cdr e))(return-from char-name (car e))))
-  (let ((code (char-code c)))
-    (declare (fixnum code))
-    (cond ((< code #x7f)
-           (when (< code (char-code #\space))
-             (let ((str (make-string 2 :element-type 'base-char)))
-               (declare (simple-base-string str))
-               (setf (schar str 0) #\^)
-               (setf (schar str 1)(code-char (%ilogxor code #x40)))
-               str)))
-          ((and (< code #x100)(graphic-char-p c)) nil)
-          (t (format nil "U+~x" code)))))
+  (let* ((code (char-code c)))
+    (declare (type (mod #x110000) code))
+    (or (and (< code (length *character-names*))
+             (svref *character-names* code))
+        (cond ((< code #x7f)
+               (when (< code (char-code #\space))
+                 (let ((str (make-string 2 :element-type 'base-char)))
+                   (declare (simple-base-string str))
+                   (setf (schar str 0) #\^)
+                   (setf (schar str 1)(code-char (%ilogxor code #x40)))
+                   str)))
+              ((and (< code #x100)(graphic-char-p c)) nil)
+              (t (format nil "U+~x" code))))))