src/code/specializable-array.lisp

   1 ;;;; a hack to suppress array specialization when building under the
   2 ;;;; cross-compiler
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; This software is derived from the CMU CL system, which was
   8 ;;;; written at Carnegie Mellon University and released into the
   9 ;;;; public domain. The software is in the public domain and is
  10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  11 ;;;; files for more information.
  12
  13 (in-package "SB!KERNEL")
  14
  15 (file-comment
  16   "$Header$")
  17
  18 ;;; It's hard to dump specialized vectors portably, because ANSI
  19 ;;; doesn't guarantee much about what specialized vectors exist.
  20 ;;; Thus, if we do
  21 ;;;   (MAKE-ARRAY 10 :ELEMENT-TYPE '(UNSIGNED-BYTE 4))
  22 ;;; in the cross-compilation host, we could easily end up with a
  23 ;;; vector of (UNSIGNED-BYTE 8) or of T, and the dumped result would
  24 ;;; reflect this.
  25 ;;;
  26 ;;; To reduce the prominence of this issue in cross-compilation, we
  27 ;;; can use these types, which expands into a specialized vector type when
  28 ;;; building the cross-compiler, and a SIMPLE-VECTOR otherwise.
  29 (deftype specializable (type)
  30   #+sb-xc-host (declare (ignore type))
  31   #+sb-xc-host t
  32   #-sb-xc-host type)
  33 (deftype specializable-vector (element-type)
  34   `(array (specializable ,element-type) 1))
  35
  36 ;;; MAKE-SPECIALIZABLE-ARRAY is MAKE-ARRAY, except that in the interests of
  37 ;;; being able to dump the result without worrying about nonportable
  38 ;;; dependences on what kinds of specialized vectors actually exist in the
  39 ;;; cross-compilation host, any :ELEMENT-TYPE argument is discarded when
  40 ;;; running under the cross-compilation host ANSI Common Lisp.
  41 #+sb-xc-host
  42 (defun make-specializable-array (dimensions
  43                                  &rest rest
  44                                  &key (element-type t)
  45                                  &allow-other-keys)
  46   (apply #'make-array
  47          dimensions
  48          (if (eq element-type t)
  49            rest
  50            (do ((reversed-modified-rest nil))
  51                ((null rest) (nreverse reversed-modified-rest))
  52              (let ((first (pop rest))
  53                    (second (pop rest)))
  54                (when (eq first :element-type)
  55                  (setf second t))
  56                (push first reversed-modified-rest)
  57                (push second reversed-modified-rest))))))
  58 #-sb-xc-host
  59 (declaim #!-sb-fluid (inline make-specializable-array))
  60 #-sb-xc-host
  61 (defun make-specializable-array (&rest rest) (apply #'make-array rest))