X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fmain.lisp;h=9a86abe1dff752c5b060fafd323a6f9d4993b8a5;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=3a96c2bbdd024a97c09288615189b74641b68394;hpb=8375acd89ba695e2fc838fffd5211a5ddf9c3b0d;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 3a96c2b..9a86abe 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.
@@ -37,6 +38,9 @@
 (defvar *check-consistency* nil)
 (defvar *all-components*)
 
+;;; Set to NIL to disable loop analysis for register allocation. 
+(defvar *loop-analyze* t)
+
 ;;; Bind this to a stream to capture various internal debugging output.
 (defvar *compiler-trace-output* nil)
 
@@ -196,7 +200,7 @@
 		    (t
 		     (compiler-warn
 		      "~@<The ~(~A~) ~S is undefined, and its name is ~
-                       reserved by ANSI CL so that even if it it were ~
+                       reserved by ANSI CL so that even if it were ~
                        defined later, the code doing so would not be ~
                        portable.~:@>"
 		      kind name)))
@@ -398,7 +402,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
@@ -521,6 +526,25 @@
 
     (ir1-phases component)
 
+    (when *loop-analyze*
+      (dfo-as-needed component)
+      (find-dominators component)
+      (loop-analyze component))
+
+    #|
+    (when (and *loop-analyze* *compiler-trace-output*)
+      (labels ((print-blocks (block)
+		 (format *compiler-trace-output* "    ~A~%" block)
+		 (when (block-loop-next block)
+		   (print-blocks (block-loop-next block))))
+	       (print-loop (loop)
+		 (format *compiler-trace-output* "loop=~A~%" loop)
+		 (print-blocks (loop-blocks loop))
+		 (dolist (l (loop-inferiors loop))
+		   (print-loop l))))
+	(print-loop (component-outer-loop component))))
+    |#
+    
     ;; FIXME: What is MAYBE-MUMBLE for? Do we need it any more?
     (maybe-mumble "env ")
     (physenv-analyze component)
@@ -727,7 +751,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 +760,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 +937,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 +975,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
@@ -1402,6 +1424,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~%")
@@ -1438,9 +1461,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*
-	       "~@<compilation aborted because of input error: ~2I~_~A~:>"
+	       "~@<compilation aborted because of fatal error: ~2I~_~A~:>"
 	       condition)
        (values nil t t)))))