src/compiler/generic/array.lisp

   1 ;;;; generic array operations
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11 (in-package "SB!VM")
  12 \f
  13 ;;; (ARRAY NIL) stuff looks the same on all platforms
  14 (define-vop (data-vector-ref/simple-array-nil)
  15   (:translate data-vector-ref)
  16   (:policy :fast-safe)
  17   (:args (object :scs (descriptor-reg))
  18          (index :scs (unsigned-reg)))
  19   (:arg-types simple-array-nil positive-fixnum)
  20   (:results (value :scs (descriptor-reg)))
  21   (:result-types *)
  22   (:ignore index value)
  23   (:vop-var vop)
  24   (:save-p :compute-only)
  25   (:generator 1
  26     (error-call vop
  27                 #!+(or x86 x86-64 ppc) 'nil-array-accessed-error
  28                 #!-(or x86 x86-64 ppc) nil-array-accessed-error
  29                 object)))
  30
  31 ;;; It shouldn't be possible to fall through to here in normal user
  32 ;;; code, as the system is smart enough to deduce that there must be
  33 ;;; an error upstream, as there are no objects of type NIL that can be
  34 ;;; stored in this data vector; however, just in case, we provide this
  35 ;;; translation, so that
  36 ;;;   (LOCALLY
  37 ;;;     (DECLARE (TYPE (SIMPLE-ARRAY NIL (*)) X)
  38 ;;;              (OPTIMIZE (SPEED 3) (SAFETY 0)))
  39 ;;;     (SB-KERNEL:DATA-VECTOR-SET X 3 'FOO))
  40 ;;; signals the right kind of error.
  41 (define-vop (data-vector-set/simple-array-nil)
  42   (:translate data-vector-set)
  43   (:policy :fast-safe)
  44   (:args (object :scs (descriptor-reg))
  45          (index :scs (unsigned-reg))
  46          (value :scs (descriptor-reg)))
  47   (:arg-types simple-array-nil positive-fixnum *)
  48   (:results (result :scs (descriptor-reg)))
  49   (:result-types *)
  50   (:ignore index value result)
  51   (:vop-var vop)
  52   (:save-p :compute-only)
  53   (:generator 1
  54     (error-call vop
  55                 #!+(or x86 x86-64 ppc) 'nil-array-accessed-error
  56                 #!-(or x86 x86-64 ppc) nil-array-accessed-error
  57                 object)))
  58
  59 (define-vop (data-vector-ref-with-offset/simple-array-nil)
  60   (:translate data-vector-ref-with-offset)
  61   (:policy :fast-safe)
  62   (:args (object :scs (descriptor-reg))
  63          (index :scs (unsigned-reg)))
  64   (:info offset)
  65   (:arg-types simple-array-nil positive-fixnum
  66               (:constant (integer 0 0)))
  67   (:results (value :scs (descriptor-reg)))
  68   (:result-types *)
  69   (:ignore index value offset)
  70   (:vop-var vop)
  71   (:save-p :compute-only)
  72   (:generator 1
  73     (error-call vop
  74                 #!+(or x86 x86-64 ppc) 'nil-array-accessed-error
  75                 #!-(or x86 x86-64 ppc) nil-array-accessed-error
  76                 object)))
  77
  78 (define-vop (data-vector-set/simple-array-nil)
  79   (:translate data-vector-set)
  80   (:policy :fast-safe)
  81   (:args (object :scs (descriptor-reg))
  82          (index :scs (unsigned-reg))
  83          (value :scs (descriptor-reg)))
  84   (:info offset)
  85   (:arg-types simple-array-nil positive-fixnum *
  86               (:constant (integer 0 0)))
  87   (:results (result :scs (descriptor-reg)))
  88   (:result-types *)
  89   (:ignore index value result offset)
  90   (:vop-var vop)
  91   (:save-p :compute-only)
  92   (:generator 1
  93     (error-call vop
  94                 #!+(or x86 x86-64 ppc) 'nil-array-accessed-error
  95                 #!-(or x86 x86-64 ppc) nil-array-accessed-error
  96                 object)))
  97 \f
  98 ;;; FIXME: There is probably plenty of other array stuff that looks
  99 ;;; the same or similar enough to be genericized.  Do so, and move it
 100 ;;; here so that a new port doesn't need to do as much work.