Changeset 12866


Ignore:
Timestamp:
08/06/10 21:47:06 (12 years ago)
Author:
astalla
Message:

WIHT-CODE-TO-METHOD fixes and tests for nesting.

Location:
branches/generic-class-file/abcl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

    r12863 r12866  
    882882  labels ;; an alist
    883883
    884   current-local) ;; used for handling nested WITH-CODE-TO-METHOD blocks
     884  (current-local 0)) ;; used for handling nested WITH-CODE-TO-METHOD blocks
    885885
    886886
     
    10471047        *register* (code-current-local code)))
    10481048
    1049 (defmacro with-code-to-method ((class-file method &key safe-nesting) &body body)
     1049(defmacro with-code-to-method ((class-file method &key (safe-nesting t))
     1050             &body body)
    10501051  (let ((m (gensym))
    10511052        (c (gensym)))
     
    10551056               (save-code-specials *current-code-attribute*))))
    10561057       (let* ((,m ,method)
    1057               (,c (method-ensure-code method))
     1058              (,c (method-ensure-code ,method))
    10581059              (*pool* (class-file-constants ,class-file))
    10591060              (*code* (code-code ,c))
     
    10631064         ,@body
    10641065         (setf (code-code ,c) *code*
     1066         (code-current-local ,c) *register*
    10651067;;               (code-exception-handlers ,c) *handlers*
    10661068               (code-max-locals ,c) *registers-allocated*))
  • branches/generic-class-file/abcl/test/lisp/abcl/class-file.lisp

    r12843 r12866  
    319319          (values (funcall fn) (funcall fn NIL)))))
    320320  NIL T)
     321
     322;;Nested with-code-to-method
     323(deftest with-code-to-method.1
     324    (let* ((class (jvm::make-class-name "org/armedbear/lisp/gm_6"))
     325           (file (jvm::!make-class-file class jvm::+lisp-object+ '(:public)))
     326           (method (jvm::!make-method :class-constructor :void nil
     327              :flags '(:static)))
     328     (registers nil))
     329      (jvm::class-add-method file method)
     330      (jvm::with-code-to-method (file method)
     331  (jvm::allocate-register)
     332  (push jvm::*register* registers)
     333  (jvm::with-code-to-method (file method)
     334    (jvm::allocate-register)
     335    (push jvm::*register* registers)
     336    (jvm::with-code-to-method (file method)
     337      (jvm::allocate-register)
     338      (push jvm::*register* registers))
     339    (jvm::allocate-register)
     340    (push jvm::*register* registers))
     341  (jvm::allocate-register)
     342  (push jvm::*register* registers))
     343      (jvm::finalize-class-file file)
     344      (nreverse registers))
     345  (1 2 3 4 5))
     346
     347(deftest with-code-to-method.2
     348    (let* ((class (jvm::make-class-name "org/armedbear/lisp/gm_7"))
     349           (file (jvm::!make-class-file class jvm::+lisp-object+ '(:public)))
     350           (method1 (jvm::!make-method :class-constructor :void nil
     351               :flags '(:static)))
     352     (method2 (jvm::!make-method "method2" :void nil))
     353     (registers nil))
     354      (jvm::class-add-method file method1)
     355      (jvm::class-add-method file method2)
     356      (jvm::with-code-to-method (file method1)
     357  (jvm::allocate-register)
     358  (push jvm::*register* registers)
     359  (jvm::with-code-to-method (file method2)
     360    (jvm::allocate-register)
     361    (push jvm::*register* registers)
     362    (jvm::with-code-to-method (file method1)
     363      (jvm::allocate-register)
     364      (push jvm::*register* registers))
     365    (jvm::allocate-register)
     366    (push jvm::*register* registers))
     367  (jvm::allocate-register)
     368  (push jvm::*register* registers))
     369      (jvm::finalize-class-file file)
     370      (nreverse registers))
     371  (1 1 2 2 3))
    321372
    322373;; ;;  generation of an ABCL-like function, with mixed output to constructor,
Note: See TracChangeset for help on using the changeset viewer.