From: Christophe R. <cr...@us...> - 2003-06-18 15:16:10
|
Update of /cvsroot/sbcl/sbcl/src/compiler/generic In directory sc8-pr-cvs1:/tmp/cvs-serv9771/src/compiler/generic Modified Files: Tag: vector_nil_string_branch early-objdef.lisp genesis.lisp interr.lisp late-type-vops.lisp primtype.lisp vm-fndb.lisp vm-typetran.lisp Log Message: 0.8.0.78.vector-nil-string.1: As noted with horror between myself and pfdietz on #lisp, vectors specialized on NIL are strings. This patch implements (VECTOR NIL) as subtype of STRING with no regressions in either our regression test suite or pfdietz' test suite. However, this notwithstanding, there are a number of issues that need to be resolved before this hits HEAD. (Why would it hit HEAD, you ask? Well, it /is/ an ANSI issue, but in this case that would probably just merit it an entry in BUGS, were it not for the fact that a Unicode implementation is likely to have several string representations, so most of the issues that we're addressing here will have to be dealt with in any case; the use of (ARRAY NIL) as a "poison pill" to investigate string routines and the like is probably a good thing. Note that this is only a half-way house; while STRING is no longer the same type as BASE-STRING, which is one portion of the Unicode battle, CHARACTER remains equivalent to BASE-CHAR). Brokennesses: * STRING= and similar functions may work by accident for (VECTOR NIL 0), but they're unlikely to be robustly working; * FFI and ALIEN: we need at the very least (a) to ensure that C-STRINGs get turned into a useful string type, not (VECTOR NIL) and (b) to install a conversion routine for the other direction, so that the Lisp string #.(make-array 0 :element-type nil) becomes the C string ""; * Filesystem access and SB-UNIX is completely unaudited. This may be similar to the above issue; * SXHASH-SIMPLE-STRING tries to access string elements, and promptly errors on a (VECTOR NIL) with non-zero length. This also breaks TYPE-OF; * INTERN currently takes only a BASE-STRING; * [ probably others. Should examine Brian Spilsbury's Unicode patch for some more gotchas. ] Suboptimalities: * 10% slowdown in self-compilation, probably mostly caused by CONCATENATE (not transformed away for general SIMPLE-STRINGs any more) and HAIRY-DATA-VECTOR-{REF,SET} (type dispatch unavoidable for the latter on STRING-typed objects). We can mitigate the latter issue by, for STRINGlike types including (VECTOR NIL), having a vector nil type test branching to an array-nil-accessed error clause if true, then retrying the hairy-data-vector optimization; * throughout the codebase, string and base-string have been interchangeably used for a number of years; we need to look at them all and fix them if necessary. Index: early-objdef.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/early-objdef.lisp,v retrieving revision 1.14 retrieving revision 1.14.10.1 diff -u -d -r1.14 -r1.14.10.1 --- early-objdef.lisp 10 Mar 2003 14:54:25 -0000 1.14 +++ early-objdef.lisp 18 Jun 2003 15:16:06 -0000 1.14.10.1 @@ -72,10 +72,10 @@ #!+long-float complex-long-float simple-array - simple-string + simple-array-nil + simple-base-string simple-bit-vector simple-vector - simple-array-nil simple-array-unsigned-byte-2 simple-array-unsigned-byte-4 simple-array-unsigned-byte-8 @@ -91,7 +91,8 @@ simple-array-complex-single-float simple-array-complex-double-float #!+long-float simple-array-complex-long-float - complex-string + complex-base-string + complex-vector-nil complex-bit-vector complex-vector complex-array Index: genesis.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/genesis.lisp,v retrieving revision 1.78 retrieving revision 1.78.4.1 diff -u -d -r1.78 -r1.78.4.1 --- genesis.lisp 5 May 2003 14:09:12 -0000 1.78 +++ genesis.lisp 18 Jun 2003 15:16:06 -0000 1.78.4.1 @@ -598,7 +598,7 @@ (des (allocate-vector-object gspace sb!vm:n-byte-bits (1+ length) - sb!vm:simple-string-widetag)) + sb!vm:simple-base-string-widetag)) (bytes (gspace-bytes gspace)) (offset (+ (* sb!vm:vector-data-offset sb!vm:n-word-bytes) (descriptor-byte-offset des)))) Index: interr.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/interr.lisp,v retrieving revision 1.11 retrieving revision 1.11.10.1 diff -u -d -r1.11 -r1.11.10.1 --- interr.lisp 10 Mar 2003 14:54:26 -0000 1.11 +++ interr.lisp 18 Jun 2003 15:16:06 -0000 1.11.10.1 @@ -59,6 +59,8 @@ "Object is not of type LONG-FLOAT.") (object-not-simple-string "Object is not of type SIMPLE-STRING.") + (object-not-simple-base-string + "Object is not of type SIMPLE-BASE-STRING.") (object-not-simple-bit-vector "Object is not of type SIMPLE-BIT-VECTOR.") (object-not-simple-vector @@ -69,6 +71,8 @@ "Object is not of type VECTOR.") (object-not-string "Object is not of type STRING.") + (object-not-base-string + "Object is not of type BASE-STRING.") (object-not-bit-vector "Object is not of type BIT-VECTOR.") (object-not-array Index: late-type-vops.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/late-type-vops.lisp,v retrieving revision 1.3 retrieving revision 1.3.10.1 diff -u -d -r1.3 -r1.3.10.1 --- late-type-vops.lisp 10 Mar 2003 14:54:28 -0000 1.3 +++ late-type-vops.lisp 18 Jun 2003 15:16:06 -0000 1.3.10.1 @@ -75,9 +75,13 @@ object-not-long-float-error (long-float-widetag)) -(!define-type-vops simple-string-p check-simple-string simple-string +(!define-type-vops simple-string-p check-simple-string nil object-not-simple-string-error - (simple-string-widetag)) + (simple-base-string-widetag simple-array-nil-widetag)) + +(!define-type-vops simple-base-string-p check-simple-base-string simple-base-string + object-not-simple-base-string-error + (simple-base-string-widetag)) (!define-type-vops simple-bit-vector-p check-simple-bit-vector simple-bit-vector object-not-simple-bit-vector-error @@ -208,18 +212,26 @@ (funcallable-instance-header-widetag)) (!define-type-vops array-header-p nil nil nil - (simple-array-widetag complex-string-widetag complex-bit-vector-widetag - complex-vector-widetag complex-array-widetag)) + (simple-array-widetag complex-base-string-widetag complex-bit-vector-widetag + complex-vector-widetag complex-array-widetag complex-vector-nil-widetag)) (!define-type-vops stringp check-string nil object-not-string-error - (simple-string-widetag complex-string-widetag)) + (simple-base-string-widetag complex-base-string-widetag + simple-array-nil-widetag complex-vector-nil-widetag)) + +(!define-type-vops base-string-p check-base-string nil object-not-base-string-error + (simple-base-string-widetag complex-base-string-widetag)) (!define-type-vops bit-vector-p check-bit-vector nil object-not-bit-vector-error (simple-bit-vector-widetag complex-bit-vector-widetag)) +(!define-type-vops vector-nil-p check-vector-nil nil + object-not-vector-nil-error + (simple-array-nil-widetag complex-vector-nil-widetag)) + (!define-type-vops vectorp check-vector nil object-not-vector-error - (simple-string-widetag + (simple-base-string-widetag simple-array-nil-widetag simple-bit-vector-widetag simple-vector-widetag @@ -238,7 +250,8 @@ simple-array-complex-single-float-widetag simple-array-complex-double-float-widetag #!+long-float simple-array-complex-long-float-widetag - complex-string-widetag + complex-base-string-widetag + complex-vector-nil-widetag complex-bit-vector-widetag complex-vector-widetag)) @@ -259,7 +272,7 @@ (!define-type-vops simple-array-p check-simple-array nil object-not-simple-array-error (simple-array-widetag - simple-string-widetag + simple-base-string-widetag simple-array-nil-widetag simple-bit-vector-widetag simple-vector-widetag @@ -281,7 +294,7 @@ (!define-type-vops arrayp check-array nil object-not-array-error (simple-array-widetag - simple-string-widetag + simple-base-string-widetag simple-array-nil-widetag simple-bit-vector-widetag simple-vector-widetag @@ -300,7 +313,8 @@ simple-array-complex-single-float-widetag simple-array-complex-double-float-widetag #!+long-float simple-array-complex-long-float-widetag - complex-string-widetag + complex-base-string-widetag + complex-vector-nil-widetag complex-bit-vector-widetag complex-vector-widetag complex-array-widetag)) Index: primtype.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/primtype.lisp,v retrieving revision 1.11 retrieving revision 1.11.8.1 diff -u -d -r1.11 -r1.11.8.1 --- primtype.lisp 8 Apr 2003 23:57:20 -0000 1.11 +++ primtype.lisp 18 Jun 2003 15:16:06 -0000 1.11.8.1 @@ -102,7 +102,7 @@ (/show0 "primtype.lisp 96") (!def-primitive-type simple-array-nil (descriptor-reg) :type (simple-array nil (*))) -(!def-primitive-type simple-string (descriptor-reg) +(!def-primitive-type simple-base-string (descriptor-reg) :type simple-base-string) (!def-primitive-type simple-bit-vector (descriptor-reg)) (!def-primitive-type simple-vector (descriptor-reg)) @@ -163,7 +163,7 @@ (defvar *simple-array-primitive-types* '((nil . simple-array-nil) - (base-char . simple-string) + (base-char . simple-base-string) (bit . simple-bit-vector) ((unsigned-byte 2) . simple-array-unsigned-byte-2) ((unsigned-byte 4) . simple-array-unsigned-byte-4) Index: vm-fndb.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-fndb.lisp,v retrieving revision 1.16 retrieving revision 1.16.2.1 diff -u -d -r1.16 -r1.16.2.1 --- vm-fndb.lisp 10 Jun 2003 11:08:13 -0000 1.16 +++ vm-fndb.lisp 18 Jun 2003 15:16:06 -0000 1.16.2.1 @@ -21,8 +21,9 @@ complex-double-float-p #!+long-float complex-long-float-p complex-vector-p base-char-p %standard-char-p %instancep + base-string-p simple-base-string-p array-header-p - simple-array-p simple-array-nil-p + simple-array-p simple-array-nil-p vector-nil-p simple-array-unsigned-byte-2-p simple-array-unsigned-byte-4-p simple-array-unsigned-byte-8-p simple-array-unsigned-byte-16-p simple-array-unsigned-byte-32-p Index: vm-typetran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-typetran.lisp,v retrieving revision 1.3 retrieving revision 1.3.10.1 diff -u -d -r1.3 -r1.3.10.1 --- vm-typetran.lisp 10 Mar 2003 14:54:29 -0000 1.3 +++ vm-typetran.lisp 18 Jun 2003 15:16:06 -0000 1.3.10.1 @@ -18,6 +18,7 @@ ;;; These type predicates are used to implement simple cases of TYPEP. ;;; They shouldn't be used explicitly. (define-type-predicate base-char-p base-char) +(define-type-predicate base-string-p base-string) (define-type-predicate bignump bignum) (define-type-predicate complex-double-float-p (complex double-float)) (define-type-predicate complex-single-float-p (complex single-float)) @@ -66,10 +67,12 @@ #!+long-float (define-type-predicate simple-array-complex-long-float-p (simple-array (complex long-float) (*))) +(define-type-predicate simple-base-string-p simple-base-string) (define-type-predicate system-area-pointer-p system-area-pointer) (define-type-predicate unsigned-byte-32-p (unsigned-byte 32)) (define-type-predicate signed-byte-32-p (signed-byte 32)) (define-type-predicate vector-t-p (vector t)) +(define-type-predicate vector-nil-p (vector nil)) (define-type-predicate weak-pointer-p weak-pointer) (define-type-predicate code-component-p code-component) (define-type-predicate lra-p lra) |