Changeset 14552


Ignore:
Timestamp:
06/18/13 19:20:51 (4 years ago)
Author:
ehuelsmann
Message:

Inline calls to jrun-exception-protected
(used by handler-bind to catch out of memory conditions).

This commit saves generation roughly 50 cls files.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Lisp.java

    r14465 r14552  
    382382    pushJavaStackFrames();
    383383    return Symbol.ERROR.execute(condition);
     384  }
     385
     386  public static final LispObject stackError()
     387  {
     388    pushJavaStackFrames();
     389    return Symbol.ERROR.execute(new StorageCondition("Stack overflow."));
     390  }
     391
     392  public static final LispObject memoryError(OutOfMemoryError exception)
     393  {
     394    pushJavaStackFrames();
     395    return Symbol.ERROR.execute(new StorageCondition("Out of memory: "
     396                                                     + exception.getMessage()));
    384397  }
    385398
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r14543 r14552  
    647647    block))
    648648
     649(defun p1-java-jrun-exception-protected (form)
     650  (assert (eq (first form) 'java:jrun-exception-protected))
     651  (assert (eq (car (second form)) 'lambda))
     652  (assert (eq (cadr (second form)) nil))
     653  (let* ((body (cddr (second form)))
     654         (block (make-exception-protected-node))
     655         (*block* block)
     656         (*blocks* (cons block *blocks*)))
     657    (setf (exception-protected-form block)
     658          (p1-body body))
     659    block))
    649660
    650661(defun p1-unwind-protect (form)
     
    13691380                  (THREADS:SYNCHRONIZED-ON
    13701381                                        p1-threads-synchronized-on)
     1382                  (JAVA:JRUN-EXCEPTION-PROTECTED
     1383                                        p1-java-jrun-exception-protected)
    13711384                  (JVM::WITH-INLINE-CODE identity)))
    13721385    (install-p1-handler (%car pair) (%cadr pair))))
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r14420 r14552  
    605605               ((jump-node-p form)
    606606                (single-valued-p (node-form form)))
     607               ((exception-protected-node-p form)
     608                (single-valued-p (exception-protected-form form)))
    607609               (t
    608610                (assert (not "SINGLE-VALUED-P unhandled NODE-P branch")))))
     
    67466748                           END-PROTECTED-RANGE nil)))
    67476749
     6750(defun p2-java-jrun-exception-protected (block target)
     6751  (let* ((form (exception-protected-form block))
     6752         (*register* *register*)
     6753         (*blocks* (cons block *blocks*))
     6754         (BEGIN-PROTECTED-RANGE (gensym "F"))
     6755         (END-PROTECTED-RANGE (gensym "U"))
     6756         (STACK-EXHAUST (gensym "S"))
     6757         (MEMORY-EXHAUST (gensym "M"))
     6758         (EXIT (gensym "E")))
     6759    (label BEGIN-PROTECTED-RANGE)
     6760    (compile-progn-body form target)
     6761    (emit 'goto EXIT)
     6762    (label END-PROTECTED-RANGE)
     6763    (label STACK-EXHAUST)
     6764    (emit 'pop)
     6765    (emit-invokestatic +lisp+ "stackError" nil +lisp-object+)
     6766    (emit 'areturn)
     6767    (add-exception-handler BEGIN-PROTECTED-RANGE
     6768                           END-PROTECTED-RANGE
     6769                           STACK-EXHAUST
     6770                           +java-stack-overflow+)
     6771    (label MEMORY-EXHAUST)
     6772    (emit-invokestatic +lisp+ "memoryError" (list +java-out-of-memory+)
     6773                       +lisp-object+)
     6774    (emit 'areturn)
     6775    (add-exception-handler BEGIN-PROTECTED-RANGE
     6776                           END-PROTECTED-RANGE
     6777                           MEMORY-EXHAUST
     6778                           +java-out-of-memory+)
     6779    (label EXIT)))
    67486780
    67496781(defknown p2-catch-node (t t) t)
     
    69807012       ((synchronized-node-p form)
    69817013        (p2-threads-synchronized-on form target)
     7014        (fix-boxing representation nil))
     7015       ((protected-node-p form)
     7016        (p2-java-jrun-exception-protected form target)
    69827017        (fix-boxing representation nil))
    69837018       (t
  • trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

    r14096 r14552  
    159159(define-class-name +java-string+ "java.lang.String")
    160160(define-class-name +java-system+ "java.lang.System")
     161(define-class-name +java-stack-overflow+ "java.lang.StackOverflowError")
     162(define-class-name +java-out-of-memory+ "java.lang.OutOfMemoryError")
    161163(define-class-name +java-io-input-stream+ "java.io.InputStream")
    162164(define-class-name +java-util-collection+ "java.util.Collection")
  • trunk/abcl/src/org/armedbear/lisp/jvm.lisp

    r14444 r14552  
    574574    block))
    575575
     576
     577(defstruct (exception-protected-node
     578             (:conc-name exception-protected-)
     579             (:include protected-node)
     580             (:constructor %make-exception-protected-node ())))
     581(defknown make-exception-protected-node () t)
     582(defun make-exception-protected-node ()
     583  (let ((block (%make-exception-protected-node)))
     584    (push block (compiland-blocks *current-compiland*))
     585    (add-node-child *block* block)
     586    block))
     587
     588
    576589(defun find-block (name)
    577590  (dolist (block *blocks*)
Note: See TracChangeset for help on using the changeset viewer.