Ignore:
Timestamp:
01/17/05 03:34:53 (17 years ago)
Author:
piso
Message:

Work in progress (tested).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r8364 r8366  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.352 2005-01-16 00:36:47 piso Exp $
     4;;; $Id: jvm.lisp,v 1.353 2005-01-17 03:34:53 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    38413841      ;; Non-local RETURN.
    38423842      (setf (block-non-local-return-p block) t)
    3843       (emit 'new +lisp-return-class+)
    3844       (emit 'dup)
    3845       (compile-form `',(block-catch-tag block) :target :stack) ; Tag.
    3846 
    3847       ;; Added Dec 9 2004 7:28 AM
    3848       (emit-clear-values)
    3849 
    3850       (compile-form (third form) :target :stack) ; Result.
    3851       (emit-invokespecial +lisp-return-class+
    3852                           "<init>"
    3853                           "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)V"
    3854                           -3)
    3855       (emit 'athrow)
    3856       ;; Following code will not be reached, but is needed for JVM stack
    3857       ;; consistency.
    3858       (when target
    3859         (emit-push-nil)
    3860         (emit-move-from-stack target))))))
     3843      (let* ((*register* *register*)
     3844             (temp-register (allocate-register)))
     3845
     3846        (emit-clear-values)
     3847        (compile-form (third form) :target temp-register) ; Result.
     3848
     3849        (emit 'new +lisp-return-class+)
     3850        (emit 'dup)
     3851        (compile-form `',(block-catch-tag block) :target :stack) ; Tag.
     3852
     3853;        (emit-clear-values)
     3854
     3855;;         (compile-form (third form) :target :stack) ; Result.
     3856        (emit 'aload temp-register)
     3857
     3858        (emit-invokespecial +lisp-return-class+
     3859                            "<init>"
     3860                            "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)V"
     3861                            -3)
     3862        (emit 'athrow)
     3863        ;; Following code will not be reached, but is needed for JVM stack
     3864        ;; consistency.
     3865        (when target
     3866          (emit-push-nil)
     3867          (emit-move-from-stack target)))))))
    38613868
    38623869(defun compile-cons (form &key (target *val*) representation)
     
    39833990          (*debug* *debug*))
    39843991      (p2-compiland compiland))
    3985     (when (null *compile-file-truename*)
    3986       (setf function (sys:load-compiled-function classfile)))
     3992    (cond (*compile-file-truename*
     3993           ;; Verify that the class file is loadable.
     3994           (unless (ignore-errors (sys:load-compiled-function classfile))
     3995             (error "P2-LOCAL-FUNCTION: unable to load ~S." classfile)))
     3996          (t
     3997           (setf function (sys:load-compiled-function classfile))))
    39873998    (cond (local-function
    39883999           (setf (local-function-classfile local-function) classfile)
Note: See TracChangeset for help on using the changeset viewer.