| ... |
... |
@@ -27,37 +27,44 @@ |
|
27
|
27
|
(dotimes (i char-code-limit)
|
|
28
|
28
|
(let ((stage1 (ldb (byte (- 16 stage2-size) stage2-size) i))
|
|
29
|
29
|
(stage2 (ldb (byte stage2-size 0) i)))
|
|
30
|
|
- ;; Compute mapping from lower case to upper case which is
|
|
31
|
|
- ;; stored in the low 16 bits of the stage2 table.
|
|
32
|
|
- ;;
|
|
33
|
|
- ;; Only consider characters that have an upper case letter and
|
|
34
|
|
- ;; whose lowercase version returns the original letter.
|
|
35
|
30
|
(let ((upper (lisp::unicode-upper i))
|
|
36
|
31
|
(lower (lisp::unicode-lower i))
|
|
37
|
32
|
(entry 0))
|
|
38
|
33
|
(declare (type (unsigned-byte 32) entry))
|
|
|
34
|
+
|
|
|
35
|
+ (assert (< upper char-code-limit))
|
|
|
36
|
+ (assert (< lower char-code-limit))
|
|
|
37
|
+
|
|
|
38
|
+ ;; Compute mapping from lower case to upper case which is
|
|
|
39
|
+ ;; stored in the low 16 bits of the stage2 table.
|
|
|
40
|
+ ;;
|
|
|
41
|
+ ;; Only consider characters that have an upper case letter and
|
|
|
42
|
+ ;; whose lowercase version returns the original letter.
|
|
39
|
43
|
(when (and (/= i upper)
|
|
40
|
44
|
(= i (lisp::unicode-lower upper)))
|
|
41
|
45
|
(setf entry upper))
|
|
42
|
|
- ;; Compute mapping from upper case to lower case. The offset
|
|
43
|
|
- ;; is stored in the high 16 bits ofthe stage2 table.
|
|
|
46
|
+ ;; Compute mapping from upper case to lower case which is
|
|
|
47
|
+ ;; stored in the high 16 bits ofthe stage2 table.
|
|
44
|
48
|
;;
|
|
45
|
49
|
;; Only consider characters that have a lower case letter and
|
|
46
|
50
|
;; whose upper case version returns the original letter.
|
|
47
|
51
|
(when (and (/= i lower)
|
|
48
|
52
|
(= i (lisp::unicode-upper lower)))
|
|
49
|
|
- (setf entry (logior entry (ash lower 16))))
|
|
|
53
|
+ (setf entry (ash lower 16)))
|
|
50
|
54
|
|
|
|
55
|
+ ;; Note: the entry can only contain a lower case code or an
|
|
|
56
|
+ ;; upper case code, not both because we a character is
|
|
|
57
|
+ ;; either lower case or upper case and not both at the same
|
|
|
58
|
+ ;; time.
|
|
51
|
59
|
(setf (aref (aref table stage1) stage2)
|
|
52
|
60
|
entry))))
|
|
|
61
|
+
|
|
53
|
62
|
;; Find each stage2 table that is all zeroes and replace it with
|
|
54
|
63
|
;; NIL.
|
|
55
|
64
|
(dotimes (k (length table))
|
|
56
|
65
|
(let ((empty (count-if-not #'zerop (aref table k))))
|
|
57
|
66
|
(when (zerop empty)
|
|
58
|
|
- (setf (aref table k) nil))
|
|
59
|
|
- #+nil
|
|
60
|
|
- (format t "~3D: ~D: ~A~%" k empty (aref table k))))
|
|
|
67
|
+ (setf (aref table k) nil))))
|
|
61
|
68
|
table))
|
|
62
|
69
|
|
|
63
|
70
|
;; Given a case-mapping table TABLE, print some information about the
|