Changeset 12866
- Timestamp:
- 08/06/10 21:47:06 (13 years ago)
- 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 882 882 labels ;; an alist 883 883 884 current-local) ;; used for handling nested WITH-CODE-TO-METHOD blocks884 (current-local 0)) ;; used for handling nested WITH-CODE-TO-METHOD blocks 885 885 886 886 … … 1047 1047 *register* (code-current-local code))) 1048 1048 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) 1050 1051 (let ((m (gensym)) 1051 1052 (c (gensym))) … … 1055 1056 (save-code-specials *current-code-attribute*)))) 1056 1057 (let* ((,m ,method) 1057 (,c (method-ensure-code method))1058 (,c (method-ensure-code ,method)) 1058 1059 (*pool* (class-file-constants ,class-file)) 1059 1060 (*code* (code-code ,c)) … … 1063 1064 ,@body 1064 1065 (setf (code-code ,c) *code* 1066 (code-current-local ,c) *register* 1065 1067 ;; (code-exception-handlers ,c) *handlers* 1066 1068 (code-max-locals ,c) *registers-allocated*)) -
branches/generic-class-file/abcl/test/lisp/abcl/class-file.lisp
r12843 r12866 319 319 (values (funcall fn) (funcall fn NIL))))) 320 320 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)) 321 372 322 373 ;; ;; generation of an ABCL-like function, with mixed output to constructor,
Note: See TracChangeset
for help on using the changeset viewer.