source: trunk/source/level-1/l1-aprims.lisp @ 10140

Last change on this file since 10140 was 10140, checked in by rme, 11 years ago

array element subtypes for x8632; most-positive-fixnum =>
target::target-most-positive-fixnum.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 94.5 KB
Line 
1;;;-*-Mode: LISP; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17;; L1-aprims.lisp
18
19
20(in-package "CCL")
21
22
23(let* ((standard-initial-bindings ())
24       (standard-initial-bindings-lock (make-read-write-lock)))
25
26  (defun standard-initial-bindings ()
27    (with-read-lock (standard-initial-bindings-lock)
28      (copy-list standard-initial-bindings)))
29
30  (defun define-standard-initial-binding (symbol initform)
31    (setq symbol (require-type symbol 'symbol))
32    (%proclaim-special symbol)
33    (unless (boundp symbol)
34      (set symbol (funcall initform)))
35    (with-write-lock (standard-initial-bindings-lock)
36      (let* ((pair (assoc symbol standard-initial-bindings)))
37        (if pair
38          (setf (cdr pair) initform)
39          (push (cons symbol initform) standard-initial-bindings))))
40    (record-source-file symbol 'variable)
41    symbol))
42
43(def-standard-initial-binding *package*)
44(def-standard-initial-binding *gensym-counter* 0)
45(def-standard-initial-binding *random-state* (initialize-random-state #xFBF1 9))
46#+lock-accounting
47(progn
48(def-standard-initial-binding *locks-held* ())
49(def-standard-initial-binding *locks-pending* ())
50(def-standard-initial-binding *lock-conses* (make-list 20)))
51(def-standard-initial-binding *whostate* "Reset")
52(setq *whostate* "Active")
53(def-standard-initial-binding *error-print-length* 20)
54(def-standard-initial-binding *error-print-level* 8)
55
56(defun %badarg (arg type)
57  (%err-disp $XWRONGTYPE arg type))
58
59(defun atom (arg)
60  "Return true if OBJECT is an ATOM, and NIL otherwise."
61  (not (consp arg)))
62
63(defun list (&rest args)
64  "Return constructs and returns a list of its arguments."
65  args)
66
67(%fhave '%temp-list #'list)
68
69(defun list* (arg &rest others)
70  "Return a list of the arguments with last cons a dotted pair"
71  (cond ((null others) arg)
72        ((null (cdr others)) (cons arg (car others)))
73        (t (do ((x others (cdr x)))
74               ((null (cddr x)) (rplacd x (cadr x))))
75           (cons arg others))))
76
77
78
79(defun funcall (fn &rest args)
80  "Call FUNCTION with the given ARGUMENTS."
81  (declare (dynamic-extent args))
82  (apply fn args))
83
84
85(defun apply (function arg &rest args)
86  "Apply FUNCTION to a list of arguments produced by evaluating ARGUMENTS in
87   the manner of LIST*. That is, a list is made of the values of all but the
88   last argument, appended to the value of the last argument, which must be a
89   list."
90  (declare (dynamic-extent args))
91  (cond ((null args)
92         (apply function arg))
93        ((null (cdr args))
94         (apply function arg (car args)))
95        (t (do* ((a1 args a2)
96                 (a2 (cdr args) (cdr a2)))
97                ((atom (cdr a2))
98                 (rplacd a1 (car a2))
99                 (apply function arg args))))))
100
101
102;;; This is not fast, but it gets the functionality that
103;;; Wood and possibly other code depend on.
104(defun applyv (function arg &rest other-args)
105  (declare (dynamic-extent other-args))
106  (let* ((other-args (cons arg other-args))
107         (last-arg (car (last other-args)))
108         (last-arg-length (length last-arg))
109         (butlast-args (nbutlast other-args))
110         (rest-args (make-list last-arg-length))
111         (rest-args-tail rest-args))
112    (declare (dynamic-extent other-args rest-args))
113    (dotimes (i last-arg-length)
114      (setf (car rest-args-tail) (aref last-arg i))
115      (pop rest-args-tail))
116    (apply function (nconc butlast-args rest-args))))
117
118;;; This is slow, and since %apply-lexpr isn't documented either,
119;;; nothing in the world should depend on it.  This is just being
120;;; anal retentive.  VERY anal retentive.
121
122(defun %apply-lexpr (function arg &rest args)
123  (cond ((null args) (%apply-lexpr function arg))
124        (t (apply function arg (nconc (nbutlast args)
125                                      (collect-lexpr-args (car (last args)) 0))))))
126
127
128(defun values-list (arg)
129  "Return all of the elements of LIST, in order, as values."
130  (apply #'values arg))
131
132
133
134
135
136
137; copy-list
138
139(defun copy-list (list)
140  "Return a new list which is EQUAL to LIST."
141  (if list
142    (let ((result (cons (car list) '()) ))
143      (do ((x (cdr list) (cdr x))
144           (splice result
145                   (%cdr (%rplacd splice (cons (%car x) '() ))) ))
146          ((atom x) (unless (null x)
147                      (%rplacd splice x)) result)))))
148
149(defun alt-list-length (l)
150  "Detect (and complain about) cirucular lists; allow any atom to
151terminate the list"
152  (do* ((n 0 (1+ n))
153        (fast l)
154        (slow l))
155       ((atom fast) n)
156    (declare (fixnum n))
157    (setq fast (cdr fast))
158    (if (logbitp 0 n)
159      (if (eq (setq slow (cdr slow)) fast)
160        (%err-disp $XIMPROPERLIST l)))))
161
162
163(defun last (list &optional (n 1))
164  "Return the last N conses (not the last element!) of a list."
165  (if (and (typep n 'fixnum)
166           (>= (the fixnum n) 0))
167    (locally (declare (fixnum n))
168      (do* ((checked-list list (cdr checked-list))
169            (returned-list list)
170            (index 0 (1+ index)))
171           ((atom checked-list) returned-list)
172        (declare (type index index))
173        (if (>= index n)
174          (pop returned-list))))
175    (if (and (typep n 'bignum)
176             (> n 0))
177      (require-type list 'list)
178      (report-bad-arg  n 'unsigned-byte))))
179
180
181
182
183
184(defun nthcdr (index list)
185  "Performs the cdr function n times on a list."
186  (setq list (require-type list 'list))
187  (if (and (typep index 'fixnum)
188           (>= (the fixnum index) 0))
189      (locally (declare (fixnum index))
190        (dotimes (i index list)
191          (when (null (setq list (cdr list))) (return))))
192      (progn
193        (unless (typep index 'unsigned-byte)
194          (report-bad-arg index 'unsigned-byte))
195        (do* ((n index (- n target::target-most-positive-fixnum)))
196             ((typep n 'fixnum) (nthcdr n list))
197          (unless (setq list (nthcdr target::target-most-positive-fixnum list))
198            (return))))))
199
200
201(defun nth (index list)
202  "Return the nth object in a list where the car is the zero-th element."
203  (car (nthcdr index list)))
204
205
206(defun nconc (&rest lists)
207  (declare (dynamic-extent lists))
208  "Concatenates the lists given as arguments (by changing them)"
209  (do* ((top lists (cdr top)))
210       ((null top) nil)
211    (let* ((top-of-top (car top)))
212      (cond
213       ((consp top-of-top)
214        (let* ((result top-of-top)
215               (splice result))
216          (do* ((elements (cdr top) (cdr elements)))
217                 ((endp elements))
218            (let ((ele (car elements)))
219              (typecase ele
220                (cons (rplacd (last splice) ele)
221                      (setf splice ele))
222                (null (rplacd (last splice) nil))
223                (atom (if (cdr elements)
224                        (report-bad-arg ele 'list)
225                        (rplacd (last splice) ele)))
226                (t (report-bad-arg ele 'list)))))
227          (return result)))
228       ((null top-of-top) nil)
229       (t
230        (if (cdr top)
231          (report-bad-arg top-of-top 'list)
232          (return top-of-top)))))))
233
234
235(defvar %setf-function-names% (make-hash-table :weak t :test 'eq))
236(defvar %setf-function-name-inverses% (make-hash-table :weak t :test 'eq))
237
238(defun setf-function-name (sym)
239   (or (gethash sym %setf-function-names%)
240       (progn
241         (let* ((setf-package-sym (construct-setf-function-name sym)))
242           (setf (gethash setf-package-sym %setf-function-name-inverses%) sym
243                 (gethash sym %setf-function-names%) setf-package-sym)))))
244
245(defun existing-setf-function-name (sym)
246  (gethash sym %setf-function-names%))
247
248(defun maybe-setf-name (sym)
249  (let* ((other (gethash sym %setf-function-name-inverses%)))
250    (if other
251      `(setf ,other)
252      sym)))
253
254                     
255
256(defconstant *setf-package* (or (find-package "SETF") (make-package "SETF" :use nil :external-size 1)))
257
258(defun construct-setf-function-name (sym)
259  (let ((pkg (symbol-package sym)))
260    (setq sym (symbol-name sym))
261    (if (null pkg)
262      (gentemp sym *setf-package*)
263      (values
264       (intern
265        ;;I wonder, if we didn't check, would anybody report it as a bug?
266        (if (not (%str-member #\: (setq pkg (package-name pkg))))
267          (%str-cat pkg "::" sym)
268          (%str-cat (prin1-to-string pkg) "::" (princ-to-string sym)))
269        *setf-package*)))))
270
271(defun setf-function-name-p (name)
272  (and (consp name)
273             (consp (%cdr name))
274             (null (%cddr name))
275             (symbolp (%cadr name))
276             (eq (car name) 'setf)))
277
278(defun valid-function-name-p (name)
279  (if (symbolp name)                    ; Nil is a valid function name.  I guess.
280    (values t name)
281    (if (setf-function-name-p name)
282      (values t (setf-function-name (%cadr name)))
283      ; What other kinds of function names do we care to support ?
284      (values nil nil))))
285
286;;; Why isn't this somewhere else ?
287(defun ensure-valid-function-name (name)
288  (multiple-value-bind (valid-p nm) (valid-function-name-p name)
289    (if valid-p nm (error "Invalid function name ~s." name))))
290
291
292;;; Returns index if char appears in string, else nil.
293
294(defun %str-member (char string &optional start end)
295  (let* ((base-string-p (typep string 'simple-base-string)))
296    (unless base-string-p
297      (setq string (require-type string 'simple-string)))
298    (unless (characterp char)
299      (setq char (require-type char 'character)))
300    (do* ((i (or start 0) (1+ i))
301            (n (or end (uvsize string))))
302           ((= i n))
303        (declare (fixnum i n) (optimize (speed 3) (safety 0)))
304        (if (eq (schar (the simple-base-string string) i) char)
305          (return i)))))
306
307
308
309;;; Returns index of elt in vector, or nil if it's not there.
310(defun %vector-member (elt vector)
311  (unless (typep vector 'simple-vector)
312    (report-bad-arg vector 'simple-vector))
313  (dotimes (i (the fixnum (length vector)))
314    (when (eq elt (%svref vector i)) (return i))))
315
316(defun logical-pathname-p (thing) (istruct-typep thing 'logical-pathname))
317
318(progn
319;;; It's back ...
320(defun list-nreverse (list)
321  (nreconc list nil))
322
323;;; We probably want to make this smarter so that less boxing
324;;; (and bignum/double-float consing!) takes place.
325
326(defun vector-nreverse (v)
327  (let* ((len (length v))
328         (middle (ash (the fixnum len) -1)))
329    (declare (fixnum middle len))
330    (do* ((left 0 (1+ left))
331          (right (1- len) (1- right)))
332         ((= left middle) v)
333      (declare (fixnum left right))
334      (rotatef (aref v left) (aref v right)))))
335   
336(defun nreverse (seq)
337  "Return a sequence of the same elements in reverse order; the argument
338   is destroyed."
339  (when seq
340    (seq-dispatch seq
341                  (list-nreverse seq)
342                  (vector-nreverse seq)))))
343
344(defun nreconc (x y)
345  "Return (NCONC (NREVERSE X) Y)."
346  (do ((1st (cdr x) (if (endp 1st) 1st (cdr 1st)))
347       (2nd x 1st)              ;2nd follows first down the list.
348       (3rd y 2nd))             ;3rd follows 2nd down the list.
349      ((atom 2nd) 3rd)
350    (rplacd 2nd 3rd)))
351
352;;; The two-arg case is maybe a bit faster.  We -don't- want to
353;;; do the two-arg case repeatedly to implement the N-arg case.
354(defun append (&rest lists)
355  (declare (dynamic-extent lists))
356  "Construct a new list by concatenating the list arguments"
357  (if lists
358    (let* ((head (cons nil nil))
359           (tail head))
360      (declare (dynamic-extent head)
361               (cons head tail))
362      (do* ()
363           ((null lists) (cdr head))
364        (let* ((list (pop lists)))
365          (if (null lists)
366            (rplacd tail list)
367            (dolist (element list)
368                (setq tail (cdr (rplacd tail (cons element nil)))))))))))
369
370
371
372                     
373
374
375
376
377
378
379
380(progn
381(defun list-reverse (l)
382  (do* ((new ()))
383       ((null l) new)
384    (push (pop l) new)))
385
386; Again, it's worth putting more work into this when the dust settles.
387(defun vector-reverse (v)
388  (let* ((len (length v))
389         (new (make-array (the fixnum len) :element-type (array-element-type v))))   ; a LOT more work ...
390    (declare (fixnum len))
391    (do* ((left 0 (1+ left))
392          (right (1- len) (1- right)))
393         ((= left len) new)
394      (declare (fixnum left right))
395      (setf (uvref new left)
396            (aref v right)))))
397
398(defun reverse (seq)
399  "Return a new sequence containing the same elements but in reverse order."
400  (seq-dispatch seq (list-reverse seq) (vector-reverse seq)))
401)
402
403(defun check-sequence-bounds (seq start end)
404  (let* ((length (length seq)))
405    (declare (fixnum length))
406    (if (not end)
407      (setq end length)
408      (unless (typep end 'fixnum)
409        (report-bad-arg end 'fixnum)))
410    (unless (typep start 'fixnum)
411      (report-bad-arg start 'fixnum))
412    (locally (declare (fixnum start end))
413      (cond ((> end length)
414             (report-bad-arg end `(integer 0 (,length))))
415            ((< start 0)
416             (report-bad-arg start `(integer 0)))
417            ((< end 0)
418             (report-bad-arg end `(integer 0 (,length))))
419            ((> start end)
420             (report-bad-arg start `(integer 0 ,end)))
421            (t end)))))
422 
423
424(defun byte-length (string &optional  (start 0) end)
425  (setq end (check-sequence-bounds string start end))
426  (- end start))
427
428
429
430(defun make-cstring (string)
431  (let* ((len (length string)))
432    (declare (fixnum len))
433    (let* ((s (malloc (the fixnum (1+ len)))))
434      (setf (%get-byte s len) 0)
435      (multiple-value-bind (data offset) (array-data-and-offset string)
436        (dotimes (i len s)
437          (setf (%get-unsigned-byte s i) (%scharcode data (+ offset i))))
438        s))))
439
440
441(defun extended-string-p (thing)
442  (declare (ignore thing)))
443
444(defun simple-extended-string-p (thing)
445  (declare (ignore thing)))
446
447
448
449(defun move-string-bytes (source dest off1 off2 n)
450  (declare (fixnum off1 off2 n)
451           (simple-base-string source dest)
452           (optimize (speed 3) (safety 0)))
453  (dotimes (i n dest)
454    (setf (schar dest off2) (schar source off1))
455    (incf off1)
456    (incf off2)))
457
458
459(defun %str-cat (s1 s2 &rest more)
460  (declare (dynamic-extent more))
461  (require-type s1 'simple-string)
462  (require-type s2 'simple-string)
463  (let* ((len1 (length s1))
464         (len2 (length s2))
465         (len (%i+ len2 len1)))
466    (declare (optimize (speed 3)(safety 0)))
467    (dolist (s more)
468      (require-type s 'simple-string)
469      (setq len (+ len (length s))))
470    (let ((new-string (make-string len :element-type 'base-char)))
471      (move-string-bytes s1 new-string 0 0 len1)
472      (move-string-bytes s2 new-string 0 len1 len2)
473      (dolist (s more)
474        (setq len2 (%i+ len1 len2))
475        (move-string-bytes s new-string 0 len2 (setq len1 (length s))))
476      new-string)))
477
478
479(defun %substr (str start end)
480  (require-type start 'fixnum)
481  (require-type end 'fixnum)
482  (require-type str 'string)
483  (let ((len (length str)))
484    (multiple-value-bind (str strb)(array-data-and-offset str)
485      (let ((newlen (%i- end start)))
486        (when (%i> end len)(error "End ~S exceeds length ~S." end len))
487        (when (%i< start 0)(error "Negative start"))
488        (let ((new (make-string newlen)))
489          (do* ((i 0 (1+ i))
490                (pos (%i+ start strb) (1+ pos)))
491               ((= i newlen) new)
492            (declare (fixnum i pos))
493            (setf (schar new i) (schar str pos))))))))
494
495
496
497;;; 3 callers
498(defun %list-to-uvector (subtype list)   ; subtype may be nil (meaning simple-vector
499  (let* ((n (length list))
500         (new (%alloc-misc n (or subtype target::subtag-simple-vector))))  ; yech
501    (dotimes (i n)
502      (declare (fixnum i))
503      (uvset new i (%car list))
504      (setq list (%cdr list)))
505    new))
506
507
508; appears to be unused
509(defun upgraded-array-element-type (type &optional env)
510  "Return the element type that will actually be used to implement an array
511   with the specifier :ELEMENT-TYPE Spec."
512  (declare (ignore env))
513  (element-subtype-type (element-type-subtype type)))
514
515(defun upgraded-complex-part-type (type &optional env)
516  (declare (ignore env))
517  (declare (ignore type))               ; Ok, ok.  So (upgraded-complex-part-type 'bogus) is 'REAL. So ?
518  'real)
519
520
521#+ppc32-target
522(progn
523  (defparameter array-element-subtypes
524    #(single-float 
525      (unsigned-byte 32)
526      (signed-byte 32)
527      fixnum
528      base-char                         ;ucs4
529      (unsigned-byte 8)
530      (signed-byte 8)
531      base-char
532      (unsigned-byte 16)
533      (signed-byte 16)
534      double-float
535      bit))
536 
537  ;; given uvector subtype - what is the corresponding element-type
538  (defun element-subtype-type (subtype)
539    (declare (fixnum subtype))
540    (if  (= subtype ppc32::subtag-simple-vector) t
541        (svref array-element-subtypes 
542               (ash (- subtype ppc32::min-cl-ivector-subtag) (- ppc32::ntagbits)))))
543  )
544
545#+x8632-target
546(progn
547  (defparameter array-element-subtypes
548    #(single-float 
549      (unsigned-byte 32)
550      (signed-byte 32)
551      fixnum
552      base-char                         ;ucs4
553      (unsigned-byte 8)
554      (signed-byte 8)
555      base-char
556      (unsigned-byte 16)
557      (signed-byte 16)
558      double-float
559      bit))
560 
561  ;; given uvector subtype - what is the corresponding element-type
562  (defun element-subtype-type (subtype)
563    (declare (fixnum subtype))
564    (if  (= subtype x8632::subtag-simple-vector) t
565        (svref array-element-subtypes 
566               (ash (- subtype x8632::min-cl-ivector-subtag) (- x8632::ntagbits)))))
567  )
568
569#+ppc64-target
570(progn
571
572(defparameter array-element-subtypes
573  #(bogus
574    bogus
575    bogus
576    bogus
577    (signed-byte 8)
578    (signed-byte 16)
579    (signed-byte 32)
580    (signed-byte 64)
581    (unsigned-byte 8)
582    (unsigned-byte 16)
583    (unsigned-byte 32)
584    (unsigned-byte 64)
585    bogus
586    bogus
587    single-float
588    fixnum
589    bogus
590    bogus
591    bogus
592    double-float
593    bogus
594    bogus
595    base-char
596    bogus
597    bogus
598    bogus
599    bogus
600    bogus
601    bogus
602    bit
603    bogus
604    bogus)) 
605
606 
607  ;;; given uvector subtype - what is the corresponding element-type
608  (defun element-subtype-type (subtype)
609    (declare (fixnum subtype))
610    (if  (= subtype ppc64::subtag-simple-vector)
611      t
612      (svref array-element-subtypes 
613             (ash (- subtype 128) -2))))
614  )
615
616#+x8664-target
617(progn
618
619  ;;; 1, 8, 16-bit element types
620  (defparameter *immheader-0-array-element-types*
621    #(bogus
622      bogus
623      bogus
624      bogus
625      bogus
626      bogus
627      bogus
628      bogus
629      bogus
630      bogus
631      (signed-byte 16)
632      (unsigned-byte 16)
633      base-char
634      (signed-byte 8)
635      (unsigned-byte 8)
636      bit))
637
638  ;;; 32-bit element types
639  (defparameter *immheader-1-array-element-types*
640    #(bogus
641      bogus
642      bogus
643      bogus
644      bogus
645      bogus
646      bogus
647      bogus
648      bogus
649      bogus
650      bogus
651      bogus
652      base-char
653      (signed-byte 32)
654      (unsigned-byte 32)
655      single-float))
656
657  ;;; 64-bit element types
658  (defparameter *immheader-2-array-element-types*
659    #(bogus
660      bogus
661      bogus
662      bogus
663      bogus
664      bogus
665      bogus
666      bogus
667      bogus
668      bogus
669      bogus
670      bogus
671      fixnum
672      (signed-byte 64)
673      (unsigned-byte 64)
674      double-float)) 
675     
676 
677  (defun element-subtype-type (subtype)
678    (declare (type (unsigned-byte 8) subtype))
679    (if (= subtype x8664::subtag-simple-vector)
680      t
681      (let* ((class (ash subtype (- x8664::ntagbits)))
682             (tag (logand subtype x8664::fulltagmask)))
683        (declare (type (unsigned-byte 4) class tag))
684        (cond ((= tag x8664::fulltag-immheader-0)
685               (%svref *immheader-0-array-element-types* class))
686              ((= tag x8664::fulltag-immheader-1)
687               (%svref *immheader-1-array-element-types* class))
688              ((= tag x8664::fulltag-immheader-2)
689               (%svref *immheader-2-array-element-types* class))
690              (t 'bogus)))))
691  )
692
693
694;;; %make-displaced-array assumes the following
695
696(eval-when (:compile-toplevel)
697  (assert (eql target::arrayH.flags-cell target::vectorH.flags-cell))
698  (assert (eql target::arrayH.displacement-cell target::vectorH.displacement-cell))
699  (assert (eql target::arrayH.data-vector-cell target::vectorH.data-vector-cell)))
700
701
702(defun %make-displaced-array (dimensions displaced-to
703                                         &optional fill adjustable
704                                         offset explicitp)
705  (if offset 
706    (unless (and (fixnump offset) (>= (the fixnum offset) 0))
707      (setq offset (require-type offset '(and fixnum (integer 0 *)))))
708    (setq offset 0))
709  (locally (declare (fixnum offset))
710    (let* ((disp-size (array-total-size displaced-to))
711           (rank (if (listp dimensions)(length dimensions) 1))
712           (new-size (if (fixnump dimensions)
713                       dimensions
714                       (if (listp dimensions)
715                         (if (eql rank 1)
716                           (car dimensions)
717                           (if (eql rank 0) 1 ; why not 0?
718                           (apply #'* dimensions))))))
719           (vect-subtype (typecode displaced-to))
720           (target displaced-to)
721           (real-offset offset)
722           (flags 0))
723      (declare (fixnum disp-size rank flags vect-subtype real-offset))
724      (when explicitp
725        (setq flags (bitset $arh_exp_disp_bit flags)))
726      (if (not (fixnump new-size))(error "Bad array dimensions ~s." dimensions)) 
727      (locally (declare (fixnum new-size))
728        ; (when (> (+ offset new-size) disp-size) ...), but don't cons bignums
729        (when (or (> new-size disp-size)
730                  (let ((max-offset (- disp-size new-size)))
731                    (declare (fixnum max-offset))
732                    (> offset max-offset)))
733          (%err-disp $err-disp-size displaced-to))
734        (if adjustable  (setq flags (bitset $arh_adjp_bit flags)))
735        (when fill
736          (if (eq fill t)
737            (setq fill new-size)
738            (unless (and (eql rank 1)
739                         (fixnump fill)
740                         (locally (declare (fixnum fill))
741                           (and (>= fill 0) (<= fill new-size))))
742              (error "Bad fill pointer ~s" fill)))
743          (setq flags (bitset $arh_fill_bit flags))))
744      ; If displaced-to is an array or vector header and is either
745      ; adjustable or its target is a header, then we need to set the
746      ; $arh_disp_bit. If displaced-to is not adjustable, then our
747      ; target can be its target instead of itself.
748      (when (or (eql vect-subtype target::subtag-arrayH)
749                (eql vect-subtype target::subtag-vectorH))
750        (let ((dflags (%svref displaced-to target::arrayH.flags-cell)))
751          (declare (fixnum dflags))
752          (when (or (logbitp $arh_adjp_bit dflags)
753                    t
754                    (progn
755                      #+nope
756                      (setq target (%svref displaced-to target::arrayH.data-vector-cell)
757                            real-offset (+ offset (%svref displaced-to target::arrayH.displacement-cell)))
758                      (logbitp $arh_disp_bit dflags)
759                      #-nope t))
760            (setq flags (bitset $arh_disp_bit flags))))
761        (setq vect-subtype (%array-header-subtype displaced-to)))
762      ; assumes flags is low byte
763      (setq flags (dpb vect-subtype target::arrayH.flags-cell-subtag-byte flags))
764      (if (eq rank 1)
765        (%gvector target::subtag-vectorH 
766                      (if (fixnump fill) fill new-size)
767                      new-size
768                      target
769                      real-offset
770                      flags)
771        (let ((val (%alloc-misc (+ target::arrayh.dim0-cell rank) target::subtag-arrayH)))
772          (setf (%svref val target::arrayH.rank-cell) rank)
773          (setf (%svref val target::arrayH.physsize-cell) new-size)
774          (setf (%svref val target::arrayH.data-vector-cell) target)
775          (setf (%svref val target::arrayH.displacement-cell) real-offset)
776          (setf (%svref val target::arrayH.flags-cell) flags)
777          (do* ((dims dimensions (cdr dims))
778                (i 0 (1+ i)))             
779               ((null dims))
780            (declare (fixnum i)(list dims))
781            (setf (%svref val (%i+ target::arrayH.dim0-cell i)) (car dims)))
782          val)))))
783
784(defun make-array (dims &key (element-type t element-type-p)
785                        displaced-to
786                        displaced-index-offset
787                        adjustable
788                        fill-pointer
789                        (initial-element nil initial-element-p)
790                        (initial-contents nil initial-contents-p))
791  (when (and initial-element-p initial-contents-p)
792        (error "Cannot specify both ~S and ~S" :initial-element-p :initial-contents-p))
793  (make-array-1 dims element-type element-type-p
794                displaced-to
795                displaced-index-offset
796                adjustable
797                fill-pointer
798                initial-element initial-element-p
799                initial-contents initial-contents-p
800                nil))
801
802
803
804
805
806(defun vector-pop (vector)
807  "Decrease the fill pointer by 1 and return the element pointed to by the
808  new fill pointer."
809  (let* ((fill (fill-pointer vector)))
810    (declare (fixnum fill))
811    (if (zerop fill)
812      (error "Fill pointer of ~S is 0 ." vector)
813      (progn
814        (decf fill)
815        (%set-fill-pointer vector fill)
816        (aref vector fill)))))
817
818
819
820
821(defun elt (sequence idx)
822  "Return the element of SEQUENCE specified by INDEX."
823  (seq-dispatch
824   sequence
825   (let* ((cell (nthcdr idx sequence)))
826     (if (consp cell)
827       (car (the cons cell))
828       (if cell
829         (report-bad-arg sequence '(satisfies proper-list-p))
830         (%err-disp $XACCESSNTH idx sequence))))
831       
832   (progn
833     (unless (and (typep idx 'fixnum) (>= (the fixnum idx) 0))
834       (report-bad-arg idx 'unsigned-byte))
835     (locally 
836       (if (>= idx (length sequence))
837         (%err-disp $XACCESSNTH idx sequence)
838         (aref sequence idx))))))
839
840
841
842
843(defun set-elt (sequence idx value)
844  (seq-dispatch
845   sequence
846   (let* ((cell (nthcdr idx sequence)))
847     (if (consp cell)
848       (setf (car (the cons cell)) value)
849       (if cell
850         (report-bad-arg sequence '(satisfies proper-list-p))
851         (%err-disp $XACCESSNTH idx sequence))))
852   (progn
853     (unless (and (typep idx 'fixnum) (>= (the fixnum idx) 0))
854       (report-bad-arg idx 'unsigned-byte))
855     (locally 
856       (declare (fixnum idx))
857       (if (>= idx (length sequence))
858         (%err-disp $XACCESSNTH idx sequence)
859         (setf (aref sequence idx) value))))))
860
861
862
863
864(%fhave 'equalp #'equal)                ; bootstrapping
865
866(defun copy-tree (tree)
867  "Recursively copy trees of conses."
868  (if (atom tree)
869    tree
870    (locally (declare (type cons tree))
871      (do* ((tail (cdr tree) (cdr tail))
872            (result (cons (copy-tree (car tree)) nil))
873            (ptr result (cdr ptr)))
874           ((atom tail)
875            (setf (cdr ptr) tail)
876            result)
877        (declare (type cons ptr result))
878        (locally 
879          (declare (type cons tail))
880          (setf (cdr ptr) (cons (copy-tree (car tail)) nil)))))))
881
882
883
884
885(defvar *periodic-task-interval* 0.3)
886(defvar *periodic-task-seconds* 0)
887(defvar *periodic-task-nanoseconds* 300000000)
888
889(defun set-periodic-task-interval (n)
890  (multiple-value-setq (*periodic-task-seconds* *periodic-task-nanoseconds*)
891    (nanoseconds n))
892  (setq *periodic-task-interval* n))
893
894(defun periodic-task-interval ()
895  *periodic-task-interval*)
896
897
898
899(defun char-downcase (c)
900  "Return CHAR converted to lower-case if that is possible."
901  (let* ((code (char-code c)))
902    (declare (type (mod #x110000) code))
903    (if (and (>= code (char-code #\A))(<= code (char-code #\Z)))
904      (%code-char (%i+ code #.(- (char-code #\a)(char-code #\A))))
905      (or (and (>= code #x80)
906               (%non-standard-lower-case-equivalent c))
907          c))))
908
909
910
911(defun digit-char-p (char &optional radix)
912  "If char is a digit in the specified radix, returns the fixnum for
913  which that digit stands, else returns NIL."
914  (let* ((code (char-code char))
915         (r (if radix (if (and (typep radix 'fixnum)
916                               (%i>= radix 2)
917                               (%i<= radix 36))
918                        radix
919                        (%validate-radix radix)) 10))
920         (weight (if (and (<= code (char-code #\9))
921                          (>= code (char-code #\0)))
922                   (the fixnum (- code (char-code #\0)))
923                   (if (and (<= code (char-code #\Z))
924                            (>= code (char-code #\A)))
925                     (the fixnum (+ 10 (the fixnum (- code (char-code #\A)))))
926                   (if (and (<= code (char-code #\z))
927                            (>= code (char-code #\a)))
928                     (the fixnum (+ 10 (the fixnum (- code (char-code #\a))))))))))
929    (declare (fixnum code r))
930    (and weight (< (the fixnum weight) r) weight)))
931
932
933
934
935
936(defun char-upcase (c)
937  "Return CHAR converted to upper-case if that is possible.  Don't convert
938   lowercase eszet (U+DF)."
939  (let* ((code (char-code c)))
940    (declare (type (mod #x110000) code))
941    (if (and (>= code (char-code #\a))(<= code (char-code #\z)))
942      (%code-char (%i- code #.(- (char-code #\a)(char-code #\A))))
943      (or (and (>= code #x80) (%non-standard-upper-case-equivalent c))
944          c))))
945
946(defun %non-standard-char-code-upcase (code)
947  (declare (type (mod #x110000) code))
948  (if (>= code #x80)
949    (let* ((upper (%non-standard-upper-case-equivalent (code-char code))))
950      (if upper
951        (char-code upper)
952        code))
953    code))
954
955
956(defun string-start-end (string start end)
957  (setq string (string string))
958  (let ((len (length (the string string))))
959    (flet ((are (a i)(error "Array index ~S out of bounds for ~S." i a)))   
960      (if (and end (> end len))(are string end))
961      (if (and start (or (< start 0)(> start len)))(are string start))
962      (setq start (or start 0) end (or end len))
963      (if (%i> start end)
964        (error "Start ~S exceeds end ~S." start end))
965      (if (typep string 'simple-string)
966        (values string start end)
967        (multiple-value-bind (str off)(array-data-and-offset string)
968          (values str (%i+ off start)(%i+ off end)))))))
969
970(defun get-properties (place indicator-list)
971  "Like GETF, except that INDICATOR-LIST is a list of indicators which will
972  be looked for in the property list stored in PLACE. Three values are
973  returned, see manual for details."
974  (do ((plist place (cddr plist)))
975      ((null plist) (values nil nil nil))
976    (cond ((atom (cdr plist))
977           (report-bad-arg place '(satisfies proper-list-p)))
978          ((memq (car plist) indicator-list) ;memq defined in kernel
979           (return (values (car plist) (cadr plist) plist))))))
980
981(defun string= (string1 string2 &key start1 end1 start2 end2)
982  "Given two strings (string1 and string2), and optional integers start1,
983  start2, end1 and end2, compares characters in string1 to characters in
984  string2 (using char=)."
985    (locally (declare (optimize (speed 3)(safety 0)))
986      (if (and (simple-string-p string1)(null start1)(null end1))
987        (setq start1 0 end1 (length string1))
988        (multiple-value-setq (string1 start1 end1)(string-start-end string1 start1 end1)))
989      (if (and (simple-string-p string2)(null start2)(null end2))
990        (setq start2 0 end2 (length string2))
991        (multiple-value-setq (string2 start2 end2)(string-start-end string2 start2 end2)))   
992      (%simple-string= string1 string2 start1 start2 end1 end2)))
993
994
995(defun lfun-keyvect (lfun)
996  (let ((bits (lfun-bits lfun)))
997    (declare (fixnum bits))
998    (and (logbitp $lfbits-keys-bit bits)
999         (or (logbitp $lfbits-method-bit bits)
1000             (and (not (logbitp $lfbits-gfn-bit bits))
1001                  (not (logbitp $lfbits-cm-bit bits))))
1002         (nth-immediate lfun 1))))
1003
1004
1005
1006(defun function-lambda-expression (fn)
1007  "Return (VALUES DEFINING-LAMBDA-EXPRESSION CLOSURE-P NAME), where
1008  DEFINING-LAMBDA-EXPRESSION is NIL if unknown, or a suitable argument
1009  to COMPILE otherwise, CLOSURE-P is non-NIL if the function's definition
1010  might have been enclosed in some non-null lexical environment, and
1011  NAME is some name (for debugging only) or NIL if there is no name."
1012  ;(declare (values def env-p name))
1013  (let* ((bits (lfun-bits (setq fn (require-type fn 'function)))))
1014    (declare (fixnum bits))
1015    (if (logbitp $lfbits-trampoline-bit bits)
1016      (function-lambda-expression (nth-immediate fn 1))
1017      (values (uncompile-function fn)
1018              (logbitp $lfbits-nonnullenv-bit bits)
1019              (function-name fn)))))
1020
1021; env must be a lexical-environment or NIL.
1022; If env contains function or variable bindings or SPECIAL declarations, return t.
1023; Else return nil
1024(defun %non-empty-environment-p (env)
1025  (loop
1026    (when (or (null env) (istruct-typep env 'definition-environment))
1027      (return nil))
1028    (when (or (consp (lexenv.variables env))
1029              (consp (lexenv.functions env))
1030              (dolist (vdecl (lexenv.vdecls env))
1031                (when (eq (cadr vdecl) 'special)
1032                  (return t))))
1033      (return t))
1034    (setq env (lexenv.parent-env env))))
1035
1036;(coerce object 'compiled-function)
1037(defun coerce-to-compiled-function (object)
1038  (setq object (coerce-to-function object))
1039  (unless (typep object 'compiled-function)
1040    (multiple-value-bind (def envp) (function-lambda-expression object)
1041      (when (or envp (null def))
1042        (%err-disp $xcoerce object 'compiled-function))
1043      (setq object (compile-user-function def nil))))
1044  object)
1045
1046
1047
1048(defun %set-toplevel (&optional (fun nil fun-p))
1049  ;(setq fun (require-type fun '(or symbol function)))
1050  (let* ((tcr (%current-tcr)))
1051    (prog1 (%tcr-toplevel-function tcr)
1052      (when fun-p
1053        (%set-tcr-toplevel-function tcr fun)))))
1054
1055
1056(defun gccounts ()
1057  (let* ((total (%get-gc-count))
1058         (full (full-gccount))
1059         (g2-count 0)
1060         (g1-count 0)
1061         (g0-count 0))
1062    (when (egc-enabled-p)
1063      (let* ((a (%active-dynamic-area)))
1064        (setq g0-count (%fixnum-ref a target::area.gc-count) a (%fixnum-ref a target::area.older))
1065        (setq g1-count (%fixnum-ref a target::area.gc-count) a (%fixnum-ref a target::area.older))
1066        (setq g2-count (%fixnum-ref a target::area.gc-count))))
1067    (values total full g2-count g1-count g0-count)))
1068
1069     
1070
1071
1072
1073(defstatic %pascal-functions%
1074    #(NIL NIL NIL NIL NIL NIL NIL NIL
1075      NIL NIL NIL NIL NIL NIL NIL NIL
1076      NIL NIL NIL NIL NIL NIL NIL NIL
1077      NIL NIL NIL NIL NIL NIL NIL NIL))
1078
1079
1080(defun gc-retain-pages (arg)
1081  "Try to influence the GC to retain/recycle the pages allocated between
1082GCs if arg is true, and to release them otherwise. This is generally a
1083gtradeoff between paging and other VM considerations."
1084  (setq *gc-event-status-bits*
1085        (if arg
1086          (bitset $gc-retain-pages-bit *gc-event-status-bits*)
1087          (bitclr $gc-retain-pages-bit *gc-event-status-bits*)))
1088  (not (null arg)))
1089
1090(defun gc-retaining-pages ()
1091  "Return T if the GC tries to retain pages between full GCs and NIL if
1092it's trying to release them to improve VM paging performance."
1093  (logbitp $gc-retain-pages-bit *gc-event-status-bits*)) 
1094
1095
1096(defun gc-verbose (on-full-gc &optional (egc-too on-full-gc))
1097  "If the first (required) argument is non-NIL, configures the GC to print
1098informational messages on entry and exit to each full GC; if the first argument
1099is NIL, suppresses those messages.  The second (optional) argument controls printing of messages on entry and exit to an ephemeral GC.  Returns values as per GC-VERBOSE-P."
1100  (let* ((bits *gc-event-status-bits*))
1101    (if on-full-gc
1102      (bitsetf $gc-verbose-bit bits)
1103      (bitclrf $gc-verbose-bit bits))
1104    (if egc-too
1105      (bitsetf $egc-verbose-bit bits)
1106      (bitclrf $egc-verbose-bit bits))
1107    (setq *gc-event-status-bits* bits)
1108    (values on-full-gc egc-too)))
1109
1110
1111(defun gc-verbose-p ()
1112  "Returns two values: the first is true if the GC is configured to
1113print messages on each full GC; the second is true if the GC is configured
1114to print messages on each ephemeral GC."
1115  (let* ((bits *gc-event-status-bits*))
1116    (values (logbitp $gc-verbose-bit bits)
1117            (logbitp $egc-verbose-bit bits))))
1118
1119(defun egc-active-p ()
1120  "Return T if the EGC was active at the time of the call, NIL otherwise.
1121Since this is generally a volatile piece of information, it's not clear
1122whether this function serves a useful purpose when native threads are
1123involved."
1124  (and (egc-enabled-p)
1125       (not (eql 0 (%get-kernel-global 'oldest-ephemeral)))))
1126
1127; this IS effectively a passive way of inquiring about enabled status.
1128(defun egc-enabled-p ()
1129  "Return T if the EGC was enabled at the time of the call, NIL otherwise."
1130  (not (eql 0 (%fixnum-ref (%active-dynamic-area) target::area.older))))
1131
1132(defun egc-configuration ()
1133  "Return as multiple values the sizes in kilobytes of the thresholds
1134associated with the youngest ephemeral generation, the middle ephemeral
1135generation, and the oldest ephemeral generation."
1136  (let* ((ta (%get-kernel-global 'tenured-area))
1137         (g2 (%fixnum-ref ta target::area.younger))
1138         (g1 (%fixnum-ref g2 target::area.younger))
1139         (g0 (%fixnum-ref g1 target::area.younger)))
1140    (values (ash (the fixnum (%fixnum-ref g0 target::area.threshold)) (- (- 10 target::fixnum-shift)))
1141            (ash (the fixnum (%fixnum-ref g1 target::area.threshold)) (- (- 10 target::fixnum-shift)))
1142            (ash (the fixnum (%fixnum-ref g2 target::area.threshold)) (- (- 10 target::fixnum-shift))))))
1143
1144
1145(defun configure-egc (e0size e1size e2size)
1146  "If the EGC is currently disabled, put the indicated threshold sizes in
1147effect and returns T, otherwise, returns NIL. (The provided threshold sizes
1148are rounded up to a multiple of 64Kbytes in OpenMCL 0.14 and to a multiple
1149of 32KBytes in earlier versions.)"
1150  (let* ((was-enabled (egc-active-p)))
1151    (unwind-protect
1152         (progn
1153           (egc nil)
1154           (setq e2size (logand (lognot #xffff) (+ #xffff (ash (require-type e2size '(unsigned-byte 18)) 10)))
1155                 e1size (logand (lognot #xffff) (+ #xffff (ash (require-type e1size '(unsigned-byte 18)) 10)))
1156                 e0size (logand (lognot #xffff) (+ #xffff (ash (require-type e0size '(integer 1 #.(ash 1 18))) 10))))
1157           (%configure-egc e0size e1size e2size))
1158      (egc was-enabled))))
1159
1160
1161
1162(defun macptr-flags (macptr)
1163  (if (eql (uvsize (setq macptr (require-type macptr 'macptr))) 1)
1164    0
1165    (uvref macptr TARGET::XMACPTR.FLAGS-CELL)))
1166
1167
1168; This doesn't really make the macptr be gcable (now has to be
1169; on linked list), but we might have other reasons for setting
1170; other flag bits.
1171(defun set-macptr-flags (macptr value) 
1172  (unless (eql (uvsize (setq macptr (require-type macptr 'macptr))) 1)
1173    (setf (%svref macptr TARGET::XMACPTR.FLAGS-CELL) value)
1174    value))
1175
1176(defun %new-gcable-ptr (size &optional clear-p)
1177  (let ((p (make-gcable-macptr $flags_DisposPtr)))
1178    (%setf-macptr p (malloc size))
1179    (if clear-p
1180      (#_bzero p size))
1181    p))
1182
1183(defun %gcable-ptr-p (p)
1184  (and (typep p 'macptr)
1185       (= (uvsize p) target::xmacptr.element-count)))
1186
1187(defstatic *non-standard-lower-to-upper* (make-hash-table :test #'eq)
1188  "Maps non-STANDARD-CHAR lowercase chars to uppercase equivalents")
1189
1190(defstatic *non-standard-upper-to-lower* (make-hash-table :test #'eq)
1191  "Maps non-STANDARD-CHAR uppercase chars to lowercase equivalents")
1192
1193;;; This alist is automatically (and not to cleverly ...) generated.
1194;;; The (upper . lower) pairs have the property that UPPER is the
1195;;; value "simple uppercase equivalent" entry for LOWER in the
1196;;; UnicodeData.txt file and LOWER is the corresponding entry for
1197;;; UPPER.
1198(dolist (pair '((#\Latin_Capital_Letter_A_With_Grave . #\Latin_Small_Letter_A_With_Grave)
1199                (#\Latin_Capital_Letter_A_With_Acute . #\Latin_Small_Letter_A_With_Acute)
1200                (#\Latin_Capital_Letter_A_With_Circumflex
1201                 . #\Latin_Small_Letter_A_With_Circumflex)
1202                (#\Latin_Capital_Letter_A_With_Tilde . #\Latin_Small_Letter_A_With_Tilde)
1203                (#\Latin_Capital_Letter_A_With_Diaeresis
1204                 . #\Latin_Small_Letter_A_With_Diaeresis)
1205                (#\Latin_Capital_Letter_A_With_Ring_Above
1206                 . #\Latin_Small_Letter_A_With_Ring_Above)
1207                (#\Latin_Capital_Letter_Ae . #\Latin_Small_Letter_Ae)
1208                (#\Latin_Capital_Letter_C_With_Cedilla . #\Latin_Small_Letter_C_With_Cedilla)
1209                (#\Latin_Capital_Letter_E_With_Grave . #\Latin_Small_Letter_E_With_Grave)
1210                (#\Latin_Capital_Letter_E_With_Acute . #\Latin_Small_Letter_E_With_Acute)
1211                (#\Latin_Capital_Letter_E_With_Circumflex
1212                 . #\Latin_Small_Letter_E_With_Circumflex)
1213                (#\Latin_Capital_Letter_E_With_Diaeresis
1214                 . #\Latin_Small_Letter_E_With_Diaeresis)
1215                (#\Latin_Capital_Letter_I_With_Grave . #\Latin_Small_Letter_I_With_Grave)
1216                (#\Latin_Capital_Letter_I_With_Acute . #\Latin_Small_Letter_I_With_Acute)
1217                (#\Latin_Capital_Letter_I_With_Circumflex
1218                 . #\Latin_Small_Letter_I_With_Circumflex)
1219                (#\Latin_Capital_Letter_I_With_Diaeresis
1220                 . #\Latin_Small_Letter_I_With_Diaeresis)
1221                (#\Latin_Capital_Letter_Eth . #\Latin_Small_Letter_Eth)
1222                (#\Latin_Capital_Letter_N_With_Tilde . #\Latin_Small_Letter_N_With_Tilde)
1223                (#\Latin_Capital_Letter_O_With_Grave . #\Latin_Small_Letter_O_With_Grave)
1224                (#\Latin_Capital_Letter_O_With_Acute . #\Latin_Small_Letter_O_With_Acute)
1225                (#\Latin_Capital_Letter_O_With_Circumflex
1226                 . #\Latin_Small_Letter_O_With_Circumflex)
1227                (#\Latin_Capital_Letter_O_With_Tilde . #\Latin_Small_Letter_O_With_Tilde)
1228                (#\Latin_Capital_Letter_O_With_Diaeresis
1229                 . #\Latin_Small_Letter_O_With_Diaeresis)
1230                (#\Latin_Capital_Letter_O_With_Stroke . #\Latin_Small_Letter_O_With_Stroke)
1231                (#\Latin_Capital_Letter_U_With_Grave . #\Latin_Small_Letter_U_With_Grave)
1232                (#\Latin_Capital_Letter_U_With_Acute . #\Latin_Small_Letter_U_With_Acute)
1233                (#\Latin_Capital_Letter_U_With_Circumflex
1234                 . #\Latin_Small_Letter_U_With_Circumflex)
1235                (#\Latin_Capital_Letter_U_With_Diaeresis
1236                 . #\Latin_Small_Letter_U_With_Diaeresis)
1237                (#\Latin_Capital_Letter_Y_With_Acute . #\Latin_Small_Letter_Y_With_Acute)
1238                (#\Latin_Capital_Letter_Thorn . #\Latin_Small_Letter_Thorn)
1239                (#\Latin_Capital_Letter_A_With_Macron . #\Latin_Small_Letter_A_With_Macron)
1240                (#\Latin_Capital_Letter_A_With_Breve . #\Latin_Small_Letter_A_With_Breve)
1241                (#\Latin_Capital_Letter_A_With_Ogonek . #\Latin_Small_Letter_A_With_Ogonek)
1242                (#\Latin_Capital_Letter_C_With_Acute . #\Latin_Small_Letter_C_With_Acute)
1243                (#\Latin_Capital_Letter_C_With_Circumflex
1244                 . #\Latin_Small_Letter_C_With_Circumflex)
1245                (#\Latin_Capital_Letter_C_With_Dot_Above
1246                 . #\Latin_Small_Letter_C_With_Dot_Above)
1247                (#\Latin_Capital_Letter_C_With_Caron . #\Latin_Small_Letter_C_With_Caron)
1248                (#\Latin_Capital_Letter_D_With_Caron . #\Latin_Small_Letter_D_With_Caron)
1249                (#\Latin_Capital_Letter_D_With_Stroke . #\Latin_Small_Letter_D_With_Stroke)
1250                (#\Latin_Capital_Letter_E_With_Macron . #\Latin_Small_Letter_E_With_Macron)
1251                (#\Latin_Capital_Letter_E_With_Breve . #\Latin_Small_Letter_E_With_Breve)
1252                (#\Latin_Capital_Letter_E_With_Dot_Above
1253                 . #\Latin_Small_Letter_E_With_Dot_Above)
1254                (#\Latin_Capital_Letter_E_With_Ogonek . #\Latin_Small_Letter_E_With_Ogonek)
1255                (#\Latin_Capital_Letter_E_With_Caron . #\Latin_Small_Letter_E_With_Caron)
1256                (#\Latin_Capital_Letter_G_With_Circumflex
1257                 . #\Latin_Small_Letter_G_With_Circumflex)
1258                (#\Latin_Capital_Letter_G_With_Breve . #\Latin_Small_Letter_G_With_Breve)
1259                (#\Latin_Capital_Letter_G_With_Dot_Above
1260                 . #\Latin_Small_Letter_G_With_Dot_Above)
1261                (#\Latin_Capital_Letter_G_With_Cedilla . #\Latin_Small_Letter_G_With_Cedilla)
1262                (#\Latin_Capital_Letter_H_With_Circumflex
1263                 . #\Latin_Small_Letter_H_With_Circumflex)
1264                (#\Latin_Capital_Letter_H_With_Stroke . #\Latin_Small_Letter_H_With_Stroke)
1265                (#\Latin_Capital_Letter_I_With_Tilde . #\Latin_Small_Letter_I_With_Tilde)
1266                (#\Latin_Capital_Letter_I_With_Macron . #\Latin_Small_Letter_I_With_Macron)
1267                (#\Latin_Capital_Letter_I_With_Breve . #\Latin_Small_Letter_I_With_Breve)
1268                (#\Latin_Capital_Letter_I_With_Ogonek . #\Latin_Small_Letter_I_With_Ogonek)
1269                (#\Latin_Capital_Ligature_Ij . #\Latin_Small_Ligature_Ij)
1270                (#\Latin_Capital_Letter_J_With_Circumflex
1271                 . #\Latin_Small_Letter_J_With_Circumflex)
1272                (#\Latin_Capital_Letter_K_With_Cedilla . #\Latin_Small_Letter_K_With_Cedilla)
1273                (#\Latin_Capital_Letter_L_With_Acute . #\Latin_Small_Letter_L_With_Acute)
1274                (#\Latin_Capital_Letter_L_With_Cedilla . #\Latin_Small_Letter_L_With_Cedilla)
1275                (#\Latin_Capital_Letter_L_With_Caron . #\Latin_Small_Letter_L_With_Caron)
1276                (#\Latin_Capital_Letter_L_With_Middle_Dot
1277                 . #\Latin_Small_Letter_L_With_Middle_Dot)
1278                (#\Latin_Capital_Letter_L_With_Stroke . #\Latin_Small_Letter_L_With_Stroke)
1279                (#\Latin_Capital_Letter_N_With_Acute . #\Latin_Small_Letter_N_With_Acute)
1280                (#\Latin_Capital_Letter_N_With_Cedilla . #\Latin_Small_Letter_N_With_Cedilla)
1281                (#\Latin_Capital_Letter_N_With_Caron . #\Latin_Small_Letter_N_With_Caron)
1282                (#\Latin_Capital_Letter_Eng . #\Latin_Small_Letter_Eng)
1283                (#\Latin_Capital_Letter_O_With_Macron . #\Latin_Small_Letter_O_With_Macron)
1284                (#\Latin_Capital_Letter_O_With_Breve . #\Latin_Small_Letter_O_With_Breve)
1285                (#\Latin_Capital_Letter_O_With_Double_Acute
1286                 . #\Latin_Small_Letter_O_With_Double_Acute)
1287                (#\Latin_Capital_Ligature_Oe . #\Latin_Small_Ligature_Oe)
1288                (#\Latin_Capital_Letter_R_With_Acute . #\Latin_Small_Letter_R_With_Acute)
1289                (#\Latin_Capital_Letter_R_With_Cedilla . #\Latin_Small_Letter_R_With_Cedilla)
1290                (#\Latin_Capital_Letter_R_With_Caron . #\Latin_Small_Letter_R_With_Caron)
1291                (#\Latin_Capital_Letter_S_With_Acute . #\Latin_Small_Letter_S_With_Acute)
1292                (#\Latin_Capital_Letter_S_With_Circumflex
1293                 . #\Latin_Small_Letter_S_With_Circumflex)
1294                (#\Latin_Capital_Letter_S_With_Cedilla . #\Latin_Small_Letter_S_With_Cedilla)
1295                (#\Latin_Capital_Letter_S_With_Caron . #\Latin_Small_Letter_S_With_Caron)
1296                (#\Latin_Capital_Letter_T_With_Cedilla . #\Latin_Small_Letter_T_With_Cedilla)
1297                (#\Latin_Capital_Letter_T_With_Caron . #\Latin_Small_Letter_T_With_Caron)
1298                (#\Latin_Capital_Letter_T_With_Stroke . #\Latin_Small_Letter_T_With_Stroke)
1299                (#\Latin_Capital_Letter_U_With_Tilde . #\Latin_Small_Letter_U_With_Tilde)
1300                (#\Latin_Capital_Letter_U_With_Macron . #\Latin_Small_Letter_U_With_Macron)
1301                (#\Latin_Capital_Letter_U_With_Breve . #\Latin_Small_Letter_U_With_Breve)
1302                (#\Latin_Capital_Letter_U_With_Ring_Above
1303                 . #\Latin_Small_Letter_U_With_Ring_Above)
1304                (#\Latin_Capital_Letter_U_With_Double_Acute
1305                 . #\Latin_Small_Letter_U_With_Double_Acute)
1306                (#\Latin_Capital_Letter_U_With_Ogonek . #\Latin_Small_Letter_U_With_Ogonek)
1307                (#\Latin_Capital_Letter_W_With_Circumflex
1308                 . #\Latin_Small_Letter_W_With_Circumflex)
1309                (#\Latin_Capital_Letter_Y_With_Circumflex
1310                 . #\Latin_Small_Letter_Y_With_Circumflex)
1311                (#\Latin_Capital_Letter_Y_With_Diaeresis
1312                 . #\Latin_Small_Letter_Y_With_Diaeresis)
1313                (#\Latin_Capital_Letter_Z_With_Acute . #\Latin_Small_Letter_Z_With_Acute)
1314                (#\Latin_Capital_Letter_Z_With_Dot_Above
1315                 . #\Latin_Small_Letter_Z_With_Dot_Above)
1316                (#\Latin_Capital_Letter_Z_With_Caron . #\Latin_Small_Letter_Z_With_Caron)
1317                (#\Latin_Capital_Letter_B_With_Hook . #\Latin_Small_Letter_B_With_Hook)
1318                (#\Latin_Capital_Letter_B_With_Topbar . #\Latin_Small_Letter_B_With_Topbar)
1319                (#\Latin_Capital_Letter_Tone_Six . #\Latin_Small_Letter_Tone_Six)
1320                (#\Latin_Capital_Letter_Open_O . #\Latin_Small_Letter_Open_O)
1321                (#\Latin_Capital_Letter_C_With_Hook . #\Latin_Small_Letter_C_With_Hook)
1322                (#\Latin_Capital_Letter_African_D . #\Latin_Small_Letter_D_With_Tail)
1323                (#\Latin_Capital_Letter_D_With_Hook . #\Latin_Small_Letter_D_With_Hook)
1324                (#\Latin_Capital_Letter_D_With_Topbar . #\Latin_Small_Letter_D_With_Topbar)
1325                (#\Latin_Capital_Letter_Reversed_E . #\Latin_Small_Letter_Turned_E)
1326                (#\Latin_Capital_Letter_Schwa . #\Latin_Small_Letter_Schwa)
1327                (#\Latin_Capital_Letter_Open_E . #\Latin_Small_Letter_Open_E)
1328                (#\Latin_Capital_Letter_F_With_Hook . #\Latin_Small_Letter_F_With_Hook)
1329                (#\Latin_Capital_Letter_G_With_Hook . #\Latin_Small_Letter_G_With_Hook)
1330                (#\Latin_Capital_Letter_Gamma . #\Latin_Small_Letter_Gamma)
1331                (#\Latin_Capital_Letter_Iota . #\Latin_Small_Letter_Iota)
1332                (#\Latin_Capital_Letter_I_With_Stroke . #\Latin_Small_Letter_I_With_Stroke)
1333                (#\Latin_Capital_Letter_K_With_Hook . #\Latin_Small_Letter_K_With_Hook)
1334                (#\Latin_Capital_Letter_Turned_M . #\Latin_Small_Letter_Turned_M)
1335                (#\Latin_Capital_Letter_N_With_Left_Hook
1336                 . #\Latin_Small_Letter_N_With_Left_Hook)
1337                (#\Latin_Capital_Letter_O_With_Middle_Tilde . #\Latin_Small_Letter_Barred_O)
1338                (#\Latin_Capital_Letter_O_With_Horn . #\Latin_Small_Letter_O_With_Horn)
1339                (#\Latin_Capital_Letter_Oi . #\Latin_Small_Letter_Oi)
1340                (#\Latin_Capital_Letter_P_With_Hook . #\Latin_Small_Letter_P_With_Hook)
1341                (#\Latin_Letter_Yr . #\Latin_Letter_Small_Capital_R)
1342                (#\Latin_Capital_Letter_Tone_Two . #\Latin_Small_Letter_Tone_Two)
1343                (#\Latin_Capital_Letter_Esh . #\Latin_Small_Letter_Esh)
1344                (#\Latin_Capital_Letter_T_With_Hook . #\Latin_Small_Letter_T_With_Hook)
1345                (#\Latin_Capital_Letter_T_With_Retroflex_Hook
1346                 . #\Latin_Small_Letter_T_With_Retroflex_Hook)
1347                (#\Latin_Capital_Letter_U_With_Horn . #\Latin_Small_Letter_U_With_Horn)
1348                (#\Latin_Capital_Letter_Upsilon . #\Latin_Small_Letter_Upsilon)
1349                (#\Latin_Capital_Letter_V_With_Hook . #\Latin_Small_Letter_V_With_Hook)
1350                (#\Latin_Capital_Letter_Y_With_Hook . #\Latin_Small_Letter_Y_With_Hook)
1351                (#\Latin_Capital_Letter_Z_With_Stroke . #\Latin_Small_Letter_Z_With_Stroke)
1352                (#\Latin_Capital_Letter_Ezh . #\Latin_Small_Letter_Ezh)
1353                (#\Latin_Capital_Letter_Ezh_Reversed . #\Latin_Small_Letter_Ezh_Reversed)
1354                (#\Latin_Capital_Letter_Tone_Five . #\Latin_Small_Letter_Tone_Five)
1355                (#\Latin_Capital_Letter_Dz_With_Caron . #\Latin_Small_Letter_Dz_With_Caron)
1356                (#\Latin_Capital_Letter_Lj . #\Latin_Small_Letter_Lj)
1357                (#\Latin_Capital_Letter_Nj . #\Latin_Small_Letter_Nj)
1358                (#\Latin_Capital_Letter_A_With_Caron . #\Latin_Small_Letter_A_With_Caron)
1359                (#\Latin_Capital_Letter_I_With_Caron . #\Latin_Small_Letter_I_With_Caron)
1360                (#\Latin_Capital_Letter_O_With_Caron . #\Latin_Small_Letter_O_With_Caron)
1361                (#\Latin_Capital_Letter_U_With_Caron . #\Latin_Small_Letter_U_With_Caron)
1362                (#\Latin_Capital_Letter_U_With_Diaeresis_And_Macron
1363                 . #\Latin_Small_Letter_U_With_Diaeresis_And_Macron)
1364                (#\Latin_Capital_Letter_U_With_Diaeresis_And_Acute
1365                 . #\Latin_Small_Letter_U_With_Diaeresis_And_Acute)
1366                (#\Latin_Capital_Letter_U_With_Diaeresis_And_Caron
1367                 . #\Latin_Small_Letter_U_With_Diaeresis_And_Caron)
1368                (#\Latin_Capital_Letter_U_With_Diaeresis_And_Grave
1369                 . #\Latin_Small_Letter_U_With_Diaeresis_And_Grave)
1370                (#\Latin_Capital_Letter_A_With_Diaeresis_And_Macron
1371                 . #\Latin_Small_Letter_A_With_Diaeresis_And_Macron)
1372                (#\Latin_Capital_Letter_A_With_Dot_Above_And_Macron
1373                 . #\Latin_Small_Letter_A_With_Dot_Above_And_Macron)
1374                (#\Latin_Capital_Letter_Ae_With_Macron . #\Latin_Small_Letter_Ae_With_Macron)
1375                (#\Latin_Capital_Letter_G_With_Stroke . #\Latin_Small_Letter_G_With_Stroke)
1376                (#\Latin_Capital_Letter_G_With_Caron . #\Latin_Small_Letter_G_With_Caron)
1377                (#\Latin_Capital_Letter_K_With_Caron . #\Latin_Small_Letter_K_With_Caron)
1378                (#\Latin_Capital_Letter_O_With_Ogonek . #\Latin_Small_Letter_O_With_Ogonek)
1379                (#\Latin_Capital_Letter_O_With_Ogonek_And_Macron
1380                 . #\Latin_Small_Letter_O_With_Ogonek_And_Macron)
1381                (#\Latin_Capital_Letter_Ezh_With_Caron . #\Latin_Small_Letter_Ezh_With_Caron)
1382                (#\Latin_Capital_Letter_Dz . #\Latin_Small_Letter_Dz)
1383                (#\Latin_Capital_Letter_G_With_Acute . #\Latin_Small_Letter_G_With_Acute)
1384                (#\Latin_Capital_Letter_Hwair . #\Latin_Small_Letter_Hv)
1385                (#\Latin_Capital_Letter_Wynn . #\Latin_Letter_Wynn)
1386                (#\Latin_Capital_Letter_N_With_Grave . #\Latin_Small_Letter_N_With_Grave)
1387                (#\Latin_Capital_Letter_A_With_Ring_Above_And_Acute
1388                 . #\Latin_Small_Letter_A_With_Ring_Above_And_Acute)
1389                (#\Latin_Capital_Letter_Ae_With_Acute . #\Latin_Small_Letter_Ae_With_Acute)
1390                (#\Latin_Capital_Letter_O_With_Stroke_And_Acute
1391                 . #\Latin_Small_Letter_O_With_Stroke_And_Acute)
1392                (#\Latin_Capital_Letter_A_With_Double_Grave
1393                 . #\Latin_Small_Letter_A_With_Double_Grave)
1394                (#\Latin_Capital_Letter_A_With_Inverted_Breve
1395                 . #\Latin_Small_Letter_A_With_Inverted_Breve)
1396                (#\Latin_Capital_Letter_E_With_Double_Grave
1397                 . #\Latin_Small_Letter_E_With_Double_Grave)
1398                (#\Latin_Capital_Letter_E_With_Inverted_Breve
1399                 . #\Latin_Small_Letter_E_With_Inverted_Breve)
1400                (#\Latin_Capital_Letter_I_With_Double_Grave
1401                 . #\Latin_Small_Letter_I_With_Double_Grave)
1402                (#\Latin_Capital_Letter_I_With_Inverted_Breve
1403                 . #\Latin_Small_Letter_I_With_Inverted_Breve)
1404                (#\Latin_Capital_Letter_O_With_Double_Grave
1405                 . #\Latin_Small_Letter_O_With_Double_Grave)
1406                (#\Latin_Capital_Letter_O_With_Inverted_Breve
1407                 . #\Latin_Small_Letter_O_With_Inverted_Breve)
1408                (#\Latin_Capital_Letter_R_With_Double_Grave
1409                 . #\Latin_Small_Letter_R_With_Double_Grave)
1410                (#\Latin_Capital_Letter_R_With_Inverted_Breve
1411                 . #\Latin_Small_Letter_R_With_Inverted_Breve)
1412                (#\Latin_Capital_Letter_U_With_Double_Grave
1413                 . #\Latin_Small_Letter_U_With_Double_Grave)
1414                (#\Latin_Capital_Letter_U_With_Inverted_Breve
1415                 . #\Latin_Small_Letter_U_With_Inverted_Breve)
1416                (#\Latin_Capital_Letter_S_With_Comma_Below
1417                 . #\Latin_Small_Letter_S_With_Comma_Below)
1418                (#\Latin_Capital_Letter_T_With_Comma_Below
1419                 . #\Latin_Small_Letter_T_With_Comma_Below)
1420                (#\Latin_Capital_Letter_Yogh . #\Latin_Small_Letter_Yogh)
1421                (#\Latin_Capital_Letter_H_With_Caron . #\Latin_Small_Letter_H_With_Caron)
1422                (#\Latin_Capital_Letter_N_With_Long_Right_Leg
1423                 . #\Latin_Small_Letter_N_With_Long_Right_Leg)
1424                (#\Latin_Capital_Letter_Ou . #\Latin_Small_Letter_Ou)
1425                (#\Latin_Capital_Letter_Z_With_Hook . #\Latin_Small_Letter_Z_With_Hook)
1426                (#\Latin_Capital_Letter_A_With_Dot_Above
1427                 . #\Latin_Small_Letter_A_With_Dot_Above)
1428                (#\Latin_Capital_Letter_E_With_Cedilla . #\Latin_Small_Letter_E_With_Cedilla)
1429                (#\Latin_Capital_Letter_O_With_Diaeresis_And_Macron
1430                 . #\Latin_Small_Letter_O_With_Diaeresis_And_Macron)
1431                (#\Latin_Capital_Letter_O_With_Tilde_And_Macron
1432                 . #\Latin_Small_Letter_O_With_Tilde_And_Macron)
1433                (#\Latin_Capital_Letter_O_With_Dot_Above
1434                 . #\Latin_Small_Letter_O_With_Dot_Above)
1435                (#\Latin_Capital_Letter_O_With_Dot_Above_And_Macron
1436                 . #\Latin_Small_Letter_O_With_Dot_Above_And_Macron)
1437                (#\Latin_Capital_Letter_Y_With_Macron . #\Latin_Small_Letter_Y_With_Macron)
1438                (#\Latin_Capital_Letter_A_With_Stroke . #\U+2C65)
1439                (#\Latin_Capital_Letter_C_With_Stroke . #\Latin_Small_Letter_C_With_Stroke)
1440                (#\Latin_Capital_Letter_L_With_Bar . #\Latin_Small_Letter_L_With_Bar)
1441                (#\Latin_Capital_Letter_T_With_Diagonal_Stroke . #\U+2C66)
1442                (#\Latin_Capital_Letter_Glottal_Stop . #\Latin_Small_Letter_Glottal_Stop)
1443                (#\Latin_Capital_Letter_B_With_Stroke . #\Latin_Small_Letter_B_With_Stroke)
1444                (#\Latin_Capital_Letter_U_Bar . #\Latin_Small_Letter_U_Bar)
1445                (#\Latin_Capital_Letter_Turned_V . #\Latin_Small_Letter_Turned_V)
1446                (#\Latin_Capital_Letter_E_With_Stroke . #\Latin_Small_Letter_E_With_Stroke)
1447                (#\Latin_Capital_Letter_J_With_Stroke . #\Latin_Small_Letter_J_With_Stroke)
1448                (#\Latin_Capital_Letter_Small_Q_With_Hook_Tail
1449                 . #\Latin_Small_Letter_Q_With_Hook_Tail)
1450                (#\Latin_Capital_Letter_R_With_Stroke . #\Latin_Small_Letter_R_With_Stroke)
1451                (#\Latin_Capital_Letter_Y_With_Stroke . #\Latin_Small_Letter_Y_With_Stroke)
1452                (#\Greek_Capital_Letter_Alpha_With_Tonos
1453                 . #\Greek_Small_Letter_Alpha_With_Tonos)
1454                (#\Greek_Capital_Letter_Epsilon_With_Tonos
1455                 . #\Greek_Small_Letter_Epsilon_With_Tonos)
1456                (#\Greek_Capital_Letter_Eta_With_Tonos . #\Greek_Small_Letter_Eta_With_Tonos)
1457                (#\Greek_Capital_Letter_Iota_With_Tonos
1458                 . #\Greek_Small_Letter_Iota_With_Tonos)
1459                (#\Greek_Capital_Letter_Omicron_With_Tonos
1460                 . #\Greek_Small_Letter_Omicron_With_Tonos)
1461                (#\Greek_Capital_Letter_Upsilon_With_Tonos
1462                 . #\Greek_Small_Letter_Upsilon_With_Tonos)
1463                (#\Greek_Capital_Letter_Omega_With_Tonos
1464                 . #\Greek_Small_Letter_Omega_With_Tonos)
1465                (#\Greek_Capital_Letter_Alpha . #\Greek_Small_Letter_Alpha)
1466                (#\Greek_Capital_Letter_Beta . #\Greek_Small_Letter_Beta)
1467                (#\Greek_Capital_Letter_Gamma . #\Greek_Small_Letter_Gamma)
1468                (#\Greek_Capital_Letter_Delta . #\Greek_Small_Letter_Delta)
1469                (#\Greek_Capital_Letter_Epsilon . #\Greek_Small_Letter_Epsilon)
1470                (#\Greek_Capital_Letter_Zeta . #\Greek_Small_Letter_Zeta)
1471                (#\Greek_Capital_Letter_Eta . #\Greek_Small_Letter_Eta)
1472                (#\Greek_Capital_Letter_Theta . #\Greek_Small_Letter_Theta)
1473                (#\Greek_Capital_Letter_Iota . #\Greek_Small_Letter_Iota)
1474                (#\Greek_Capital_Letter_Kappa . #\Greek_Small_Letter_Kappa)
1475                (#\Greek_Capital_Letter_Lamda . #\Greek_Small_Letter_Lamda)
1476                (#\Greek_Capital_Letter_Mu . #\Greek_Small_Letter_Mu)
1477                (#\Greek_Capital_Letter_Nu . #\Greek_Small_Letter_Nu)
1478                (#\Greek_Capital_Letter_Xi . #\Greek_Small_Letter_Xi)
1479                (#\Greek_Capital_Letter_Omicron . #\Greek_Small_Letter_Omicron)
1480                (#\Greek_Capital_Letter_Pi . #\Greek_Small_Letter_Pi)
1481                (#\Greek_Capital_Letter_Rho . #\Greek_Small_Letter_Rho)
1482                (#\Greek_Capital_Letter_Sigma . #\Greek_Small_Letter_Sigma)
1483                (#\Greek_Capital_Letter_Tau . #\Greek_Small_Letter_Tau)
1484                (#\Greek_Capital_Letter_Upsilon . #\Greek_Small_Letter_Upsilon)
1485                (#\Greek_Capital_Letter_Phi . #\Greek_Small_Letter_Phi)
1486                (#\Greek_Capital_Letter_Chi . #\Greek_Small_Letter_Chi)
1487                (#\Greek_Capital_Letter_Psi . #\Greek_Small_Letter_Psi)
1488                (#\Greek_Capital_Letter_Omega . #\Greek_Small_Letter_Omega)
1489                (#\Greek_Capital_Letter_Iota_With_Dialytika
1490                 . #\Greek_Small_Letter_Iota_With_Dialytika)
1491                (#\Greek_Capital_Letter_Upsilon_With_Dialytika
1492                 . #\Greek_Small_Letter_Upsilon_With_Dialytika)
1493                (#\Greek_Letter_Archaic_Koppa . #\Greek_Small_Letter_Archaic_Koppa)
1494                (#\Greek_Letter_Stigma . #\Greek_Small_Letter_Stigma)
1495                (#\Greek_Letter_Digamma . #\Greek_Small_Letter_Digamma)
1496                (#\Greek_Letter_Koppa . #\Greek_Small_Letter_Koppa)
1497                (#\Greek_Letter_Sampi . #\Greek_Small_Letter_Sampi)
1498                (#\Coptic_Capital_Letter_Shei . #\Coptic_Small_Letter_Shei)
1499                (#\Coptic_Capital_Letter_Fei . #\Coptic_Small_Letter_Fei)
1500                (#\Coptic_Capital_Letter_Khei . #\Coptic_Small_Letter_Khei)
1501                (#\Coptic_Capital_Letter_Hori . #\Coptic_Small_Letter_Hori)
1502                (#\Coptic_Capital_Letter_Gangia . #\Coptic_Small_Letter_Gangia)
1503                (#\Coptic_Capital_Letter_Shima . #\Coptic_Small_Letter_Shima)
1504                (#\Coptic_Capital_Letter_Dei . #\Coptic_Small_Letter_Dei)
1505                (#\Greek_Capital_Letter_Sho . #\Greek_Small_Letter_Sho)
1506                (#\Greek_Capital_Lunate_Sigma_Symbol . #\Greek_Lunate_Sigma_Symbol)
1507                (#\Greek_Capital_Letter_San . #\Greek_Small_Letter_San)
1508                (#\Greek_Capital_Reversed_Lunate_Sigma_Symbol
1509                 . #\Greek_Small_Reversed_Lunate_Sigma_Symbol)
1510                (#\Greek_Capital_Dotted_Lunate_Sigma_Symbol
1511                 . #\Greek_Small_Dotted_Lunate_Sigma_Symbol)
1512                (#\Greek_Capital_Reversed_Dotted_Lunate_Sigma_Symbol
1513                 . #\Greek_Small_Reversed_Dotted_Lunate_Sigma_Symbol)
1514                (#\Cyrillic_Capital_Letter_Ie_With_Grave
1515                 . #\Cyrillic_Small_Letter_Ie_With_Grave)
1516                (#\Cyrillic_Capital_Letter_Io . #\Cyrillic_Small_Letter_Io)
1517                (#\Cyrillic_Capital_Letter_Dje . #\Cyrillic_Small_Letter_Dje)
1518                (#\Cyrillic_Capital_Letter_Gje . #\Cyrillic_Small_Letter_Gje)
1519                (#\Cyrillic_Capital_Letter_Ukrainian_Ie
1520                 . #\Cyrillic_Small_Letter_Ukrainian_Ie)
1521                (#\Cyrillic_Capital_Letter_Dze . #\Cyrillic_Small_Letter_Dze)
1522                (#\Cyrillic_Capital_Letter_Byelorussian-Ukrainian_I
1523                 . #\Cyrillic_Small_Letter_Byelorussian-Ukrainian_I)
1524                (#\Cyrillic_Capital_Letter_Yi . #\Cyrillic_Small_Letter_Yi)
1525                (#\Cyrillic_Capital_Letter_Je . #\Cyrillic_Small_Letter_Je)
1526                (#\Cyrillic_Capital_Letter_Lje . #\Cyrillic_Small_Letter_Lje)
1527                (#\Cyrillic_Capital_Letter_Nje . #\Cyrillic_Small_Letter_Nje)
1528                (#\Cyrillic_Capital_Letter_Tshe . #\Cyrillic_Small_Letter_Tshe)
1529                (#\Cyrillic_Capital_Letter_Kje . #\Cyrillic_Small_Letter_Kje)
1530                (#\Cyrillic_Capital_Letter_I_With_Grave
1531                 . #\Cyrillic_Small_Letter_I_With_Grave)
1532                (#\Cyrillic_Capital_Letter_Short_U . #\Cyrillic_Small_Letter_Short_U)
1533                (#\Cyrillic_Capital_Letter_Dzhe . #\Cyrillic_Small_Letter_Dzhe)
1534                (#\Cyrillic_Capital_Letter_A . #\Cyrillic_Small_Letter_A)
1535                (#\Cyrillic_Capital_Letter_Be . #\Cyrillic_Small_Letter_Be)
1536                (#\Cyrillic_Capital_Letter_Ve . #\Cyrillic_Small_Letter_Ve)
1537                (#\Cyrillic_Capital_Letter_Ghe . #\Cyrillic_Small_Letter_Ghe)
1538                (#\Cyrillic_Capital_Letter_De . #\Cyrillic_Small_Letter_De)
1539                (#\Cyrillic_Capital_Letter_Ie . #\Cyrillic_Small_Letter_Ie)
1540                (#\Cyrillic_Capital_Letter_Zhe . #\Cyrillic_Small_Letter_Zhe)
1541                (#\Cyrillic_Capital_Letter_Ze . #\Cyrillic_Small_Letter_Ze)
1542                (#\Cyrillic_Capital_Letter_I . #\Cyrillic_Small_Letter_I)
1543                (#\Cyrillic_Capital_Letter_Short_I . #\Cyrillic_Small_Letter_Short_I)
1544                (#\Cyrillic_Capital_Letter_Ka . #\Cyrillic_Small_Letter_Ka)
1545                (#\Cyrillic_Capital_Letter_El . #\Cyrillic_Small_Letter_El)
1546                (#\Cyrillic_Capital_Letter_Em . #\Cyrillic_Small_Letter_Em)
1547                (#\Cyrillic_Capital_Letter_En . #\Cyrillic_Small_Letter_En)
1548                (#\Cyrillic_Capital_Letter_O . #\Cyrillic_Small_Letter_O)
1549                (#\Cyrillic_Capital_Letter_Pe . #\Cyrillic_Small_Letter_Pe)
1550                (#\Cyrillic_Capital_Letter_Er . #\Cyrillic_Small_Letter_Er)
1551                (#\Cyrillic_Capital_Letter_Es . #\Cyrillic_Small_Letter_Es)
1552                (#\Cyrillic_Capital_Letter_Te . #\Cyrillic_Small_Letter_Te)
1553                (#\Cyrillic_Capital_Letter_U . #\Cyrillic_Small_Letter_U)
1554                (#\Cyrillic_Capital_Letter_Ef . #\Cyrillic_Small_Letter_Ef)
1555                (#\Cyrillic_Capital_Letter_Ha . #\Cyrillic_Small_Letter_Ha)
1556                (#\Cyrillic_Capital_Letter_Tse . #\Cyrillic_Small_Letter_Tse)
1557                (#\Cyrillic_Capital_Letter_Che . #\Cyrillic_Small_Letter_Che)
1558                (#\Cyrillic_Capital_Letter_Sha . #\Cyrillic_Small_Letter_Sha)
1559                (#\Cyrillic_Capital_Letter_Shcha . #\Cyrillic_Small_Letter_Shcha)
1560                (#\Cyrillic_Capital_Letter_Hard_Sign . #\Cyrillic_Small_Letter_Hard_Sign)
1561                (#\Cyrillic_Capital_Letter_Yeru . #\Cyrillic_Small_Letter_Yeru)
1562                (#\Cyrillic_Capital_Letter_Soft_Sign . #\Cyrillic_Small_Letter_Soft_Sign)
1563                (#\Cyrillic_Capital_Letter_E . #\Cyrillic_Small_Letter_E)
1564                (#\Cyrillic_Capital_Letter_Yu . #\Cyrillic_Small_Letter_Yu)
1565                (#\Cyrillic_Capital_Letter_Ya . #\Cyrillic_Small_Letter_Ya)
1566                (#\Cyrillic_Capital_Letter_Omega . #\Cyrillic_Small_Letter_Omega)
1567                (#\Cyrillic_Capital_Letter_Yat . #\Cyrillic_Small_Letter_Yat)
1568                (#\Cyrillic_Capital_Letter_Iotified_E . #\Cyrillic_Small_Letter_Iotified_E)
1569                (#\Cyrillic_Capital_Letter_Little_Yus . #\Cyrillic_Small_Letter_Little_Yus)
1570                (#\Cyrillic_Capital_Letter_Iotified_Little_Yus
1571                 . #\Cyrillic_Small_Letter_Iotified_Little_Yus)
1572                (#\Cyrillic_Capital_Letter_Big_Yus . #\Cyrillic_Small_Letter_Big_Yus)
1573                (#\Cyrillic_Capital_Letter_Iotified_Big_Yus
1574                 . #\Cyrillic_Small_Letter_Iotified_Big_Yus)
1575                (#\Cyrillic_Capital_Letter_Ksi . #\Cyrillic_Small_Letter_Ksi)
1576                (#\Cyrillic_Capital_Letter_Psi . #\Cyrillic_Small_Letter_Psi)
1577                (#\Cyrillic_Capital_Letter_Fita . #\Cyrillic_Small_Letter_Fita)
1578                (#\Cyrillic_Capital_Letter_Izhitsa . #\Cyrillic_Small_Letter_Izhitsa)
1579                (#\Cyrillic_Capital_Letter_Izhitsa_With_Double_Grave_Accent
1580                 . #\Cyrillic_Small_Letter_Izhitsa_With_Double_Grave_Accent)
1581                (#\Cyrillic_Capital_Letter_Uk . #\Cyrillic_Small_Letter_Uk)
1582                (#\Cyrillic_Capital_Letter_Round_Omega . #\Cyrillic_Small_Letter_Round_Omega)
1583                (#\Cyrillic_Capital_Letter_Omega_With_Titlo
1584                 . #\Cyrillic_Small_Letter_Omega_With_Titlo)
1585                (#\Cyrillic_Capital_Letter_Ot . #\Cyrillic_Small_Letter_Ot)
1586                (#\Cyrillic_Capital_Letter_Koppa . #\Cyrillic_Small_Letter_Koppa)
1587                (#\Cyrillic_Capital_Letter_Short_I_With_Tail
1588                 . #\Cyrillic_Small_Letter_Short_I_With_Tail)
1589                (#\Cyrillic_Capital_Letter_Semisoft_Sign
1590                 . #\Cyrillic_Small_Letter_Semisoft_Sign)
1591                (#\Cyrillic_Capital_Letter_Er_With_Tick
1592                 . #\Cyrillic_Small_Letter_Er_With_Tick)
1593                (#\Cyrillic_Capital_Letter_Ghe_With_Upturn
1594                 . #\Cyrillic_Small_Letter_Ghe_With_Upturn)
1595                (#\Cyrillic_Capital_Letter_Ghe_With_Stroke
1596                 . #\Cyrillic_Small_Letter_Ghe_With_Stroke)
1597                (#\Cyrillic_Capital_Letter_Ghe_With_Middle_Hook
1598                 . #\Cyrillic_Small_Letter_Ghe_With_Middle_Hook)
1599                (#\Cyrillic_Capital_Letter_Zhe_With_Descender
1600                 . #\Cyrillic_Small_Letter_Zhe_With_Descender)
1601                (#\Cyrillic_Capital_Letter_Ze_With_Descender
1602                 . #\Cyrillic_Small_Letter_Ze_With_Descender)
1603                (#\Cyrillic_Capital_Letter_Ka_With_Descender
1604                 . #\Cyrillic_Small_Letter_Ka_With_Descender)
1605                (#\Cyrillic_Capital_Letter_Ka_With_Vertical_Stroke
1606                 . #\Cyrillic_Small_Letter_Ka_With_Vertical_Stroke)
1607                (#\Cyrillic_Capital_Letter_Ka_With_Stroke
1608                 . #\Cyrillic_Small_Letter_Ka_With_Stroke)
1609                (#\Cyrillic_Capital_Letter_Bashkir_Ka . #\Cyrillic_Small_Letter_Bashkir_Ka)
1610                (#\Cyrillic_Capital_Letter_En_With_Descender
1611                 . #\Cyrillic_Small_Letter_En_With_Descender)
1612                (#\Cyrillic_Capital_Ligature_En_Ghe . #\Cyrillic_Small_Ligature_En_Ghe)
1613                (#\Cyrillic_Capital_Letter_Pe_With_Middle_Hook
1614                 . #\Cyrillic_Small_Letter_Pe_With_Middle_Hook)
1615                (#\Cyrillic_Capital_Letter_Abkhasian_Ha
1616                 . #\Cyrillic_Small_Letter_Abkhasian_Ha)
1617                (#\Cyrillic_Capital_Letter_Es_With_Descender
1618                 . #\Cyrillic_Small_Letter_Es_With_Descender)
1619                (#\Cyrillic_Capital_Letter_Te_With_Descender
1620                 . #\Cyrillic_Small_Letter_Te_With_Descender)
1621                (#\Cyrillic_Capital_Letter_Straight_U . #\Cyrillic_Small_Letter_Straight_U)
1622                (#\Cyrillic_Capital_Letter_Straight_U_With_Stroke
1623                 . #\Cyrillic_Small_Letter_Straight_U_With_Stroke)
1624                (#\Cyrillic_Capital_Letter_Ha_With_Descender
1625                 . #\Cyrillic_Small_Letter_Ha_With_Descender)
1626                (#\Cyrillic_Capital_Ligature_Te_Tse . #\Cyrillic_Small_Ligature_Te_Tse)
1627                (#\Cyrillic_Capital_Letter_Che_With_Descender
1628                 . #\Cyrillic_Small_Letter_Che_With_Descender)
1629                (#\Cyrillic_Capital_Letter_Che_With_Vertical_Stroke
1630                 . #\Cyrillic_Small_Letter_Che_With_Vertical_Stroke)
1631                (#\Cyrillic_Capital_Letter_Shha . #\Cyrillic_Small_Letter_Shha)
1632                (#\Cyrillic_Capital_Letter_Abkhasian_Che
1633                 . #\Cyrillic_Small_Letter_Abkhasian_Che)
1634                (#\Cyrillic_Capital_Letter_Abkhasian_Che_With_Descender
1635                 . #\Cyrillic_Small_Letter_Abkhasian_Che_With_Descender)
1636                (#\Cyrillic_Letter_Palochka . #\Cyrillic_Small_Letter_Palochka)
1637                (#\Cyrillic_Capital_Letter_Zhe_With_Breve
1638                 . #\Cyrillic_Small_Letter_Zhe_With_Breve)
1639                (#\Cyrillic_Capital_Letter_Ka_With_Hook
1640                 . #\Cyrillic_Small_Letter_Ka_With_Hook)
1641                (#\Cyrillic_Capital_Letter_El_With_Tail
1642                 . #\Cyrillic_Small_Letter_El_With_Tail)
1643                (#\Cyrillic_Capital_Letter_En_With_Hook
1644                 . #\Cyrillic_Small_Letter_En_With_Hook)
1645                (#\Cyrillic_Capital_Letter_En_With_Tail
1646                 . #\Cyrillic_Small_Letter_En_With_Tail)
1647                (#\Cyrillic_Capital_Letter_Khakassian_Che
1648                 . #\Cyrillic_Small_Letter_Khakassian_Che)
1649                (#\Cyrillic_Capital_Letter_Em_With_Tail
1650                 . #\Cyrillic_Small_Letter_Em_With_Tail)
1651                (#\Cyrillic_Capital_Letter_A_With_Breve
1652                 . #\Cyrillic_Small_Letter_A_With_Breve)
1653                (#\Cyrillic_Capital_Letter_A_With_Diaeresis
1654                 . #\Cyrillic_Small_Letter_A_With_Diaeresis)
1655                (#\Cyrillic_Capital_Ligature_A_Ie . #\Cyrillic_Small_Ligature_A_Ie)
1656                (#\Cyrillic_Capital_Letter_Ie_With_Breve
1657                 . #\Cyrillic_Small_Letter_Ie_With_Breve)
1658                (#\Cyrillic_Capital_Letter_Schwa . #\Cyrillic_Small_Letter_Schwa)
1659                (#\Cyrillic_Capital_Letter_Schwa_With_Diaeresis
1660                 . #\Cyrillic_Small_Letter_Schwa_With_Diaeresis)
1661                (#\Cyrillic_Capital_Letter_Zhe_With_Diaeresis
1662                 . #\Cyrillic_Small_Letter_Zhe_With_Diaeresis)
1663                (#\Cyrillic_Capital_Letter_Ze_With_Diaeresis
1664                 . #\Cyrillic_Small_Letter_Ze_With_Diaeresis)
1665                (#\Cyrillic_Capital_Letter_Abkhasian_Dze
1666                 . #\Cyrillic_Small_Letter_Abkhasian_Dze)
1667                (#\Cyrillic_Capital_Letter_I_With_Macron
1668                 . #\Cyrillic_Small_Letter_I_With_Macron)
1669                (#\Cyrillic_Capital_Letter_I_With_Diaeresis
1670                 . #\Cyrillic_Small_Letter_I_With_Diaeresis)
1671                (#\Cyrillic_Capital_Letter_O_With_Diaeresis
1672                 . #\Cyrillic_Small_Letter_O_With_Diaeresis)
1673                (#\Cyrillic_Capital_Letter_Barred_O . #\Cyrillic_Small_Letter_Barred_O)
1674                (#\Cyrillic_Capital_Letter_Barred_O_With_Diaeresis
1675                 . #\Cyrillic_Small_Letter_Barred_O_With_Diaeresis)
1676                (#\Cyrillic_Capital_Letter_E_With_Diaeresis
1677                 . #\Cyrillic_Small_Letter_E_With_Diaeresis)
1678                (#\Cyrillic_Capital_Letter_U_With_Macron
1679                 . #\Cyrillic_Small_Letter_U_With_Macron)
1680                (#\Cyrillic_Capital_Letter_U_With_Diaeresis
1681                 . #\Cyrillic_Small_Letter_U_With_Diaeresis)
1682                (#\Cyrillic_Capital_Letter_U_With_Double_Acute
1683                 . #\Cyrillic_Small_Letter_U_With_Double_Acute)
1684                (#\Cyrillic_Capital_Letter_Che_With_Diaeresis
1685                 . #\Cyrillic_Small_Letter_Che_With_Diaeresis)
1686                (#\Cyrillic_Capital_Letter_Ghe_With_Descender
1687                 . #\Cyrillic_Small_Letter_Ghe_With_Descender)
1688                (#\Cyrillic_Capital_Letter_Yeru_With_Diaeresis
1689                 . #\Cyrillic_Small_Letter_Yeru_With_Diaeresis)
1690                (#\Cyrillic_Capital_Letter_Ghe_With_Stroke_And_Hook
1691                 . #\Cyrillic_Small_Letter_Ghe_With_Stroke_And_Hook)
1692                (#\Cyrillic_Capital_Letter_Ha_With_Hook
1693                 . #\Cyrillic_Small_Letter_Ha_With_Hook)
1694                (#\Cyrillic_Capital_Letter_Ha_With_Stroke
1695                 . #\Cyrillic_Small_Letter_Ha_With_Stroke)
1696                (#\Cyrillic_Capital_Letter_Komi_De . #\Cyrillic_Small_Letter_Komi_De)
1697                (#\Cyrillic_Capital_Letter_Komi_Dje . #\Cyrillic_Small_Letter_Komi_Dje)
1698                (#\Cyrillic_Capital_Letter_Komi_Zje . #\Cyrillic_Small_Letter_Komi_Zje)
1699                (#\Cyrillic_Capital_Letter_Komi_Dzje . #\Cyrillic_Small_Letter_Komi_Dzje)
1700                (#\Cyrillic_Capital_Letter_Komi_Lje . #\Cyrillic_Small_Letter_Komi_Lje)
1701                (#\Cyrillic_Capital_Letter_Komi_Nje . #\Cyrillic_Small_Letter_Komi_Nje)
1702                (#\Cyrillic_Capital_Letter_Komi_Sje . #\Cyrillic_Small_Letter_Komi_Sje)
1703                (#\Cyrillic_Capital_Letter_Komi_Tje . #\Cyrillic_Small_Letter_Komi_Tje)
1704                (#\Cyrillic_Capital_Letter_Reversed_Ze . #\Cyrillic_Small_Letter_Reversed_Ze)
1705                (#\Cyrillic_Capital_Letter_El_With_Hook
1706                 . #\Cyrillic_Small_Letter_El_With_Hook)
1707                (#\Armenian_Capital_Letter_Ayb . #\Armenian_Small_Letter_Ayb)
1708                (#\Armenian_Capital_Letter_Ben . #\Armenian_Small_Letter_Ben)
1709                (#\Armenian_Capital_Letter_Gim . #\Armenian_Small_Letter_Gim)
1710                (#\Armenian_Capital_Letter_Da . #\Armenian_Small_Letter_Da)
1711                (#\Armenian_Capital_Letter_Ech . #\Armenian_Small_Letter_Ech)
1712                (#\Armenian_Capital_Letter_Za . #\Armenian_Small_Letter_Za)
1713                (#\Armenian_Capital_Letter_Eh . #\Armenian_Small_Letter_Eh)
1714                (#\Armenian_Capital_Letter_Et . #\Armenian_Small_Letter_Et)
1715                (#\Armenian_Capital_Letter_To . #\Armenian_Small_Letter_To)
1716                (#\Armenian_Capital_Letter_Zhe . #\Armenian_Small_Letter_Zhe)
1717                (#\Armenian_Capital_Letter_Ini . #\Armenian_Small_Letter_Ini)
1718                (#\Armenian_Capital_Letter_Liwn . #\Armenian_Small_Letter_Liwn)
1719                (#\Armenian_Capital_Letter_Xeh . #\Armenian_Small_Letter_Xeh)
1720                (#\Armenian_Capital_Letter_Ca . #\Armenian_Small_Letter_Ca)
1721                (#\Armenian_Capital_Letter_Ken . #\Armenian_Small_Letter_Ken)
1722                (#\Armenian_Capital_Letter_Ho . #\Armenian_Small_Letter_Ho)
1723                (#\Armenian_Capital_Letter_Ja . #\Armenian_Small_Letter_Ja)
1724                (#\Armenian_Capital_Letter_Ghad . #\Armenian_Small_Letter_Ghad)
1725                (#\Armenian_Capital_Letter_Cheh . #\Armenian_Small_Letter_Cheh)
1726                (#\Armenian_Capital_Letter_Men . #\Armenian_Small_Letter_Men)
1727                (#\Armenian_Capital_Letter_Yi . #\Armenian_Small_Letter_Yi)
1728                (#\Armenian_Capital_Letter_Now . #\Armenian_Small_Letter_Now)
1729                (#\Armenian_Capital_Letter_Sha . #\Armenian_Small_Letter_Sha)
1730                (#\Armenian_Capital_Letter_Vo . #\Armenian_Small_Letter_Vo)
1731                (#\Armenian_Capital_Letter_Cha . #\Armenian_Small_Letter_Cha)
1732                (#\Armenian_Capital_Letter_Peh . #\Armenian_Small_Letter_Peh)
1733                (#\Armenian_Capital_Letter_Jheh . #\Armenian_Small_Letter_Jheh)
1734                (#\Armenian_Capital_Letter_Ra . #\Armenian_Small_Letter_Ra)
1735                (#\Armenian_Capital_Letter_Seh . #\Armenian_Small_Letter_Seh)
1736                (#\Armenian_Capital_Letter_Vew . #\Armenian_Small_Letter_Vew)
1737                (#\Armenian_Capital_Letter_Tiwn . #\Armenian_Small_Letter_Tiwn)
1738                (#\Armenian_Capital_Letter_Reh . #\Armenian_Small_Letter_Reh)
1739                (#\Armenian_Capital_Letter_Co . #\Armenian_Small_Letter_Co)
1740                (#\Armenian_Capital_Letter_Yiwn . #\Armenian_Small_Letter_Yiwn)
1741                (#\Armenian_Capital_Letter_Piwr . #\Armenian_Small_Letter_Piwr)
1742                (#\Armenian_Capital_Letter_Keh . #\Armenian_Small_Letter_Keh)
1743                (#\Armenian_Capital_Letter_Oh . #\Armenian_Small_Letter_Oh)
1744                (#\Armenian_Capital_Letter_Feh . #\Armenian_Small_Letter_Feh)
1745                (#\U+10A0 . #\U+2D00) (#\U+10A1 . #\U+2D01) (#\U+10A2 . #\U+2D02)
1746                (#\U+10A3 . #\U+2D03) (#\U+10A4 . #\U+2D04) (#\U+10A5 . #\U+2D05)
1747                (#\U+10A6 . #\U+2D06) (#\U+10A7 . #\U+2D07) (#\U+10A8 . #\U+2D08)
1748                (#\U+10A9 . #\U+2D09) (#\U+10AA . #\U+2D0A) (#\U+10AB . #\U+2D0B)
1749                (#\U+10AC . #\U+2D0C) (#\U+10AD . #\U+2D0D) (#\U+10AE . #\U+2D0E)
1750                (#\U+10AF . #\U+2D0F) (#\U+10B0 . #\U+2D10) (#\U+10B1 . #\U+2D11)
1751                (#\U+10B2 . #\U+2D12) (#\U+10B3 . #\U+2D13) (#\U+10B4 . #\U+2D14)
1752                (#\U+10B5 . #\U+2D15) (#\U+10B6 . #\U+2D16) (#\U+10B7 . #\U+2D17)
1753                (#\U+10B8 . #\U+2D18) (#\U+10B9 . #\U+2D19) (#\U+10BA . #\U+2D1A)
1754                (#\U+10BB . #\U+2D1B) (#\U+10BC . #\U+2D1C) (#\U+10BD . #\U+2D1D)
1755                (#\U+10BE . #\U+2D1E) (#\U+10BF . #\U+2D1F) (#\U+10C0 . #\U+2D20)
1756                (#\U+10C1 . #\U+2D21) (#\U+10C2 . #\U+2D22) (#\U+10C3 . #\U+2D23)
1757                (#\U+10C4 . #\U+2D24) (#\U+10C5 . #\U+2D25) (#\U+1E00 . #\U+1E01)
1758                (#\U+1E02 . #\U+1E03) (#\U+1E04 . #\U+1E05) (#\U+1E06 . #\U+1E07)
1759                (#\U+1E08 . #\U+1E09) (#\U+1E0A . #\U+1E0B) (#\U+1E0C . #\U+1E0D)
1760                (#\U+1E0E . #\U+1E0F) (#\U+1E10 . #\U+1E11) (#\U+1E12 . #\U+1E13)
1761                (#\U+1E14 . #\U+1E15) (#\U+1E16 . #\U+1E17) (#\U+1E18 . #\U+1E19)
1762                (#\U+1E1A . #\U+1E1B) (#\U+1E1C . #\U+1E1D) (#\U+1E1E . #\U+1E1F)
1763                (#\U+1E20 . #\U+1E21) (#\U+1E22 . #\U+1E23) (#\U+1E24 . #\U+1E25)
1764                (#\U+1E26 . #\U+1E27) (#\U+1E28 . #\U+1E29) (#\U+1E2A . #\U+1E2B)
1765                (#\U+1E2C . #\U+1E2D) (#\U+1E2E . #\U+1E2F) (#\U+1E30 . #\U+1E31)
1766                (#\U+1E32 . #\U+1E33) (#\U+1E34 . #\U+1E35) (#\U+1E36 . #\U+1E37)
1767                (#\U+1E38 . #\U+1E39) (#\U+1E3A . #\U+1E3B) (#\U+1E3C . #\U+1E3D)
1768                (#\U+1E3E . #\U+1E3F) (#\U+1E40 . #\U+1E41) (#\U+1E42 . #\U+1E43)
1769                (#\U+1E44 . #\U+1E45) (#\U+1E46 . #\U+1E47) (#\U+1E48 . #\U+1E49)
1770                (#\U+1E4A . #\U+1E4B) (#\U+1E4C . #\U+1E4D) (#\U+1E4E . #\U+1E4F)
1771                (#\U+1E50 . #\U+1E51) (#\U+1E52 . #\U+1E53) (#\U+1E54 . #\U+1E55)
1772                (#\U+1E56 . #\U+1E57) (#\U+1E58 . #\U+1E59) (#\U+1E5A . #\U+1E5B)
1773                (#\U+1E5C . #\U+1E5D) (#\U+1E5E . #\U+1E5F) (#\U+1E60 . #\U+1E61)
1774                (#\U+1E62 . #\U+1E63) (#\U+1E64 . #\U+1E65) (#\U+1E66 . #\U+1E67)
1775                (#\U+1E68 . #\U+1E69) (#\U+1E6A . #\U+1E6B) (#\U+1E6C . #\U+1E6D)
1776                (#\U+1E6E . #\U+1E6F) (#\U+1E70 . #\U+1E71) (#\U+1E72 . #\U+1E73)
1777                (#\U+1E74 . #\U+1E75) (#\U+1E76 . #\U+1E77) (#\U+1E78 . #\U+1E79)
1778                (#\U+1E7A . #\U+1E7B) (#\U+1E7C . #\U+1E7D) (#\U+1E7E . #\U+1E7F)
1779                (#\U+1E80 . #\U+1E81) (#\U+1E82 . #\U+1E83) (#\U+1E84 . #\U+1E85)
1780                (#\U+1E86 . #\U+1E87) (#\U+1E88 . #\U+1E89) (#\U+1E8A . #\U+1E8B)
1781                (#\U+1E8C . #\U+1E8D) (#\U+1E8E . #\U+1E8F) (#\U+1E90 . #\U+1E91)
1782                (#\U+1E92 . #\U+1E93) (#\U+1E94 . #\U+1E95) (#\U+1EA0 . #\U+1EA1)
1783                (#\U+1EA2 . #\U+1EA3) (#\U+1EA4 . #\U+1EA5) (#\U+1EA6 . #\U+1EA7)
1784                (#\U+1EA8 . #\U+1EA9) (#\U+1EAA . #\U+1EAB) (#\U+1EAC . #\U+1EAD)
1785                (#\U+1EAE . #\U+1EAF) (#\U+1EB0 . #\U+1EB1) (#\U+1EB2 . #\U+1EB3)
1786                (#\U+1EB4 . #\U+1EB5) (#\U+1EB6 . #\U+1EB7) (#\U+1EB8 . #\U+1EB9)
1787                (#\U+1EBA . #\U+1EBB) (#\U+1EBC . #\U+1EBD) (#\U+1EBE . #\U+1EBF)
1788                (#\U+1EC0 . #\U+1EC1) (#\U+1EC2 . #\U+1EC3) (#\U+1EC4 . #\U+1EC5)
1789                (#\U+1EC6 . #\U+1EC7) (#\U+1EC8 . #\U+1EC9) (#\U+1ECA . #\U+1ECB)
1790                (#\U+1ECC . #\U+1ECD) (#\U+1ECE . #\U+1ECF) (#\U+1ED0 . #\U+1ED1)
1791                (#\U+1ED2 . #\U+1ED3) (#\U+1ED4 . #\U+1ED5) (#\U+1ED6 . #\U+1ED7)
1792                (#\U+1ED8 . #\U+1ED9) (#\U+1EDA . #\U+1EDB) (#\U+1EDC . #\U+1EDD)
1793                (#\U+1EDE . #\U+1EDF) (#\U+1EE0 . #\U+1EE1) (#\U+1EE2 . #\U+1EE3)
1794                (#\U+1EE4 . #\U+1EE5) (#\U+1EE6 . #\U+1EE7) (#\U+1EE8 . #\U+1EE9)
1795                (#\U+1EEA . #\U+1EEB) (#\U+1EEC . #\U+1EED) (#\U+1EEE . #\U+1EEF)
1796                (#\U+1EF0 . #\U+1EF1) (#\U+1EF2 . #\U+1EF3) (#\U+1EF4 . #\U+1EF5)
1797                (#\U+1EF6 . #\U+1EF7) (#\U+1EF8 . #\U+1EF9) (#\U+1F08 . #\U+1F00)
1798                (#\U+1F09 . #\U+1F01) (#\U+1F0A . #\U+1F02) (#\U+1F0B . #\U+1F03)
1799                (#\U+1F0C . #\U+1F04) (#\U+1F0D . #\U+1F05) (#\U+1F0E . #\U+1F06)
1800                (#\U+1F0F . #\U+1F07) (#\U+1F18 . #\U+1F10) (#\U+1F19 . #\U+1F11)
1801                (#\U+1F1A . #\U+1F12) (#\U+1F1B . #\U+1F13) (#\U+1F1C . #\U+1F14)
1802                (#\U+1F1D . #\U+1F15) (#\U+1F28 . #\U+1F20) (#\U+1F29 . #\U+1F21)
1803                (#\U+1F2A . #\U+1F22) (#\U+1F2B . #\U+1F23) (#\U+1F2C . #\U+1F24)
1804                (#\U+1F2D . #\U+1F25) (#\U+1F2E . #\U+1F26) (#\U+1F2F . #\U+1F27)
1805                (#\U+1F38 . #\U+1F30) (#\U+1F39 . #\U+1F31) (#\U+1F3A . #\U+1F32)
1806                (#\U+1F3B . #\U+1F33) (#\U+1F3C . #\U+1F34) (#\U+1F3D . #\U+1F35)
1807                (#\U+1F3E . #\U+1F36) (#\U+1F3F . #\U+1F37) (#\U+1F48 . #\U+1F40)
1808                (#\U+1F49 . #\U+1F41) (#\U+1F4A . #\U+1F42) (#\U+1F4B . #\U+1F43)
1809                (#\U+1F4C . #\U+1F44) (#\U+1F4D . #\U+1F45) (#\U+1F59 . #\U+1F51)
1810                (#\U+1F5B . #\U+1F53) (#\U+1F5D . #\U+1F55) (#\U+1F5F . #\U+1F57)
1811                (#\U+1F68 . #\U+1F60) (#\U+1F69 . #\U+1F61) (#\U+1F6A . #\U+1F62)
1812                (#\U+1F6B . #\U+1F63) (#\U+1F6C . #\U+1F64) (#\U+1F6D . #\U+1F65)
1813                (#\U+1F6E . #\U+1F66) (#\U+1F6F . #\U+1F67) (#\U+1F88 . #\U+1F80)
1814                (#\U+1F89 . #\U+1F81) (#\U+1F8A . #\U+1F82) (#\U+1F8B . #\U+1F83)
1815                (#\U+1F8C . #\U+1F84) (#\U+1F8D . #\U+1F85) (#\U+1F8E . #\U+1F86)
1816                (#\U+1F8F . #\U+1F87) (#\U+1F98 . #\U+1F90) (#\U+1F99 . #\U+1F91)
1817                (#\U+1F9A . #\U+1F92) (#\U+1F9B . #\U+1F93) (#\U+1F9C . #\U+1F94)
1818                (#\U+1F9D . #\U+1F95) (#\U+1F9E . #\U+1F96) (#\U+1F9F . #\U+1F97)
1819                (#\U+1FA8 . #\U+1FA0) (#\U+1FA9 . #\U+1FA1) (#\U+1FAA . #\U+1FA2)
1820                (#\U+1FAB . #\U+1FA3) (#\U+1FAC . #\U+1FA4) (#\U+1FAD . #\U+1FA5)
1821                (#\U+1FAE . #\U+1FA6) (#\U+1FAF . #\U+1FA7) (#\U+1FB8 . #\U+1FB0)
1822                (#\U+1FB9 . #\U+1FB1) (#\U+1FBA . #\U+1F70) (#\U+1FBB . #\U+1F71)
1823                (#\U+1FBC . #\U+1FB3) (#\U+1FC8 . #\U+1F72) (#\U+1FC9 . #\U+1F73)
1824                (#\U+1FCA . #\U+1F74) (#\U+1FCB . #\U+1F75) (#\U+1FCC . #\U+1FC3)
1825                (#\U+1FD8 . #\U+1FD0) (#\U+1FD9 . #\U+1FD1) (#\U+1FDA . #\U+1F76)
1826                (#\U+1FDB . #\U+1F77) (#\U+1FE8 . #\U+1FE0) (#\U+1FE9 . #\U+1FE1)
1827                (#\U+1FEA . #\U+1F7A) (#\U+1FEB . #\U+1F7B) (#\U+1FEC . #\U+1FE5)
1828                (#\U+1FF8 . #\U+1F78) (#\U+1FF9 . #\U+1F79) (#\U+1FFA . #\U+1F7C)
1829                (#\U+1FFB . #\U+1F7D) (#\U+1FFC . #\U+1FF3) (#\U+2132 . #\U+214E)
1830                (#\U+2160 . #\U+2170) (#\U+2161 . #\U+2171) (#\U+2162 . #\U+2172)
1831                (#\U+2163 . #\U+2173) (#\U+2164 . #\U+2174) (#\U+2165 . #\U+2175)
1832                (#\U+2166 . #\U+2176) (#\U+2167 . #\U+2177) (#\U+2168 . #\U+2178)
1833                (#\U+2169 . #\U+2179) (#\U+216A . #\U+217A) (#\U+216B . #\U+217B)
1834                (#\U+216C . #\U+217C) (#\U+216D . #\U+217D) (#\U+216E . #\U+217E)
1835                (#\U+216F . #\U+217F) (#\U+2183 . #\U+2184) (#\U+24B6 . #\U+24D0)
1836                (#\U+24B7 . #\U+24D1) (#\U+24B8 . #\U+24D2) (#\U+24B9 . #\U+24D3)
1837                (#\U+24BA . #\U+24D4) (#\U+24BB . #\U+24D5) (#\U+24BC . #\U+24D6)
1838                (#\U+24BD . #\U+24D7) (#\U+24BE . #\U+24D8) (#\U+24BF . #\U+24D9)
1839                (#\U+24C0 . #\U+24DA) (#\U+24C1 . #\U+24DB) (#\U+24C2 . #\U+24DC)
1840                (#\U+24C3 . #\U+24DD) (#\U+24C4 . #\U+24DE) (#\U+24C5 . #\U+24DF)
1841                (#\U+24C6 . #\U+24E0) (#\U+24C7 . #\U+24E1) (#\U+24C8 . #\U+24E2)
1842                (#\U+24C9 . #\U+24E3) (#\U+24CA . #\U+24E4) (#\U+24CB . #\U+24E5)
1843                (#\U+24CC . #\U+24E6) (#\U+24CD . #\U+24E7) (#\U+24CE . #\U+24E8)
1844                (#\U+24CF . #\U+24E9) (#\U+2C00 . #\U+2C30) (#\U+2C01 . #\U+2C31)
1845                (#\U+2C02 . #\U+2C32) (#\U+2C03 . #\U+2C33) (#\U+2C04 . #\U+2C34)
1846                (#\U+2C05 . #\U+2C35) (#\U+2C06 . #\U+2C36) (#\U+2C07 . #\U+2C37)
1847                (#\U+2C08 . #\U+2C38) (#\U+2C09 . #\U+2C39) (#\U+2C0A . #\U+2C3A)
1848                (#\U+2C0B . #\U+2C3B) (#\U+2C0C . #\U+2C3C) (#\U+2C0D . #\U+2C3D)
1849                (#\U+2C0E . #\U+2C3E) (#\U+2C0F . #\U+2C3F) (#\U+2C10 . #\U+2C40)
1850                (#\U+2C11 . #\U+2C41) (#\U+2C12 . #\U+2C42) (#\U+2C13 . #\U+2C43)
1851                (#\U+2C14 . #\U+2C44) (#\U+2C15 . #\U+2C45) (#\U+2C16 . #\U+2C46)
1852                (#\U+2C17 . #\U+2C47) (#\U+2C18 . #\U+2C48) (#\U+2C19 . #\U+2C49)
1853                (#\U+2C1A . #\U+2C4A) (#\U+2C1B . #\U+2C4B) (#\U+2C1C . #\U+2C4C)
1854                (#\U+2C1D . #\U+2C4D) (#\U+2C1E . #\U+2C4E) (#\U+2C1F . #\U+2C4F)
1855                (#\U+2C20 . #\U+2C50) (#\U+2C21 . #\U+2C51) (#\U+2C22 . #\U+2C52)
1856                (#\U+2C23 . #\U+2C53) (#\U+2C24 . #\U+2C54) (#\U+2C25 . #\U+2C55)
1857                (#\U+2C26 . #\U+2C56) (#\U+2C27 . #\U+2C57) (#\U+2C28 . #\U+2C58)
1858                (#\U+2C29 . #\U+2C59) (#\U+2C2A . #\U+2C5A) (#\U+2C2B . #\U+2C5B)
1859                (#\U+2C2C . #\U+2C5C) (#\U+2C2D . #\U+2C5D) (#\U+2C2E . #\U+2C5E)
1860                (#\U+2C60 . #\U+2C61) (#\U+2C62 . #\Latin_Small_Letter_L_With_Middle_Tilde)
1861                (#\U+2C63 . #\U+1D7D) (#\U+2C64 . #\Latin_Small_Letter_R_With_Tail)
1862                (#\U+2C67 . #\U+2C68) (#\U+2C69 . #\U+2C6A) (#\U+2C6B . #\U+2C6C)
1863                (#\U+2C75 . #\U+2C76) (#\U+2C80 . #\U+2C81) (#\U+2C82 . #\U+2C83)
1864                (#\U+2C84 . #\U+2C85) (#\U+2C86 . #\U+2C87) (#\U+2C88 . #\U+2C89)
1865                (#\U+2C8A . #\U+2C8B) (#\U+2C8C . #\U+2C8D) (#\U+2C8E . #\U+2C8F)
1866                (#\U+2C90 . #\U+2C91) (#\U+2C92 . #\U+2C93) (#\U+2C94 . #\U+2C95)
1867                (#\U+2C96 . #\U+2C97) (#\U+2C98 . #\U+2C99) (#\U+2C9A . #\U+2C9B)
1868                (#\U+2C9C . #\U+2C9D) (#\U+2C9E . #\U+2C9F) (#\U+2CA0 . #\U+2CA1)
1869                (#\U+2CA2 . #\U+2CA3) (#\U+2CA4 . #\U+2CA5) (#\U+2CA6 . #\U+2CA7)
1870                (#\U+2CA8 . #\U+2CA9) (#\U+2CAA . #\U+2CAB) (#\U+2CAC . #\U+2CAD)
1871                (#\U+2CAE . #\U+2CAF) (#\U+2CB0 . #\U+2CB1) (#\U+2CB2 . #\U+2CB3)
1872                (#\U+2CB4 . #\U+2CB5) (#\U+2CB6 . #\U+2CB7) (#\U+2CB8 . #\U+2CB9)
1873                (#\U+2CBA . #\U+2CBB) (#\U+2CBC . #\U+2CBD) (#\U+2CBE . #\U+2CBF)
1874                (#\U+2CC0 . #\U+2CC1) (#\U+2CC2 . #\U+2CC3) (#\U+2CC4 . #\U+2CC5)
1875                (#\U+2CC6 . #\U+2CC7) (#\U+2CC8 . #\U+2CC9) (#\U+2CCA . #\U+2CCB)
1876                (#\U+2CCC . #\U+2CCD) (#\U+2CCE . #\U+2CCF) (#\U+2CD0 . #\U+2CD1)
1877                (#\U+2CD2 . #\U+2CD3) (#\U+2CD4 . #\U+2CD5) (#\U+2CD6 . #\U+2CD7)
1878                (#\U+2CD8 . #\U+2CD9) (#\U+2CDA . #\U+2CDB) (#\U+2CDC . #\U+2CDD)
1879                (#\U+2CDE . #\U+2CDF) (#\U+2CE0 . #\U+2CE1) (#\U+2CE2 . #\U+2CE3)
1880                (#\U+FF21 . #\U+FF41) (#\U+FF22 . #\U+FF42) (#\U+FF23 . #\U+FF43)
1881                (#\U+FF24 . #\U+FF44) (#\U+FF25 . #\U+FF45) (#\U+FF26 . #\U+FF46)
1882                (#\U+FF27 . #\U+FF47) (#\U+FF28 . #\U+FF48) (#\U+FF29 . #\U+FF49)
1883                (#\U+FF2A . #\U+FF4A) (#\U+FF2B . #\U+FF4B) (#\U+FF2C . #\U+FF4C)
1884                (#\U+FF2D . #\U+FF4D) (#\U+FF2E . #\U+FF4E) (#\U+FF2F . #\U+FF4F)
1885                (#\U+FF30 . #\U+FF50) (#\U+FF31 . #\U+FF51) (#\U+FF32 . #\U+FF52)
1886                (#\U+FF33 . #\U+FF53) (#\U+FF34 . #\U+FF54) (#\U+FF35 . #\U+FF55)
1887                (#\U+FF36 . #\U+FF56) (#\U+FF37 . #\U+FF57) (#\U+FF38 . #\U+FF58)
1888                (#\U+FF39 . #\U+FF59) (#\U+FF3A . #\U+FF5A) (#\U+10400 . #\U+10428)
1889                (#\U+10401 . #\U+10429) (#\U+10402 . #\U+1042A) (#\U+10403 . #\U+1042B)
1890                (#\U+10404 . #\U+1042C) (#\U+10405 . #\U+1042D) (#\U+10406 . #\U+1042E)
1891                (#\U+10407 . #\U+1042F) (#\U+10408 . #\U+10430) (#\U+10409 . #\U+10431)
1892                (#\U+1040A . #\U+10432) (#\U+1040B . #\U+10433) (#\U+1040C . #\U+10434)
1893                (#\U+1040D . #\U+10435) (#\U+1040E . #\U+10436) (#\U+1040F . #\U+10437)
1894                (#\U+10410 . #\U+10438) (#\U+10411 . #\U+10439) (#\U+10412 . #\U+1043A)
1895                (#\U+10413 . #\U+1043B) (#\U+10414 . #\U+1043C) (#\U+10415 . #\U+1043D)
1896                (#\U+10416 . #\U+1043E) (#\U+10417 . #\U+1043F) (#\U+10418 . #\U+10440)
1897                (#\U+10419 . #\U+10441) (#\U+1041A . #\U+10442) (#\U+1041B . #\U+10443)
1898                (#\U+1041C . #\U+10444) (#\U+1041D . #\U+10445) (#\U+1041E . #\U+10446)
1899                (#\U+1041F . #\U+10447) (#\U+10420 . #\U+10448) (#\U+10421 . #\U+10449)
1900                (#\U+10422 . #\U+1044A) (#\U+10423 . #\U+1044B) (#\U+10424 . #\U+1044C)
1901                (#\U+10425 . #\U+1044D) (#\U+10426 . #\U+1044E) (#\U+10427 . #\U+1044F)))
1902  (destructuring-bind (upper . lower) pair
1903    (setf (gethash upper *non-standard-upper-to-lower*) lower
1904          (gethash lower *non-standard-lower-to-upper*) upper)))
1905
1906(assert-hash-table-readonly *non-standard-upper-to-lower*)
1907(assert-hash-table-readonly *non-standard-lower-to-upper*)
1908
1909(defun %non-standard-upper-case-equivalent (char)
1910  (gethash char *non-standard-lower-to-upper*))
1911
1912;;;True for a-z, and maybe other things.
1913(defun lower-case-p (c)
1914  "The argument must be a character object; LOWER-CASE-P returns T if the
1915   argument is a lower-case character, NIL otherwise."
1916  (let ((code (char-code c)))
1917    (if (< code #x80)
1918      (and (>= code (char-code #\a))
1919           (<= code (char-code #\z)))
1920     (not (null (%non-standard-upper-case-equivalent c))))))
1921
1922
1923;;;True for a-z A-Z, others.
1924
1925
1926(defun alpha-char-p (c)
1927  "The argument must be a character object. ALPHA-CHAR-P returns T if the
1928   argument is an alphabetic character; otherwise NIL."
1929  (let* ((code (char-code c)))
1930    (declare (fixnum code))
1931    (or (and (>= code (char-code #\A)) (<= code (char-code #\Z)))
1932        (and (>= code (char-code #\a)) (<= code (char-code #\z)))
1933        (and (>= code #x80)
1934             (or (not (null (%non-standard-upper-case-equivalent c)))
1935                 (not (null (%non-standard-lower-case-equivalent c))))))))
1936
1937
1938
1939
1940;;; def-accessors type-tracking stuff.  Used by inspector
1941(defvar *def-accessor-types* nil)
1942
1943(defun add-accessor-types (types names)
1944  (dolist (type types)
1945    (let ((cell (or (assq type *def-accessor-types*)
1946                    (car (push (cons type nil) *def-accessor-types*)))))
1947      (setf (cdr cell) (if (vectorp names) names (%list-to-uvector nil names))))))
1948
1949
1950;;; Some simple explicit storage management for cons cells
1951
1952(def-standard-initial-binding *cons-pool* (%cons-pool nil))
1953
1954(defun cheap-cons (car cdr)
1955  (let* ((pool *cons-pool*)
1956         (cons (pool.data pool)))
1957    (if cons
1958      (locally (declare (type cons cons))
1959        (setf (pool.data pool) (cdr cons)
1960              (car cons) car
1961              (cdr cons) cdr)
1962        cons)
1963      (cons car cdr))))
1964
1965(defun free-cons (cons)
1966  (when (consp cons)
1967    (locally (declare (type cons cons))
1968      (setf (car cons) nil
1969            (cdr cons) nil)
1970      (let* ((pool *cons-pool*)
1971             (freelist (pool.data pool)))
1972        (setf (pool.data pool) cons
1973              (cdr cons) freelist)))))
1974
1975(defun cheap-copy-list (list)
1976  (let ((l list)
1977        res)
1978    (loop
1979      (when (atom l)
1980        (return (nreconc res l)))
1981      (setq res (cheap-cons (pop l) res)))))
1982
1983(defun cheap-list (&rest args)
1984  (declare (dynamic-extent args))
1985  (cheap-copy-list args))
1986
1987;;; Works for dotted lists
1988(defun cheap-free-list (list)
1989  (let ((l list)
1990        next-l)
1991    (loop
1992      (setq next-l (cdr l))
1993      (free-cons l)
1994      (when (atom (setq l next-l))
1995        (return)))))
1996
1997(defmacro pop-and-free (place)
1998  (setq place (require-type place 'symbol))     ; all I need for now.
1999  (let ((list (gensym))
2000        (cdr (gensym)))
2001    `(let* ((,list ,place)
2002            (,cdr (cdr ,list)))
2003       (prog1
2004         (car ,list)
2005         (setf ,place ,cdr)
2006         (free-cons ,list)))))
2007
2008;;; Support for defresource & using-resource macros
2009(defun make-resource (constructor &key destructor initializer)
2010  (%cons-resource constructor destructor initializer))
2011
2012(defun allocate-resource (resource)
2013  (setq resource (require-type resource 'resource))
2014  (with-lock-grabbed ((resource.lock resource))
2015    (let ((pool (resource.pool resource))
2016          res)
2017      (let ((data (pool.data pool)))
2018        (when data
2019          (setf res (car data)
2020                (pool.data pool) (cdr (the cons data)))
2021          (free-cons data)))
2022      (if res
2023        (let ((initializer (resource.initializer resource)))
2024          (when initializer
2025            (funcall initializer res)))
2026        (setq res (funcall (resource.constructor resource))))
2027      res)))
2028
2029(defun free-resource (resource instance)
2030  (setq resource (require-type resource 'resource))
2031  (with-lock-grabbed ((resource.lock resource))
2032    (let ((pool (resource.pool resource))
2033          (destructor (resource.destructor resource)))
2034      (when destructor
2035        (funcall destructor instance))
2036      (setf (pool.data pool)
2037            (cheap-cons instance (pool.data pool)))))
2038  resource)
2039
2040
2041
2042
2043(defpackage #.(ftd-interface-package-name
2044               (backend-target-foreign-type-data *target-backend*))
2045  (:nicknames "OS")
2046  (:use "COMMON-LISP"))
2047
2048
2049
Note: See TracBrowser for help on using the repository browser.