Raymond Toy pushed to branch issue-158-darwin-pathnames at cmucl / cmucl
Commits:
-
be398f1a
by Raymond Toy at 2022-12-21T10:17:05-08:00
-
856f9a9f
by Raymond Toy at 2022-12-21T10:21:08-08:00
4 changed files:
Changes:
... | ... | @@ -252,7 +252,12 @@ |
252 | 252 | ;;; This constructor is used to make an instance of the correct type
|
253 | 253 | ;;; from parsed arguments.
|
254 | 254 | |
255 | -(defvar *enable-normalization* nil)
|
|
255 | +(defvar *enable-darwin-path-normalization* nil
|
|
256 | + "When non-NIL, pathnames are on Darwin are normalized when created.
|
|
257 | + Otherwise, the pathnames are unchanged.
|
|
258 | + |
|
259 | + This must be NIL during bootstrapping because Unicode is not yet
|
|
260 | + available.")
|
|
256 | 261 | |
257 | 262 | (defun normalize-name (piece)
|
258 | 263 | ;; Normalize Darwin pathnames by converting Hangul
|
... | ... | @@ -261,7 +266,7 @@ |
261 | 266 | ;; characters.
|
262 | 267 | (typecase piece
|
263 | 268 | (string
|
264 | - (if *enable-normalization*
|
|
269 | + (if *enable-darwin-path-normalization*
|
|
265 | 270 | (decompose (unicode::decompose-hangul piece)
|
266 | 271 | :compatibility nil
|
267 | 272 | :darwinp t)
|
... | ... | @@ -289,16 +294,29 @@ |
289 | 294 | (upcasify name)
|
290 | 295 | (upcasify type)
|
291 | 296 | (upcasify version)))
|
292 | - #-(not nil)
|
|
297 | + #-darwin
|
|
293 | 298 | (%make-pathname host device directory name type version)
|
294 | - #+(not nil)
|
|
295 | - (%make-pathname host device
|
|
296 | - (when directory
|
|
297 | - (list* (car directory)
|
|
298 | - (mapcar #'normalize-name (cdr directory))))
|
|
299 | - (normalize-name name)
|
|
300 | - (normalize-name type)
|
|
301 | - version))))
|
|
299 | + #+darwin
|
|
300 | + (flet ((normalize-name (piece)
|
|
301 | + ;; Normalize Darwin pathnames by converting Hangul
|
|
302 | + ;; syllables to conjoining jamo, and converting the
|
|
303 | + ;; string to NFD form, but skipping over a range of
|
|
304 | + ;; characters.
|
|
305 | + (typecase piece
|
|
306 | + (string
|
|
307 | + (if *enable-darwin-path-normalization*
|
|
308 | + (decompose (unicode::decompose-hangul piece)
|
|
309 | + :compatibility nil
|
|
310 | + :darwinp t)
|
|
311 | + piece))
|
|
312 | + (t
|
|
313 | + ;; What should we do about lisp::pattern objects?
|
|
314 | + piece))))
|
|
315 | + (%make-pathname host device
|
|
316 | + (mapcar #'normalize-name (cdr directory))
|
|
317 | + (normalize-name name)
|
|
318 | + (normalize-name type)
|
|
319 | + version))))
|
|
302 | 320 | |
303 | 321 | ;;; *LOGICAL-HOSTS* --internal.
|
304 | 322 | ;;;
|
... | ... | @@ -284,16 +284,17 @@ |
284 | 284 | (set-up-locale-external-format)
|
285 | 285 | ;; Set terminal encodings to :locale
|
286 | 286 | (set-system-external-format :locale)
|
287 | - ;; Get some unicode stuff needed for decomposing strings.
|
|
288 | - ;; This is needed on Darwin to normalize pathname
|
|
289 | - ;; objects, which needs this information. If we don't,
|
|
290 | - ;; we'll load the information at runtime when creating
|
|
291 | - ;; the path to "unidata.dat", which then calls decompose
|
|
292 | - ;; again, and so on.
|
|
287 | + #+darwin
|
|
293 | 288 | (progn
|
289 | + ;; Get some unicode stuff needed for decomposing strings.
|
|
290 | + ;; This is needed on Darwin to normalize pathname
|
|
291 | + ;; objects, which needs this information. If we don't,
|
|
292 | + ;; we'll load the information at runtime when creating
|
|
293 | + ;; the path to "unidata.dat", which then calls decompose
|
|
294 | + ;; again, and so on.
|
|
294 | 295 | (lisp::load-decomp)
|
295 | 296 | (lisp::load-combining)
|
296 | - (setf *enable-normalization* t))
|
|
297 | + (setf *enable-darwin-path-normalization* t))
|
|
297 | 298 | (ext::process-command-strings process-command-line)
|
298 | 299 | (setf *editor-lisp-p* nil)
|
299 | 300 | (macrolet ((find-switch (name)
|
... | ... | @@ -527,18 +527,19 @@ |
527 | 527 | (l-base #x1100)
|
528 | 528 | (v-base #x1161)
|
529 | 529 | (t-base #x11a7)
|
530 | - (s-count 11172)
|
|
531 | - (l-count 19)
|
|
532 | 530 | (v-count 21)
|
533 | 531 | (t-count 28)
|
534 | 532 | (n-count (* v-count t-count)))
|
535 | 533 | ;; Step 1: Compute index of the syllable S
|
536 | 534 | (let ((s-index (- cp s-base)))
|
537 | - ;; Step 2: If s is in the range 0 <= s <= s-count, the compute the components
|
|
535 | + ;; Step 2: If s is in the range 0 <= s <= s-count, the compute
|
|
536 | + ;; the components.
|
|
538 | 537 | (let ((l (+ l-base (truncate s-index n-count)))
|
539 | 538 | (v (+ v-base (truncate (mod s-index n-count) t-count)))
|
540 | 539 | (tt (+ t-base (mod s-index t-count))))
|
541 | - ;; Step 3: If tt = t-base, then there is no trailing character so replace s by the sequence <l,v>. Otherwise there is a trailing character, so replace s by the sequence <l,v,tt>
|
|
540 | + ;; Step 3: If tt = t-base, then there is no trailing character
|
|
541 | + ;; so replace s by the sequence <l,v>. Otherwise there is a
|
|
542 | + ;; trailing character, so replace s by the sequence <l,v,tt>.
|
|
542 | 543 | (princ (code-char l) stream)
|
543 | 544 | (princ (code-char v) stream)
|
544 | 545 | (unless (= tt t-base)
|
... | ... | @@ -513,12 +513,11 @@ |
513 | 513 | (read-vector lvec stm :endian-swap :network-order)
|
514 | 514 | (values split hvec mvec lvec))))
|
515 | 515 | (declare (ignorable #'read16 #'read32 #'read-ntrie))
|
516 | - (let (#+nil(lisp::*enable-normalization* nil))
|
|
517 | - (with-open-file (,stm *unidata-path* :direction :input
|
|
518 | - :element-type '(unsigned-byte 8))
|
|
519 | - (unless (unidata-locate ,stm ,locn)
|
|
520 | - (error (intl:gettext "No data in file.")))
|
|
521 | - ,@body))))))
|
|
516 | + (with-open-file (,stm *unidata-path* :direction :input
|
|
517 | + :element-type '(unsigned-byte 8))
|
|
518 | + (unless (unidata-locate ,stm ,locn)
|
|
519 | + (error (intl:gettext "No data in file.")))
|
|
520 | + ,@body)))))
|
|
522 | 521 | |
523 | 522 | (defloader load-range (stm 0)
|
524 | 523 | (let* ((n (read32 stm))
|