0.7.13.21:

	The (ARRAY NIL) has landed.
	... implement a SIMPLE-ARRAY-NIL primitive type, including in
		garbage collection and (ROOM) logic;
	... adjust implementation of array creation and reference to
		deal with arrays that can't contain anything;
	... (HAIRY-)DATA-VECTOR-REF are can no longer be FLUSHABLE;
	Enjoy!

diff --git a/BUGS b/BUGS
index 08fea20..e1a60e3 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1270,8 +1270,7 @@ WORKAROUND:
   compiler gets its hands on the code needing compilation from the REPL,
   it has been macroexpanded several times.
 
   compiler gets its hands on the code needing compilation from the REPL,
   it has been macroexpanded several times.
 

-241:
-  "DEFCLASS mysteriously remembers uninterned accessor names."
+241: "DEFCLASS mysteriously remembers uninterned accessor names."

   (from tonyms on #lisp IRC 2003-02-25)
   In sbcl-0.7.12.55, typing
     (defclass foo () ((bar :accessor foo-bar)))
   (from tonyms on #lisp IRC 2003-02-25)
   In sbcl-0.7.12.55, typing
     (defclass foo () ((bar :accessor foo-bar)))

diff --git a/NEWS b/NEWS
index 52fc2aa..90bf931 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1584,16 +1584,18 @@ changes in sbcl-0.7.13 relative to sbcl-0.7.12:
     DEFSTRUCT-SLOT-DESCRIPTION structure.
 
 changes in sbcl-0.7.14 relative to sbcl-0.7.13:
     DEFSTRUCT-SLOT-DESCRIPTION structure.
 
 changes in sbcl-0.7.14 relative to sbcl-0.7.13:

+  * fixed CEILING optimization for a divisor of form 2^k.
+  * fixed bug 240 (emitting extra style warnings "using the lexical
+    binding of the symbol *XXX*" for &OPTIONAL arguments).  (reported
+    by Antonio Martinez)

   * fixed some bugs revealed by Paul Dietz' test suite:
     ** a bug in the CONS type specifier, whereby the CAR and CDR
        types got intertwined, has been fixed;
     ** the type system is now able to reason about the interaction
        between INTEGER and RATIO types more completely;
     ** APPEND checks its arguments for being proper lists;
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** a bug in the CONS type specifier, whereby the CAR and CDR
        types got intertwined, has been fixed;
     ** the type system is now able to reason about the interaction
        between INTEGER and RATIO types more completely;
     ** APPEND checks its arguments for being proper lists;

-  * fixed CEILING optimization for a divisor of form 2^k.
-  * fixed bug 240 (emitting extra style warnings "using the lexical
-    binding of the symbol *XXX*" for &OPTIONAL arguments). (reported
-    by Antonio Martinez)
+    ** An array specialized to be unable to hold elements has been
+       implemented (as required -- yes, really) by ANSI;

 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/build-order.lisp-expr b/build-order.lisp-expr
index 5f25b0c..f9edeaf 100644 (file)
--- a/build-order.lisp-expr
+++ b/build-order.lisp-expr
@@ -528,6 +528,7 @@
   ;; what the problem is and fix it. (See the comments in
   ;; src/compiler/x86/array for a candidate patch.) -- WHN 19990323
   :ignore-failure-p)
   ;; what the problem is and fix it. (See the comments in
   ;; src/compiler/x86/array for a candidate patch.) -- WHN 19990323
   :ignore-failure-p)

+ ("src/compiler/generic/array")

  ("src/compiler/target/pred")
 
  ("src/compiler/target/type-vops")
  ("src/compiler/target/pred")
 
  ("src/compiler/target/type-vops")

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index a151110..604a8d4 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1133,7 +1133,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
              "NAMED-TYPE" "NAMED-TYPE-NAME" "NAMED-TYPE-P"
              "NATIVE-BYTE-ORDER" "NEGATE"
             "NEGATION-TYPE" "NEGATION-TYPE-TYPE"
              "NAMED-TYPE" "NAMED-TYPE-NAME" "NAMED-TYPE-P"
              "NATIVE-BYTE-ORDER" "NEGATE"
             "NEGATION-TYPE" "NEGATION-TYPE-TYPE"

