Menu
▾
▴
[Sbcl-commits] master: Defer compililng external-formats until warm load
|
From: Douglas K. <sn...@us...> - 2017-11-08 16:34:52
|
The branch "master" has been updated in SBCL:
via 7aa157f240268b2c7b5b56eb7b8fcdcbc7e744ed (commit)
from 24cb3449aeffd8f8a7bafdec3c91292d494fcdc0 (commit)
- Log -----------------------------------------------------------------
commit 7aa157f240268b2c7b5b56eb7b8fcdcbc7e744ed
Author: Douglas Katzman <do...@go...>
Date: Wed Nov 8 11:32:35 2017 -0500
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 c86dafa..c57e866 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 80de97b..fd1d81f 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 108bbfb..5199fef 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 352cb33..59457fc 100644
--- a/src/code/external-formats/enc-cn.lisp
+++ b/src/code/external-formats/enc-cn.lisp
@@ -2,7 +2,7 @@
;;; Chun Tian (binghe) <bin...@gm...>
;;; 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 96dfc58..abf32b5 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 224b921..802efc1 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 eb39003..d1fbaa2 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 b5bdadb..89af59a 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 2661a63..f377621 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 cad6234..d4630c3 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 8ad4fe3..ec6bd00 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 4931a45..6904eff 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 d31c4cc..0063648 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 8876680..e4d830a 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 de32c40..0ffca01 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 d0866f1..190b6b5 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 cbde458..77b46f4 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))))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|