Changeset 14543

Timestamp:

06/16/13 09:17:21 (9 years ago)

Author:

ehuelsmann

Message:

Centralize non-local exit detection;

hot code helps hot spot determine which code to compile.

File:

• trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp (modified) (3 diffs)

trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

@@ -42 +42 @@
 (require "JAVA")
 
+(proclaim '(optimize speed))
 
 (defun generate-inline-expansion (name lambda-list body
@@ -445 +446 @@
 (defun p1-body (body)
   (declare (optimize speed))
-  (loop for form in body
-     collect (p1 form)))
+  (loop
+     for form in body
+     for processed-form = (p1 form)
+     collect processed-form
+     while (not (and (consp processed-form)
+                     (memq (car processed-form) '(GO RETURN-FROM THROW))))))
 
 (defknown p1-default (t) t)
 (declaim (inline p1-default))
 (defun p1-default (form)
-  (cons (car form) (p1-body (cdr form))))
+  (declare (optimize speed))
+  (cons (car form) (loop for f in (cdr form) collect (p1 f))))
 
 (defun let/let*-variables (block bindings)
@@ -635 +641 @@
          (block (make-synchronized-node))
          (*block* block)
-         (*blocks* (cons block *blocks*))
-         result)
-    (dolist (subform body)
-      (let ((op (and (consp subform) (%car subform))))
-        (push (p1 subform) result)
-        (when (memq op '(GO RETURN-FROM THROW))
-          (return))))
+         (*blocks* (cons block *blocks*)))
     (setf (synchronized-form block)
           (list* 'threads:synchronized-on synchronized-object
-                 (nreverse result)))
+                 (p1-body body)))
     block))
+
 
 (defun p1-unwind-protect (form)