-             "NEVER-SUBTYPEP" "NIL-FUN-RETURNED-ERROR"
+             "NEVER-SUBTYPEP" "NIL-ARRAY-ACCESSED-ERROR"
+            "NIL-FUN-RETURNED-ERROR"

              "NOT-<=-ERROR" "NOT-=-ERROR"
              "NOT-DUMPED-AT-ALL"
              "NUMERIC-CONTAGION" "NUMERIC-TYPE"
              "NOT-<=-ERROR" "NOT-=-ERROR"
              "NOT-DUMPED-AT-ALL"
              "NUMERIC-CONTAGION" "NUMERIC-TYPE"

@@ -1170,6 +1171,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
              "OBJECT-NOT-SIMPLE-ARRAY-DOUBLE-FLOAT-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-ERROR"
              #!+long-float "OBJECT-NOT-SIMPLE-ARRAY-LONG-FLOAT-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-DOUBLE-FLOAT-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-ERROR"
              #!+long-float "OBJECT-NOT-SIMPLE-ARRAY-LONG-FLOAT-ERROR"

+            "OBJECT-NOT-SIMPLE-ARRAY-NIL-ERROR"

              "OBJECT-NOT-SIMPLE-ARRAY-SINGLE-FLOAT-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-16-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-2-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-SINGLE-FLOAT-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-16-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-2-ERROR"

@@ -1211,6 +1213,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
              "SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-P"
              "SIMPLE-ARRAY-DOUBLE-FLOAT-P"
             #!+long-float "SIMPLE-ARRAY-LONG-FLOAT-P"
              "SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-P"
              "SIMPLE-ARRAY-DOUBLE-FLOAT-P"
             #!+long-float "SIMPLE-ARRAY-LONG-FLOAT-P"

+            "SIMPLE-ARRAY-NIL-P"

              "SIMPLE-ARRAY-P"
              "SIMPLE-ARRAY-SINGLE-FLOAT-P"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-16-P"
              "SIMPLE-ARRAY-P"
              "SIMPLE-ARRAY-SINGLE-FLOAT-P"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-16-P"

@@ -1832,6 +1835,7 @@ structure representations"
              "SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-WIDETAG"
              "SIMPLE-ARRAY-DOUBLE-FLOAT-WIDETAG"
              #!+long-float "SIMPLE-ARRAY-LONG-FLOAT-WIDETAG"
              "SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-WIDETAG"
              "SIMPLE-ARRAY-DOUBLE-FLOAT-WIDETAG"
              #!+long-float "SIMPLE-ARRAY-LONG-FLOAT-WIDETAG"

+            "SIMPLE-ARRAY-NIL-WIDETAG"

              "SIMPLE-ARRAY-SINGLE-FLOAT-WIDETAG"
              "SIMPLE-ARRAY-WIDETAG" "SIMPLE-ARRAY-UNSIGNED-BYTE-16-WIDETAG"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-2-WIDETAG"
              "SIMPLE-ARRAY-SINGLE-FLOAT-WIDETAG"
              "SIMPLE-ARRAY-WIDETAG" "SIMPLE-ARRAY-UNSIGNED-BYTE-16-WIDETAG"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-2-WIDETAG"

