From 4363cb61eb8e2dc833070da398864a039210e1c8 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 30 Oct 2009 15:23:11 +0000 Subject: [PATCH] 1.0.32.5: defend against full MAKE-ARRAY before the type system is ready This is basically defence against bugs of the form lp #316323, where the wrong answer comes out of a make-array before SUBTYPEP is working properly. We should be able to arrange the build so that we never have to do a full MAKE-ARRAY before we're ready for it. Slight modifications of a couple of macros: VOP-related and multibyte encoding-related. There should be no user-visible change. --- src/code/array.lisp | 2 ++ src/code/external-formats/enc-cn-tbl.lisp | 4 +-- src/code/external-formats/enc-jpn-tbl.lisp | 8 ++--- src/code/external-formats/mb-util.lisp | 13 +++----- src/compiler/meta-vmdef.lisp | 49 +++++++++------------------- version.lisp-expr | 2 +- 6 files changed, 30 insertions(+), 48 deletions(-) diff --git a/src/code/array.lisp b/src/code/array.lisp index 4a9e054..b46b1ff 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -96,6 +96,8 @@ (values #.sb!vm:simple-bit-vector-widetag 1)) ;; OK, we have to wade into SUBTYPEPing after all. (t + (unless *type-system-initialized* + (bug "SUBTYPEP dispatch for MAKE-ARRAY before the type system is ready")) #.`(pick-vector-type type ,@(map 'list (lambda (saetp) diff --git a/src/code/external-formats/enc-cn-tbl.lisp b/src/code/external-formats/enc-cn-tbl.lisp index 53f9cef..603c3b2 100644 --- a/src/code/external-formats/enc-cn-tbl.lisp +++ b/src/code/external-formats/enc-cn-tbl.lisp @@ -12,7 +12,7 @@ (in-package "SB!IMPL") (define-multibyte-mapper *gbk-to-ucs-table* - '( ;; begin, insert GBK2UCS.TXT here (emacs: C-x i GBK2UCS.TXT) + ( ;; begin, insert GBK2UCS.TXT here (emacs: C-x i GBK2UCS.TXT) (#x8140 #x4E02) (#x8141 #x4E04) (#x8142 #x4E05) @@ -21807,7 +21807,7 @@ )) ;; end of *gbk-to-ucs-table* (define-multibyte-mapper *ucs-to-gbk-table* - '( ;; begin, insert UCS2GBK.TXT here (emacs: C-x i UCS2GBK.TXT) + ( ;; begin, insert UCS2GBK.TXT here (emacs: C-x i UCS2GBK.TXT) (#x00A4 #xA1E8) (#x00A7 #xA1EC) (#x00A8 #xA1A7) diff --git a/src/code/external-formats/enc-jpn-tbl.lisp b/src/code/external-formats/enc-jpn-tbl.lisp index 04e3ee4..cc0d0a7 100644 --- a/src/code/external-formats/enc-jpn-tbl.lisp +++ b/src/code/external-formats/enc-jpn-tbl.lisp @@ -1,6 +1,6 @@ (in-package "SB!IMPL") (define-multibyte-mapper *ucs-to-eucjp-table* - '((#xa1 #x8fa2c2) + ((#xa1 #x8fa2c2) (#xa2 #xa1f1) (#xa3 #xa1f2) (#xa4 #x8fa2f0) @@ -13012,7 +13012,7 @@ (#xffe3 #xa1b1) (#xffe5 #xa1ef))) (define-multibyte-mapper *eucjp-to-ucs-table* - '((#x8ea1 #xff61) + ((#x8ea1 #xff61) (#x8ea2 #xff62) (#x8ea3 #xff63) (#x8ea4 #xff64) @@ -26022,7 +26022,7 @@ (#x8fede2 #x9fa3) (#x8fede3 #x9fa5))) (define-multibyte-mapper *ucs-to-sjis-table* - '((#xa2 #x8191) + ((#xa2 #x8191) (#xa3 #x8192) (#xa5 #x5c) (#xa7 #x8198) @@ -35304,7 +35304,7 @@ (#xffe4 #xfa55) (#xffe5 #x818f))) (define-multibyte-mapper *sjis-to-ucs-table* - '((#xa1 #xff61) + ((#xa1 #xff61) (#xa2 #xff62) (#xa3 #xff63) (#xa4 #xff64) diff --git a/src/code/external-formats/mb-util.lisp b/src/code/external-formats/mb-util.lisp index e883099..0cb711d 100644 --- a/src/code/external-formats/mb-util.lisp +++ b/src/code/external-formats/mb-util.lisp @@ -1,15 +1,12 @@ (in-package "SB!IMPL") -(defun make-multibyte-mapper (list) +(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))))) - (make-array (list (length list) 2) - :element-type (list 'integer 0 hi) - :initial-contents list))) - -(defmacro define-multibyte-mapper (name list) - `(defparameter ,name - (make-multibyte-mapper ,list))) + `(defparameter ,name + (make-array '(,(length list) 2) + :element-type '(integer 0 ,hi) + :initial-contents ',list)))) (defun get-multibyte-mapper (table code) (declare (optimize speed (safety 0)) diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp index 6fe1a05..3f6d93c 100644 --- a/src/compiler/meta-vmdef.lisp +++ b/src/compiler/meta-vmdef.lisp @@ -614,16 +614,14 @@ 1) (ash (meta-sc-number-or-lose sc) 1)))) (incf index)) - ;; KLUDGE: As in the other COERCEs wrapped around with - ;; MAKE-SPECIALIZABLE-ARRAY results in COMPUTE-REF-ORDERING, - ;; this coercion could be removed by a sufficiently smart - ;; compiler, but I dunno whether Python is that smart. It - ;; would be good to check this and help it if it's not smart - ;; enough to remove it for itself. However, it's probably not - ;; urgent, since the overhead of an extra no-op conversion is - ;; unlikely to be large compared to consing and corresponding - ;; GC. -- WHN ca. 19990701 - `(coerce ,results '(specializable-vector ,element-type)))))) + ;; KLUDGE: The load-time MAKE-ARRAY here is an artifact of our + ;; cross-compilation strategy, and the conservative + ;; assumptions we are forced to make on which specialized + ;; arrays exist on the host lisp that the cross-compiler is + ;; running on. (We used to use COERCE here, but that caused + ;; SUBTYPEP calls too early in cold-init for comfort). -- + ;; CSR, 2009-10-30 + `(make-array ,(length results) :element-type '(specializable ,element-type) :initial-contents ',results))))) (defun compute-ref-ordering (parse) (let* ((num-args (+ (length (vop-parse-args parse)) @@ -700,30 +698,15 @@ (incf index))) `(:num-args ,num-args :num-results ,num-results - ;; KLUDGE: The (COERCE .. (SPECIALIZABLE-VECTOR ..)) wrapper - ;; here around the result returned by - ;; MAKE-SPECIALIZABLE-ARRAY above was of course added to - ;; help with cross-compilation. "A sufficiently smart - ;; compiler" should be able to optimize all this away in the - ;; final target Lisp, leaving a single MAKE-ARRAY with no - ;; subsequent coercion. However, I don't know whether Python - ;; is that smart. (Can it figure out the return type of - ;; MAKE-ARRAY? Does it know that COERCE can be optimized - ;; away if the input type is known to be the same as the - ;; COERCEd-to type?) At some point it would be good to test - ;; to see whether this construct is in fact causing run-time - ;; overhead, and fix it if so. (Some declarations of the - ;; types returned by MAKE-ARRAY might be enough to fix it.) - ;; However, it's probably not urgent to fix this, since it's - ;; hard to imagine that any overhead caused by calling - ;; COERCE and letting it decide to bail out could be large - ;; compared to the cost of consing and GCing the vectors in - ;; the first place. -- WHN ca. 19990701 - :ref-ordering (coerce ',ordering - '(specializable-vector ,oe-type)) + ;; KLUDGE: see the comment regarding MAKE-ARRAY in + ;; COMPUTE-TEMPORARIES-DESCRIPTION. -- CSR, 2009-10-30 + :ref-ordering (make-array ,(length ordering) + :initial-contents ',ordering + :element-type '(specializable ,oe-type)) ,@(when (targets) - `(:targets (coerce ',(targets) - '(specializable-vector ,te-type))))))))) + `(:targets (make-array ,(length (targets)) + :initial-contents ',(targets) + :element-type '(specializable ,te-type))))))))) (defun make-emit-function-and-friends (parse) `(:emit-function #'emit-generic-vop diff --git a/version.lisp-expr b/version.lisp-expr index 261dc49..7212c30 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.32.4" +"1.0.32.5" -- 1.7.10.4