src/compiler/ir1report.lisp

   1 ;;;; machinery for reporting errors/warnings/notes/whatnot from
   2 ;;;; the compiler
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; This software is derived from the CMU CL system, which was
   8 ;;;; written at Carnegie Mellon University and released into the
   9 ;;;; public domain. The software is in the public domain and is
  10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  11 ;;;; files for more information.
  12
  13 (in-package "SB!C")
  14 \f
  15 ;;;; compiler error context determination
  16
  17 (declaim (special *current-path*))
  18
  19 ;;; We bind print level and length when printing out messages so that
  20 ;;; we don't dump huge amounts of garbage.
  21 ;;;
  22 ;;; FIXME: It's not possible to get the defaults right for everyone.
  23 ;;; So: Should these variables be in the SB-EXT package? Or should we
  24 ;;; just get rid of them completely and just use the bare
  25 ;;; CL:*PRINT-FOO* variables instead?
  26 (declaim (type (or unsigned-byte null)
  27                *compiler-error-print-level*
  28                *compiler-error-print-length*
  29                *compiler-error-print-lines*))
  30 (defvar *compiler-error-print-level* 5
  31   #!+sb-doc
  32   "the value for *PRINT-LEVEL* when printing compiler error messages")
  33 (defvar *compiler-error-print-length* 10
  34   #!+sb-doc
  35   "the value for *PRINT-LENGTH* when printing compiler error messages")
  36 (defvar *compiler-error-print-lines* 12
  37   #!+sb-doc
  38   "the value for *PRINT-LINES* when printing compiler error messages")
  39
  40 (defvar *enclosing-source-cutoff* 1
  41   #!+sb-doc
  42   "The maximum number of enclosing non-original source forms (i.e. from
  43   macroexpansion) that we print in full. For additional enclosing forms, we
  44   print only the CAR.")
  45 (declaim (type unsigned-byte *enclosing-source-cutoff*))
  46
  47 ;;; We separate the determination of compiler error contexts from the
  48 ;;; actual signalling of those errors by objectifying the error
  49 ;;; context. This allows postponement of the determination of how (and
  50 ;;; if) to signal the error.
  51 ;;;
  52 ;;; We take care not to reference any of the IR1 so that pending
  53 ;;; potential error messages won't prevent the IR1 from being GC'd. To
  54 ;;; this end, we convert source forms to strings so that source forms
  55 ;;; that contain IR1 references (e.g. %DEFUN) don't hold onto the IR.
  56 (defstruct (compiler-error-context
  57             #-no-ansi-print-object
  58             (:print-object (lambda (x stream)
  59                              (print-unreadable-object (x stream :type t))))
  60             (:copier nil))
  61   ;; a list of the stringified CARs of the enclosing non-original source forms
  62   ;; exceeding the *enclosing-source-cutoff*
  63   (enclosing-source nil :type list)
  64   ;; a list of stringified enclosing non-original source forms
  65   (source nil :type list)
  66   ;; the stringified form in the original source that expanded into SOURCE
  67   (original-source (missing-arg) :type simple-string)
  68   ;; a list of prefixes of "interesting" forms that enclose original-source
  69   (context nil :type list)
  70   ;; the FILE-INFO-NAME for the relevant FILE-INFO
  71   (file-name (missing-arg) :type (or pathname (member :lisp :stream)))
  72   ;; the file position at which the top level form starts, if applicable
  73   (file-position nil :type (or index null))
  74   ;; the original source part of the source path
  75   (original-source-path nil :type list)
  76   ;; the lexenv active at the time
  77   (lexenv nil :type (or null lexenv)))
  78
  79 ;;; If true, this is the node which is used as context in compiler warning
  80 ;;; messages.
  81 (declaim (type (or null compiler-error-context node) *compiler-error-context*))
  82 (defvar *compiler-error-context* nil)
  83
  84 ;;; a hashtable mapping macro names to source context parsers. Each parser
  85 ;;; function returns the source-context list for that form.
  86 (defvar *source-context-methods* (make-hash-table))
  87
  88 ;;; documentation originally from cmu-user.tex:
  89 ;;;   This macro defines how to extract an abbreviated source context from
  90 ;;;   the \var{name}d form when it appears in the compiler input.
  91 ;;;   \var{lambda-list} is a \code{defmacro} style lambda-list used to
  92 ;;;   parse the arguments. The \var{body} should return a list of
  93 ;;;   subforms that can be printed on about one line. There are
  94 ;;;   predefined methods for \code{defstruct}, \code{defmethod}, etc. If
  95 ;;;   no method is defined, then the first two subforms are returned.
  96 ;;;   Note that this facility implicitly determines the string name
  97 ;;;   associated with anonymous functions.
  98 ;;; So even though SBCL itself only uses this macro within this file,
  99 ;;; it's a reasonable thing to put in SB-EXT in case some dedicated
 100 ;;; user wants to do some heavy tweaking to make SBCL give more
 101 ;;; informative output about his code.
 102 (defmacro define-source-context (name lambda-list &body body)
 103   #!+sb-doc
 104   "DEFINE-SOURCE-CONTEXT Name Lambda-List Form*
 105    This macro defines how to extract an abbreviated source context from the
 106    Named form when it appears in the compiler input. Lambda-List is a DEFMACRO
 107    style lambda-list used to parse the arguments. The Body should return a
 108    list of subforms suitable for a \"~{~S ~}\" format string."
 109   (let ((n-whole (gensym)))
 110     `(setf (gethash ',name *source-context-methods*)
 111            (lambda (,n-whole)
 112              (destructuring-bind ,lambda-list ,n-whole ,@body)))))
 113
 114 (defmacro def-source-context (&rest rest)
 115   (deprecation-warning 'def-source-context 'define-source-context)
 116   `(define-source-context ,@rest))
 117
 118 (define-source-context defstruct (name-or-options &rest slots)
 119   (declare (ignore slots))
 120   `(defstruct ,(if (consp name-or-options)
 121                    (car name-or-options)
 122                    name-or-options)))
 123
 124 (define-source-context function (thing)
 125   (if (and (consp thing) (eq (first thing) 'lambda) (consp (rest thing)))
 126       `(lambda ,(second thing))
 127       `(function ,thing)))
 128
 129 ;;; Return the first two elements of FORM if FORM is a list. Take the
 130 ;;; CAR of the second form if appropriate.
 131 (defun source-form-context (form)
 132   (cond ((atom form) nil)
 133         ((>= (length form) 2)
 134          (let* ((context-fun-default (lambda (x)
 135                                        (declare (ignore x))
 136                                        (list (first form) (second form))))
 137                 (context-fun (gethash (first form)
 138                                       *source-context-methods*
 139                                       context-fun-default)))
 140            (declare (type function context-fun))
 141            (funcall context-fun (rest form))))
 142         (t
 143          form)))
 144
 145 ;;; Given a source path, return the original source form and a
 146 ;;; description of the interesting aspects of the context in which it
 147 ;;; appeared. The context is a list of lists, one sublist per context
 148 ;;; form. The sublist is a list of some of the initial subforms of the
 149 ;;; context form.
 150 ;;;
 151 ;;; For now, we use the first two subforms of each interesting form. A
 152 ;;; form is interesting if the first element is a symbol beginning
 153 ;;; with "DEF" and it is not the source form. If there is no
 154 ;;; DEF-mumble, then we use the outermost containing form. If the
 155 ;;; second subform is a list, then in some cases we return the CAR of
 156 ;;; that form rather than the whole form (i.e. don't show DEFSTRUCT
 157 ;;; options, etc.)
 158 (defun find-original-source (path)
 159   (declare (list path))
 160   (let* ((rpath (reverse (source-path-original-source path)))
 161          (tlf (first rpath))
 162          (root (find-source-root tlf *source-info*)))
 163     (collect ((context))
 164       (let ((form root)
 165             (current (rest rpath)))
 166         (loop
 167           (when (atom form)
 168             (aver (null current))
 169             (return))
 170           (let ((head (first form)))
 171             (when (symbolp head)
 172               (let ((name (symbol-name head)))
 173                 (when (and (>= (length name) 3) (string= name "DEF" :end1 3))
 174                   (context (source-form-context form))))))
 175           (when (null current) (return))
 176           (setq form (nth (pop current) form)))
 177
 178         (cond ((context)
 179                (values form (context)))
 180               ((and path root)
 181                (let ((c (source-form-context root)))
 182                  (values form (if c (list c) nil))))
 183               (t
 184                (values '(unable to locate source)
 185                        '((some strange place)))))))))
 186
 187 ;;; Convert a source form to a string, suitably formatted for use in
 188 ;;; compiler warnings.
 189 (defun stringify-form (form &optional (pretty t))
 190   (with-standard-io-syntax
 191    (let ((*print-readably* nil)
 192          (*print-pretty* pretty)
 193          (*print-level* *compiler-error-print-level*)
 194          (*print-length* *compiler-error-print-length*)
 195          (*print-lines* *compiler-error-print-lines*))
 196      (if pretty
 197          (format nil "~<~@;  ~S~:>" (list form))
 198          (prin1-to-string form)))))
 199
 200 ;;; Return a COMPILER-ERROR-CONTEXT structure describing the current
 201 ;;; error context, or NIL if we can't figure anything out. ARGS is a
 202 ;;; list of things that are going to be printed out in the error
 203 ;;; message, and can thus be blown off when they appear in the source
 204 ;;; context.
 205 (defun find-error-context (args)
 206   (let ((context *compiler-error-context*))
 207     (if (compiler-error-context-p context)
 208         context
 209         (let ((path (or (and (boundp '*current-path*) *current-path*)
 210                         (if context
 211                             (node-source-path context)
 212                             nil))))
 213           (when (and *source-info* path)
 214             (multiple-value-bind (form src-context) (find-original-source path)
 215               (collect ((full nil cons)
 216                         (short nil cons))
 217                 (let ((forms (source-path-forms path))
 218                       (n 0))
 219                   (dolist (src (if (member (first forms) args)
 220                                    (rest forms)
 221                                    forms))
 222                     (if (>= n *enclosing-source-cutoff*)
 223                         (short (stringify-form (if (consp src)
 224                                                    (car src)
 225                                                    src)
 226                                                nil))
 227                         (full (stringify-form src)))
 228                     (incf n)))
 229
 230                 (let* ((tlf (source-path-tlf-number path))
 231                        (file-info (source-info-file-info *source-info*)))
 232                   (make-compiler-error-context
 233                    :enclosing-source (short)
 234                    :source (full)
 235                    :original-source (stringify-form form)
 236                    :context src-context
 237                    :file-name (file-info-name file-info)
 238                    :file-position
 239                    (multiple-value-bind (ignore pos)
 240                        (find-source-root tlf *source-info*)
 241                      (declare (ignore ignore))
 242                      pos)
 243                    :original-source-path
 244                    (source-path-original-source path)
 245                    :lexenv (if context
 246                                (node-lexenv context)
 247                                (if (boundp '*lexenv*) *lexenv* nil)))))))))))
 248 \f
 249 ;;;; printing error messages
 250
 251 ;;; We save the context information that we printed out most recently
 252 ;;; so that we don't print it out redundantly.
 253
 254 ;;; The last COMPILER-ERROR-CONTEXT that we printed.
 255 (defvar *last-error-context* nil)
 256 (declaim (type (or compiler-error-context null) *last-error-context*))
 257
 258 ;;; The format string and args for the last error we printed.
 259 (defvar *last-format-string* nil)
 260 (defvar *last-format-args* nil)
 261 (declaim (type (or string null) *last-format-string*))
 262 (declaim (type list *last-format-args*))
 263
 264 ;;; The number of times that the last error message has been emitted,
 265 ;;; so that we can compress duplicate error messages.
 266 (defvar *last-message-count* 0)
 267 (declaim (type index *last-message-count*))
 268
 269 ;;; If the last message was given more than once, then print out an
 270 ;;; indication of how many times it was repeated. We reset the message
 271 ;;; count when we are done.
 272 (defun note-message-repeats (&optional (terpri t))
 273   (cond ((= *last-message-count* 1)
 274          (when terpri (terpri *error-output*)))
 275         ((> *last-message-count* 1)
 276           (format *error-output* "~&; [Last message occurs ~W times.]~2%"
 277                  *last-message-count*)))
 278   (setq *last-message-count* 0))
 279
 280 ;;; Print out the message, with appropriate context if we can find it.
 281 ;;; If the context is different from the context of the last message
 282 ;;; we printed, then we print the context. If the original source is
 283 ;;; different from the source we are working on, then we print the
 284 ;;; current source in addition to the original source.
 285 ;;;
 286 ;;; We suppress printing of messages identical to the previous, but
 287 ;;; record the number of times that the message is repeated.
 288 (defun print-compiler-message (format-string format-args)
 289
 290   (declare (type simple-string format-string))
 291   (declare (type list format-args))
 292
 293   (let ((stream *error-output*)
 294         (context (find-error-context format-args)))
 295     (cond
 296      (context
 297       (let ((file (compiler-error-context-file-name context))
 298             (in (compiler-error-context-context context))
 299             (form (compiler-error-context-original-source context))
 300             (enclosing (compiler-error-context-enclosing-source context))
 301             (source (compiler-error-context-source context))
 302             (last *last-error-context*))
 303
 304         (unless (and last
 305                      (equal file (compiler-error-context-file-name last)))
 306           (when (pathnamep file)
 307             (note-message-repeats)
 308             (setq last nil)
 309             (format stream "~2&; file: ~A~%" (namestring file))))
 310
 311         (unless (and last
 312                      (equal in (compiler-error-context-context last)))
 313           (note-message-repeats)
 314           (setq last nil)
 315           (format stream "~&")
 316           (pprint-logical-block (stream nil :per-line-prefix "; ")
 317             (format stream "in:~{~<~%    ~4:;~{ ~S~}~>~^ =>~}" in))
 318           (format stream "~%"))
 319
 320
 321         (unless (and last
 322                      (string= form
 323                               (compiler-error-context-original-source last)))
 324           (note-message-repeats)
 325           (setq last nil)
 326           (format stream "~&")
 327           (pprint-logical-block (stream nil :per-line-prefix "; ")
 328             (format stream "  ~A" form))
 329           (format stream "~&"))
 330
 331         (unless (and last
 332                      (equal enclosing
 333                             (compiler-error-context-enclosing-source last)))
 334           (when enclosing
 335             (note-message-repeats)
 336             (setq last nil)
 337             (format stream "~&; --> ~{~<~%; --> ~1:;~A~> ~}~%" enclosing)))
 338
 339         (unless (and last
 340                      (equal source (compiler-error-context-source last)))
 341           (setq *last-format-string* nil)
 342           (when source
 343             (note-message-repeats)
 344             (dolist (src source)
 345               (format stream "~&")
 346               (write-string "; ==>" stream)
 347               (format stream "~&")
 348               (pprint-logical-block (stream nil :per-line-prefix "; ")
 349                 (write-string src stream)))))))
 350      (t
 351        (format stream "~&")
 352       (note-message-repeats)
 353       (setq *last-format-string* nil)
 354        (format stream "~&")))
 355
 356     (setq *last-error-context* context)
 357
 358     ;; FIXME: this testing for effective equality of compiler messages
 359     ;; is ugly, and really ought to be done at a higher level.
 360     (unless (and (equal format-string *last-format-string*)
 361                  (tree-equal format-args *last-format-args*))
 362       (note-message-repeats nil)
 363       (setq *last-format-string* format-string)
 364       (setq *last-format-args* format-args)
 365       (let ((*print-level*  *compiler-error-print-level*)
 366             (*print-length* *compiler-error-print-length*)
 367             (*print-lines*  *compiler-error-print-lines*))
 368         (format stream "~&")
 369         (pprint-logical-block (stream nil :per-line-prefix "; ")
 370           (format stream "~&~?" format-string format-args))
 371         (format stream "~&"))))
 372
 373   (incf *last-message-count*)
 374   (values))
 375
 376 (defun print-compiler-condition (condition)
 377   (declare (type condition condition))
 378   (let (;; These different classes of conditions have different
 379         ;; effects on the return codes of COMPILE-FILE, so it's nice
 380         ;; for users to be able to pick them out by lexical search
 381         ;; through the output.
 382         (what (etypecase condition
 383                 (style-warning 'style-warning)
 384                 (warning 'warning)
 385                 ((or error compiler-error) 'error))))
 386     (multiple-value-bind (format-string format-args)
 387         (if (typep condition 'simple-condition)
 388             (values (simple-condition-format-control condition)
 389                     (simple-condition-format-arguments condition))
 390             (values "~A"
 391                     (list (with-output-to-string (s)
 392                             (princ condition s)))))
 393       (print-compiler-message
 394        (format nil "caught ~S:~%  ~A" what format-string)
 395        format-args)))
 396   (values))
 397
 398 ;;; The act of signalling one of these beasts must not cause WARNINGSP
 399 ;;; (or FAILUREP) to be set from COMPILE or COMPILE-FILE, so we can't
 400 ;;; inherit from WARNING or STYLE-WARNING.
 401 ;;;
 402 ;;; FIXME: the handling of compiler-notes could be unified with
 403 ;;; warnings and style-warnings (see the various handler functions
 404 ;;; below).
 405 (define-condition compiler-note (condition) ()
 406   (:documentation
 407    "Root of the hierarchy of conditions representing information discovered
 408 by the compiler that the user might wish to know, but which does not merit
 409 a STYLE-WARNING (or any more serious condition)."))
 410 (define-condition simple-compiler-note (simple-condition compiler-note) ())
 411 (define-condition code-deletion-note (simple-compiler-note) ()
 412   (:documentation
 413    "A condition type signalled when the compiler deletes code that the user
 414 has written, having proved that it is unreachable."))
 415
 416 (defun compiler-notify (datum &rest args)
 417   (unless (if *compiler-error-context*
 418               (policy *compiler-error-context* (= inhibit-warnings 3))
 419               (policy *lexenv* (= inhibit-warnings 3)))
 420     (let ((condition
 421            (coerce-to-condition datum args
 422                                 'simple-compiler-note 'compiler-notify)))
 423       (restart-case
 424           (signal condition)
 425         (muffle-warning ()
 426           (return-from compiler-notify (values))))
 427       (incf *compiler-note-count*)
 428       (multiple-value-bind (format-string format-args)
 429           (if (typep condition 'simple-condition)
 430               (values (simple-condition-format-control condition)
 431                       (simple-condition-format-arguments condition))
 432               (values "~A"
 433                       (list (with-output-to-string (s)
 434                               (princ condition s)))))
 435         (print-compiler-message (format nil "note: ~A" format-string)
 436                                 format-args))))
 437   (values))
 438
 439 ;;; Issue a note when we might or might not be in the compiler.
 440 (defun maybe-compiler-notify (&rest rest)
 441   (if (boundp '*lexenv*) ; if we're in the compiler
 442       (apply #'compiler-notify rest)
 443       (progn
 444         (let ((condition
 445                (coerce-to-condition (car rest) (cdr rest)
 446                                     'simple-compiler-note
 447                                     'maybe-compiler-notify)))
 448           (restart-case
 449               (signal condition)
 450             (muffle-warning ()
 451               (return-from maybe-compiler-notify (values))))
 452           (let ((stream *error-output*))
 453             (pprint-logical-block (stream nil :per-line-prefix ";")
 454               (format stream " note: ~3I~_")
 455               (pprint-logical-block (stream nil)
 456                 (format stream "~A" condition)))
 457             ;; (outside logical block, no per-line-prefix)
 458             (fresh-line stream)))
 459         (values))))
 460
 461 ;;; The politically correct way to print out progress messages and
 462 ;;; such like. We clear the current error context so that we know that
 463 ;;; it needs to be reprinted, and we also FORCE-OUTPUT so that the
 464 ;;; message gets seen right away.
 465 (declaim (ftype (function (string &rest t) (values)) compiler-mumble))
 466 (defun compiler-mumble (format-string &rest format-args)
 467   (note-message-repeats)
 468   (setq *last-error-context* nil)
 469   (apply #'format *error-output* format-string format-args)
 470   (force-output *error-output*)
 471   (values))
 472
 473 ;;; Return a string that somehow names the code in COMPONENT. We use
 474 ;;; the source path for the bind node for an arbitrary entry point to
 475 ;;; find the source context, then return that as a string.
 476 (declaim (ftype (function (component) simple-string) find-component-name))
 477 (defun find-component-name (component)
 478   (let ((ep (first (block-succ (component-head component)))))
 479     (aver ep) ; else no entry points??
 480     (multiple-value-bind (form context)
 481         (find-original-source
 482          (node-source-path (block-start-node ep)))
 483       (declare (ignore form))
 484       (let ((*print-level* 2)
 485             (*print-pretty* nil))
 486         (format nil "~{~{~S~^ ~}~^ => ~}" context)))))
 487 \f
 488 ;;;; condition system interface
 489
 490 ;;; Keep track of how many times each kind of condition happens.
 491 (defvar *compiler-error-count*)
 492 (defvar *compiler-warning-count*)
 493 (defvar *compiler-style-warning-count*)
 494 (defvar *compiler-note-count*)
 495
 496 ;;; Keep track of whether any surrounding COMPILE or COMPILE-FILE call
 497 ;;; should return WARNINGS-P or FAILURE-P.
 498 (defvar *failure-p*)
 499 (defvar *warnings-p*)
 500
 501 ;;; condition handlers established by the compiler. We re-signal the
 502 ;;; condition, then if it isn't handled, we increment our warning
 503 ;;; counter and print the error message.
 504 (defun compiler-error-handler (condition)
 505   (signal condition)
 506   (incf *compiler-error-count*)
 507   (setf *warnings-p* t
 508         *failure-p* t)
 509   (print-compiler-condition condition)
 510   (continue condition))
 511 (defun compiler-warning-handler (condition)
 512   (signal condition)
 513   (incf *compiler-warning-count*)
 514   (setf *warnings-p* t
 515         *failure-p* t)
 516   (print-compiler-condition condition)
 517   (muffle-warning condition))
 518 (defun compiler-style-warning-handler (condition)
 519   (signal condition)
 520   (incf *compiler-style-warning-count*)
 521   (setf *warnings-p* t)
 522   (print-compiler-condition condition)
 523   (muffle-warning condition))
 524 \f
 525 ;;;; undefined warnings
 526
 527 (defvar *undefined-warning-limit* 3
 528   #!+sb-doc
 529   "If non-null, then an upper limit on the number of unknown function or type
 530   warnings that the compiler will print for any given name in a single
 531   compilation. This prevents excessive amounts of output when the real
 532   problem is a missing definition (as opposed to a typo in the use.)")
 533
 534 ;;; Make an entry in the *UNDEFINED-WARNINGS* describing a reference
 535 ;;; to NAME of the specified KIND. If we have exceeded the warning
 536 ;;; limit, then just increment the count, otherwise note the current
 537 ;;; error context.
 538 ;;;
 539 ;;; Undefined types are noted by a condition handler in
 540 ;;; WITH-COMPILATION-UNIT, which can potentially be invoked outside
 541 ;;; the compiler, hence the BOUNDP check.
 542 (defun note-undefined-reference (name kind)
 543   (unless (and
 544            ;; Check for boundness so we don't blow up if we're called
 545            ;; when IR1 conversion isn't going on.
 546            (boundp '*lexenv*)
 547            (or
 548             ;; FIXME: I'm pretty sure the INHIBIT-WARNINGS test below
 549             ;; isn't a good idea; we should have INHIBIT-WARNINGS
 550             ;; affect compiler notes, not STYLE-WARNINGs. And I'm not
 551             ;; sure what the BOUNDP '*LEXENV* test above is for; it's
 552             ;; likely a good idea, but it probably deserves an
 553             ;; explanatory comment.
 554             (policy *lexenv* (= inhibit-warnings 3))
 555             ;; KLUDGE: weird decoupling between here and where we're
 556             ;; going to signal the condition.  I don't think we can
 557             ;; rewrite this using SIGNAL and RESTART-CASE (to take
 558             ;; advantage of the (SATISFIES HANDLE-CONDITION-P)
 559             ;; handler, because if that doesn't handle it the ordinary
 560             ;; compiler handlers will trigger.
 561             (typep
 562              (ecase kind
 563                (:variable (make-condition 'warning))
 564                ((:function :type) (make-condition 'style-warning)))
 565              (car
 566               (rassoc 'muffle-warning
 567                       (lexenv-handled-conditions *lexenv*))))))
 568     (let* ((found (dolist (warning *undefined-warnings* nil)
 569                     (when (and (equal (undefined-warning-name warning) name)
 570                                (eq (undefined-warning-kind warning) kind))
 571                       (return warning))))
 572            (res (or found
 573                     (make-undefined-warning :name name :kind kind))))
 574       (unless found (push res *undefined-warnings*))
 575       (when (or (not *undefined-warning-limit*)
 576                 (< (undefined-warning-count res) *undefined-warning-limit*))
 577         (push (find-error-context (list name))
 578               (undefined-warning-warnings res)))
 579       (incf (undefined-warning-count res))))
 580   (values))