Changeset 14543


Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r14445 r14543  
    4242(require "JAVA")
    4343
     44(proclaim '(optimize speed))
    4445
    4546(defun generate-inline-expansion (name lambda-list body
     
    445446(defun p1-body (body)
    446447  (declare (optimize speed))
    447   (loop for form in body
    448      collect (p1 form)))
     448  (loop
     449     for form in body
     450     for processed-form = (p1 form)
     451     collect processed-form
     452     while (not (and (consp processed-form)
     453                     (memq (car processed-form) '(GO RETURN-FROM THROW))))))
    449454
    450455(defknown p1-default (t) t)
    451456(declaim (inline p1-default))
    452457(defun p1-default (form)
    453   (cons (car form) (p1-body (cdr form))))
     458  (declare (optimize speed))
     459  (cons (car form) (loop for f in (cdr form) collect (p1 f))))
    454460
    455461(defun let/let*-variables (block bindings)
     
    635641         (block (make-synchronized-node))
    636642         (*block* block)
    637          (*blocks* (cons block *blocks*))
    638          result)
    639     (dolist (subform body)
    640       (let ((op (and (consp subform) (%car subform))))
    641         (push (p1 subform) result)
    642         (when (memq op '(GO RETURN-FROM THROW))
    643           (return))))
     643         (*blocks* (cons block *blocks*)))
    644644    (setf (synchronized-form block)
    645645          (list* 'threads:synchronized-on synchronized-object
    646                  (nreverse result)))
     646                 (p1-body body)))
    647647    block))
     648
    648649
    649650(defun p1-unwind-protect (form)
Note: See TracChangeset for help on using the changeset viewer.