Ignore:
Timestamp:
04/16/12 20:13:03 (11 years ago)
Author:
Mark Evenson
Message:

compiler: don't signal conditions for fasl verification error and muffle diagnostics by default.

HEADS UP: problems seem to exist ANSI tests, which triggers the
attempt to load the fasl classfile to verify its integrity.

Don't signal problems just yet, until satisfied that the correct
diagnostic messages are being triggered.

Refactored diagnostics interface to use a new SYS::DIAG macro whose output is
directed to the value of SYS:*COMPILER-DIAGNOSTIC*. This should be
reconsidered in view of all the diagnostic frameworks when I
understand how they are to be used

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r13914 r13915  
    8484  (assert nil))
    8585
    86 (defparameter *diagnostic* t
     86;;; ??? rename to something shorter?
     87(defparameter *compiler-diagnostic* nil
    8788  "The stream to emit compiler diagnostic messages to, or nil to muffle output.")
     89(export '*compiler-diagnostic*)
     90(defmacro diag (fmt &rest args)
     91  `(format *compiler-diagnostic* "~&SYSTEM::*COMPILER-DIAGNOSTIC* ~A~&" (format nil ,fmt ,@args)))
    8892
    8993(declaim (ftype (function (t) t) verify-load))
    90 (defun verify-load (classfile)
    91       (and classfile
    92            (unless
    93                  (> (file-length (open classfile :direction :input))
    94                     0)
     94(defun verify-load (classfile &key (force nil))
     95  "Return whether the file at the path denoted by CLASSFILE is a loadable JVM artifact."
     96  (unless classfile
     97    (diag "Nil classfile argument passed to verify-load.")
     98    (return-from verify-load nil))
     99  (when
     100      (= 0 (file-length (open classfile :direction :input)))
    95101             ;;; TODO hook into a real ABCL compiler condition hierarchy
    96              (signal "Internal compiler error detected: Fasl contains ~
    97 zero-length jvm classfile corresponding to ~A." classfile)))
    98            (if (> *safety* *speed*)
    99                (progn
    100                  (format *diagnostic*
    101                          "~&SYSTEM::*DIAGNOSTIC* Testing compiled bytecode by loading classfile into JVM because (> *safety* *speed*).~%")
    102                  (let ((*load-truename* *output-file-pathname*))
    103                    (report-error
    104                     (load-compiled-function classfile))))
    105                t))
     102    (diag "Internal compiler error detected: Fasl contains ~
     103zero-length jvm classfile corresponding to ~A." classfile)
     104    (return-from verify-load nil))
     105  (when (or force (> *safety* *speed*))
     106    (diag "Testing compiled bytecode by loading classfile into JVM.")
     107    (let ((*load-truename* *output-file-pathname*))
     108      ;; load-compiled-function used to be wrapped via report-error
     109      (return-from verify-load (load-compiled-function classfile))))
     110  t)
    106111
    107112(declaim (ftype (function (t) t) note-toplevel-form))
     
    175180                                             classfile f
    176181                                             declare-inline))))
    177          (compiled-function (handler-case (verify-load classfile)
    178                               (t (c)
    179                                 (error "Compilation failed for JVM class number ~A
    180 corresponding to form ~A~&with condition ~A"
    181                                        saved-class-number toplevel-form c)))))
    182     (declare (ignore result))
     182         (compiled-function (verify-load classfile)))
     183    (declare (ignore toplevel-form result))
    183184    (progn
     185      #+nil
    184186      (when (> *debug* 0)
     187;; TODO        (annotate form toplevel-form classfile compiled-function fasl-class-number)
    185188        ;;; ??? define an API by perhaps exporting these symbols?
    186189        (setf (getf form 'form-source)
Note: See TracChangeset for help on using the changeset viewer.