| ... |
... |
@@ -67,16 +67,26 @@ |
|
67
|
67
|
"A character code strictly larger than this is handled using Unicode
|
|
68
|
68
|
rules.")
|
|
69
|
69
|
|
|
|
70
|
+;; Table of mappings for upper case and lower case letters. See
|
|
|
71
|
+;; src/lisp/case-table.c.
|
|
70
|
72
|
(alien:def-alien-variable "case_table"
|
|
71
|
73
|
(alien:array (alien:* (alien:array c-call:unsigned-int 64)) 1024))
|
|
72
|
74
|
|
|
|
75
|
+;; Each entry in the case table consists of the code for either an
|
|
|
76
|
+;; upper case or lower case character code.
|
|
73
|
77
|
(defconstant +upper-case-entry+ (byte 16 0))
|
|
74
|
78
|
(defconstant +lower-case-entry+ (byte 16 16))
|
|
75
|
|
-(defconstant +stage2-size+ 6)
|
|
|
79
|
+
|
|
|
80
|
+(defconstant +stage2-size+ 6
|
|
|
81
|
+ "Number of bits used for the index of the second stage table of the
|
|
|
82
|
+ case mapping table.")
|
|
76
|
83
|
|
|
77
|
84
|
(declaim (inline case-table-entry))
|
|
78
|
85
|
|
|
79
|
86
|
(defun case-table-entry (code)
|
|
|
87
|
+ "For the character code, CODE, return 0 or the 32-bit value from the
|
|
|
88
|
+ case table. A value of 0 means there was no case mapping (neither
|
|
|
89
|
+ upper nor lower case)."
|
|
80
|
90
|
(declare (type (integer 0 (#.char-code-limit)) code)
|
|
81
|
91
|
(optimize (speed 3) (safety 0)))
|
|
82
|
92
|
(let* ((index1 (ldb (byte (- 16 +stage2-size+) +stage2-size+)
|
| ... |
... |
@@ -84,16 +94,14 @@ |
|
84
|
94
|
(index2 (ldb (byte +stage2-size+ 0)
|
|
85
|
95
|
code))
|
|
86
|
96
|
(stage2-sap (alien:alien-sap (alien:deref case-table index1))))
|
|
87
|
|
- #+nil
|
|
88
|
|
- (progn
|
|
89
|
|
- (format t "index1,2 = ~D ~D~%" index1 index2)
|
|
90
|
|
- (format t "stage2-sap = ~A~%" stage2-sap))
|
|
91
|
97
|
(if (zerop (sys:sap-int stage2-sap))
|
|
92
|
98
|
0
|
|
93
|
99
|
(sys:sap-ref-32 stage2-sap (* 4 index2)))))
|
|
94
|
100
|
|
|
95
|
101
|
(declaim (inline case-table-lower-case))
|
|
96
|
102
|
(defun case-table-lower-case (code)
|
|
|
103
|
+ "Compute the lower-case character code for the given character CODE.
|
|
|
104
|
+ If no lower-case code exists, just return CODE."
|
|
97
|
105
|
(declare (type (integer 0 (#.char-code-limit)) code)
|
|
98
|
106
|
(optimize (speed 3)))
|
|
99
|
107
|
(let ((lower-case (ldb +lower-case-entry+ (case-table-entry code))))
|
| ... |
... |
@@ -103,6 +111,8 @@ |
|
103
|
111
|
|
|
104
|
112
|
(declaim (inline case-table-upper-case))
|
|
105
|
113
|
(defun case-table-upper-case (code)
|
|
|
114
|
+ "Compute the upper-case character code for the given character CODE.
|
|
|
115
|
+ If no upper-case code exists, just return CODE."
|
|
106
|
116
|
(declare (type (integer 0 (#.char-code-limit)) code)
|
|
107
|
117
|
(optimize (speed 3)))
|
|
108
|
118
|
(let ((upper-case (ldb +upper-case-entry+ (case-table-entry code))))
|