common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

clean.sh: optionally don't delete ucd output files.

Browse source 
They are recomputed as needed.
This commit is contained in:
Stas Boukarev 2023-08-04 21:22:39 +03:00
parent 15e7e061de
commit a5f36524ab
6 changed files with 68 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
clean.sh
View file

@ -8,7 +8,19 @@ set -e
# The supposed explanation definitely no longer holds - there is no "src/c-runtime/sbcl.h"
# as a symlink into "output/". The sbcl.h file is a plain file, and it's been that way
# for quite some time.
rm -rf obj/* output/* src/runtime/genesis/ src/runtime/sbcl.mk src/runtime/*.dSYM
rm -rf obj/* src/runtime/genesis/ src/runtime/sbcl.mk src/runtime/*.dSYM
if [ -z "$SBCL_LEAVE_OUTPUT" ]
then
rm -fr output/*
else
for f in output/*; do
if [ $f != output/ucd ]; then
rm -r $f
fi
done
fi
# Ensure that we know GNUMAKE.
. ./find-gnumake.sh

1
make-host-1.lisp
View file

@ -76,6 +76,7 @@
(values (read stream) (read stream)))
(unless (outputs-up-to-date inputs outputs)
(format t "~&; Building Unicode data~%")
(ensure-directories-exist "output/ucd/")
(let ((*ucd-inputs* (make-hash-table :test 'equal))
(*ucd-outputs* (make-hash-table :test 'equal)))
(dolist (input inputs)

2
src/code/target-char.lisp
View file

@ -60,7 +60,7 @@
(macrolet ((frob ()
(flet ((file (name type)
(sb-cold:find-bootstrap-file (format nil "output/~A.~A" name type)))
(sb-cold:find-bootstrap-file (format nil "output/ucd/~A.~A" name type)))
(read-ub8-vector (pathname)
(with-open-file (stream pathname
:element-type '(unsigned-byte 8))

24
src/code/target-unicode.lisp
View file

@ -17,10 +17,10 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *proplist-properties*
(mapcar (lambda (x) (cons (car x) (sb-xc:coerce (cdr x) '(vector (unsigned-byte 32)))))
'#.(plist-to-alist (sb-cold:read-from-file "output/misc-properties.lisp-expr")))))
'#.(plist-to-alist (sb-cold:read-from-file "output/ucd/misc-properties.lisp-expr")))))
(sb-ext:define-load-time-global **confusables**
(let ((data '#.(sb-cold:read-from-file "output/confusables.lisp-expr")))
(let ((data '#.(sb-cold:read-from-file "output/ucd/confusables.lisp-expr")))
(sb-impl::%stuff-hash-table
(make-hash-table :test #'eq #+sb-unicode :size #+sb-unicode (length data))
(loop for (source . target) in data
@ -40,7 +40,7 @@
t)))
(sb-ext:define-load-time-global **bidi-mirroring-glyphs**
(let ((list '#.(sb-cold:read-from-file "output/bidi-mirrors.lisp-expr")))
(let ((list '#.(sb-cold:read-from-file "output/ucd/bidi-mirrors.lisp-expr")))
(sb-impl::%stuff-hash-table
(make-hash-table :test #'eq :size (length list))
(loop for (k v) in list collect (cons k v))
@ -169,7 +169,7 @@ Numeric value is the most general of the Unicode numeric properties.
The only constraint on the numeric value is that it be a rational number."
(or (gethash character
(load-time-value
(let ((list '#.(sb-cold:read-from-file "output/numerics.lisp-expr")))
(let ((list '#.(sb-cold:read-from-file "output/ucd/numerics.lisp-expr")))
(sb-impl::%stuff-hash-table
(make-hash-table :test #'eq :size (length list))
(loop for (k . v) in list
@ -213,10 +213,10 @@ If CHARACTER does not have a known block, returns :NO-BLOCK"
(let* ((code (char-code character))
(block-index (ordered-ranges-position
code
#.(coerce (sb-cold:read-from-file "output/block-ranges.lisp-expr")
#.(coerce (sb-cold:read-from-file "output/ucd/block-ranges.lisp-expr")
'(vector (unsigned-byte 32))))))
(if block-index
(aref #.(sb-cold:read-from-file "output/block-names.lisp-expr") block-index)
(aref #.(sb-cold:read-from-file "output/ucd/block-names.lisp-expr") block-index)
:no-block)))
(defun unicode-1-name (character)
@ -456,7 +456,7 @@ disappears when accents are placed on top of it. and NIL otherwise"
#-sb-unicode
(declare (ignore char1 char2))
#-sb-unicode
#.(let* ((data (sb-cold:read-from-file "output/comp.lisp-expr"))
#.(let* ((data (sb-cold:read-from-file "output/ucd/comp.lisp-expr"))
(entries (loop for pair across data
for key = (car pair)
for c1 = (ldb (byte 21 21) key)
@ -480,7 +480,7 @@ disappears when accents are placed on top of it. and NIL otherwise"
(cond
((gethash (dpb c1 (byte 21 21) c2)
(load-time-value
(let ((data '#.(sb-cold:read-from-file "output/comp.lisp-expr")))
(let ((data '#.(sb-cold:read-from-file "output/ucd/comp.lisp-expr")))
(sb-impl::%stuff-hash-table
(make-hash-table :size (length data) #+64-bit :test #+64-bit #'eq)
(loop for pair across data
@ -592,10 +592,10 @@ only characters for which it returns T are collected."
;;; Unicode case algorithms
;; FIXME: Make these parts less redundant (macro?)
(sb-ext:define-load-time-global **special-titlecases**
'#.(sb-cold:read-from-file "output/titlecases.lisp-expr"))
'#.(sb-cold:read-from-file "output/ucd/titlecases.lisp-expr"))
(sb-ext:define-load-time-global **special-casefolds**
'#.(sb-cold:read-from-file "output/foldcases.lisp-expr"))
'#.(sb-cold:read-from-file "output/ucd/foldcases.lisp-expr"))
(defun has-case-p (char)
;; Bit 6 is the Unicode case flag, as opposed to the Common Lisp one
@ -1422,7 +1422,7 @@ it defaults to 80 characters"
;;; Collation
(defconstant +maximum-variable-primary-element+
#.(sb-cold:read-from-file "output/other-collation-info.lisp-expr"))
#.(sb-cold:read-from-file "output/ucd/other-collation-info.lisp-expr"))
(defun unpack-collation-key (key)
(flet ((unpack (value)
@ -1439,7 +1439,7 @@ it defaults to 80 characters"
(macrolet ((collations-hash-table ()
(let ((data (let ((*read-base* 16))
(sb-cold:read-from-file "output/collation.lisp-expr"))))
(sb-cold:read-from-file "output/ucd/collation.lisp-expr"))))
#+64-bit (dovector (item data) (aver (fixnump (car item))))
`(load-time-value
(sb-impl::%stuff-hash-table

70
src/cold/ucd-filespecs.lisp-expr
View file

@ -21,38 +21,38 @@
"tools-for-build/more-ucd-consts.lisp-expr")
;; Outputs
("output/bidi-mirrors.lisp-expr"
"output/BidiMirroring.txt"
"output/block-names.lisp-expr"
"output/block-ranges.lisp-expr"
"output/Blocks.txt"
"output/case.dat"
"output/CaseFolding.txt"
"output/casepages.dat"
"output/casepages.lisp-expr"
"output/collation.lisp-expr"
"output/comp.lisp-expr"
"output/CompositionExclusions.txt"
"output/confusables.lisp-expr"
"output/decomp.dat"
"output/DerivedAge.txt"
"output/DerivedNormalizationProps.txt"
"output/EastAsianWidth.txt"
"output/emoji-data.txt"
"output/confusables.txt"
"output/foldcases.lisp-expr"
"output/Jamo.txt"
"output/LineBreak.txt"
"output/misc-properties.lisp-expr"
"output/NormalizationCorrections.txt"
"output/numerics.lisp-expr"
"output/other-collation-info.lisp-expr"
"output/PropList.txt"
"output/Scripts.txt"
"output/SpecialCasing.txt"
"output/titlecases.lisp-expr"
"output/ucd1-names.lisp-expr"
"output/ucdhigh.dat"
"output/ucdlow.dat"
"output/ucdmisc.dat"
"output/ucd-names.lisp-expr")
("output/ucd/bidi-mirrors.lisp-expr"
"output/ucd/BidiMirroring.txt"
"output/ucd/block-names.lisp-expr"
"output/ucd/block-ranges.lisp-expr"
"output/ucd/Blocks.txt"
"output/ucd/case.dat"
"output/ucd/CaseFolding.txt"
"output/ucd/casepages.dat"
"output/ucd/casepages.lisp-expr"
"output/ucd/collation.lisp-expr"
"output/ucd/comp.lisp-expr"
"output/ucd/CompositionExclusions.txt"
"output/ucd/confusables.lisp-expr"
"output/ucd/decomp.dat"
"output/ucd/DerivedAge.txt"
"output/ucd/DerivedNormalizationProps.txt"
"output/ucd/EastAsianWidth.txt"
"output/ucd/emoji-data.txt"
"output/ucd/confusables.txt"
"output/ucd/foldcases.lisp-expr"
"output/ucd/Jamo.txt"
"output/ucd/LineBreak.txt"
"output/ucd/misc-properties.lisp-expr"
"output/ucd/NormalizationCorrections.txt"
"output/ucd/numerics.lisp-expr"
"output/ucd/other-collation-info.lisp-expr"
"output/ucd/PropList.txt"
"output/ucd/Scripts.txt"
"output/ucd/SpecialCasing.txt"
"output/ucd/titlecases.lisp-expr"
"output/ucd/ucd1-names.lisp-expr"
"output/ucd/ucdhigh.dat"
"output/ucd/ucdlow.dat"
"output/ucd/ucdmisc.dat"
"output/ucd/ucd-names.lisp-expr")

11
tools-for-build/ucd.lisp
View file

@ -6,7 +6,7 @@
(defvar *output-directory*
(merge-pathnames
(make-pathname :directory '(:relative :up "output"))
(make-pathname :directory '(:relative :up "output" "ucd"))
(make-pathname :directory (pathname-directory *load-truename*))))
(defparameter *unicode-character-database*
@ -43,7 +43,7 @@
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(setf (gethash (format nil "output/~A.txt" ,name) *ucd-outputs*) 'made)
(setf (gethash (format nil "output/ucd/~A.txt" ,name) *ucd-outputs*) 'made)
(do ((inbyte (read-byte ,in nil nil) (read-byte ,in nil nil))
(eszet (map '(vector (unsigned-byte 8)) 'char-code "<eszet>"))
(eszet-count 0)
@ -105,7 +105,7 @@
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(setf (gethash (format nil "output/~A.txt" ,name) *ucd-outputs*) 'made)
(setf (gethash (format nil "output/ucd/~A.txt" ,name) *ucd-outputs*) 'made)
(do ((inbyte (read-byte ,in nil nil) (read-byte ,in nil nil)))
((null inbyte) nil)
(cond
@ -124,7 +124,7 @@
:defaults *output-directory*)
:direction :output :element-type '(unsigned-byte 8)
:if-exists :supersede :if-does-not-exist :create)
(setf (gethash (format nil "output/~A.dat" ,name) *ucd-outputs*) 'made)
(setf (gethash (format nil "output/ucd/~A.dat" ,name) *ucd-outputs*) 'made)
,@body))
(defmacro with-ucd-output-syntax (&body body)
@ -139,7 +139,7 @@
:defaults *output-directory*)
:direction :output :element-type 'character
:if-exists :supersede :if-does-not-exist :create)
(setf (gethash (format nil "output/~A.lisp-expr" ,name) *ucd-outputs*) 'made)
(setf (gethash (format nil "output/ucd/~A.lisp-expr" ,name) *ucd-outputs*) 'made)
(with-ucd-output-syntax
,@body)))
@ -1046,6 +1046,7 @@ Used to look up block data.")
(prin1 *maximum-variable-key*) (terpri)))
(defun output (&optional (*output-directory* *output-directory*))
(ensure-directories-exist *output-directory*)
(output-misc-data)
(output-ucd-data)
(output-decomposition-data)