1.0.9.18: Instrument COMPUTE-CALLING-FRAME for non-x86 with /noshow0.
[sbcl.git] / 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 ;;; It's hard to dump specialized vectors portably, because ANSI
16 ;;; doesn't guarantee much about what specialized vectors exist.
17 ;;; Thus, if we do
18 ;;;   (MAKE-ARRAY 10 :ELEMENT-TYPE '(UNSIGNED-BYTE 4))
19 ;;; in the cross-compilation host, we could easily end up with a
20 ;;; vector of (UNSIGNED-BYTE 8) or of T, and the dumped result would
21 ;;; reflect this.
22 ;;;
23 ;;; To reduce the prominence of this issue in cross-compilation, we
24 ;;; can use these types, which expands into a specialized vector type when
25 ;;; building the cross-compiler, and a SIMPLE-VECTOR otherwise.
26 (deftype specializable (type)
27   #+sb-xc-host (declare (ignore type))
28   #+sb-xc-host t
29   #-sb-xc-host type)
30 (deftype specializable-vector (element-type)
31   `(array (specializable ,element-type) 1))
32
33 ;;; MAKE-SPECIALIZABLE-ARRAY is MAKE-ARRAY, except that in the interests of
34 ;;; being able to dump the result without worrying about nonportable
35 ;;; dependences on what kinds of specialized vectors actually exist in the
36 ;;; cross-compilation host, any :ELEMENT-TYPE argument is discarded when
37 ;;; running under the cross-compilation host ANSI Common Lisp.
38 #+sb-xc-host
39 (defun make-specializable-array (dimensions
40                                  &rest rest
41                                  &key (element-type t)
42                                  &allow-other-keys)
43   (apply #'make-array
44          dimensions
45          (if (eq element-type t)
46            rest
47            (do ((reversed-modified-rest nil))
48                ((null rest) (nreverse reversed-modified-rest))
49              (let ((first (pop rest))
50                    (second (pop rest)))
51                (when (eq first :element-type)
52                  (setf second t))
53                (push first reversed-modified-rest)
54                (push second reversed-modified-rest))))))
55 #-sb-xc-host
56 (declaim #!-sb-fluid (inline make-specializable-array))
57 #-sb-xc-host
58 (defun make-specializable-array (&rest rest) (apply #'make-array rest))