SB-EXT:CODE-DELETION-NOTE (a subtype of SB-EXT:COMPILER-NOTE) with
an associated MUFFLE-WARNING restart.
* The compiler now performs limited argument count validation of
- constant format strings in FORMAT. (thanks to Gerd Moellmann)
+ constant format strings in FORMAT, and where appropriate in ERROR,
+ CERROR and WARN. (thanks to Gerd Moellmann)
* bug fix: WITH-OUTPUT-TO-STRING (and MAKE-STRING-OUTPUT-STREAM) now
accept and act upon their :ELEMENT-TYPE keyword argument.
(reported by Edi Weitz)
;; take up about the same space as corresponding fixnums, there
;; should be no way that we fall through to this case: any shift
;; right by a bignum should give zero. But let's check anyway:
- (t (error "bignum overflow: can't shift right by ~S")))))
+ (t (error "bignum overflow: can't shift right by ~S" count)))))
(defun bignum-ashift-right-digits (bignum digits)
(declare (type bignum-type bignum)
'(array character list symbol))
raw-result)
(t
- (error "can't handle TYPE-OF ~S in cross-compilation")))))
+ (error "can't handle TYPE-OF ~S in cross-compilation" object)))))
;;; Is SYMBOL in the CL package? Note that we're testing this on the
;;; cross-compilation host, which could do things any old way. In
;;; INTEXP -- Handle the rational base, integer power case.
-;;; FIXME: As long as the system dies on stack overflow or memory
-;;; exhaustion, it seems reasonable to have this, but its default
-;;; should be NIL, and when it's NIL, anything should be accepted.
-(defparameter *intexp-maximum-exponent* 10000)
+(declaim (type (or integer null) *intexp-maximum-exponent*))
+(defparameter *intexp-maximum-exponent* nil)
;;; This function precisely calculates base raised to an integral
;;; power. It separates the cases by the sign of power, for efficiency
;;; a positive integer. Values of power are calculated as positive
;;; integers, and inverted if negative.
(defun intexp (base power)
- (when (> (abs power) *intexp-maximum-exponent*)
- ;; FIXME: should be ordinary error, not CERROR. (Once we set the
- ;; default for the variable to NIL, the un-continuable error will
- ;; be less obnoxious.)
- (cerror "Continue with calculation."
- "The absolute value of ~S exceeds ~S."
- power '*intexp-maximum-exponent* base power))
+ (when (and *intexp-maximum-exponent*
+ (> (abs power) *intexp-maximum-exponent*))
+ (error "The absolute value of ~S exceeds ~S."
+ power '*intexp-maximum-exponent*))
(cond ((minusp power)
(/ (intexp base (- power))))
((eql base 2)
(when cset
(cerror
"Unintern the conflicting symbols in the ~2*~A package."
- "Use'ing package ~A results in name conflicts for these symbols:~%~S"
+ "Using package ~A results in name conflicts for these symbols:~%~
+ ~S"
(package-%name pkg) cset (package-%name package))
(dolist (s cset) (moby-unintern s package))))
(declare (type segment segment)
(type annotation note))
(when (annotation-posn note)
- (error "attempt to emit ~S a second time"))
+ (error "attempt to emit ~S a second time" note))
(setf (annotation-posn note) (segment-current-posn segment))
(setf (annotation-index note) (segment-current-index segment))
(let ((last (segment-last-annotation segment))
(defknown policy-quality (policy symbol) policy-quality
(flushable))
+
+(defknown (compiler-abort compiler-error) (string &rest t) nil ())
+(defknown (compiler-warn compiler-style-warn) (string &rest t) (values) ())
+(defknown (compiler-notify maybe-compiler-notify) ((or string symbol) &rest t)
+ (values)
+ ())
+(defknown style-warn (string &rest t) null ())
(:foreign
(aver (stringp name))
(or (foreign-symbol-address-as-integer name)
- (error "unknown foreign symbol: ~S")))
+ (error "unknown foreign symbol: ~S" name)))
#!+x86
(:code-object
(aver (null name))
((continuation-block cont)
(block-home-lambda-or-null (continuation-block cont)))
(t
- (bug "confused about home lambda for ~S"))))
+ (bug "confused about home lambda for ~S" cont))))
;;; Return the LAMBDA that is CONT's home.
(declaim (ftype (sfunction (continuation) clambda)
(rassoc name (funs)))))
(unless name
(error "no move function defined to ~:[save~;load~] SC ~S ~
- with ~S ~:[to~;from~] from SC ~S"
+ ~:[to~;from~] from SC ~S"
load-p sc-name load-p (sc-name alt)))
(cond (found
(unless (eq (cdr found) name)
(error "can't tell whether to ~:[save~;load~]~@
- or ~S when operand is in SC ~S"
+ with ~S or ~S when operand is in SC ~S"
load-p name (cdr found) (sc-name alt)))
(pushnew alt (car found)))
(t
;;;; or T and the control string is a function (i.e. FORMATTER), then
;;;; convert the call to FORMAT to just a FUNCALL of that function.
-(defun check-format-args (string args)
+;;; for compile-time argument count checking.
+;;;
+;;; FIXME I: this is currently called from DEFTRANSFORMs, the vast
+;;; majority of which are not going to transform the code, but instead
+;;; are going to GIVE-UP-IR1-TRANSFORM unconditionally. It would be
+;;; nice to make this explicit, maybe by implementing a new
+;;; "optimizer" (say, DEFOPTIMIZER CONSISTENCY-CHECK).
+;;;
+;;; FIXME II: In some cases, type information could be correlated; for
+;;; instance, ~{ ... ~} requires a list argument, so if the
+;;; continuation-type of a corresponding argument is known and does
+;;; not intersect the list type, a warning could be signalled.
+(defun check-format-args (string args fun)
(declare (type string string))
(unless (typep string 'simple-string)
(setq string (coerce string 'simple-string)))
(let ((nargs (length args)))
(cond
((< nargs min)
- (compiler-warn "Too few arguments (~D) to FORMAT ~S: ~
+ (compiler-warn "Too few arguments (~D) to ~S ~S: ~
requires at least ~D."
- nargs string min))
+ nargs fun string min))
((> nargs max)
(;; to get warned about probably bogus code at
;; cross-compile time.
;; ANSI saith that too many arguments doesn't cause a
;; run-time error.
#-sb-xc-host compiler-style-warn
- "Too many arguments (~D) to FORMAT ~S: uses at most ~D."
- nargs string max)))))))
+ "Too many arguments (~D) to ~S ~S: uses at most ~D."
+ nargs fun string max)))))))
(deftransform format ((dest control &rest args) (t simple-string &rest t) *
:node node)
((policy node (> speed space))
(unless (constant-continuation-p control)
(give-up-ir1-transform "The control string is not a constant."))
- (check-format-args (continuation-value control) args)
+ (check-format-args (continuation-value control) args 'format)
(let ((arg-names (make-gensym-list (length args))))
`(lambda (dest control ,@arg-names)
(declare (ignore control))
(format dest (formatter ,(continuation-value control)) ,@arg-names))))
(t (when (constant-continuation-p control)
- (check-format-args (continuation-value control) args))
+ (check-format-args (continuation-value control) args 'format))
(give-up-ir1-transform))))
(deftransform format ((stream control &rest args) (stream function &rest t) *
(funcall control *standard-output* ,@arg-names)
nil)))
+(macrolet
+ ((def (name)
+ `(deftransform ,name
+ ((control &rest args) (simple-string &rest t) *)
+ (when (constant-continuation-p control)
+ (check-format-args (continuation-value control) args ',name))
+ (give-up-ir1-transform))))
+ (def error)
+ (def warn)
+ #+sb-xc-host ; Only we should be using these
+ (progn
+ (def style-warn)
+ (def compiler-abort)
+ (def compiler-error)
+ (def compiler-warn)
+ (def compiler-style-warn)
+ (def compiler-notify)
+ (def maybe-compiler-notify)
+ (def bug)))
+
+(deftransform cerror ((report control &rest args)
+ (simple-string simple-string &rest t) *)
+ (unless (and (constant-continuation-p control)
+ (constant-continuation-p report))
+ (give-up-ir1-transform))
+ (multiple-value-bind (min1 max1)
+ (handler-case (sb!format:%compiler-walk-format-string
+ (continuation-value control) args)
+ (sb!format:format-error (c)
+ (compiler-warn "~A" c)))
+ (when min1
+ (multiple-value-bind (min2 max2)
+ (handler-case (sb!format:%compiler-walk-format-string
+ (continuation-value report) args)
+ (sb!format:format-error (c)
+ (compiler-warn "~A" c)))
+ (when min2
+ (let ((nargs (length args)))
+ (cond
+ ((< nargs (min min1 min2))
+ (compiler-warn "Too few arguments (~D) to ~S ~S ~S: ~
+ requires at least ~D."
+ nargs 'cerror report control min))
+ ((> nargs (max max1 max2))
+ (;; to get warned about probably bogus code at
+ ;; cross-compile time.
+ #+sb-xc-host compiler-warn
+ ;; ANSI saith that too many arguments doesn't cause a
+ ;; run-time error.
+ #-sb-xc-host compiler-style-warn
+ "Too many arguments (~D) to ~S ~S ~S: uses at most ~D."
+ nargs 'cerror report control max))))))))
+ (give-up-ir1-transform))
+
(defoptimizer (coerce derive-type) ((value type))
(cond
((constant-continuation-p type)
(inst pop ebp-tn))
(t
- (cerror "Continue any-way"
- "VOP return-local doesn't work if old-fp (in slot %s) is not in slot 0"
+ (cerror "Continue anyway"
+ "VOP return-local doesn't work if old-fp (in slot ~
+ ~S) is not in slot 0"
(tn-offset old-fp)))))
((any-reg descriptor-reg)
class)
(dolist (slot slots)
(unless (eq (getf slot :allocation :instance) :instance)
- (error "Slot allocation ~S is not supported in bootstrap.")))
+ (error "Slot allocation ~S is not supported in bootstrap."
+ (getf slot :allocation))))
(when (typep wrapper 'wrapper)
(setf (wrapper-instance-slots-layout wrapper)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.2.27"
+"0.8.2.28"
projects / sbcl.git / commitdiff