Signed-off-by: Juho Snellman <jsnell@jsnell-mac-zrh.local>
---
 src/compiler/array-tran.lisp      |   30 ++++++++++++++++++++++++++++++
 src/compiler/generic/vm-tran.lisp |    8 +++++---
 2 files changed, 35 insertions(+), 3 deletions(-)

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 5aaf16a..efccf1e 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -13,6 +13,9 @@
 
 ;;;; utilities for optimizing array operations
 
+(deftype complex-non-displaced-vector ()
+  '(and vector (not simple-array) (not (satisfies array-displacement))))
+
 ;;; Return UPGRADED-ARRAY-ELEMENT-TYPE for LVAR, or do
 ;;; GIVE-UP-IR1-TRANSFORM if the upgraded element type can't be
 ;;; determined.
@@ -1068,7 +1071,34 @@
   `(hairy-data-vector-set array
                           (%check-bound array (array-total-size array) index)
                           new-value))
+
+
 
+;;;; extensible non-displaced vectors
+
+(deftransform vector-pop ((array) (complex-non-displaced-vector) *)
+  `(let ((fill-pointer (fill-pointer array)))
+     (if (zerop fill-pointer)
+         (error "There is nothing left to pop.")
+         ;; disable bounds checking (and any fixnum test)
+         (locally (declare (optimize (safety 0)))
+           (aref array
+                 (setf (%array-fill-pointer array)
+                       (1- fill-pointer)))))))
+
+(deftransform vector-push-extend ((new-element vector) (t complex-non-displaced-vector) *)
+  `(let ((min-extension (length vector)))
+     (let ((fill-pointer (fill-pointer vector)))
+       (declare (fixnum fill-pointer))
+       (when (= fill-pointer (%array-available-elements vector))
+         (adjust-array vector (+ fill-pointer (max 1 min-extension))))
+       ;; disable bounds checking
+       (locally (declare (optimize (safety 0)))
+         (setf (aref vector fill-pointer) new-element))
+       (setf (%array-fill-pointer vector) (1+ fill-pointer))
+       fill-pointer)))
+
+;
 ;;;; bit-vector array operation canonicalization
 ;;;;
 ;;;; We convert all bit-vector operations to have the result array
diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 22f075a..a32dd3b 100644
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -110,7 +110,9 @@
 ;;; arrays, but after benchmarking (on x86), Nikodemus didn't find any cases
 ;;; where it actually helped with non-simple arrays -- to the contrary, it
 ;;; only made for bigger and up 1o 100% slower code.
-(deftransform hairy-data-vector-ref ((array index) (simple-array t) *)
+(deftransform hairy-data-vector-ref ((array index)
+                                     ((or simple-array complex-non-displaced-vector) t)
+                                     *)
   "avoid runtime dispatch on array element type"
   (let ((element-ctype (extract-upgraded-element-type array))
         (declared-element-ctype (extract-declared-element-type array)))
@@ -197,7 +199,7 @@
 ;;; where it actually helped with non-simple arrays -- to the contrary, it
 ;;; only made for bigger and up 1o 100% slower code.
 (deftransform hairy-data-vector-set ((array index new-value)
-                                     (simple-array t t)
+                                     ((or simple-array complex-non-displaced-vector) t t)
                                      *)
   "avoid runtime dispatch on array element type"
   (let ((element-ctype (extract-upgraded-element-type array))
@@ -274,7 +276,7 @@
                 index)))))
 
 (deftransform %data-vector-and-index ((%array %index)
-                                      (simple-array t)
+                                      ((or simple-array complex-non-displaced-vector) t)
                                       *)
   ;; KLUDGE: why the percent signs?  Well, ARRAY and INDEX are
   ;; respectively exported from the CL and SB!INT packages, which
-- 
1.6.6.rc2