common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Remove still more assumptions about 0-filled heap

Browse source
This commit is contained in:
Douglas Katzman 2021-08-20 09:47:57 -04:00
parent de25c33663
commit a3d7e2f175
12 changed files with 32 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
src/code/room.lisp
View file

@ -1275,7 +1275,8 @@ We could try a few things to mitigate this:
&aux (n-code-bytes 0)
(total-pages next-free-page)
(pages
(make-array total-pages :element-type 'bit)))
(make-array total-pages :element-type 'bit
:initial-element 0)))
(flet ((dump-page (page-num)
(format stream "~&Page ~D~%" page-num)
(let ((where (+ dynamic-space-start (* page-num gencgc-card-bytes)))
@ -1364,8 +1365,8 @@ We could try a few things to mitigate this:
(defun !ensure-genesis-code/data-separation ()
#+gencgc
(let* ((n-bits (+ next-free-page 10))
(code-bits (make-array n-bits :element-type 'bit))
(data-bits (make-array n-bits :element-type 'bit))
(code-bits (make-array n-bits :element-type 'bit :initial-element 0))
(data-bits (make-array n-bits :element-type 'bit :initial-element 0))
(total-code-size 0))
(map-allocated-objects
(lambda (obj type size)

6
tests/bit-vector.impure.lisp
View file

@ -41,9 +41,9 @@
;; SPACE)
(locally
(declare (optimize (speed 3) (space 1)))
(let ((bv1 (make-array 5 :element-type 'bit))
(bv2 (make-array 0 :element-type 'bit))
(bv3 (make-array 68 :element-type 'bit)))
(let ((bv1 (make-array 5 :element-type 'bit :initial-element 0))
(bv2 (make-array 0 :element-type 'bit :initial-element 0))
(bv3 (make-array 68 :element-type 'bit :initial-element 0)))
(declare (type simple-bit-vector bv1 bv2 bv3))
(setf (sbit bv3 42) 1)
;; bitvector smaller than the word size

14
tests/bivalent-stream.impure.lisp
View file

@ -45,6 +45,8 @@
expected ~S.~@:>"
write-call read-call result expected)))
(defun zero-string (n) (make-string n :initial-element #\nul))
(defvar *read/write-sequence-pairs*
`(;; List source and destination sequence.
((65) () ,(list 0) () 1 (#\A))
@ -94,12 +96,12 @@
(#(#\B) () ,(cvector #\_ #\_) (:end 1) 1 #(#\B #\_))
(#(#\B) () ,(cvector #\_ #\_) (:start 1) 2 #(#\_ #\B))
;; String destination sequence.
(#(65) () ,(make-string 1) () 1 "A")
(#(#\B) () ,(make-string 1) () 1 "B")
(#(66 #\C) () ,(make-string 2) () 2 "BC")
(#(#\B 67) () ,(make-string 2) () 2 "BC")
(#(#\B) () ,(make-string 2) (:end 1) 1 ,(coerce '(#\B #\Nul) 'string))
(#(#\B) () ,(make-string 2) (:start 1) 2 ,(coerce '(#\Nul #\B) 'string))))
(#(65) () ,(zero-string 1) () 1 "A")
(#(#\B) () ,(zero-string 1) () 1 "B")
(#(66 #\C) () ,(zero-string 2) () 2 "BC")
(#(#\B 67) () ,(zero-string 2) () 2 "BC")
(#(#\B) () ,(zero-string 2) (:end 1) 1 ,(coerce '(#\B #\Nul) 'string))
(#(#\B) () ,(zero-string 2) (:start 1) 2 ,(coerce '(#\Nul #\B) 'string))))
(defun do-writes (stream pairs)
(loop :for (sequence args) :in pairs

3
tests/compiler.impure.lisp
View file

@ -1175,7 +1175,8 @@
(assert (every #'=
'(-1.0 0.0 0.0 0.0 0.0 -1.0 0.0 0.0 0.0 0.0 -1.0 0.0 0.0 0.0 0.0 1.0)
(rotate-around
(make-array 3 :element-type 'single-float) (coerce pi 'single-float))))
(make-array 3 :element-type 'single-float :initial-element 0f0)
(coerce pi 'single-float))))
;; Same bug manifests in COMPLEX-ATANH as well.
(assert (= (atanh #C(-0.7d0 1.1d0)) #C(-0.28715567731069275d0 0.9394245539093365d0))))

4
tests/gc.impure.lisp
View file

@ -268,8 +268,8 @@
#+gencgc
(defun ensure-code/data-separation ()
(let* ((n-bits (+ sb-vm:next-free-page 10))
(code-bits (make-array n-bits :element-type 'bit))
(data-bits (make-array n-bits :element-type 'bit))
(code-bits (make-array n-bits :element-type 'bit :initial-element 0))
(data-bits (make-array n-bits :element-type 'bit :initial-element 0))
(total-code-size 0))
(sb-vm:map-allocated-objects
(lambda (obj type size)

2
tests/inspect.impure.lisp
View file

@ -42,7 +42,7 @@
(assert (search "an ARRAY of T" result))
(assert (search "dimensions are ()" result)))
(let ((array (make-array '() :element-type 'fixnum)))
(let ((array (make-array '() :element-type 'fixnum :initial-element 0)))
(assert (search "an ARRAY of FIXNUM" (test-inspect array))))
(let ((array (let ((a (make-array () :initial-element 0)))

2
tests/octets.pure.lisp
View file

@ -47,7 +47,7 @@
(ensure-roundtrip-latin :latin9))
(ensure-roundtrip-utf8 ()
(let ((string (make-string char-code-limit)))
(let ((string (make-string char-code-limit :initial-element #\nul)))
(dotimes (i char-code-limit)
(unless (<= #xd800 i #xdfff)
(setf (char string i) (code-char i))))

6
tests/print.impure.lisp
View file

@ -156,10 +156,10 @@
'(1 2 0))))
(with-test (:name (print array *print-readably* :element-type))
(dolist (array (list (make-array '(1 0 1))
(dolist (array (list (make-array '(1 0 1) :initial-element 0)
(make-array 0 :element-type nil)
(make-array 1 :element-type 'base-char)
(make-array 1 :element-type 'character)))
(make-array 1 :element-type 'base-char :initial-element #\nul)
(make-array 1 :element-type 'character :initial-element #\nul)))
(assert (multiple-value-bind (result error)
(read-from-string
(write-to-string array :readably t))

3
tests/reader.pure.lisp
View file

@ -418,7 +418,8 @@
(sb-int:simple-reader-error () :win))
:win)))
(with-test (:name :sharp-star-default-fill :skipped-on :big-endian)
(with-test (:name :sharp-star-default-fill :skipped-on :sbcl)
;; can't assert anything about bits beyond the supplied ones
(let ((bv (opaque-identity #*11)))
(assert (= (sb-kernel:%vector-raw-bits bv 0) 3))))

3
tests/seq.impure.lisp
View file

@ -1218,7 +1218,8 @@
(defun random-test-bit-position (n)
(loop repeat n
do (let* ((vector (make-array (+ 2 (random 5000)) :element-type 'bit))
do (let* ((vector (make-array (+ 2 (random 5000)) :element-type 'bit
:initial-element 0))
(offset (random (1- (length vector))))
(size (1+ (random (- (length vector) offset))))
(disp (make-array size :element-type 'bit :displaced-to vector

4
tests/seq.pure.lisp
View file

@ -546,8 +546,8 @@
(with-test (:name :array-equalp-non-consing
:skipped-on :interpreter)
(let ((a (make-array 1000 :element-type 'double-float))
(b (make-array 1000 :element-type 'double-float)))
(let ((a (make-array 1000 :element-type 'double-float :initial-element 0d0))
(b (make-array 1000 :element-type 'double-float :initial-element 0d0)))
(ctu:assert-no-consing (equalp a b))))
(with-test (:name (search :array-equalp-numerics))

3
tests/symbol.impure.lisp
View file

@ -17,7 +17,8 @@
(with-test (:name :defvar-type-error)
(assert (eq :ok
(handler-case
(eval `(defvar *foo* (make-array 10 :element-type '(unsigned-byte 60))))
(eval `(defvar *foo* (make-array 10 :element-type '(unsigned-byte 60)
:initial-element 0)))
(type-error (e)
(when (and (typep e 'type-error)
(equal '(simple-array fixnum (*))