GitLab

at 2022-12-21T09:35:37-08:00

Fix bootstrap issues in pathname normalization for Darwin

We create a pathname in `filesys-init` during loading of the
kernel.core.  Unicode isn't ready at this time, so we can't do
pathname normalization yet.

Add `*enable-normalization*` to control this.  Defaults to `NIL` and
gets set to `T` in the initial-function.

This also requires that we load up the Unicode decomp and combining
tables before setting `*enable-normalization*` to `T`.

For testing, this is enabled on Linux where I do my development.
We'll have to reorder this when this is working.

@@ -308,7 +308,8 @@
  ;;; in Unwind-Protects will get executed.
  (declaim (special *lisp-initialization-functions*
 -		  *load-time-values*))
 +		  *load-time-values*
 +		  *enable-normalization*))
  (eval-when (compile)
    (defmacro print-and-call (name)
@@ -344,6 +345,7 @@
    (setf *type-system-initialized* nil)
    (setf *break-on-signals* nil)
    (setf unix::*filename-encoding* nil)
 +  (setf *enable-normalization* nil)
    #+gengc (setf conditions::*handler-clusters* nil)
    (setq intl::*default-domain* "cmucl")
    (setq intl::*locale* "C")

@@ -252,6 +252,24 @@
  ;;; This constructor is used to make an instance of the correct type
  ;;; from parsed arguments.
 +(defvar *enable-normalization* nil)
++
 +(defun normalize-name (piece)
 +  ;; Normalize Darwin pathnames by converting Hangul
 +  ;; syllables to conjoining jamo, and converting the
 +  ;; string to NFD form, but skipping over a range of
 +  ;; characters.
 +  (typecase piece
 +    (string
 +     (if *enable-normalization*
 +	 (decompose (unicode::decompose-hangul piece)
 +		    :compatibility nil
 +		    :darwinp t)
 +	 piece))
 +    (t
 +     ;; What should we do about lisp::pattern objects?
 +     piece)))
++
  (defun %make-pathname-object (host device directory name type version)
    (if (typep host 'logical-host)
        (flet ((upcasify (thing)
@@ -271,24 +289,16 @@
  				(upcasify name)
  				(upcasify type)
  				(upcasify version)))
 -      #-darwin
 +      #-(not nil)
        (%make-pathname host device directory name type version)
 -      #+darwin
 -      (flet ((normalize-name (string)
 -	       ;; Normalize Darwin pathnames by converting Hangul
 -	       ;; syllables to conjoining jamo, and converting the
 -	       ;; string to NFD form, but skipping over a range of
 -	       ;; characters.
 -	       (decompose (with-output-to-string (s)
 -			    (unicode::decompose-hangul string s))
 -			  :compatibility nil
 -			  :darwinp t)))
 -	(%make-pathname host device
 -			(list (car directory)
 -			      (mapcar #'normalize-name (cdr directory)))
 -			(normalize-name name)
 -			(normalize-name type)
 -			version))))
 +      #+(not nil)
 +      (%make-pathname host device
 +		      (when directory
 +			(list* (car directory)
 +			       (mapcar #'normalize-name (cdr directory))))
 +		      (normalize-name name)
 +		      (normalize-name type)
 +		      version))))
  ;;; *LOGICAL-HOSTS* --internal.
  ;;;

@@ -284,6 +284,16 @@
  	     (set-up-locale-external-format)
  	     ;; Set terminal encodings to :locale
  	     (set-system-external-format :locale)
 +	     ;; Get some unicode stuff needed for decomposing strings.
 +	     ;; This is needed on Darwin to normalize pathname
 +	     ;; objects, which needs this information.  If we don't,
 +	     ;; we'll load the information at runtime when creating
 +	     ;; the path to "unidata.dat", which then calls decompose
 +	     ;; again, and so on.
 +	     (progn
 +	       (lisp::load-decomp)
 +	       (lisp::load-combining)
 +	       (setf *enable-normalization* t))
  	     (ext::process-command-strings process-command-line)
  	     (setf *editor-lisp-p* nil)
  	     (macrolet ((find-switch (name)

@@ -513,11 +513,12 @@
  		    (read-vector lvec stm :endian-swap :network-order)
  		    (values split hvec mvec lvec))))
  	 (declare (ignorable #'read16 #'read32 #'read-ntrie))
 -	 (with-open-file (,stm *unidata-path* :direction :input
 -			       :element-type '(unsigned-byte 8))
 -	   (unless (unidata-locate ,stm ,locn)
 -	     (error (intl:gettext "No data in file.")))
 -	   ,@body)))))
 +	 (let (#+nil(lisp::*enable-normalization* nil))
 +	   (with-open-file (,stm *unidata-path* :direction :input
 +						:element-type '(unsigned-byte 8))
 +	     (unless (unidata-locate ,stm ,locn)
 +	       (error (intl:gettext "No data in file.")))
 +	     ,@body))))))
  (defloader load-range (stm 0)
    (let* ((n (read32 stm))

Raymond Toy pushed to branch issue-158-darwin-pathnames at cmucl / cmucl

Commits:

4 changed files:

Changes: