X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=01d9c6ff7245ed461741f873aba07dd9918bca3d;hb=f705c517d8606a9a72edd11a96725f9c4e4be93d;hp=ff1bcce79cb3ee8c64c5fa6773acbb1fc4885534;hpb=ff92598854bf7cae8d57fe49cef4d9a98e1ab345;p=sbcl.git diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index ff1bcce..01d9c6f 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -28,7 +28,8 @@ #!+sb-show *compiler-trace-output* *last-source-context* *last-original-source* *last-source-form* *last-format-string* *last-format-args* - *last-message-count* *lexenv* *fun-names-in-this-file*)) + *last-message-count* *lexenv* *fun-names-in-this-file* + *allow-instrumenting*)) ;;; Whether call of a function which cannot be defined causes a full ;;; warning. @@ -196,7 +197,7 @@ (t (compiler-warn "~@" kind name))) @@ -398,7 +399,8 @@ (maybe-mumble "control ") (control-analyze component #'make-ir2-block) - (when (ir2-component-values-receivers (component-info component)) + (when (or (ir2-component-values-receivers (component-info component)) + (component-dx-lvars component)) (maybe-mumble "stack ") (stack-analyze component) ;; Assign BLOCK-NUMBER for any cleanup blocks introduced by @@ -661,7 +663,7 @@ ;;; A FILE-INFO structure holds all the source information for a ;;; given file. -(defstruct (file-info (:copier nil)) +(def!struct (file-info (:copier nil)) ;; If a file, the truename of the corresponding source file. If from ;; a Lisp form, :LISP. If from a stream, :STREAM. (name (missing-arg) :type (or pathname (member :lisp :stream))) @@ -684,11 +686,11 @@ ;;; The SOURCE-INFO structure provides a handle on all the source ;;; information for an entire compilation. -(defstruct (source-info - #-no-ansi-print-object - (:print-object (lambda (s stream) - (print-unreadable-object (s stream :type t)))) - (:copier nil)) +(def!struct (source-info + #-no-ansi-print-object + (:print-object (lambda (s stream) + (print-unreadable-object (s stream :type t)))) + (:copier nil)) ;; the UT that compilation started at (start-time (get-universal-time) :type unsigned-byte) ;; the FILE-INFO structure for this compilation @@ -727,7 +729,7 @@ (handler-case (read stream nil stream) (reader-error (condition) (error 'input-error-in-compile-file - :error condition + :condition condition ;; We don't need to supply :POSITION here because ;; READER-ERRORs already know their position in the file. )) @@ -736,7 +738,7 @@ ;; file in the middle of something it's trying to read. (end-of-file (condition) (error 'input-error-in-compile-file - :error condition + :condition condition ;; We need to supply :POSITION here because the END-OF-FILE ;; condition doesn't carry the position that the user ;; probably cares about, where the failed READ began. @@ -913,14 +915,11 @@ (setf (component-name component) (debug-namify "~S initial component" name)) (setf (component-kind component) :initial) - (let* ((locall-fun (ir1-convert-lambdalike - definition - :debug-name (debug-namify "top level local call " - name) - ;; KLUDGE: we do this so that we get to have - ;; nice debug returnness in functions defined - ;; from the REPL - :allow-debug-catch-tag t)) + (let* ((locall-fun (let ((*allow-instrumenting* t)) + (ir1-convert-lambdalike + definition + :debug-name (debug-namify "top level local call " + name)))) (fun (ir1-convert-lambda (make-xep-lambda-expression locall-fun) :source-name (or name '.anonymous.) :debug-name (unless name @@ -954,7 +953,8 @@ '(original-source-start 0 0))) (when name (legal-fun-name-or-type-error name)) - (let* ((*lexenv* (make-lexenv :policy *policy* + (let* ( + (*lexenv* (make-lexenv :policy *policy* :handled-conditions *handled-conditions* :disabled-package-locks *disabled-package-locks*)) (fun (make-functional-from-toplevel-lambda lambda-expression @@ -1061,11 +1061,9 @@ (catch 'process-toplevel-form-error-abort (let* ((path (or (gethash form *source-paths*) (cons form path))) (*compiler-error-bailout* - (lambda () + (lambda (&optional condition) (convert-and-maybe-compile - `(error 'simple-program-error - :format-control "execution of a form compiled with errors:~% ~S" - :format-arguments (list ',form)) + (make-compiler-error-form condition form) path) (throw 'process-toplevel-form-error-abort nil)))) @@ -1404,6 +1402,7 @@ (*source-info* info) (*toplevel-lambdas* ()) (*fun-names-in-this-file* ()) + (*allow-instrumenting* nil) (*compiler-error-bailout* (lambda () (compiler-mumble "~2&; fatal error, aborting compilation~%") @@ -1440,9 +1439,10 @@ ;; Some errors are sufficiently bewildering that we just fail ;; immediately, without trying to recover and compile more of ;; the input file. - (input-error-in-compile-file (condition) + (fatal-compiler-error (condition) + (signal condition) (format *error-output* - "~@" + "~@" condition) (values nil t t))))) @@ -1695,11 +1695,9 @@ (throw 'pending-init circular-ref))) (multiple-value-bind (creation-form init-form) (handler-case - (sb!xc:make-load-form constant (make-null-lexenv)) + (sb!xc:make-load-form constant (make-null-lexenv)) (error (condition) - (compiler-error "(while making load form for ~S)~%~A" - constant - condition))) + (compiler-error condition))) (case creation-form (:sb-just-dump-it-normally (fasl-validate-structure constant *compile-object*)