From 7aa157f240268b2c7b5b56eb7b8fcdcbc7e744ed Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Wed, 8 Nov 2017 11:32:35 -0500 Subject: [PATCH] Defer compililng external-formats until warm load --- build-order.lisp-expr | 25 ------------------------ src/code/cold-init.lisp | 2 ++ src/code/external-formats/enc-cn-tbl.lisp | 2 +- src/code/external-formats/enc-cn.lisp | 5 ++--- src/code/external-formats/enc-cyr.lisp | 2 +- src/code/external-formats/enc-dos.lisp | 2 +- src/code/external-formats/enc-ebcdic.lisp | 2 +- src/code/external-formats/enc-iso.lisp | 2 +- src/code/external-formats/enc-jpn-tbl.lisp | 2 +- src/code/external-formats/enc-jpn.lisp | 5 ++--- src/code/external-formats/enc-mac.lisp | 2 +- src/code/external-formats/enc-ucs.lisp | 31 +++++++++++++++--------------- src/code/external-formats/enc-utf.lisp | 13 ++++++------- src/code/external-formats/enc-win.lisp | 2 +- src/code/external-formats/mb-util.lisp | 13 ++++--------- src/code/octets.lisp | 4 ---- src/cold/warm.lisp | 16 +++++++++++++++ 17 files changed, 55 insertions(+), 75 deletions(-) diff --git a/build-order.lisp-expr b/build-order.lisp-expr index c86dafa6b..c57e866d4 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -663,31 +663,6 @@ ("src/code/octets" :not-host) ("src/code/external-formats/enc-basic" :not-host) - ("src/code/external-formats/enc-ebcdic" :not-host) - #!+sb-unicode - ("src/code/external-formats/enc-cyr" :not-host) - #!+sb-unicode - ("src/code/external-formats/enc-dos" :not-host) - #!+sb-unicode - ("src/code/external-formats/enc-iso" :not-host) - #!+sb-unicode - ("src/code/external-formats/enc-win" :not-host) - #!+sb-unicode - ("src/code/external-formats/enc-mac" :not-host) - #!+sb-unicode - ("src/code/external-formats/mb-util" :not-host) - #!+sb-unicode - ("src/code/external-formats/enc-cn-tbl" :not-host) - #!+sb-unicode - ("src/code/external-formats/enc-cn" :not-host) - #!+sb-unicode - ("src/code/external-formats/enc-jpn-tbl" :not-host) - #!+sb-unicode - ("src/code/external-formats/enc-jpn" :not-host) - #!+sb-unicode - ("src/code/external-formats/enc-ucs" :not-host) - #!+sb-unicode - ("src/code/external-formats/enc-utf" :not-host) #!+sb-eval ("src/code/full-eval" :not-host) ; uses INFO, ARG-COUNT-ERROR diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index 80de97bfc..fd1d81fe2 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -180,6 +180,8 @@ (/show0 "doing cold toplevel forms and fixups") (progn (write `("Length(TLFs)= " ,(length *!cold-toplevels*))) (terpri)) + ;; only the basic external formats are present at this point. + (setq sb!impl::*default-external-format* :latin-1) (!with-init-wrappers (loop for index-in-cold-toplevels from 0 diff --git a/src/code/external-formats/enc-cn-tbl.lisp b/src/code/external-formats/enc-cn-tbl.lisp index 108bbfb6f..5199fefbe 100644 --- a/src/code/external-formats/enc-cn-tbl.lisp +++ b/src/code/external-formats/enc-cn-tbl.lisp @@ -9,7 +9,7 @@ ;;; $ cat CP936-only.TXT | awk -F "\t" '{printf(" (%s %s)\n",$2,$1);}' | sort | sed -e 's/0x/#x/g' > UCS2GBK.txt ;;; and insert GBK2UCS.txt and UCS2GBK.txt to this file. -(in-package "SB!IMPL") +(in-package "SB-IMPL") (define-multibyte-mapper +gbk-to-ucs-table+ ( ;; begin, insert GBK2UCS.TXT here (emacs: C-x i GBK2UCS.TXT) diff --git a/src/code/external-formats/enc-cn.lisp b/src/code/external-formats/enc-cn.lisp index 352cb33ae..59457fc36 100644 --- a/src/code/external-formats/enc-cn.lisp +++ b/src/code/external-formats/enc-cn.lisp @@ -2,7 +2,7 @@ ;;; Chun Tian (binghe) ;;; Sat Dec 23 02:45:12 CST 2006 -(in-package "SB!IMPL") +(in-package "SB-IMPL") ;;; GBK (declaim (inline ucs-to-gbk gbk-to-ucs @@ -31,7 +31,6 @@ (ignore code)) t) -(eval-when (:compile-toplevel) - (sb!xc:proclaim '(muffle-conditions compiler-note))) +(declaim (muffle-conditions compiler-note)) (define-multibyte-encoding :gbk (:gbk :cp936) ucs-to-gbk gbk-to-ucs mb-len-as-gbk gbk-continuation-byte-p) diff --git a/src/code/external-formats/enc-cyr.lisp b/src/code/external-formats/enc-cyr.lisp index 96dfc586a..abf32b550 100644 --- a/src/code/external-formats/enc-cyr.lisp +++ b/src/code/external-formats/enc-cyr.lisp @@ -1,4 +1,4 @@ -(in-package "SB!IMPL") +(in-package "SB-IMPL") (define-unibyte-mapping-external-format :koi8-r (:|koi8-r|) (#x80 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL diff --git a/src/code/external-formats/enc-dos.lisp b/src/code/external-formats/enc-dos.lisp index 224b92128..802efc118 100644 --- a/src/code/external-formats/enc-dos.lisp +++ b/src/code/external-formats/enc-dos.lisp @@ -1,4 +1,4 @@ -(in-package "SB!IMPL") +(in-package "SB-IMPL") (define-unibyte-mapping-external-format :cp437 (:|cp437|) (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA diff --git a/src/code/external-formats/enc-ebcdic.lisp b/src/code/external-formats/enc-ebcdic.lisp index eb39003ed..d1fbaa269 100644 --- a/src/code/external-formats/enc-ebcdic.lisp +++ b/src/code/external-formats/enc-ebcdic.lisp @@ -1,4 +1,4 @@ -(in-package "SB!IMPL") +(in-package "SB-IMPL") (defmacro define-unibyte-permutation-mapper (byte-code-name code-byte-name table) (let ((byte-to-code-table diff --git a/src/code/external-formats/enc-iso.lisp b/src/code/external-formats/enc-iso.lisp index b5bdadb57..89af59a02 100644 --- a/src/code/external-formats/enc-iso.lisp +++ b/src/code/external-formats/enc-iso.lisp @@ -1,4 +1,4 @@ -(in-package "SB!IMPL") +(in-package "SB-IMPL") (define-unibyte-mapping-external-format :iso-8859-2 (:|iso-8859-2| :latin-2 :|latin-2|) diff --git a/src/code/external-formats/enc-jpn-tbl.lisp b/src/code/external-formats/enc-jpn-tbl.lisp index 2661a6359..f377621d2 100644 --- a/src/code/external-formats/enc-jpn-tbl.lisp +++ b/src/code/external-formats/enc-jpn-tbl.lisp @@ -1,4 +1,4 @@ -(in-package "SB!IMPL") +(in-package "SB-IMPL") (define-multibyte-mapper +ucs-to-eucjp-table+ ((#xa1 #x8fa2c2) (#xa2 #xa1f1) diff --git a/src/code/external-formats/enc-jpn.lisp b/src/code/external-formats/enc-jpn.lisp index cad623434..d4630c3d1 100644 --- a/src/code/external-formats/enc-jpn.lisp +++ b/src/code/external-formats/enc-jpn.lisp @@ -1,4 +1,4 @@ -(in-package "SB!IMPL") +(in-package "SB-IMPL") ;;; EUC-JP (declaim (inline ucs-to-eucjp eucjp-to-ucs @@ -28,8 +28,7 @@ (type (unsigned-byte 8) code)) (<= #xA1 code #xFE)) -(eval-when (:compile-toplevel) - (sb!xc:proclaim '(muffle-conditions compiler-note))) +(declaim (muffle-conditions compiler-note)) (define-multibyte-encoding :euc-jp (:euc-jp :eucjp :|eucJP|) ucs-to-eucjp eucjp-to-ucs mb-len-as-eucjp eucjp-continuation-byte-p) diff --git a/src/code/external-formats/enc-mac.lisp b/src/code/external-formats/enc-mac.lisp index 8ad4fe308..ec6bd00f1 100644 --- a/src/code/external-formats/enc-mac.lisp +++ b/src/code/external-formats/enc-mac.lisp @@ -1,4 +1,4 @@ -(in-package "SB!IMPL") +(in-package "SB-IMPL") (define-unibyte-mapping-external-format :mac-roman (:|mac-roman| :|MacRoman| :mac :|mac| :macintosh :|macintosh|) diff --git a/src/code/external-formats/enc-ucs.lisp b/src/code/external-formats/enc-ucs.lisp index 4931a45da..6904eff64 100644 --- a/src/code/external-formats/enc-ucs.lisp +++ b/src/code/external-formats/enc-ucs.lisp @@ -14,7 +14,7 @@ ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. -(in-package "SB!IMPL") +(in-package "SB-IMPL") ;;; TODO Macro for generating different variants: ;;; :ucs-2le (little endian) sap-ref-16le @@ -29,16 +29,16 @@ ;;; Define feature LITTLE-ENDIAN-AND-MISALIGNED-READ? (defun sap-ref-16le (sap offset) - #!+(or x86 x86-64) + #+(or x86 x86-64) (sap-ref-16 sap offset) - #!-(or x86 x86-64) + #-(or x86 x86-64) (dpb (sap-ref-8 sap (1+ offset)) (byte 8 8) (sap-ref-8 sap offset))) (defun (setf sap-ref-16le) (value sap offset) - #!+(or x86 x86-64) + #+(or x86 x86-64) (setf (sap-ref-16 sap offset) value) - #!-(or x86 x86-64) + #-(or x86 x86-64) (setf (sap-ref-8 sap offset) (logand value #xff) (sap-ref-8 sap (1+ offset)) (ldb (byte 8 8) value))) @@ -51,17 +51,17 @@ (sap-ref-8 sap offset) (ldb (byte 8 8) value))) (defun sap-ref-32le (sap offset) - #!+(or x86 x86-64) + #+(or x86 x86-64) (sap-ref-32 sap offset) - #!-(or x86 x86-64) + #-(or x86 x86-64) (dpb (sap-ref-8 sap (+ offset 3)) (byte 8 24) (dpb (sap-ref-8 sap (+ offset 2)) (byte 8 16) (sap-ref-16le sap offset)))) (defun (setf sap-ref-32le) (value sap offset) - #!+(or x86 x86-64) + #+(or x86 x86-64) (setf (sap-ref-32 sap offset) value) - #!-(or x86 x86-64) + #-(or x86 x86-64) (setf (sap-ref-8 sap offset) (logand value #xff) (sap-ref-8 sap (1+ offset)) (ldb (byte 8 8) value) (sap-ref-8 sap (+ offset 2)) (ldb (byte 8 16) value) @@ -235,7 +235,7 @@ (instantiate-octets-definition define-ucs-2->string) -(define-external-format/variable-width (:ucs-2le :ucs2le #!+win32 :ucs2 #!+win32 :ucs-2) t +(define-external-format/variable-width (:ucs-2le :ucs2le #+win32 :ucs2 #+win32 :ucs-2) t (code-char #xfffd) 2 (if (< bits #x10000) @@ -347,7 +347,7 @@ (dpb (cref 3) (byte 8 24) (dpb (cref 2) (byte 8 16) (dpb (cref 1) (byte 8 8) (cref 0)))))))) - (if (< code sb!xc:char-code-limit) + (if (< code char-code-limit) (code-char code) (decoding-error array pos (+ pos bytes) :ucs-4le 'octet-decoding-error pos)))) @@ -366,13 +366,12 @@ (dpb (cref 0) (byte 8 24) (dpb (cref 1) (byte 8 16) (dpb (cref 2) (byte 8 8) (cref 3)))))))) - (if (< code sb!xc:char-code-limit) + (if (< code char-code-limit) (code-char code) (decoding-error array pos (+ pos bytes) :ucs-4be 'octet-decoding-error pos))))))) -(eval-when (:compile-toplevel) - (sb!xc:proclaim '(muffle-conditions compiler-note))) +(declaim (muffle-conditions compiler-note)) (instantiate-octets-definition define-simple-get-ucs4-character) (defmacro define-ucs-4->string (accessor type) @@ -424,7 +423,7 @@ (setf (sap-ref-32le sap tail) bits) 4 (let ((code (sap-ref-32le sap head))) - (if (< code sb!xc:char-code-limit) + (if (< code char-code-limit) (code-char code) (return-from decode-break-reason 4))) ucs-4le->string-aref @@ -436,7 +435,7 @@ (setf (sap-ref-32be sap tail) bits) 4 (let ((code (sap-ref-32be sap head))) - (if (< code sb!xc:char-code-limit) + (if (< code char-code-limit) (code-char code) (return-from decode-break-reason 4))) ucs-4be->string-aref diff --git a/src/code/external-formats/enc-utf.lisp b/src/code/external-formats/enc-utf.lisp index d31c4cce1..00636482d 100644 --- a/src/code/external-formats/enc-utf.lisp +++ b/src/code/external-formats/enc-utf.lisp @@ -14,7 +14,7 @@ ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. -(in-package "SB!IMPL") +(in-package "SB-IMPL") (declaim (inline utf-noncharacter-code-p)) @@ -423,7 +423,7 @@ (dpb (cref 3) (byte 8 24) (dpb (cref 2) (byte 8 16) (dpb (cref 1) (byte 8 8) (cref 0)))))))) - (if (and (< code sb!xc:char-code-limit) + (if (and (< code char-code-limit) (not (utf-noncharacter-code-p code))) (code-char code) (decoding-error array pos (+ pos bytes) :utf-32le @@ -443,14 +443,13 @@ (dpb (cref 0) (byte 8 24) (dpb (cref 1) (byte 8 16) (dpb (cref 2) (byte 8 8) (cref 3)))))))) - (if (and (< code sb!xc:char-code-limit) + (if (and (< code char-code-limit) (not (utf-noncharacter-code-p code))) (code-char code) (decoding-error array pos (+ pos bytes) :utf-32be 'octet-decoding-error pos))))))) -(eval-when (:compile-toplevel) - (sb!xc:proclaim '(muffle-conditions compiler-note))) +(declaim (muffle-conditions compiler-note)) (instantiate-octets-definition define-simple-get-utf32-character) (defmacro define-utf-32->string (accessor type) @@ -504,7 +503,7 @@ (setf (sap-ref-32le sap tail) bits)) 4 (let ((code (sap-ref-32le sap head))) - (if (and (< code sb!xc:char-code-limit) + (if (and (< code char-code-limit) (not (utf-noncharacter-code-p code))) (code-char code) (return-from decode-break-reason 4))) @@ -519,7 +518,7 @@ (setf (sap-ref-32be sap tail) bits)) 4 (let ((code (sap-ref-32be sap head))) - (if (and (< code sb!xc:char-code-limit) + (if (and (< code char-code-limit) (not (utf-noncharacter-code-p code))) (code-char code) (return-from decode-break-reason 4))) diff --git a/src/code/external-formats/enc-win.lisp b/src/code/external-formats/enc-win.lisp index 887668076..e4d830ab7 100644 --- a/src/code/external-formats/enc-win.lisp +++ b/src/code/external-formats/enc-win.lisp @@ -1,4 +1,4 @@ -(in-package "SB!IMPL") +(in-package "SB-IMPL") (define-unibyte-mapping-external-format :cp1250 (:|cp1250| :windows-1250 :|windows-1250|) diff --git a/src/code/external-formats/mb-util.lisp b/src/code/external-formats/mb-util.lisp index de32c40ea..0ffca0112 100644 --- a/src/code/external-formats/mb-util.lisp +++ b/src/code/external-formats/mb-util.lisp @@ -1,18 +1,13 @@ -(in-package "SB!IMPL") +(in-package "SB-IMPL") (defmacro define-multibyte-mapper (name list) (let ((list (sort (copy-list list) #'< :key #'car)) (hi (loop for x in list maximize (max (car x) (cadr x))))) - ;; FIXME: should be defconstant, but genesis is too eager to evaluate - ;; the symbol at cold-load time when it does not yet have a value - ;; [References to global constants are compiled into LOAD-TIME-VALUE, - ;; but we can't execute target code that assigns the constant, - ;; nor know at each use site whether the value expression was able - ;; to be computed and dumped using only facilities of the xc host] - `(define-load-time-global ,name + `(defconstant-eqx ,name (make-array '(,(length list) 2) :element-type '(integer 0 ,hi) - :initial-contents ',list)))) + :initial-contents ',list) + #'equalp))) (defun get-multibyte-mapper (table code) (declare (optimize speed (safety 0)) diff --git a/src/code/octets.lisp b/src/code/octets.lisp index d0866f1c7..190b6b5ed 100644 --- a/src/code/octets.lisp +++ b/src/code/octets.lisp @@ -371,10 +371,6 @@ one-past-the-end" "LATIN-1") "KEYWORD") #!+win32 (sb!win32::ansi-codepage))) - (/show0 "cold-printing defaulted external-format:") - #!+sb-show - (cold-print external-format) - (/show0 "matching to known aliases") (let ((entry (get-external-format external-format))) (cond (entry diff --git a/src/cold/warm.lisp b/src/cold/warm.lisp index cbde45814..77b46f47a 100644 --- a/src/cold/warm.lisp +++ b/src/cold/warm.lisp @@ -81,6 +81,21 @@ "SRC;INTERPRETER;SPECIAL-FORMS" "SRC;INTERPRETER;EVAL" "SRC;INTERPRETER;DEBUG")) + (external-format-srcs + (append '("SRC;CODE;EXTERNAL-FORMATS;ENC-EBCDIC") + #+sb-unicode + '("SRC;CODE;EXTERNAL-FORMATS;ENC-CYR" + "SRC;CODE;EXTERNAL-FORMATS;ENC-DOS" + "SRC;CODE;EXTERNAL-FORMATS;ENC-ISO" + "SRC;CODE;EXTERNAL-FORMATS;ENC-WIN" + "SRC;CODE;EXTERNAL-FORMATS;ENC-MAC" + "SRC;CODE;EXTERNAL-FORMATS;MB-UTIL" + "SRC;CODE;EXTERNAL-FORMATS;ENC-CN-TBL" + "SRC;CODE;EXTERNAL-FORMATS;ENC-CN" + "SRC;CODE;EXTERNAL-FORMATS;ENC-JPN-TBL" + "SRC;CODE;EXTERNAL-FORMATS;ENC-JPN" + "SRC;CODE;EXTERNAL-FORMATS;ENC-UCS" + "SRC;CODE;EXTERNAL-FORMATS;ENC-UTF"))) (pcl-srcs '(;; CLOS, derived from the PCL reference implementation ;; @@ -212,5 +227,6 @@ (*compile-print* nil)) (do-srcs early-srcs) (with-compilation-unit () (do-srcs interpreter-srcs)) + (do-srcs external-format-srcs) (with-compilation-unit () (do-srcs pcl-srcs)) (do-srcs other-srcs)))) -- 2.11.4.GIT