kpriv/freebsd-ports
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

lang/sbcl: Fix build by removing old patches

Browse source 
Approved by:	krion (maintainer)
Differential Revision:	https://reviews.freebsd.org/D31860
This commit is contained in:
Joseph Mingrone 2021-09-06 11:31:02 -03:00
parent c0545dfd2b
commit 04efa6e0f8
No known key found for this signature in database
GPG key ID: 36A40C83B0D6EF9E
2 changed files with 0 additions and 164 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

143
lang/sbcl/files/patch-src_code_seq.lisp
View file

@ -1,143 +0,0 @@
--- src/code/seq.lisp.orig 2021-07-30 08:42:09 UTC
+++ src/code/seq.lisp
@@ -722,52 +722,53 @@
collect `(eq ,tag ,(sb-vm:saetp-typecode saetp)))))
;;;; REPLACE
-(defun vector-replace (vector1 vector2 start1 start2 end1 diff)
- (declare ((or (eql -1) index) start1 start2 end1)
- (optimize (sb-c::insert-array-bounds-checks 0))
- ((integer -1 1) diff))
- (let ((tag1 (%other-pointer-widetag vector1))
- (tag2 (%other-pointer-widetag vector2)))
- (macrolet ((copy (&body body)
- `(do ((index1 start1 (+ index1 diff))
- (index2 start2 (+ index2 diff)))
- ((= index1 end1))
- (declare (fixnum index1 index2))
- ,@body)))
- (when (= tag1 tag2)
- (when (= tag1 sb-vm:simple-vector-widetag)
- (copy (setf (svref vector1 index1) (svref vector2 index2)))
- (return-from vector-replace vector1))
- (let ((copier (sb-vm::blt-copier-for-widetag tag1)))
- (when (functionp copier)
- ;; VECTOR1 = destination, VECTOR2 = source, but copier wants FROM, TO
- (funcall copier vector2 start2 vector1 start1 (- end1 start1))
- (return-from vector-replace vector1))))
- (let ((getter (the function (svref %%data-vector-reffers%% tag2)))
- (setter (the function (svref %%data-vector-setters%% tag1))))
- (copy (funcall setter vector1 index1 (funcall getter vector2 index2))))))
- vector1)
;;; If we are copying around in the same vector, be careful not to copy the
;;; same elements over repeatedly. We do this by copying backwards.
+;;; Bounding indices were checked for validity by DEFINE-SEQUENCE-TRAVERSER.
(defmacro vector-replace-from-vector ()
- `(let ((nelts (min (- target-end target-start)
- (- source-end source-start))))
- (with-array-data ((data1 target-sequence) (start1 target-start) (end1))
- (declare (ignore end1))
- (let ((end1 (the fixnum (+ start1 nelts))))
- (if (and (eq target-sequence source-sequence)
- (> target-start source-start))
- (let ((end (the fixnum (1- end1))))
- (vector-replace data1 data1
- end
- (the fixnum (- end
- (- target-start source-start)))
- (1- start1)
- -1))
- (with-array-data ((data2 source-sequence) (start2 source-start) (end2))
- (declare (ignore end2))
- (vector-replace data1 data2 start1 start2 end1 1)))))
+ `(locally
+ (declare (optimize (safety 0)))
+ (let ((nelts (min (- target-end target-start)
+ (- source-end source-start))))
+ (when (plusp nelts)
+ (with-array-data ((data1 target-sequence) (start1 target-start) (end1))
+ (progn end1)
+ (with-array-data ((data2 source-sequence) (start2 source-start) (end2))
+ (progn end2)
+ (let ((tag1 (%other-pointer-widetag data1))
+ (tag2 (%other-pointer-widetag data2)))
+ (block replace
+ (when (= tag1 tag2)
+ (when (= tag1 sb-vm:simple-vector-widetag) ; rely on the transform
+ (replace (truly-the simple-vector data1)
+ (truly-the simple-vector data2)
+ :start1 start1 :end1 (truly-the index (+ start1 nelts))
+ :start2 start2 :end2 (truly-the index (+ start2 nelts)))
+ (return-from replace))
+ (let ((copier (sb-vm::blt-copier-for-widetag tag1)))
+ (when (functionp copier)
+ ;; these copiers figure out which direction to step.
+ ;; arg order is FROM, TO which is the opposite of REPLACE.
+ (funcall copier data2 start2 data1 start1 nelts)
+ (return-from replace))))
+ ;; General case is just like the code emitted by TRANSFORM-REPLACE
+ ;; but using the getter and setter.
+ (let ((getter (the function (svref %%data-vector-reffers%% tag2)))
+ (setter (the function (svref %%data-vector-setters%% tag1))))
+ (cond ((and (eq data1 data2) (> start1 start2))
+ (do ((i (the (or (eql -1) index) (+ start1 nelts -1)) (1- i))
+ (j (the (or (eql -1) index) (+ start2 nelts -1)) (1- j)))
+ ((< i start1))
+ (declare (index i j))
+ (funcall setter data1 i (funcall getter data2 j))))
+ (t
+ (do ((i start1 (1+ i))
+ (j start2 (1+ j))
+ (end (the index (+ start1 nelts))))
+ ((>= i end))
+ (declare (index i j))
+ (funcall setter data1 i (funcall getter data2 j))))))))))))
target-sequence))
(defmacro list-replace-from-list ()
@@ -819,44 +820,6 @@
target-sequence)
(declare (fixnum target-index source-index))
(setf (aref target-sequence target-index) (car source-sequence))))
-
-;;;; The support routines for REPLACE are used by compiler transforms, so we
-;;;; worry about dealing with END being supplied or defaulting to NIL
-;;;; at this level.
-
-(defun list-replace-from-list* (target-sequence source-sequence target-start
- target-end source-start source-end)
- (when (null target-end) (setq target-end (length target-sequence)))
- (when (null source-end) (setq source-end (length source-sequence)))
- (list-replace-from-list))
-
-(defun list-replace-from-vector* (target-sequence source-sequence target-start
- target-end source-start source-end)
- (when (null target-end) (setq target-end (length target-sequence)))
- (when (null source-end) (setq source-end (length source-sequence)))
- (list-replace-from-vector))
-
-(defun vector-replace-from-list* (target-sequence source-sequence target-start
- target-end source-start source-end)
- (when (null target-end) (setq target-end (length target-sequence)))
- (when (null source-end) (setq source-end (length source-sequence)))
- (vector-replace-from-list))
-
-(defun vector-replace-from-vector* (target-sequence source-sequence
- target-start target-end source-start
- source-end)
- (when (null target-end) (setq target-end (length target-sequence)))
- (when (null source-end) (setq source-end (length source-sequence)))
- (vector-replace-from-vector))
-
-#+sb-unicode
-(defun simple-character-string-replace-from-simple-character-string*
- (target-sequence source-sequence
- target-start target-end source-start source-end)
- (declare (type (simple-array character (*)) target-sequence source-sequence))
- (when (null target-end) (setq target-end (length target-sequence)))
- (when (null source-end) (setq source-end (length source-sequence)))
- (vector-replace-from-vector))
(define-sequence-traverser replace
(target-sequence1 source-sequence2 &rest args &key start1 end1 start2 end2)

21
lang/sbcl/files/patch-tests_seq.pure.lisp
View file

@ -1,21 +0,0 @@
--- tests/seq.pure.lisp.orig 2021-07-30 08:42:10 UTC
+++ tests/seq.pure.lisp
@@ -584,3 +584,18 @@
;; Try all other numeric array types
(dolist (y arrays)
(assert (equalp x y)))))))
+
+;; lp#1938598
+(with-test (:name :vector-replace-self)
+ ;; example 1
+ (let ((string (make-array 0 :adjustable t :fill-pointer 0 :element-type 'character)))
+ (declare (notinline replace))
+ (vector-push-extend #\_ string)
+ ;; also test it indirectly
+ (replace string string :start1 1 :start2 0))
+ ;; example 2
+ (let ((string (make-array 0 :adjustable t :fill-pointer 0 :element-type 'character)))
+ (declare (notinline replace))
+ (loop for char across "tset" do (vector-push-extend char string))
+ (replace string string :start2 1 :start1 2)
+ (assert (string= string "tsse"))))