Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • src/code/extfmts.lisp
    ... ... @@ -461,15 +461,18 @@
    461 461 
     	       (format t "~&~A~%"
    462 462 
     		       (intl:gettext (or (ef-documentation ef) "")))))))))
    463 463
    464 
    +(defconstant +builtin-external-formats+ '(:utf-8 :iso8859-1 :ascii)
    465 
    +  "List of external formats that are builtin so that they don't need to
    466 
    +  be loaded on first use.")
    467 
    +
    464 468 
     (defun %find-external-format (name)
    465 469 
       ;; avoid loading files, etc., early in the boot sequence
    466 
    -  (when (or (eq name :iso8859-1)
    467 
    -	    (and (eq name :default) (eq *default-external-format* :iso8859-1)))
    468 
    -    (return-from %find-external-format
    469 
    -      (gethash :iso8859-1 *external-formats*)))
    470 
    -  (when (eq name :utf-8)
    470 
    +  (when (and (eq name :default)
    471 
    +	     (eq *default-external-format* :iso8859-1))
    472 
    +    (setf name :iso8859-1))
    473 
    +  (when (member name +builtin-external-formats+ :test 'eq)
    471 474 
         (return-from %find-external-format
    472 
    -      (gethash :utf-8 *external-formats*)))
    475 
    +      (gethash name *external-formats*)))
    473 476
    474 477 
       (when (zerop (hash-table-count *external-format-aliases*))
    475 478 
         (setf (gethash :latin1 *external-format-aliases*) :iso8859-1)
    ... ... @@ -1188,6 +1191,8 @@ character and illegal outputs are replaced by a question mark.")
    1188 1191 
     	 ,(subst (ef-name ef) ef
    1189 1192 
     		 (function-lambda-expression (aref (ef-cache ef) slot))))))
    1190 1193
    1194 
    +;;; Builtin external formats.
    1195 
    +
    1191 1196 
     ;; A safe UTF-8 external format.  Any illegal UTF-8 sequences on input
    1192 1197 
     ;; are replaced with the Unicode REPLACEMENT CHARACTER (U+FFFD), or
    1193 1198 
     ;; signals an error as appropriate.
    ... ... @@ -1303,3 +1308,29 @@ replacement character.")
    1303 1308 
              ((< ,code #x10000) (utf8 ,code 2))
    1304 1309 
              ((< ,code #x110000) (utf8 ,code 3))
    1305 1310 
              (t (error "How did this happen?  Codepoint U+~X is illegal" ,code))))))
    1311 
    +
    1312 
    +(define-external-format :ascii (:size 1 :documentation
    1313 
    +"US ASCII 7-bit encoding.  Illegal input sequences are replaced with
    1314 
    +the Unicode replacment character.  Illegal output characters are
    1315 
    +replaced with a question mark.")
    1316 
    +  ()
    1317 
    +  (octets-to-code (state input unput error c)
    1318 
    +    `(let ((,c ,input))
    1319 
    +       (values (if (< ,c #x80)
    1320 
    +		   ,c
    1321 
    +		   (if ,error
    1322 
    +		       (locally
    1323 
    +			   ;; No warnings about fdefinition
    1324 
    +			   (declare (optimize (ext:inhibit-warnings 3)))
    1325 
    +			 (funcall ,error "Invalid octet #x~4,'0X for ASCII" ,c 1))
    1326 
    +		       +replacement-character-code+))
    1327 
    +	       1)))
    1328 
    +  (code-to-octets (code state output error)
    1329 
    +    `(,output (if (> ,code #x7F)
    1330 
    +		  (if ,error
    1331 
    +		      (locally
    1332 
    +			  ;; No warnings about fdefinition
    1333 
    +			  (declare (optimize (ext:inhibit-warnings 3)))
    1334 
    +			(funcall ,error "Cannot output codepoint #x~X to ASCII stream" ,code))
    1335 
    +		      #x3F)
    1336 
    +		  ,code))))

  • src/code/fd-stream-comp.lisp
    ... ... @@ -28,6 +28,7 @@
    28 28 
     (stream::precompile-ef-slot :iso8859-1 #.stream::+ef-de+)
    29 29 
     (stream::precompile-ef-slot :iso8859-1 #.stream::+ef-osc+)
    30 30
    31 
    +;; :utf-8 is builtin.  Important since it's the default now.
    31 32 
     (stream::precompile-ef-slot :utf-8 #.stream::+ef-cin+)
    32 33 
     (stream::precompile-ef-slot :utf-8 #.stream::+ef-cout+)
    33 34 
     (stream::precompile-ef-slot :utf-8 #.stream::+ef-sout+)
    ... ... @@ -36,3 +37,13 @@
    36 37 
     (stream::precompile-ef-slot :utf-8 #.stream::+ef-en+)
    37 38 
     (stream::precompile-ef-slot :utf-8 #.stream::+ef-de+)
    38 39 
     (stream::precompile-ef-slot :utf-8 #.stream::+ef-osc+)
    40 
    +
    41 
    +;; :ascii is builtin.
    42 
    +(stream::precompile-ef-slot :ascii #.stream::+ef-cin+)
    43 
    +(stream::precompile-ef-slot :ascii #.stream::+ef-cout+)
    44 
    +(stream::precompile-ef-slot :ascii #.stream::+ef-sout+)
    45 
    +(stream::precompile-ef-slot :ascii #.stream::+ef-os+)
    46 
    +(stream::precompile-ef-slot :ascii #.stream::+ef-so+)
    47 
    +(stream::precompile-ef-slot :ascii #.stream::+ef-en+)
    48 
    +(stream::precompile-ef-slot :ascii #.stream::+ef-de+)
    49 
    +(stream::precompile-ef-slot :ascii #.stream::+ef-osc+)

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help