(sb!ext:inhibit-warnings 2)
;; SAFETY = SPEED (and < 3) should
;; reasonable safety, but might skip
- ;; some unreasonably expensive stuff.
+ ;; some unreasonably expensive stuff
+ ;; (e.g. %DETECT-STACK-EXHAUSTION
+ ;; in sbcl-0.7.2).
(safety 2)
(space 1)
(speed 2)))))
(declare (type index start end))
(declare (type function predicate))
(declare (type (or function null) key))
- (declare (optimize (speed 3) (safety 3) (debug 1) (space 1)))
+ ;; This used to be (OPTIMIZE (SPEED 3) (SAFETY 3)), but now
+ ;; (0.7.1.39) that (SAFETY 3) means "absolutely safe (including
+ ;; expensive things like %DETECT-STACK-EXHAUSTION)" we get closer
+ ;; to what we want by using (SPEED 2) (SAFETY 2): "pretty fast,
+ ;; pretty safe, and safety is no more important than speed".
+ (declare (optimize (speed 2) (safety 2) (debug 1) (space 1)))
(if (typep vector 'simple-vector)
;; (VECTOR T) is worth optimizing for, and SIMPLE-VECTOR is
;; what we get from (VECTOR T) inside WITH-ARRAY-DATA.
#!+sb-doc
"Return the real time in the internal time format. This is useful for
finding elapsed time. See INTERNAL-TIME-UNITS-PER-SECOND."
- ;; FIXME: See comment on OPTIMIZE declaration in GET-INTERNAL-RUN-TIME.
- (declare (optimize (speed 3) (safety 3)))
(multiple-value-bind (ignore seconds useconds) (sb!unix:unix-gettimeofday)
(declare (ignore ignore) (type (unsigned-byte 32) seconds useconds))
(let ((base *internal-real-time-base-seconds*)
"Return the run time in the internal time format. This is useful for
finding CPU usage."
(declare (values (unsigned-byte 32)))
- ;; FIXME: In CMU CL this was (SPEED 3) (SAFETY 0), and perhaps
- ;; someday it should be again, since overhead here is annoying. But
- ;; it's even more annoying to worry about this function returning
- ;; out-of-range values, so while debugging the profiling code,
- ;; I set it to (SAFETY 3) for now.
- (declare (optimize (speed 3) (safety 3)))
(multiple-value-bind (ignore utime-sec utime-usec stime-sec stime-usec)
(sb!unix:unix-fast-getrusage sb!unix:rusage_self)
(declare (ignore ignore)
;; documented anywhere and the observed behavior is to
;; sometimes return 1000000 exactly.)
(type (integer 0 1000000) utime-usec stime-usec))
-
(let ((result (+ (the (unsigned-byte 32)
(* (the (unsigned-byte 32) (+ utime-sec stime-sec))
sb!xc:internal-time-units-per-second))
(proclaim '(optimize (compilation-speed 1)
(debug #+sb-show 2 #-sb-show 1)
(inhibit-warnings 2)
- (safety 1)
+ (safety 2)
(space 1)
(speed 2)))
\f
;;; easiest thing to do is to read them out of package-data-list.lisp-expr
;;; now?
\f
-;;;; restoring compilation policy to neutral values in preparation for
+;;;; resetting compilation policy to neutral values in preparation for
;;;; SAVE-LISP-AND-DIE as final SBCL core
(sb-int:/show "setting compilation policy to neutral values")
;;; Pick off some constant cases.
(deftransform array-header-p ((array) (array))
(let ((type (continuation-type array)))
- (declare (optimize (safety 3)))
(unless (array-type-p type)
(give-up-ir1-transform))
(let ((dims (array-type-dimensions type)))
(cond ((csubtypep type (specifier-type '(simple-array * (*))))
- ;; No array header.
+ ;; no array header
nil)
((and (listp dims) (> (length dims) 1))
- ;; Multi-dimensional array, will have a header.
+ ;; multi-dimensional array, will have a header
t)
(t
(give-up-ir1-transform))))))
(defvar *cold-package-symbols*)
(declaim (type list *cold-package-symbols*))
-;;; a map from descriptors to symbols, so that we can back up. The key is the
-;;; address in the target core.
+;;; a map from descriptors to symbols, so that we can back up. The key
+;;; is the address in the target core.
(defvar *cold-symbols*)
(declaim (type hash-table *cold-symbols*))
;; need is SB!KERNEL:%BYTE-BLT.
(let ((package-name (package-name package)))
(cond ((find package-name '("COMMON-LISP" "KEYWORD") :test #'string=)
- ;; That's OK then.
+ ;; Cold interning things in these standard packages is OK.
+ ;; (Cold interning things in the other standard package,
+ ;; CL-USER, isn't OK. We just use CL-USER to expose symbols
+ ;; whose homes are in other packages. Thus, trying to cold
+ ;; intern a symbol whose home package is CL-USER probably
+ ;; means that a coding error has been made somewhere.)
(values))
((string= package-name "SB!" :end1 3 :end2 3)
;; That looks OK, too. (All the target-code packages
(t
;; looks bad: maybe COMMON-LISP-USER? maybe an extension
;; package in the xc host? something we can't think of
- ;; a valid reason to dump, anyway...
- (bug "internal error: PACKAGE-NAME=~S looks too much like a typo."
- package-name))))
+ ;; a valid reason to cold intern, anyway...
+ (error ; not #'BUG, because #'BUG isn't defined yet
+ "internal error: PACKAGE-NAME=~S looks too much like a typo."
+ package-name))))
(let (;; Information about each cold-interned symbol is stored
;; in COLD-INTERN-INFO.
(setf (node-lexenv bind) *lexenv*)
(let ((cont1 (make-continuation))
- (cont2 (make-continuation)))
+ (cont2 (make-continuation))
+ (revised-body (if (policy bind
+ (or (> safety
+ (max speed space))
+ (= safety 3)))
+ ;; (Stuffing this in at IR1 level like
+ ;; this is pretty crude. And it's
+ ;; particularly inefficient to execute
+ ;; it on *every* LAMBDA, including
+ ;; LET-converted LAMBDAs. Improvements
+ ;; are welcome, but meanwhile, when
+ ;; SAFETY is high, it's still arguably
+ ;; an improvement over the old CMU CL
+ ;; approach of doing nothing (waiting
+ ;; for evolution to breed careful
+ ;; users:-). -- WHN)
+ `((%detect-stack-exhaustion)
+ ,@body)
+ body)))
(continuation-starts-block cont1)
(link-node-to-previous-continuation bind cont1)
(use-continuation bind cont2)
(ir1-convert-special-bindings cont2 result
- (if (policy bind
- (or (> safety
- (max speed space))
- (= safety 3)))
- ;; (Stuffing this in at IR1 level
- ;; like this is pretty crude. And
- ;; it's particularly inefficient
- ;; to execute it on *every* LAMBDA,
- ;; including LET-converted LAMBDAs.
- ;; But when SAFETY is high, it's
- ;; still arguably an improvement
- ;; over the old CMU CL approach of
- ;; doing nothing (proactively
- ;; waiting for evolution to breed
- ;; stronger programmers:-). -- WHN)
- `((%detect-stack-exhaustion)
- ,@body)
- body)
+ revised-body
aux-vars aux-vals (svars)))
(let ((block (continuation-block result)))
(multi-compare 'char-lessp args t))
;;; This function does source transformation of N-arg inequality
-;;; functions such as /=. This is similar to Multi-Compare in the <3
+;;; functions such as /=. This is similar to MULTI-COMPARE in the <3
;;; arg cases. If there are more than two args, then we expand into
;;; the appropriate n^2 comparisons only when speed is important.
(declaim (ftype (function (symbol list) *) multi-not-equal))
-;;;; tests of the system's ability to catch resource exhaustion errors
+;;;; tests of the system's ability to catch resource exhaustion problems
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.1.46"
+"0.7.1.47"
projects / sbcl.git / commitdiff