[cmucl-cvs] CMUCL commit: src (4 files)
Raymond Toy
rtoy at common-lisp.net
Fri Jun 10 17:38:27 UTC 2011
Date: Friday, June 10, 2011 @ 10:38:27
Author: rtoy
Path: /project/cmucl/cvsroot/src
Modified: code/exports.lisp code/print.lisp code/unidata.lisp
general-info/release-20c.txt
Add function to load all unicode data into memory.
This makes it easy to make an executable image that doesn't need
unidata.bin around. (Should we do this for normal cores? It seems to
add about 1 MB to the core size.)
code/unidata.lisp:
o Add LOAD-ALL-UNICODE-DATA to load all unicode data.
o Add UNICODE-DATA-LOADED-P to check that unicode data has been
loaded.
code/print.lisp:
o If unicode data is loaded, don't check for existence of
*unidata-path*, because we don't need it.
code/exports.lisp:
o Export LOAD-ALL-UNICODE-DATA.
general-info/release-20c.txt:
o Update info
------------------------------+
code/exports.lisp | 5 +
code/print.lisp | 11 ++--
code/unidata.lisp | 105 +++++++++++++++++++++++++++++------------
general-info/release-20c.txt | 3 +
4 files changed, 88 insertions(+), 36 deletions(-)
Index: src/code/exports.lisp
diff -u src/code/exports.lisp:1.304 src/code/exports.lisp:1.305
--- src/code/exports.lisp:1.304 Wed Feb 2 04:51:27 2011
+++ src/code/exports.lisp Fri Jun 10 10:38:27 2011
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/exports.lisp,v 1.304 2011/02/02 12:51:27 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/exports.lisp,v 1.305 2011/06/10 17:38:27 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -910,7 +910,8 @@
#+unicode
(:export "STRING-TO-NFC" "STRING-TO-NFD"
"STRING-TO-NFKC" "STRING-TO-NFKD"
- "UNICODE-COMPLETE" "UNICODE-COMPLETE-NAME"))
+ "UNICODE-COMPLETE" "UNICODE-COMPLETE-NAME"
+ "LOAD-ALL-UNICODE-DATA"))
(defpackage "EVAL"
(:export "*EVAL-STACK-TRACE*" "*INTERNAL-APPLY-NODE-TRACE*"
Index: src/code/print.lisp
diff -u src/code/print.lisp:1.132 src/code/print.lisp:1.133
--- src/code/print.lisp:1.132 Tue May 31 06:26:40 2011
+++ src/code/print.lisp Fri Jun 10 10:38:27 2011
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/print.lisp,v 1.132 2011/05/31 13:26:40 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/print.lisp,v 1.133 2011/06/10 17:38:27 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -2164,10 +2164,11 @@
;;; is initialized.
#+unicode
(defun reinit-char-attributes ()
- (unless (probe-file *unidata-path*)
- (cerror _"Continue anyway" _"Cannot find ~S, so unicode support is not available"
- *unidata-path*)
- (return-from reinit-char-attributes nil))
+ (unless (unicode-data-loaded-p)
+ (unless (probe-file *unidata-path*)
+ (cerror _"Continue anyway" _"Cannot find ~S, so unicode support is not available"
+ *unidata-path*)
+ (return-from reinit-char-attributes nil)))
(flet ((set-bit (char bit)
(let ((code (char-code char)))
(setf (aref character-attributes code)
Index: src/code/unidata.lisp
diff -u src/code/unidata.lisp:1.26 src/code/unidata.lisp:1.27
--- src/code/unidata.lisp:1.26 Tue May 31 06:26:40 2011
+++ src/code/unidata.lisp Fri Jun 10 10:38:27 2011
@@ -4,7 +4,7 @@
;;; This code was written by Paul Foley and has been placed in the public
;;; domain.
;;;
-(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.26 2011/05/31 13:26:40 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.27 2011/06/10 17:38:27 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -14,11 +14,12 @@
(intl:textdomain "cmucl")
(export '(string-to-nfd string-to-nfkc string-to-nfkd string-to-nfc
- unicode-complete unicode-complete-name))
+ unicode-complete unicode-complete-name
+ load-all-unicode-data))
(defvar *unidata-path* "ext-formats:unidata.bin")
-(defvar *unidata-version* "$Revision: 1.26 $")
+(defvar *unidata-version* "$Revision: 1.27 $")
(defstruct unidata
range
@@ -473,33 +474,38 @@
(let ((n (read32 stream)))
(and (plusp n) (file-position stream n)))))
+;; List of all defined defloaders
+(defvar *defloaders* nil)
+
(defmacro defloader (name (stm locn) &body body)
- `(defun ,name ()
- (labels ((read16 (stm)
- (logior (ash (read-byte stm) 8) (read-byte stm)))
- (read32 (stm)
- (logior (ash (read16 stm) 16) (read16 stm)))
- (read-ntrie (bits stm)
- (let* ((split (read-byte stm))
- (hlen (read16 stm))
- (mlen (read16 stm))
- (llen (read16 stm))
- (hvec (make-array hlen
- :element-type '(unsigned-byte 16)))
- (mvec (make-array mlen
- :element-type '(unsigned-byte 16)))
- (lvec (make-array llen
- :element-type (list 'unsigned-byte bits))))
- (read-vector hvec stm :endian-swap :network-order)
- (read-vector mvec stm :endian-swap :network-order)
- (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.")))
- , at body))))
+ `(progn
+ (push ',name *defloaders*)
+ (defun ,name ()
+ (labels ((read16 (stm)
+ (logior (ash (read-byte stm) 8) (read-byte stm)))
+ (read32 (stm)
+ (logior (ash (read16 stm) 16) (read16 stm)))
+ (read-ntrie (bits stm)
+ (let* ((split (read-byte stm))
+ (hlen (read16 stm))
+ (mlen (read16 stm))
+ (llen (read16 stm))
+ (hvec (make-array hlen
+ :element-type '(unsigned-byte 16)))
+ (mvec (make-array mlen
+ :element-type '(unsigned-byte 16)))
+ (lvec (make-array llen
+ :element-type (list 'unsigned-byte bits))))
+ (read-vector hvec stm :endian-swap :network-order)
+ (read-vector mvec stm :endian-swap :network-order)
+ (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.")))
+ , at body)))))
(defloader load-range (stm 0)
(let* ((n (read32 stm))
@@ -1572,3 +1578,44 @@
(incf p (length code))
(return)))))
(nreverse (coerce res 'vector))))
+
+;; This is primarily intended for users who what to create a core
+;; image that contains all of the unicode data. By doing this, the
+;; resulting image no longer needs unidata.bin anymore. This is
+;; useful for an executable image.
+(defun load-all-unicode-data ()
+ "Load all unicode data and set *UNIDATA-PATH* to NIL.
+Normally, the unicode data is loaded as needed. This loads all of the
+data, which is useful for creating a core that no longer needs
+unidata.bin."
+ (dolist (loader (reverse *defloaders*))
+ (funcall loader))
+ t)
+
+;; CHeck to see if all of the unicode data has been loaded.
+(defun unicode-data-loaded-p ()
+ ;; FIXME: Would be nice to be able to do this automatically from the
+ ;; structure without having to list every slot here.
+ (and (unidata-range *unicode-data*)
+ (unidata-name+ *unicode-data*)
+ (unidata-name *unicode-data*)
+ (unidata-category *unicode-data*)
+ (unidata-scase *unicode-data*)
+ (unidata-numeric *unicode-data*)
+ (unidata-decomp *unicode-data*)
+ (unidata-combining *unicode-data*)
+ (unidata-bidi *unicode-data*)
+ (unidata-name1+ *unicode-data*)
+ (unidata-name1 *unicode-data*)
+ (unidata-qc-nfd *unicode-data*)
+ (unidata-qc-nfkd *unicode-data*)
+ (unidata-qc-nfc *unicode-data*)
+ (unidata-qc-nfkc *unicode-data*)
+ (unidata-comp-exclusions *unicode-data*)
+ (unidata-full-case-lower *unicode-data*)
+ (unidata-full-case-title *unicode-data*)
+ (unidata-full-case-upper *unicode-data*)
+ (unidata-case-fold-simple *unicode-data*)
+ (unidata-case-fold-full *unicode-data*)
+ (unidata-word-break *unicode-data*)
+ t))
Index: src/general-info/release-20c.txt
diff -u src/general-info/release-20c.txt:1.22 src/general-info/release-20c.txt:1.23
--- src/general-info/release-20c.txt:1.22 Sun Jun 5 13:39:04 2011
+++ src/general-info/release-20c.txt Fri Jun 10 10:38:27 2011
@@ -51,6 +51,9 @@
- Added -unidata command line option to allow user to specify the
unidata.bin file to be used instead of the default one.
- :CMUCL is now in *FEATURES*.
+ - Add LISP:LOAD-ALL-UNICODE-DATA to load all the Unicode
+ information into core. This is useful for creating an
+ executable image that does not need unidata.bin.
* ANSI compliance fixes:
- Fixes for signaling errors with READ-CHAR and READ-BYTE
More information about the cmucl-cvs
mailing list