* enhancement: SBCL now provides either an explicit :BIG-ENDIAN or
:LITTLE-ENDIAN in *FEATURES*, instead of :BIG-ENDIAN being implied by lack
of the :LITTLE-ENDIAN feature. (Thanks to Luís Oliveira, lp#901661)
+ * optimization: specialized arrays with non-zero :INITIAL-ELEMENT can
+ be stack-allocated. (lp#902351)
* optimization: the compiler is smarter about representation selection for
floating point constants used in full calls.
* optimization: the compiler no longer refuses to coerce large fixnums to
no longer claim to be unable to stack allocate the function.
* bug fix: COERCE now signals a type-error on several coercions to
subtypes of CHARACTER that are forbidden according to ANSI. (lp#841312)
+ * bug fix: missing failure-to-stack-allocate compiler notes for some
+ forms of MAKE-ARRAY with dynamic-extent. (lp#902351)
changes in sbcl-1.0.54 relative to sbcl-1.0.53:
* minor incompatible changes:
(values))
;; common uses for constant-byte-bashing
+ (defknown ,array-fill-name (word simple-unboxed-array ,offset ,offset)
+ simple-unboxed-array
+ ()
+ :result-arg 1)
(defun ,array-fill-name (value dst dst-offset length)
(declare (type word value) (type ,offset dst-offset length))
(declare (optimize (speed 3) (safety 1)))
(,constant-bash-name dst dst-offset length value
- #'%vector-raw-bits #'%set-vector-raw-bits))
+ #'%vector-raw-bits #'%set-vector-raw-bits)
+ dst)
(defun ,system-area-fill-name (value dst dst-offset length)
(declare (type word value) (type ,offset dst-offset length))
(declare (optimize (speed 3) (safety 1)))
(:variant ,offset))
,@(when writable
`((defknown ((setf ,fn)) (,lisp-type) ,lisp-type
- (unsafe))
+ ())
(define-vop (,set ,set-vop)
(:translate (setf ,fn))
(:variant ,offset)))))))))
(defknown classoid-of (t) classoid (flushable))
(defknown layout-of (t) layout (flushable))
(defknown copy-structure (structure-object) structure-object
- (flushable unsafe))
+ (flushable))
\f
;;;; from the "Control Structure" chapter:
(defknown special-operator-p (symbol) t
;; The set of special operators never changes.
(movable foldable flushable))
-(defknown set (symbol t) t (unsafe)
+(defknown set (symbol t) t ()
:derive-type #'result-type-last-arg)
-(defknown fdefinition ((or symbol cons)) function (unsafe explicit-check))
+(defknown fdefinition ((or symbol cons)) function (explicit-check))
(defknown %set-fdefinition ((or symbol cons) function) function
- (unsafe explicit-check))
+ (explicit-check))
(defknown makunbound (symbol) symbol)
(defknown fmakunbound ((or symbol cons)) (or symbol cons)
- (unsafe explicit-check))
+ (explicit-check))
(defknown apply (callable t &rest t) *) ; ### Last arg must be List...
(defknown funcall (callable &rest t) *)
;;; We let VALUES-LIST be foldable, since constant-folding will turn
;;; it into VALUES. VALUES is not foldable, since MV constants are
;;; represented by a call to VALUES.
-(defknown values (&rest t) * (movable flushable unsafe))
+(defknown values (&rest t) * (movable flushable))
(defknown values-list (list) * (movable foldable unsafely-flushable))
\f
;;;; from the "Macros" chapter:
(defknown copy-seq (sequence) consed-sequence (flushable)
:derive-type (sequence-result-nth-arg 1))
-(defknown length (sequence) index (foldable flushable))
+(defknown length (sequence) index (foldable flushable dx-safe))
(defknown reverse (sequence) consed-sequence (flushable)
:derive-type (sequence-result-nth-arg 1))
&key
(:initial-element t))
consed-sequence
- (movable unsafe)
+ (movable)
:derive-type (creation-result-type-specifier-nth-arg 1))
(defknown concatenate (type-specifier &rest sequence) consed-sequence
(defknown (every notany notevery) (callable sequence &rest sequence) boolean
(foldable unsafely-flushable call))
-;;; unsafe for :INITIAL-VALUE...
(defknown reduce (callable sequence &rest t &key (:from-end t) (:start index)
(:end sequence-end) (:initial-value t) (:key callable))
t
- (foldable flushable call unsafe))
+ (foldable flushable call))
(defknown fill (sequence t &rest t &key
(:start index) (:end sequence-end)) sequence
- (unsafe)
+ ()
:derive-type #'result-type-first-arg
:destroyed-constant-args (nth-constant-nonempty-sequence-args 1)
:result-arg 0)
t
(foldable unsafely-flushable))
-(defknown cons (t t) cons (movable flushable unsafe))
+(defknown cons (t t) cons (movable flushable))
(defknown tree-equal (t t &key (:test callable) (:test-not callable)) boolean
(foldable flushable call))
(defknown %lastn/fixnum (list (and unsigned-byte fixnum)) t (foldable flushable))
(defknown %lastn/bignum (list (and unsigned-byte bignum)) t (foldable flushable))
-(defknown list (&rest t) list (movable flushable unsafe))
-(defknown list* (t &rest t) t (movable flushable unsafe))
+(defknown list (&rest t) list (movable flushable))
+(defknown list* (t &rest t) t (movable flushable))
(defknown make-list (index &key (:initial-element t)) list
- (movable flushable unsafe))
+ (movable flushable))
;;; All but last must be of type LIST, but there seems to be no way to
;;; express that in this syntax.
:destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
(defknown ldiff (list t) list (flushable))
-(defknown (rplaca rplacd) (cons t) list (unsafe)
+(defknown (rplaca rplacd) (cons t) list ()
:destroyed-constant-args (nth-constant-args 1))
(defknown subst (t t t &key (:key callable) (:test callable)
(:test-not callable))
- t (flushable unsafe call))
+ t (flushable call))
(defknown nsubst (t t t &key (:key callable) (:test callable)
(:test-not callable))
- t (unsafe call)
+ t (call)
:destroyed-constant-args (nth-constant-nonempty-sequence-args 3))
(defknown (subst-if subst-if-not)
(t callable t &key (:key callable))
- t (flushable unsafe call))
+ t (flushable call))
(defknown (nsubst-if nsubst-if-not)
(t callable t &key (:key callable))
- t (unsafe call)
+ t (call)
:destroyed-constant-args (nth-constant-nonempty-sequence-args 3))
(defknown sublis (list t &key (:key callable) (:test callable)
(:test-not callable))
- t (flushable unsafe call))
+ t (flushable call))
(defknown nsublis (list t &key (:key callable) (:test callable)
(:test-not callable))
- t (flushable unsafe call)
+ t (flushable call)
:destroyed-constant-args (nth-constant-nonempty-sequence-args 2))
(defknown member (t list &key (:key callable) (:test callable)
(defknown adjoin (t list &key (:key callable) (:test callable)
(:test-not callable))
- list (foldable flushable unsafe call))
+ list (foldable flushable call))
(defknown (union intersection set-difference set-exclusive-or)
(list list &key (:key callable) (:test callable) (:test-not callable))
boolean
(foldable flushable call))
-(defknown acons (t t t) list (movable flushable unsafe))
-(defknown pairlis (t t &optional t) list (flushable unsafe))
+(defknown acons (t t t) list (movable flushable))
+(defknown pairlis (t t &optional t) list (flushable))
(defknown (rassoc assoc)
(t list &key (:key callable) (:test callable) (:test-not callable))
(defknown (assoc-if-not assoc-if rassoc-if rassoc-if-not)
(callable list &key (:key callable)) list (foldable flushable call))
-(defknown (memq assq) (t list) list (foldable flushable unsafe))
-(defknown delq (t list) list (flushable unsafe)
+(defknown (memq assq) (t list) list (foldable flushable))
+(defknown delq (t list) list (flushable)
:destroyed-constant-args (nth-constant-nonempty-sequence-args 2))
\f
;;;; from the "Hash Tables" chapter:
(:weakness (member nil :key :value :key-and-value :key-or-value))
(:synchronized t))
hash-table
- (flushable unsafe))
+ (flushable))
(defknown hash-table-p (t) boolean (movable foldable flushable))
(defknown gethash (t hash-table &optional t) (values t boolean)
- (flushable unsafe)) ; not FOLDABLE, since hash table contents can change
+ (flushable)) ; not FOLDABLE, since hash table contents can change
(defknown sb!impl::gethash2 (t hash-table) (values t boolean)
- (flushable unsafe)) ; not FOLDABLE, since hash table contents can change
+ (flushable)) ; not FOLDABLE, since hash table contents can change
(defknown sb!impl::gethash3 (t hash-table t) (values t boolean)
- (flushable unsafe)) ; not FOLDABLE, since hash table contents can change
-(defknown %puthash (t hash-table t) t (unsafe)
+ (flushable)) ; not FOLDABLE, since hash table contents can change
+(defknown %puthash (t hash-table t) t ()
:destroyed-constant-args (nth-constant-args 2))
(defknown remhash (t hash-table) boolean ()
:destroyed-constant-args (nth-constant-args 2))
(:fill-pointer t)
(:displaced-to (or array null))
(:displaced-index-offset index))
- array (flushable unsafe))
+ array (flushable))
-(defknown vector (&rest t) simple-vector (flushable unsafe))
+(defknown vector (&rest t) simple-vector (flushable))
(defknown aref (array &rest index) t (foldable))
(defknown row-major-aref (array index) t (foldable))
(:initial-element t) (:initial-contents t)
(:fill-pointer t) (:displaced-to (or array null))
(:displaced-index-offset index))
- array (unsafe))
+ array ())
; :derive-type 'result-type-arg1) Not even close...
\f
;;;; from the "Strings" chapter:
(defknown make-echo-stream (stream stream) stream (flushable))
(defknown make-string-input-stream (string &optional index sequence-end)
stream
- (flushable unsafe))
+ (flushable))
(defknown make-string-output-stream
(&key (:element-type type-specifier))
string-output-stream
(defknown set-macro-character (character callable &optional t (or readtable null))
(eql t)
- (unsafe))
+ ())
(defknown get-macro-character (character &optional (or readtable null))
(values callable boolean) (flushable))
(eql t) ())
(defknown set-dispatch-macro-character
(character character callable &optional (or readtable null)) (eql t)
- (unsafe))
+ ())
(defknown get-dispatch-macro-character
(character character &optional (or readtable null)) (or callable null)
())
short-site-name long-site-name)
() (or simple-string null) (flushable))
-(defknown identity (t) t (movable foldable flushable unsafe)
+(defknown identity (t) t (movable foldable flushable)
:derive-type #'result-type-first-arg)
(defknown constantly (t) function (movable flushable))
(defknown data-vector-ref-with-offset (simple-array index fixnum) t
(foldable explicit-check always-translatable))
(defknown data-vector-set (array index t) t
- (unsafe explicit-check always-translatable))
+ (explicit-check always-translatable))
(defknown data-vector-set-with-offset (array index fixnum t) t
- (unsafe explicit-check always-translatable))
+ (explicit-check always-translatable))
(defknown hairy-data-vector-ref (array index) t
(foldable explicit-check))
-(defknown hairy-data-vector-set (array index t) t (unsafe explicit-check))
+(defknown hairy-data-vector-set (array index t) t (explicit-check))
(defknown hairy-data-vector-ref/check-bounds (array index) t
(foldable explicit-check))
(defknown hairy-data-vector-set/check-bounds (array index t)
t
- (unsafe explicit-check))
+ (explicit-check))
(defknown %caller-frame () t (flushable))
(defknown %caller-pc () system-area-pointer (flushable))
(defknown %with-array-data (array index (or index null))
(defknown %with-array-data/fp (array index (or index null))
(values (simple-array * (*)) index index index)
(foldable flushable))
-(defknown %set-symbol-package (symbol t) t (unsafe))
+(defknown %set-symbol-package (symbol t) t ())
(defknown %coerce-name-to-fun ((or symbol cons)) function (flushable))
(defknown %coerce-callable-to-fun (callable) function (flushable))
(defknown array-bounding-indices-bad-error (t t t) nil)
nil) ; never returns
-(defknown arg-count-error (t t t t t t) nil (unsafe))
+(defknown arg-count-error (t t t t t t) nil ())
\f
;;;; SETF inverses
-(defknown %aset (array &rest t) t (unsafe)
+(defknown %aset (array &rest t) t ()
:destroyed-constant-args (nth-constant-args 1))
-(defknown %set-row-major-aref (array index t) t (unsafe)
+(defknown %set-row-major-aref (array index t) t ()
:destroyed-constant-args (nth-constant-args 1))
-(defknown (%rplaca %rplacd) (cons t) t (unsafe)
+(defknown (%rplaca %rplacd) (cons t) t ()
:destroyed-constant-args (nth-constant-args 1))
-(defknown %put (symbol t t) t (unsafe))
-(defknown %setelt (sequence index t) t (unsafe)
+(defknown %put (symbol t t) t ())
+(defknown %setelt (sequence index t) t ()
:destroyed-constant-args (nth-constant-args 1))
-(defknown %svset (simple-vector index t) t (unsafe)
+(defknown %svset (simple-vector index t) t ()
:destroyed-constant-args (nth-constant-args 1))
-(defknown %bitset ((array bit) &rest index) bit (unsafe)
+(defknown %bitset ((array bit) &rest index) bit ()
:destroyed-constant-args (nth-constant-args 1))
-(defknown %sbitset ((simple-array bit) &rest index) bit (unsafe)
+(defknown %sbitset ((simple-array bit) &rest index) bit ()
:destroyed-constant-args (nth-constant-args 1))
-(defknown %charset (string index character) character (unsafe)
+(defknown %charset (string index character) character ()
:destroyed-constant-args (nth-constant-args 1))
-(defknown %scharset (simple-string index character) character (unsafe)
+(defknown %scharset (simple-string index character) character ()
:destroyed-constant-args (nth-constant-args 1))
-(defknown %set-symbol-value (symbol t) t (unsafe))
-(defknown (setf symbol-function) (function symbol) function (unsafe))
-(defknown %set-symbol-plist (symbol list) list (unsafe))
-(defknown %setnth (unsigned-byte list t) t (unsafe)
+(defknown %set-symbol-value (symbol t) t ())
+(defknown (setf symbol-function) (function symbol) function ())
+(defknown %set-symbol-plist (symbol list) list ())
+(defknown %setnth (unsigned-byte list t) t ()
:destroyed-constant-args (nth-constant-args 2))
(defknown %set-fill-pointer (complex-vector index) index
- (unsafe explicit-check)
+ (explicit-check)
:destroyed-constant-args (nth-constant-args 1))
\f
;;;; ALIEN and call-out-to-C stuff
;; Used by WITH-PINNED-OBJECTS
#!+(or x86 x86-64)
(defknown sb!vm::touch-object (t) (values)
- (unsafe always-translatable))
+ (always-translatable))
#!+linkage-table
(defknown foreign-symbol-dataref-sap (simple-string)
;;;; miscellaneous internal utilities
(defknown %fun-name (function) t (flushable))
-(defknown (setf %fun-name) (t function) t (unsafe))
+(defknown (setf %fun-name) (t function) t ())
(defknown policy-quality (policy symbol) policy-quality
(flushable))
;;;; atomic ops
(defknown %compare-and-swap-svref (simple-vector index t t) t
- (unsafe))
+ ())
(defknown %compare-and-swap-instance-ref (instance index t t) t
- (unsafe))
+ ())
(defknown %compare-and-swap-symbol-value (symbol t t) t
- (unsafe unwind))
+ (unwind))
(defknown spin-loop-hint () (values)
(always-translatable))
:ref-trans %array-fill-pointer
:ref-known (flushable foldable)
:set-trans (setf %array-fill-pointer)
- :set-known (unsafe))
+ :set-known ())
(fill-pointer-p :type (member t nil)
:ref-trans %array-fill-pointer-p
:ref-known (flushable foldable)
:set-trans (setf %array-fill-pointer-p)
- :set-known (unsafe))
+ :set-known ())
(elements :type index
:ref-trans %array-available-elements
:ref-known (flushable foldable)
:set-trans (setf %array-available-elements)
- :set-known (unsafe))
+ :set-known ())
(data :type array
:ref-trans %array-data-vector
:ref-known (flushable foldable)
:set-trans (setf %array-data-vector)
- :set-known (unsafe))
+ :set-known ())
(displacement :type (or index null)
:ref-trans %array-displacement
:ref-known (flushable foldable)
:set-trans (setf %array-displacement)
- :set-known (unsafe))
+ :set-known ())
(displaced-p :type t
:ref-trans %array-displaced-p
:ref-known (flushable foldable)
:set-trans (setf %array-displaced-p)
- :set-known (unsafe))
+ :set-known ())
(displaced-from :type list
:ref-trans %array-displaced-from
:ref-known (flushable)
:set-trans (setf %array-displaced-from)
- :set-known (unsafe))
+ :set-known ())
(dimensions :rest-p t))
(define-primitive-object (vector :type vector
(entry-points :type (or function null)
:ref-known (flushable)
:ref-trans %code-entry-points
- :set-known (unsafe)
+ :set-known ()
:set-trans (setf %code-entry-points))
(debug-info :type t
:ref-known (flushable)
:ref-trans %code-debug-info
- :set-known (unsafe)
+ :set-known ()
:set-trans (setf %code-debug-info))
(trace-table-offset)
(constants :rest-p t))
(next :type (or function null)
:ref-known (flushable)
:ref-trans %simple-fun-next
- :set-known (unsafe)
+ :set-known ()
:set-trans (setf %simple-fun-next))
(name :ref-known (flushable)
:ref-trans %simple-fun-name
- :set-known (unsafe)
+ :set-known ()
:set-trans (setf %simple-fun-name))
(arglist :type list
:ref-known (flushable)
:ref-trans %simple-fun-arglist
- :set-known (unsafe)
+ :set-known ()
:set-trans (setf %simple-fun-arglist))
(type :ref-known (flushable)
:ref-trans %simple-fun-type
- :set-known (unsafe)
+ :set-known ()
:set-trans (setf %simple-fun-type))
;; NIL for empty, STRING for a docstring, SIMPLE-VECTOR for XREFS, and (CONS
;; STRING SIMPLE-VECTOR) for both.
:ref-trans %simple-fun-info
:ref-known (flushable)
:set-trans (setf %simple-fun-info)
- :set-known (unsafe))
+ :set-known ())
;; the SB!C::DEBUG-FUN object corresponding to this object, or NIL for none
#+nil ; FIXME: doesn't work (gotcha, lowly maintenoid!) See notes on bug 137.
(debug-fun :ref-known (flushable)
:ref-trans %simple-fun-debug-fun
- :set-known (unsafe)
+ :set-known ()
:set-trans (setf %simple-fun-debug-fun))
(code :rest-p t :c-type "unsigned char"))
:alloc-trans %make-funcallable-instance)
(trampoline :init :funcallable-instance-tramp)
(function :ref-known (flushable) :ref-trans %funcallable-instance-function
- :set-known (unsafe) :set-trans (setf %funcallable-instance-function))
+ :set-known () :set-trans (setf %funcallable-instance-function))
(info :rest-p t))
(define-primitive-object (value-cell :lowtag other-pointer-lowtag
;; for this. Is this needed as well?
:alloc-trans make-value-cell)
(value :set-trans value-cell-set
- :set-known (unsafe)
+ :set-known ()
:ref-trans value-cell-ref
:ref-known (flushable)
:init :arg))
;; also the CAR of NIL-as-end-of-list
(value :init :unbound
:set-trans %set-symbol-global-value
- :set-known (unsafe))
+ :set-known ())
;; also the CDR of NIL-as-end-of-list. Its reffer needs special
;; care for this reason, as hash values must be fixnums.
(hash :set-trans %set-symbol-hash)
(flushable movable))
(defknown %set-symbol-hash (symbol hash)
- t (unsafe))
+ t ())
(defknown initialize-vector ((simple-array * (*)) &rest t)
(simple-array * (*))
:result-arg 0)
(defknown vector-fill* (t t t t) vector
- (unsafe)
+ ()
:result-arg 0)
-(defknown vector-length (vector) index (flushable))
+(defknown vector-length (vector) index (flushable dx-safe))
(defknown vector-sap ((simple-unboxed-array (*))) system-area-pointer
(flushable))
(defknown (get-header-data get-closure-length) (t) (unsigned-byte 24)
(flushable))
(defknown set-header-data (t (unsigned-byte 24)) t
- (unsafe))
+ ())
(defknown %array-dimension (t index) index
(flushable))
(defknown %instance-layout (instance) layout
(foldable flushable))
(defknown %set-instance-layout (instance layout) layout
- (unsafe))
+ ())
(defknown %instance-length (instance) index
(foldable flushable))
(defknown %instance-ref (instance index) t
(flushable always-translatable))
(defknown %instance-set (instance index t) t
- (unsafe always-translatable))
+ (always-translatable))
(defknown %layout-invalid-error (t layout) nil)
(defknown %raw-instance-ref/word (instance index) sb!vm:word
(flushable always-translatable))
(defknown %raw-instance-set/word (instance index sb!vm:word) sb!vm:word
- (unsafe always-translatable))
+ (always-translatable))
(defknown %raw-instance-ref/single (instance index) single-float
(flushable always-translatable))
(defknown %raw-instance-set/single (instance index single-float) single-float
- (unsafe always-translatable))
+ (always-translatable))
(defknown %raw-instance-ref/double (instance index) double-float
(flushable always-translatable))
(defknown %raw-instance-set/double (instance index double-float) double-float
- (unsafe always-translatable))
+ (always-translatable))
(defknown %raw-instance-ref/complex-single (instance index)
(complex single-float)
(flushable always-translatable))
(defknown %raw-instance-set/complex-single
(instance index (complex single-float))
(complex single-float)
- (unsafe always-translatable))
+ (always-translatable))
(defknown %raw-instance-ref/complex-double (instance index)
(complex double-float)
(flushable always-translatable))
(defknown %raw-instance-set/complex-double
(instance index (complex double-float))
(complex double-float)
- (unsafe always-translatable))
+ (always-translatable))
#!+(or x86 x86-64 ppc)
(defknown %raw-instance-atomic-incf/word (instance index sb!vm:word) sb!vm:word
- (unsafe always-translatable))
+ (always-translatable))
#!+(or x86 x86-64 ppc)
(defknown %array-atomic-incf/word (t index sb!vm:word) sb!vm:word
- (unsafe always-translatable))
+ (always-translatable))
;;; These two are mostly used for bit-bashing operations.
(defknown %vector-raw-bits (t fixnum) sb!vm:word
(flushable))
(defknown (%set-vector-raw-bits) (t fixnum sb!vm:word) sb!vm:word
- (unsafe))
+ ())
(defknown allocate-vector ((unsigned-byte 8) index index) (simple-array * (*))
(defknown current-sp () system-area-pointer (movable flushable))
(defknown current-fp () system-area-pointer (movable flushable))
(defknown stack-ref (system-area-pointer index) t (flushable))
-(defknown %set-stack-ref (system-area-pointer index t) t (unsafe))
+(defknown %set-stack-ref (system-area-pointer index t) t ())
(defknown lra-code-header (t) t (movable flushable))
(defknown fun-code-header (t) t (movable flushable))
(defknown %make-lisp-obj (sb!vm:word) t (movable flushable))
(foldable flushable movable))
(defknown %bignum-set-length (bignum-type bignum-index) bignum-type
- (unsafe))
+ ())
(defknown %bignum-ref (bignum-type bignum-index) bignum-element-type
(flushable))
(defknown %bignum-set (bignum-type bignum-index bignum-element-type)
bignum-element-type
- (unsafe))
+ ())
#!+(or x86 x86-64)
(defknown %bignum-set-with-offset
(bignum-type bignum-index (signed-byte 24) bignum-element-type)
- bignum-element-type (unsafe always-translatable))
+ bignum-element-type (always-translatable))
(defknown %digit-0-or-plusp (bignum-element-type) boolean
(foldable flushable movable))
(defknown fdefn-p (t) boolean (movable foldable flushable))
(defknown fdefn-name (fdefn) t (foldable flushable))
(defknown fdefn-fun (fdefn) (or function null) (flushable))
-(defknown (setf fdefn-fun) (function fdefn) t (unsafe))
+(defknown (setf fdefn-fun) (function fdefn) t ())
(defknown fdefn-makunbound (fdefn) t ())
(defknown %simple-fun-self (function) function
(flushable))
(defknown (setf %simple-fun-self) (function function) function
- (unsafe))
+ ())
(defknown %closure-fun (function) function
(flushable))
(flushable))
(defknown %make-funcallable-instance (index) function
- (unsafe))
+ ())
(defknown %funcallable-instance-info (function index) t (flushable))
-(defknown %set-funcallable-instance-info (function index t) t (unsafe))
+(defknown %set-funcallable-instance-info (function index t) t ())
\f
;;;; mutator accessors
(forms
`(progn
(defknown ,cas-trans (,type ,slot-type ,slot-type)
- ,slot-type (unsafe))
+ ,slot-type ())
#!+compare-and-swap-vops
(def-casser ,cas-trans ,offset ,lowtag))))
(when init
(return-from combination-args-flow-cleanly-p nil)))))))))))
(recurse combination1)))
+(defun ref-good-for-dx-p (ref)
+ (let* ((lvar (ref-lvar ref))
+ (dest (when lvar (lvar-dest lvar))))
+ (and (combination-p dest)
+ (eq :known (combination-kind dest))
+ (awhen (combination-fun-info dest)
+ (or (ir1-attributep (fun-info-attributes it) dx-safe)
+ (and (not (combination-lvar dest))
+ (awhen (fun-info-result-arg it)
+ (eql lvar (nth it (combination-args dest))))))))))
+
(defun trivial-lambda-var-ref-p (use)
(and (ref-p use)
(let ((var (ref-leaf use)))
(neq :indefinite (lambda-var-extent var)))
(let ((home (lambda-var-home var))
(refs (lambda-var-refs var)))
- ;; bound by a non-XEP system lambda, no other REFS
+ ;; bound by a non-XEP system lambda, no other REFS that aren't
+ ;; DX-SAFE, or are result-args when the result is discarded.
(when (and (lambda-system-lambda-p home)
(neq :external (lambda-kind home))
- (eq use (car refs)) (not (cdr refs)))
+ (dolist (ref refs t)
+ (unless (or (eq use ref) (ref-good-for-dx-p ref))
+ (return nil))))
;; the LAMBDA this var is bound by has only a single REF, going
;; to a combination
(let* ((lambda-refs (lambda-refs home))
;;; breakdown of side effects, since we do very little code motion on
;;; IR1. We are interested in some deeper semantic properties such as
;;; whether it is safe to pass stack closures to.
+;;;
+;;; FIXME: This whole notion of "bad" explicit attributes is bad for
+;;; maintenance. How confident are we that we have no defknowns for functions
+;;; with functional arguments that are missing the CALL attribute? Much better
+;;; to have NO-CALLS, as it is much less likely to break accidentally.
(!def-boolean-attribute ir1
;; may call functions that are passed as arguments. In order to
;; determine what other effects are present, we must find the
;; effects of all arguments that may be functions.
call
- ;; may incorporate function or number arguments into the result or
- ;; somehow pass them upward. Note that this applies to any argument
- ;; that *might* be a function or number, not just the arguments that
- ;; always are.
- unsafe
;; may fail to return during correct execution. Errors are O.K.
+ ;; UNUSED, BEWARE OF BITROT.
unwind
;; the (default) worst case. Includes all the other bad things, plus
;; any other possible bad thing. If this is present, the above bad
;; attributes will be explicitly present as well.
any
+ ;; all arguments are safe for dynamic extent.
+ ;; (We used to have an UNSAFE attribute, which was basically the inverse
+ ;; of this, but it was unused and bitrotted, so when we started making
+ ;; use of the information we flipped the name and meaning the safe way
+ ;; around.)
+ dx-safe
;; may be constant-folded. The function has no side effects, but may
;; be affected by side effects on the arguments. e.g. SVREF, MAPC.
;; Functions that side-effect their arguments are not considered to
important-result
;; may be moved with impunity. Has no side effects except possibly
;; consing, and is affected only by its arguments.
- ;;
- ;; Since it is not used now, its distribution in fndb.lisp is
- ;; mere random; use with caution.
+ ;; UNUSED, BEWARE OF BITROT.
movable
;; The function is a true predicate likely to be open-coded. Convert
;; any non-conditional uses into (IF <pred> T NIL). Not usually
;;; the function might have.
(defmacro defknown (name arg-types result-type &optional (attributes '(any))
&body keys)
+ #-sb-xc-host
+ (when (member 'unsafe attributes)
+ (style-warn "Ignoring legacy attribute UNSAFE. Replaced by its inverse: DX-SAFE.")
+ (setf attributes (remove 'unsafe attributes)))
(when (and (intersection attributes '(any call unwind))
(intersection attributes '(movable)))
(error "function cannot have both good and bad attributes: ~S" attributes))
(when (member 'any attributes)
- (setq attributes (union '(call unsafe unwind) attributes)))
+ (setq attributes (union '(call unwind) attributes)))
(when (member 'flushable attributes)
(pushnew 'unsafely-flushable attributes))
(cl:in-package :ctu)
(unless (fboundp 'compiler-derived-type)
- (defknown compiler-derived-type (t) (values t t) (movable flushable unsafe))
+ (defknown compiler-derived-type (t) (values t t) (flushable))
(deftransform compiler-derived-type ((x) * * :node node)
(sb-c::delay-ir1-transform node :optimize)
`(values ',(type-specifier (sb-c::lvar-type x)) t))
(true v)
nil))
+(defun-with-dx make-array-on-stack-6 ()
+ (let ((v (make-array 3 :initial-element 12 :element-type '(unsigned-byte 8))))
+ (declare (sb-int:truly-dynamic-extent v))
+ (true v)
+ nil))
+
+(defun-with-dx make-array-on-stack-7 ()
+ (let ((v (make-array 3 :initial-element 12 :element-type '(signed-byte 8))))
+ (declare (sb-int:truly-dynamic-extent v))
+ (true v)
+ nil))
+
+(defun-with-dx make-array-on-stack-8 ()
+ (let ((v (make-array 3 :initial-element 12 :element-type 'word)))
+ (declare (sb-int:truly-dynamic-extent v))
+ (true v)
+ nil))
+
+(defun-with-dx make-array-on-stack-9 ()
+ (let ((v (make-array 3 :initial-element 12.0 :element-type 'single-float)))
+ (declare (sb-int:truly-dynamic-extent v))
+ (true v)
+ nil))
+
+(defun-with-dx make-array-on-stack-10 ()
+ (let ((v (make-array 3 :initial-element 12.0d0 :element-type 'double-float)))
+ (declare (sb-int:truly-dynamic-extent v))
+ (true v)
+ nil))
+
(defun-with-dx vector-on-stack (x y)
(let ((v (vector 1 x 2 y 3)))
(declare (sb-int:truly-dynamic-extent v))
(assert-no-consing (make-array-on-stack-5))
(assert-no-consing (vector-on-stack :x :y)))
+(with-test (:name (:no-consing :specialized-dx-vectors)
+ :skipped-on `(not (and :stack-allocatable-vectors
+ :c-stack-is-control-stack)))
+ (assert-no-consing (make-array-on-stack-6))
+ (assert-no-consing (make-array-on-stack-7))
+ (assert-no-consing (make-array-on-stack-8))
+ (assert-no-consing (make-array-on-stack-9))
+ (assert-no-consing (make-array-on-stack-10)))
+
(with-test (:name (:no-consing :dx-raw-instances) :fails-on :ppc :skipped-on '(not :raw-instance-init-vops))
(let (a b)
(setf a 1.24 b 1.23d0)
projects / sbcl.git / commitdiff