diff --git a/src/code/array.lisp b/src/code/array.lisp
index 68aa0c6..9d1045d 100644 (file)
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -107,6 +107,7 @@
      ;; FIXME: The data here are redundant with
      ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
      (pick-vector-type type
      ;; FIXME: The data here are redundant with
      ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
      (pick-vector-type type

+       (nil (values #.sb!vm:simple-array-nil-widetag 0))

        (base-char (values #.sb!vm:simple-string-widetag #.sb!vm:n-byte-bits))
        (bit (values #.sb!vm:simple-bit-vector-widetag 1))
        ((unsigned-byte 2)
        (base-char (values #.sb!vm:simple-string-widetag #.sb!vm:n-byte-bits))
        (bit (values #.sb!vm:simple-bit-vector-widetag 1))
        ((unsigned-byte 2)

@@ -173,11 +174,11 @@
     (when (and displaced-index-offset (null displaced-to))
       (error "can't specify :DISPLACED-INDEX-OFFSET without :DISPLACED-TO"))
     (if (and simple (= array-rank 1))
     (when (and displaced-index-offset (null displaced-to))
       (error "can't specify :DISPLACED-INDEX-OFFSET without :DISPLACED-TO"))
     (if (and simple (= array-rank 1))

-       ;; Its a (simple-array * (*))
+       ;; it's a (SIMPLE-ARRAY * (*))

        (multiple-value-bind (type n-bits)
            (%vector-widetag-and-n-bits element-type)
          (declare (type (unsigned-byte 8) type)
        (multiple-value-bind (type n-bits)
            (%vector-widetag-and-n-bits element-type)
          (declare (type (unsigned-byte 8) type)

-                  (type (integer 1 256) n-bits))
+                  (type (integer 0 256) n-bits))

          (let* ((length (car dimensions))
                 (array (allocate-vector
                         type
          (let* ((length (car dimensions))
                 (array (allocate-vector
                         type

@@ -201,7 +202,7 @@
                       length))
              (replace array initial-contents))
            array))
                       length))
              (replace array initial-contents))
            array))

-       ;; It's either a complex array or a multidimensional array.
+       ;; it's either a complex array or a multidimensional array.

        (let* ((total-size (reduce #'* dimensions))
               (data (or displaced-to
                         (data-vector-from-inits
        (let* ((total-size (reduce #'* dimensions))
               (data (or displaced-to
                         (data-vector-from-inits

@@ -328,7 +329,8 @@
       #!+long-float long-float
       (complex single-float)
       (complex double-float)
       #!+long-float long-float
       (complex single-float)
       (complex double-float)

-      #!+long-float (complex long-float))))
+      #!+long-float (complex long-float)
+      nil)))

     
 (defun hairy-data-vector-ref (array index)
   (with-array-data ((vector array) (index index) (end))
     
 (defun hairy-data-vector-ref (array index)
   (with-array-data ((vector array) (index index) (end))

@@ -552,6 +554,7 @@
       ;; FIXME: The data here are redundant with
       ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
       (pick-element-type
       ;; FIXME: The data here are redundant with
       ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
       (pick-element-type

+       (sb!vm:simple-array-nil-widetag nil)

        ((sb!vm:simple-string-widetag sb!vm:complex-string-widetag) 'base-char)
        ((sb!vm:simple-bit-vector-widetag
         sb!vm:complex-bit-vector-widetag) 'bit)
        ((sb!vm:simple-string-widetag sb!vm:complex-string-widetag) 'base-char)
        ((sb!vm:simple-bit-vector-widetag
         sb!vm:complex-bit-vector-widetag) 'bit)

@@ -870,6 +873,8 @@
   (unless (array-header-p vector)
     (macrolet ((frob (name &rest things)
                 `(etypecase ,name
   (unless (array-header-p vector)
     (macrolet ((frob (name &rest things)
                 `(etypecase ,name

+                   ((simple-array nil (*)) (error 'cell-error
+                                            :name 'nil-array-element))

                    ,@(mapcar (lambda (thing)
                                (destructuring-bind (type-spec fill-value)
                                    thing
                    ,@(mapcar (lambda (thing)
                                (destructuring-bind (type-spec fill-value)
                                    thing

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 1d20994..99375b4 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -715,6 +715,13 @@
                  "The START and END parameters ~S and ~S are bad for an array of total size ~S."
                  start end (array-total-size object))))))))
 
                  "The START and END parameters ~S and ~S are bad for an array of total size ~S."
                  start end (array-total-size object))))))))
 

+(define-condition nil-array-accessed-error (type-error)
+  ()
+  (:report (lambda (condition stream)
+            (format stream
+                    "An attempt to access an array of element-type ~
+                      NIL was made.  Congratulations!"))))
+

 (define-condition io-timeout (stream-error)
   ((direction :reader io-timeout-direction :initarg :direction))
   (:report
 (define-condition io-timeout (stream-error)
   ((direction :reader io-timeout-direction :initarg :direction))
   (:report

diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index 4ee10ee..d32be0a 100644 (file)
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -222,6 +222,10 @@
         "A function with declared result type NIL returned:~%  ~S"
         :format-arguments (list function)))
 
         "A function with declared result type NIL returned:~%  ~S"
         :format-arguments (list function)))
 

+(deferr nil-array-accessed-error (array)
+  (error 'nil-array-accessed-error
+        :datum array :expected-type '(not (array nil))))
+

 (deferr division-by-zero-error (this that)
   (error 'division-by-zero
         :operation 'division
 (deferr division-by-zero-error (this that)
   (error 'division-by-zero
         :operation 'division

@@ -272,6 +276,11 @@
         :datum object
         :expected-type '(unsigned-byte 32)))
 
         :datum object
         :expected-type '(unsigned-byte 32)))
 

+(deferr object-not-simple-array-nil-error (object)
+  (error 'type-error
+        :datum object
+        :expected-type '(simple-array nil (*))))
+

 (deferr object-not-simple-array-unsigned-byte-2-error (object)
   (error 'type-error
         :datum object
 (deferr object-not-simple-array-unsigned-byte-2-error (object)
   (error 'type-error
         :datum object

diff --git a/src/code/room.lisp b/src/code/room.lisp
index d549fa7..df09fbe 100644 (file)
--- a/src/code/room.lisp
+++ b/src/code/room.lisp
@@ -80,18 +80,27 @@
                 (simple-array-double-float-widetag . 3)
                 (simple-array-complex-single-float-widetag . 3)
                 (simple-array-complex-double-float-widetag . 4)))
                 (simple-array-double-float-widetag . 3)
                 (simple-array-complex-single-float-widetag . 3)
                 (simple-array-complex-double-float-widetag . 4)))

-  (let ((name (car stuff))
-       (size (cdr stuff)))
+  (let* ((name (car stuff))
+        (size (cdr stuff))
+        (sname (string name)))

     (setf (svref *meta-room-info* (symbol-value name))
     (setf (svref *meta-room-info* (symbol-value name))

-         (make-room-info :name name
+         (make-room-info :name (intern (subseq sname
+                                               0
+                                               (mismatch sname "-WIDETAG"
+                                                         :from-end t)))

                          :kind :vector
                          :length size))))
 
 (setf (svref *meta-room-info* simple-string-widetag)
                          :kind :vector
                          :length size))))
 
 (setf (svref *meta-room-info* simple-string-widetag)

-      (make-room-info :name 'simple-string-widetag
+      (make-room-info :name 'simple-string

                      :kind :string
                      :length 0))
 
                      :kind :string
                      :length 0))
 

+(setf (svref *meta-room-info* simple-array-nil-widetag)
+      (make-room-info :name 'simple-array-nil
+                     :kind :fixed
+                     :length 2))
+

 (setf (svref *meta-room-info* code-header-widetag)
       (make-room-info :name 'code
                      :kind :code))
 (setf (svref *meta-room-info* code-header-widetag)
       (make-room-info :name 'code
                      :kind :code))

@@ -211,7 +220,8 @@
                             (:fixed
                              (aver (or (eql (room-info-length info)
                                               (1+ (get-header-data obj)))
                             (:fixed
                              (aver (or (eql (room-info-length info)
                                               (1+ (get-header-data obj)))

-                                         (floatp obj)))
+                                       (floatp obj)
+                                       (simple-array-nil-p obj)))

                              (round-to-dualword
                               (* (room-info-length info) n-word-bytes)))
                             ((:vector :string)
                              (round-to-dualword
                               (* (room-info-length info) n-word-bytes)))
                             ((:vector :string)

diff --git a/src/cold/slam.lisp b/src/cold/slam.lisp
index 7101401..92534c6 100644 (file)
--- a/src/cold/slam.lisp
+++ b/src/cold/slam.lisp
@@ -39,4 +39,6 @@
                                stem
                                *target-obj-suffix*)))
       (unless (output-up-to-date-wrt-input-p objname srcname)
                                stem
                                *target-obj-suffix*)))
       (unless (output-up-to-date-wrt-input-p objname srcname)

-       (target-compile-stem stem)))))
+       (target-compile-stem stem
+                            :assem-p (find :assem flags)
+                            :ignore-failure-p (find :ignore-failure-p flags))))))

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index eb3f9df..a384a6c 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -227,7 +227,10 @@
         (destructuring-bind (type-spec &rest rest) args
           (let ((ctype (specifier-type type-spec)))
             (apply #'!make-saetp ctype rest))))
         (destructuring-bind (type-spec &rest rest) args
           (let ((ctype (specifier-type type-spec)))
             (apply #'!make-saetp ctype rest))))

-       `((base-char ,(code-char 0) 8 ,sb!vm:simple-string-widetag
+       `(;; Erm.  Yeah.  There aren't a lot of things that make sense
+        ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07
+        (nil '#:mu 0 ,sb!vm:simple-array-nil-widetag)
+        (base-char ,(code-char 0) 8 ,sb!vm:simple-string-widetag

                    ;; (SIMPLE-STRINGs are stored with an extra trailing
                    ;; #\NULL for convenience in calling out to C.)
                    :n-pad-elements 1)
                    ;; (SIMPLE-STRINGs are stored with an extra trailing
                    ;; #\NULL for convenience in calling out to C.)
                    :n-pad-elements 1)

@@ -366,14 +369,17 @@
                                   'length
                                   `(+ length ,n-pad-elements)))
           (n-words-form
                                   'length
                                   `(+ length ,n-pad-elements)))
           (n-words-form

-           (if (>= n-bits-per-element sb!vm:n-word-bits)
-               `(* ,padded-length-form
-                   (the fixnum ; i.e., not RATIO
-                     ,(/ n-bits-per-element sb!vm:n-word-bits)))
-               (let ((n-elements-per-word (/ sb!vm:n-word-bits
-                                             n-bits-per-element)))
-                 (declare (type index n-elements-per-word)) ; i.e., not RATIO
-                 `(ceiling ,padded-length-form ,n-elements-per-word)))))
+           (cond
+             ((= n-bits-per-element 0) 0)
+             ((>= n-bits-per-element sb!vm:n-word-bits)
+              `(* ,padded-length-form
+                (the fixnum ; i.e., not RATIO
+                  ,(/ n-bits-per-element sb!vm:n-word-bits))))
+             (t
+              (let ((n-elements-per-word (/ sb!vm:n-word-bits
+                                            n-bits-per-element)))
+                (declare (type index n-elements-per-word)) ; i.e., not RATIO
+                `(ceiling ,padded-length-form ,n-elements-per-word))))))

       (values
        `(truly-the ,result-type-spec
         (allocate-vector ,typecode length ,n-words-form))
       (values
        `(truly-the ,result-type-spec
         (allocate-vector ,typecode length ,n-words-form))

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 255bc7e..aceeef6 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -798,8 +798,8 @@
 
 (defknown vector (&rest t) simple-vector (flushable unsafe))
 
 
 (defknown vector (&rest t) simple-vector (flushable unsafe))
 

-(defknown aref (array &rest index) t (foldable flushable))
-(defknown row-major-aref (array index) t (foldable flushable))
+(defknown aref (array &rest index) t (foldable))
+(defknown row-major-aref (array index) t (foldable))

 
 (defknown array-element-type (array)
   type-specifier
 
 (defknown array-element-type (array)
   type-specifier

@@ -1317,10 +1317,10 @@
 (defknown %negate (number) number (movable foldable flushable explicit-check))
 (defknown %check-bound (array index fixnum) index (movable foldable flushable))
 (defknown data-vector-ref (simple-array index) t
 (defknown %negate (number) number (movable foldable flushable explicit-check))
 (defknown %check-bound (array index fixnum) index (movable foldable flushable))
 (defknown data-vector-ref (simple-array index) t

-  (foldable flushable explicit-check))
+  (foldable explicit-check))

 (defknown data-vector-set (array index t) t (unsafe explicit-check))
 (defknown hairy-data-vector-ref (array index) t
 (defknown data-vector-set (array index t) t (unsafe explicit-check))
 (defknown hairy-data-vector-ref (array index) t

-  (foldable flushable explicit-check))
+  (foldable explicit-check))

 (defknown hairy-data-vector-set (array index t) t (unsafe explicit-check))
 (defknown %caller-frame-and-pc () (values t t) (flushable))
 (defknown %with-array-data (array index (or index null))
 (defknown hairy-data-vector-set (array index t) t (unsafe explicit-check))
 (defknown %caller-frame-and-pc () (values t t) (flushable))
 (defknown %with-array-data (array index (or index null))

diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp
index fb4deda..1c08743 100644 (file)
--- a/src/compiler/generic/early-objdef.lisp
+++ b/src/compiler/generic/early-objdef.lisp
@@ -75,6 +75,7 @@
   simple-string
   simple-bit-vector
   simple-vector
   simple-string
   simple-bit-vector
   simple-vector

+  simple-array-nil

   simple-array-unsigned-byte-2
   simple-array-unsigned-byte-4
   simple-array-unsigned-byte-8
   simple-array-unsigned-byte-2
   simple-array-unsigned-byte-4
   simple-array-unsigned-byte-8

diff --git a/src/compiler/generic/interr.lisp b/src/compiler/generic/interr.lisp
index ea88a91..6fcae75 100644 (file)
--- a/src/compiler/generic/interr.lisp
+++ b/src/compiler/generic/interr.lisp
@@ -121,6 +121,8 @@
    "Object is not of type (SIGNED-BYTE 32).")
   (object-not-unsigned-byte-32
    "Object is not of type (UNSIGNED-BYTE 32).")
    "Object is not of type (SIGNED-BYTE 32).")
   (object-not-unsigned-byte-32
    "Object is not of type (UNSIGNED-BYTE 32).")

+  (object-not-simple-array-nil
+   "Object is not of type (SIMPLE-ARRAY NIL (*)).")

   (object-not-simple-array-unsigned-byte-2
    "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 2) (*)).")
   (object-not-simple-array-unsigned-byte-4
   (object-not-simple-array-unsigned-byte-2
    "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 2) (*)).")
   (object-not-simple-array-unsigned-byte-4

@@ -174,6 +176,8 @@
    "Object is not of type BASE-CHAR.")
   (nil-fun-returned
    "A function with declared result type NIL returned.")
    "Object is not of type BASE-CHAR.")
   (nil-fun-returned
    "A function with declared result type NIL returned.")

+  (nil-array-accessed
+   "An array with element-type NIL was accessed.")

   (layout-invalid
    "Object layout is invalid. (indicates obsolete instance)")
   (object-not-complex-vector
   (layout-invalid
    "Object layout is invalid. (indicates obsolete instance)")
   (object-not-complex-vector

diff --git a/src/compiler/generic/late-type-vops.lisp b/src/compiler/generic/late-type-vops.lisp
index 4953792..b764d8f 100644 (file)
--- a/src/compiler/generic/late-type-vops.lisp
+++ b/src/compiler/generic/late-type-vops.lisp
@@ -87,6 +87,12 @@
     object-not-simple-vector-error
   (simple-vector-widetag))
 
     object-not-simple-vector-error
   (simple-vector-widetag))
 

+(!define-type-vops simple-array-nil-p
+                  check-simple-array-nil
+                  simple-array-nil
+                  object-not-simple-array-nil-error
+  (simple-array-nil-widetag))
+                  

 (!define-type-vops simple-array-unsigned-byte-2-p
       check-simple-array-unsigned-byte-2
       simple-array-unsigned-byte-2
 (!define-type-vops simple-array-unsigned-byte-2-p
       check-simple-array-unsigned-byte-2
       simple-array-unsigned-byte-2

@@ -214,6 +220,7 @@
 
 (!define-type-vops vectorp check-vector nil object-not-vector-error
   (simple-string-widetag
 
 (!define-type-vops vectorp check-vector nil object-not-vector-error
   (simple-string-widetag

+   simple-array-nil-widetag

    simple-bit-vector-widetag
    simple-vector-widetag
    simple-array-unsigned-byte-2-widetag
    simple-bit-vector-widetag
    simple-vector-widetag
    simple-array-unsigned-byte-2-widetag

@@ -253,6 +260,7 @@
     object-not-simple-array-error
   (simple-array-widetag
    simple-string-widetag
     object-not-simple-array-error
   (simple-array-widetag
    simple-string-widetag

+   simple-array-nil-widetag

    simple-bit-vector-widetag
    simple-vector-widetag
    simple-array-unsigned-byte-2-widetag
    simple-bit-vector-widetag
    simple-vector-widetag
    simple-array-unsigned-byte-2-widetag

@@ -274,6 +282,7 @@
 (!define-type-vops arrayp check-array nil object-not-array-error
   (simple-array-widetag
    simple-string-widetag
 (!define-type-vops arrayp check-array nil object-not-array-error
   (simple-array-widetag
    simple-string-widetag

+   simple-array-nil-widetag

    simple-bit-vector-widetag
    simple-vector-widetag
    simple-array-unsigned-byte-2-widetag
    simple-bit-vector-widetag
    simple-vector-widetag
    simple-array-unsigned-byte-2-widetag

diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp
index c2df398..d44d79d 100644 (file)
--- a/src/compiler/generic/primtype.lisp
+++ b/src/compiler/generic/primtype.lisp
@@ -100,6 +100,8 @@
 
 ;;; primitive other-pointer array types
 (/show0 "primtype.lisp 96")
 
 ;;; primitive other-pointer array types
 (/show0 "primtype.lisp 96")

+(!def-primitive-type simple-array-nil (descriptor-reg)
+  :type (simple-array nil (*)))

 (!def-primitive-type simple-string (descriptor-reg)
   :type simple-base-string)
 (!def-primitive-type simple-bit-vector (descriptor-reg))
 (!def-primitive-type simple-string (descriptor-reg)
   :type simple-base-string)
 (!def-primitive-type simple-bit-vector (descriptor-reg))

@@ -160,7 +162,8 @@
           *backend-t-primitive-type*))))
 
 (defvar *simple-array-primitive-types*
           *backend-t-primitive-type*))))
 
 (defvar *simple-array-primitive-types*

-  '((base-char . simple-string)
+  '((nil . simple-array-nil)
+    (base-char . simple-string)

     (bit . simple-bit-vector)
     ((unsigned-byte 2) . simple-array-unsigned-byte-2)
     ((unsigned-byte 4) . simple-array-unsigned-byte-4)
     (bit . simple-bit-vector)
     ((unsigned-byte 2) . simple-array-unsigned-byte-2)
     ((unsigned-byte 4) . simple-array-unsigned-byte-4)

diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp
index 12d83fa..2a4857b 100644 (file)
--- a/src/compiler/generic/vm-fndb.lisp
+++ b/src/compiler/generic/vm-fndb.lisp
@@ -22,7 +22,8 @@
           complex-vector-p
           base-char-p %standard-char-p %instancep
           array-header-p
           complex-vector-p
           base-char-p %standard-char-p %instancep
           array-header-p

-          simple-array-p simple-array-unsigned-byte-2-p
+          simple-array-p simple-array-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
           simple-array-signed-byte-8-p simple-array-signed-byte-16-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
           simple-array-signed-byte-8-p simple-array-signed-byte-16-p

diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp
index 279ec9d..62a6609 100644 (file)
--- a/src/compiler/generic/vm-type.lisp
+++ b/src/compiler/generic/vm-type.lisp
@@ -82,7 +82,8 @@
 (defvar *specialized-array-element-types*)
 (!cold-init-forms
   (setf *specialized-array-element-types*
 (defvar *specialized-array-element-types*)
 (!cold-init-forms
   (setf *specialized-array-element-types*

-       '(bit
+       '(nil
+         bit

          (unsigned-byte 2)
          (unsigned-byte 4)
          (unsigned-byte 8)
          (unsigned-byte 2)
          (unsigned-byte 4)
          (unsigned-byte 8)

diff --git a/src/compiler/generic/vm-typetran.lisp b/src/compiler/generic/vm-typetran.lisp
index 1f75a0e..b6c6005 100644 (file)
--- a/src/compiler/generic/vm-typetran.lisp
+++ b/src/compiler/generic/vm-typetran.lisp
@@ -33,6 +33,7 @@
 (define-type-predicate short-float-p short-float)
 (define-type-predicate single-float-p single-float)
 (define-type-predicate simple-array-p simple-array)
 (define-type-predicate short-float-p short-float)
 (define-type-predicate single-float-p single-float)
 (define-type-predicate simple-array-p simple-array)

+(define-type-predicate simple-array-nil-p (simple-array nil (*)))

 (define-type-predicate simple-array-unsigned-byte-2-p
                       (simple-array (unsigned-byte 2) (*)))
 (define-type-predicate simple-array-unsigned-byte-4-p
 (define-type-predicate simple-array-unsigned-byte-2-p
                       (simple-array (unsigned-byte 2) (*)))
 (define-type-predicate simple-array-unsigned-byte-4-p

diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c
index 8610294..147b2f3 100644 (file)
--- a/src/runtime/gc-common.c
+++ b/src/runtime/gc-common.c
@@ -846,6 +846,26 @@ size_vector(lispobj *where)
 }
 
 static int
 }
 
 static int

+scav_vector_nil(lispobj *where, lispobj object)
+{
+    return 2;
+}
+
+static lispobj
+trans_vector_nil(lispobj object)
+{
+    gc_assert(is_lisp_pointer(object));
+    return copy_unboxed_object(object, 2);
+}
+
+static int
+size_vector_nil(lispobj *where)
+{
+    /* Just the header word and the length word */
+    return 2;
+}
+
+static int

 scav_vector_bit(lispobj *where, lispobj object)
 {
     struct vector *vector;
 scav_vector_bit(lispobj *where, lispobj object)
 {
     struct vector *vector;

@@ -1508,6 +1528,7 @@ gc_init_tables(void)
     scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
     scavtab[SIMPLE_STRING_WIDETAG] = scav_string;
     scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
     scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
     scavtab[SIMPLE_STRING_WIDETAG] = scav_string;
     scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;

+    scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;

     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
        scav_vector_unsigned_byte_2;
     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
        scav_vector_unsigned_byte_2;
     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =

@@ -1603,6 +1624,7 @@ gc_init_tables(void)
     transother[SIMPLE_STRING_WIDETAG] = trans_string;
     transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
     transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
     transother[SIMPLE_STRING_WIDETAG] = trans_string;
     transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
     transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;

+    transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;

     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
        trans_vector_unsigned_byte_2;
     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
        trans_vector_unsigned_byte_2;
     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =

@@ -1702,6 +1724,7 @@ gc_init_tables(void)
     sizetab[SIMPLE_STRING_WIDETAG] = size_string;
     sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
     sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
     sizetab[SIMPLE_STRING_WIDETAG] = size_string;
     sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
     sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;

+    sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;

     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
        size_vector_unsigned_byte_2;
     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
        size_vector_unsigned_byte_2;
     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 5fb17ea..aec65cd 100644 (file)
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -2306,6 +2306,7 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer)
 #endif
        case SIMPLE_STRING_WIDETAG:
        case SIMPLE_BIT_VECTOR_WIDETAG:
 #endif
        case SIMPLE_STRING_WIDETAG:
        case SIMPLE_BIT_VECTOR_WIDETAG:

+       case SIMPLE_ARRAY_NIL_WIDETAG:

        case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:

@@ -2389,6 +2390,7 @@ maybe_adjust_large_object(lispobj *where)
     case BIGNUM_WIDETAG:
     case SIMPLE_STRING_WIDETAG:
     case SIMPLE_BIT_VECTOR_WIDETAG:
     case BIGNUM_WIDETAG:
     case SIMPLE_STRING_WIDETAG:
     case SIMPLE_BIT_VECTOR_WIDETAG:

+    case SIMPLE_ARRAY_NIL_WIDETAG:

     case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:

@@ -3380,6 +3382,7 @@ verify_space(lispobj *start, size_t words)
 #endif
                case SIMPLE_STRING_WIDETAG:
                case SIMPLE_BIT_VECTOR_WIDETAG:
 #endif
                case SIMPLE_STRING_WIDETAG:
                case SIMPLE_BIT_VECTOR_WIDETAG:

+               case SIMPLE_ARRAY_NIL_WIDETAG:

                case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:

diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp
index 6663f06..50f9987 100644 (file)
--- a/tests/array.pure.lisp
+++ b/tests/array.pure.lisp
@@ -108,3 +108,11 @@
 (let ((x (copy-seq #*0011))
       (y (copy-seq #*0101)))
   (assert (equalp (bit-and x y nil) #*0001)))
 (let ((x (copy-seq #*0011))
       (y (copy-seq #*0101)))
   (assert (equalp (bit-and x y nil) #*0001)))

+
+;;; arrays of NIL should work, FSVO "work".
+(let ((a (make-array '(10 10) :element-type 'nil)))
+  (assert (= (array-total-size a) 100))
+  (assert (equal (array-dimensions a) '(10 10)))
+  (assert (eq (array-element-type a) 'nil)))
+
+(assert (eq (upgraded-array-element-type 'nil) 'nil))

diff --git a/version.lisp-expr b/version.lisp-expr
index eed2ce6..50f5b56 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 

-"0.7.13.20"
+"0.7.13.21"