61 lines
2.8 KiB
Diff
61 lines
2.8 KiB
Diff
From 60bbad167b0691995a659121acda55392e4021b6 Mon Sep 17 00:00:00 2001
|
|
From: Andrew Berkley <ajb@dwavesys.com>
|
|
Date: Sun, 4 Jul 2021 12:50:34 -0700
|
|
Subject: [PATCH] Fix for sbcl 2.1.6
|
|
|
|
---
|
|
compat.lisp | 30 +++++++++++++++---------------
|
|
1 file changed, 15 insertions(+), 15 deletions(-)
|
|
|
|
diff --git a/compat.lisp b/compat.lisp
|
|
index 95a9869..ea6d1a1 100644
|
|
--- a/compat.lisp
|
|
+++ b/compat.lisp
|
|
@@ -1,12 +1,13 @@
|
|
(in-package #:png)
|
|
|
|
-#+sbcl ; Present in SBCL 1.0.24.
|
|
-(declaim (ftype (function (array) (values (simple-array * (*)) &optional))
|
|
- array-storage-vector))
|
|
-
|
|
#+sbcl
|
|
-(defun array-storage-vector (array)
|
|
- "Returns the underlying storage vector of ARRAY, which must be a non-displaced array.
|
|
+(macrolet ((make-array-storage-vector ()
|
|
+ (let ((%array-data-vector (or (find-symbol "%ARRAY-DATA-VECTOR" :sb-kernel)
|
|
+ (find-symbol "%ARRAY-DATA" :sb-kernel)))) ;; renamed in sbcl 2.1.6
|
|
+ `(progn
|
|
+ (declaim (ftype (function (array) (values (simple-array * (*)) &optional)) array-storage-vector))
|
|
+ (defun array-storage-vector (array)
|
|
+ "Returns the underlying storage vector of ARRAY, which must be a non-displaced array.
|
|
|
|
In SBCL, if ARRAY is a of type \(SIMPLE-ARRAY * \(*)), it is its own storage
|
|
vector. Multidimensional arrays, arrays with fill pointers, and adjustable
|
|
@@ -16,15 +17,14 @@ ARRAY, which this function returns.
|
|
Important note: the underlying vector is an implementation detail. Even though
|
|
this function exposes it, changes in the implementation may cause this
|
|
function to be removed without further warning."
|
|
- ;; KLUDGE: Without TRULY-THE the system is not smart enough to
|
|
- ;; figure out that the return value is always of the known type.
|
|
- (sb-ext:truly-the (simple-array * (*))
|
|
- (if (sb-kernel:array-header-p array)
|
|
- (if (sb-kernel:%array-displaced-p array)
|
|
- (error "~S cannot be used with displaced arrays. Use ~S instead."
|
|
- 'array-storage-vector 'array-displacement)
|
|
- (sb-kernel:%array-data-vector array))
|
|
- array)))
|
|
+ (sb-ext:truly-the (simple-array * (*))
|
|
+ (if (sb-kernel:array-header-p array)
|
|
+ (if (sb-kernel:%array-displaced-p array)
|
|
+ (error "~S cannot be used with displaced arrays. Use ~S instead."
|
|
+ 'array-storage-vector 'array-displacement)
|
|
+ (,%array-data-vector array))
|
|
+ array)))))))
|
|
+ (make-array-storage-vector))
|
|
|
|
#+allegro
|
|
(defmacro with-pointer-to-array-data ((ptr-var array) &body body)
|
|
--
|
|
2.33.0
|
|
|