X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=1c42b5840b45c2bbd519fd114479de03815d717a;hb=f12b298a4ce9090470000360b49523e56475a680;hp=6a75cf05b12f347aa40899d0d883974faa96de74;hpb=f22ad70037030c07074327cf239bd84dc17b44b6;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 6a75cf0..1c42b58 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -176,7 +176,7 @@
               (*compiler-note-count* 0)
               (*undefined-warnings* nil)
               (*in-compilation-unit* t))
-          (sb!thread:with-recursive-lock (*big-compiler-lock*)
+          (with-world-lock ()
             (handler-bind ((parse-unknown-type
                             (lambda (c)
                               (note-undefined-reference
@@ -387,10 +387,12 @@
 (defun ir1-phases (component)
   (declare (type component component))
   (aver-live-component component)
-  (let ((*constraint-number* 0)
+  (let ((*constraint-universe* (make-array 64 ; arbitrary, but don't
+                                              ;make this 0.
+                                           :fill-pointer 0 :adjustable t))
         (loop-count 1)
         (*delayed-ir1-transforms* nil))
-    (declare (special *constraint-number* *delayed-ir1-transforms*))
+    (declare (special *constraint-universe* *delayed-ir1-transforms*))
     (loop
       (ir1-optimize-until-done component)
       (when (or (component-new-functionals component)
@@ -457,6 +459,8 @@
             (maybe-mumble "copy ")
             (copy-propagate component))
 
+          (ir2-optimize component)
+
           (select-representations component)
 
           (when *check-consistency*
@@ -756,7 +760,7 @@
                               (print-unreadable-object (s stream :type t))))
              (:copier nil))
   ;; the UT that compilation started at
-  (start-time (get-universal-time) :type unsigned-byte)
+  (start-time (get-internal-real-time) :type unsigned-byte)
   ;; the FILE-INFO structure for this compilation
   (file-info nil :type (or file-info null))
   ;; the stream that we are using to read the FILE-INFO, or NIL if
@@ -1029,7 +1033,8 @@
                                            (functional-lexenv locall-fun))))
            (fun (ir1-convert-lambda (make-xep-lambda-expression locall-fun)
                                     :source-name source-name
-                                    :debug-name (debug-name 'tl-xep debug-name-tail))))
+                                    :debug-name (debug-name 'tl-xep debug-name-tail)
+                                    :system-lambda t)))
       (when name
         (assert-global-function-definition-type name locall-fun))
       (setf (functional-entry-fun fun) locall-fun
@@ -1603,10 +1608,13 @@
             ((try-with-type pathname "lisp"  nil))
             ((try-with-type pathname "lisp"  t))))))
 
-(defun elapsed-time-to-string (tsec)
-  (multiple-value-bind (tmin sec) (truncate tsec 60)
-    (multiple-value-bind (thr min) (truncate tmin 60)
-      (format nil "~D:~2,'0D:~2,'0D" thr min sec))))
+(defun elapsed-time-to-string (internal-time-delta)
+  (multiple-value-bind (tsec remainder)
+      (truncate internal-time-delta internal-time-units-per-second)
+    (let ((ms (truncate remainder (/ internal-time-units-per-second 1000))))
+      (multiple-value-bind (tmin sec) (truncate tsec 60)
+        (multiple-value-bind (thr min) (truncate tmin 60)
+          (format nil "~D:~2,'0D:~2,'0D.~3,'0D" thr min sec ms))))))
 
 ;;; Print some junk at the beginning and end of compilation.
 (defun print-compile-start-note (source-info)
@@ -1627,7 +1635,7 @@
   (compiler-mumble "~&; compilation ~:[aborted after~;finished in~] ~A~&"
                    won
                    (elapsed-time-to-string
-                    (- (get-universal-time)
+                    (- (get-internal-real-time)
                        (source-info-start-time source-info))))
   (values))