Changeset 12791
- Timestamp:
- 07/08/10 21:57:18 (13 years ago)
- Location:
- branches/generic-class-file/abcl/src/org/armedbear/lisp
- Files:
-
- 3 edited
-
compile-file.lisp (modified) (1 diff)
-
compiler-pass2.lisp (modified) (83 diffs)
-
jvm-class-file.lisp (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/generic-class-file/abcl/src/org/armedbear/lisp/compile-file.lisp
r12761 r12791 685 685 (jvm::with-inline-code () 686 686 (jvm::emit 'jvm::aload 1) 687 (jvm::emit-invokevirtual jvm::+lisp-object -class+ "javaInstance"687 (jvm::emit-invokevirtual jvm::+lisp-object+ "javaInstance" 688 688 nil jvm::+java-object+) 689 689 (jvm::emit 'jvm::checkcast "org/armedbear/lisp/FaslClassLoader") -
branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r12790 r12791 200 200 201 201 202 (defconstant +lisp-object-class+ "org/armedbear/lisp/LispObject")203 (defconstant +lisp-object+ "Lorg/armedbear/lisp/LispObject;")204 202 (defconstant +lisp-object-array+ "[Lorg/armedbear/lisp/LispObject;") 205 203 (defconstant +closure-binding-array+ "[Lorg/armedbear/lisp/ClosureBinding;") … … 583 581 584 582 (defvar rep-classes 585 '((:boolean #.+lisp-object-class+ #.+lisp-object+)586 (:char #.+lisp-character-class+ #.+lisp-character+)587 (:int #.+lisp-integer-class+ #.+lisp-integer+)588 (:long #.+lisp-integer-class+ #.+lisp-integer+)589 (:float #.+lisp-single-float-class+ #.+lisp-single-float+)590 (:double #.+lisp-double-float-class+ #.+lisp-double-float+))583 `((:boolean . ,+lisp-object+) 584 (:char . ,+!lisp-character+) 585 (:int . ,+!lisp-integer+) 586 (:long . ,+!lisp-integer+) 587 (:float . ,+!lisp-single-float+) 588 (:double . ,+!lisp-double-float+)) 591 589 "Lists the class on which to call the `getInstance' method on, 592 590 when converting the internal representation to a LispObject.") … … 613 611 (let ((class (cdr (assoc in rep-classes))) 614 612 (arg-spec (cdr (assoc in rep-arg-chars)))) 615 (emit-invokestatic (first class)"getInstance" (list arg-spec)616 (second class))))613 (emit-invokestatic class "getInstance" (list arg-spec) 614 class))) 617 615 (return-from convert-representation)) 618 616 (let* ((in-map (cdr (assoc in rep-conversion))) … … 628 626 (funcall op)) 629 627 ((stringp op) 630 (emit-invokevirtual +lisp-object -class+ op nil628 (emit-invokevirtual +lisp-object+ op nil 631 629 (cdr (assoc out rep-arg-chars)))) 632 630 (t … … 658 656 (declaim (ftype (function t string) pretty-java-class)) 659 657 (defun pretty-java-class (class) 660 (cond ((equal class +lisp-object-class+)658 (cond ((equal (!class-name class) (!class-name +lisp-object+)) 661 659 "LispObject") 662 660 ((equal class +lisp-symbol+) … … 944 942 (emit 'getfield +lisp-fixnum-class+ "value" "I")) 945 943 (t 946 (emit-invokevirtual +lisp-object -class+ "intValue" nil "I"))))944 (emit-invokevirtual +lisp-object+ "intValue" nil "I")))) 947 945 ((eq required-representation :char) 948 946 (emit-unbox-character)) … … 950 948 (emit-unbox-boolean)) 951 949 ((eq required-representation :long) 952 (emit-invokevirtual +lisp-object -class+ "longValue" nil "J"))950 (emit-invokevirtual +lisp-object+ "longValue" nil "J")) 953 951 ((eq required-representation :float) 954 (emit-invokevirtual +lisp-object -class+ "floatValue" nil "F"))952 (emit-invokevirtual +lisp-object+ "floatValue" nil "F")) 955 953 ((eq required-representation :double) 956 (emit-invokevirtual +lisp-object -class+ "doubleValue" nil "D"))954 (emit-invokevirtual +lisp-object+ "doubleValue" nil "D")) 957 955 (t (assert nil)))) 958 956 … … 984 982 (defknown emit-invoke-method (t t t) t) 985 983 (defun emit-invoke-method (method-name target representation) 986 (emit-invokevirtual +lisp-object -class+ method-name nil +lisp-object+)984 (emit-invokevirtual +lisp-object+ method-name nil +lisp-object+) 987 985 (fix-boxing representation nil) 988 986 (emit-move-from-stack target representation)) … … 2122 2120 (string "STR" ,#'equal ,#'serialize-string 2123 2121 ,+lisp-abstract-string+) ;; because of (not compile-file) 2124 (package "PKG" ,#'eq ,#'serialize-package ,+ !lisp-object+)2122 (package "PKG" ,#'eq ,#'serialize-package ,+lisp-object+) 2125 2123 (symbol "SYM" ,#'eq ,#'serialize-symbol ,+!lisp-symbol+) 2126 (T "OBJ" ,#'eq ,#'serialize-object ,+ !lisp-object+))2124 (T "OBJ" ,#'eq ,#'serialize-object ,+lisp-object+)) 2127 2125 "A list of 5-element lists. The elements of the sublists mean: 2128 2126 … … 2177 2175 (emit-invokestatic +lisp+ "recall" 2178 2176 (list +java-string+) +lisp-object+) 2179 (when (not (eq field-type + !lisp-object+))2177 (when (not (eq field-type +lisp-object+)) 2180 2178 (emit 'checkcast field-type)) 2181 2179 (emit 'putstatic *this-class* field-name field-type) … … 2232 2230 ;; make sure we're not cacheing a proxied function 2233 2231 ;; (AutoloadedFunctionProxy) by allowing it to resolve itself 2234 (emit-invokevirtual +lisp-object -class+2232 (emit-invokevirtual +lisp-object+ 2235 2233 "resolve" nil +lisp-object+) 2236 2234 (emit 'putstatic *this-class* f +lisp-object+) … … 2325 2323 g)) 2326 2324 2327 (declaim (ftype (function (t &optional t) string) declare-object)) 2328 (defun declare-object (obj &optional (obj-ref +lisp-object+) 2329 obj-class) 2325 (declaim (ftype (function (t) string) declare-object)) 2326 (defun declare-object (obj) 2330 2327 "Stores the object OBJ in the object-lookup-table, 2331 2328 loading the object value into a field upon class-creation time. … … 2336 2333 (remember g obj) 2337 2334 (let* ((*code* *static-code*)) 2338 (declare-field g obj-ref+field-access-private+)2335 (declare-field g +lisp-object+ +field-access-private+) 2339 2336 (emit 'ldc (pool-string g)) 2340 2337 (emit-invokestatic +lisp+ "recall" 2341 2338 (list +java-string+) +lisp-object+) 2342 (when (and obj-class (string/= obj-class +lisp-object-class+)) 2343 (emit 'checkcast obj-class)) 2344 (emit 'putstatic *this-class* g obj-ref) 2339 (emit 'putstatic *this-class* g +lisp-object+) 2345 2340 (setf *static-code* *code*) 2346 2341 g))) … … 2356 2351 ((integerp form) 2357 2352 (emit-load-externalized-object form) 2358 (emit-invokevirtual +lisp-object -class+ "intValue" nil "I"))2353 (emit-invokevirtual +lisp-object+ "intValue" nil "I")) 2359 2354 (t 2360 2355 (sys::%format t "compile-constant int representation~%") … … 2367 2362 ((integerp form) 2368 2363 (emit-load-externalized-object form) 2369 (emit-invokevirtual +lisp-object -class+ "longValue" nil "J"))2364 (emit-invokevirtual +lisp-object+ "longValue" nil "J")) 2370 2365 (t 2371 2366 (sys::%format t "compile-constant long representation~%") … … 2493 2488 (ecase representation 2494 2489 (:boolean 2495 (emit-invokevirtual +lisp-object -class+2490 (emit-invokevirtual +lisp-object+ 2496 2491 unboxed-method-name 2497 2492 nil "Z")) 2498 2493 ((NIL) 2499 (emit-invokevirtual +lisp-object -class+2494 (emit-invokevirtual +lisp-object+ 2500 2495 boxed-method-name 2501 2496 nil +lisp-object+))) … … 2565 2560 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 2566 2561 arg2 'stack nil) 2567 (emit-invokevirtual +lisp-object -class+ op2562 (emit-invokevirtual +lisp-object+ op 2568 2563 (lisp-object-arg-types 1) +lisp-object+) 2569 2564 (fix-boxing representation nil) … … 2630 2625 2631 2626 (defun emit-ifne-for-eql (representation instruction-type) 2632 (emit-invokevirtual +lisp-object -class+ "eql" instruction-type "Z")2627 (emit-invokevirtual +lisp-object+ "eql" instruction-type "Z") 2633 2628 (convert-representation :boolean representation)) 2634 2629 … … 2676 2671 (ecase representation 2677 2672 (:boolean 2678 (emit-invokevirtual +lisp-object -class+ "eql"2673 (emit-invokevirtual +lisp-object+ "eql" 2679 2674 (lisp-object-arg-types 1) "Z")) 2680 2675 ((NIL) 2681 (emit-invokevirtual +lisp-object -class+ "EQL"2676 (emit-invokevirtual +lisp-object+ "EQL" 2682 2677 (lisp-object-arg-types 1) +lisp-object+))))) 2683 2678 (emit-move-from-stack target representation))) … … 2844 2839 (t 2845 2840 (emit-push-constant-int numargs) 2846 (emit 'anewarray +lisp-object -class+)2841 (emit 'anewarray +lisp-object+) 2847 2842 (let ((i 0)) 2848 2843 (dolist (arg args) … … 2877 2872 (list +lisp-object-array+))) 2878 2873 (return-type +lisp-object+)) 2879 (emit-invokevirtual +lisp-object -class+ "execute" arg-types return-type)))2874 (emit-invokevirtual +lisp-object+ "execute" arg-types return-type))) 2880 2875 2881 2876 (declaim (ftype (function (t) t) emit-call-thread-execute)) … … 3142 3137 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil) 3143 3138 (emit-push-constant-int arg2) 3144 (emit-invokevirtual +lisp-object -class+3139 (emit-invokevirtual +lisp-object+ 3145 3140 (case op 3146 3141 (< "isLessThan") … … 3275 3270 (let ((arg (%cadr form))) 3276 3271 (compile-forms-and-maybe-emit-clear-values arg 'stack nil) 3277 (emit-invokevirtual +lisp-object -class+ java-predicate nil "Z")3272 (emit-invokevirtual +lisp-object+ java-predicate nil "Z") 3278 3273 'ifeq))) 3279 3274 … … 3297 3292 (let ((arg (%cadr form))) 3298 3293 (compile-forms-and-maybe-emit-clear-values arg 'stack nil) 3299 (emit-invokevirtual +lisp-object -class+ "constantp" nil "Z")3294 (emit-invokevirtual +lisp-object+ "constantp" nil "Z") 3300 3295 'ifeq))) 3301 3296 … … 3488 3483 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 3489 3484 arg2 'stack :char) 3490 (emit-invokevirtual +lisp-object -class+ "eql" '("C") "Z")3485 (emit-invokevirtual +lisp-object+ "eql" '("C") "Z") 3491 3486 'ifeq) 3492 3487 ((eq type1 'CHARACTER) … … 3494 3489 arg2 'stack nil) 3495 3490 (emit 'swap) 3496 (emit-invokevirtual +lisp-object -class+ "eql" '("C") "Z")3491 (emit-invokevirtual +lisp-object+ "eql" '("C") "Z") 3497 3492 'ifeq) 3498 3493 ((fixnum-type-p type2) 3499 3494 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 3500 3495 arg2 'stack :int) 3501 (emit-invokevirtual +lisp-object -class+ "eql" '("I") "Z")3496 (emit-invokevirtual +lisp-object+ "eql" '("I") "Z") 3502 3497 'ifeq) 3503 3498 ((fixnum-type-p type1) … … 3505 3500 arg2 'stack nil) 3506 3501 (emit 'swap) 3507 (emit-invokevirtual +lisp-object -class+ "eql" '("I") "Z")3502 (emit-invokevirtual +lisp-object+ "eql" '("I") "Z") 3508 3503 'ifeq) 3509 3504 (t 3510 3505 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 3511 3506 arg2 'stack nil) 3512 (emit-invokevirtual +lisp-object -class+ "eql"3507 (emit-invokevirtual +lisp-object+ "eql" 3513 3508 (lisp-object-arg-types 1) "Z") 3514 3509 'ifeq))))) … … 3525 3520 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 3526 3521 arg2 'stack :int) 3527 (emit-invokevirtual +lisp-object -class+3522 (emit-invokevirtual +lisp-object+ 3528 3523 translated-op 3529 3524 '("I") "Z")) … … 3531 3526 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 3532 3527 arg2 'stack nil) 3533 (emit-invokevirtual +lisp-object -class+3528 (emit-invokevirtual +lisp-object+ 3534 3529 translated-op 3535 3530 (lisp-object-arg-types 1) "Z"))) … … 3542 3537 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 3543 3538 arg2 'stack nil) 3544 (emit-invokevirtual +lisp-object -class+ "typep"3539 (emit-invokevirtual +lisp-object+ "typep" 3545 3540 (lisp-object-arg-types 1) +lisp-object+) 3546 3541 (emit-push-nil) … … 3583 3578 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 3584 3579 arg2 'stack :int) 3585 (emit-invokevirtual +lisp-object -class+ "isNotEqualTo" '("I") "Z")3580 (emit-invokevirtual +lisp-object+ "isNotEqualTo" '("I") "Z") 3586 3581 'ifeq) 3587 3582 ((fixnum-type-p type1) … … 3591 3586 arg2 'stack nil) 3592 3587 (emit 'swap) 3593 (emit-invokevirtual +lisp-object -class+ "isNotEqualTo" '("I") "Z")3588 (emit-invokevirtual +lisp-object+ "isNotEqualTo" '("I") "Z") 3594 3589 'ifeq) 3595 3590 (t 3596 3591 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 3597 3592 arg2 'stack nil) 3598 (emit-invokevirtual +lisp-object -class+ "isNotEqualTo"3593 (emit-invokevirtual +lisp-object+ "isNotEqualTo" 3599 3594 (lisp-object-arg-types 1) "Z") 3600 3595 'ifeq))))) … … 3633 3628 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 3634 3629 arg2 'stack :int) 3635 (emit-invokevirtual +lisp-object -class+3630 (emit-invokevirtual +lisp-object+ 3636 3631 (ecase op 3637 3632 (< "isLessThan") … … 3648 3643 arg2 'stack nil) 3649 3644 (emit 'swap) 3650 (emit-invokevirtual +lisp-object -class+3645 (emit-invokevirtual +lisp-object+ 3651 3646 (ecase op 3652 3647 (< "isGreaterThan") … … 3660 3655 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 3661 3656 arg2 'stack nil) 3662 (emit-invokevirtual +lisp-object -class+3657 (emit-invokevirtual +lisp-object+ 3663 3658 (ecase op 3664 3659 (< "isLessThan") … … 3841 3836 (emit-invokestatic +lisp+ "coerceToFunction" 3842 3837 (lisp-object-arg-types 1) +lisp-object+) 3843 (emit-invokevirtual +lisp-object -class+ "execute" nil +lisp-object+))3838 (emit-invokevirtual +lisp-object+ "execute" nil +lisp-object+)) 3844 3839 (3 3845 3840 (let* ((*register* *register*) … … 3875 3870 (aload function-register) 3876 3871 (aload values-register) 3877 (emit-invokevirtual +lisp-object -class+ "dispatch"3872 (emit-invokevirtual +lisp-object+ "dispatch" 3878 3873 (list +lisp-object-array+) +lisp-object+)))) 3879 3874 (fix-boxing representation nil) … … 4459 4454 ;; we have a block variable; that should be a closure variable 4460 4455 (assert (not (null (variable-closure-index (tagbody-id-variable block))))) 4461 (emit 'new +lisp-object -class+)4456 (emit 'new +lisp-object+) 4462 4457 (emit 'dup) 4463 (emit-invokespecial-init +lisp-object -class+ '())4458 (emit-invokespecial-init +lisp-object+ '()) 4464 4459 (emit-new-closure-binding (tagbody-id-variable block))) 4465 4460 (label BEGIN-BLOCK) … … 4657 4652 ;; we have a block variable; that should be a closure variable 4658 4653 (assert (not (null (variable-closure-index (block-id-variable block))))) 4659 (emit 'new +lisp-object -class+)4654 (emit 'new +lisp-object+) 4660 4655 (emit 'dup) 4661 (emit-invokespecial-init +lisp-object -class+ '())4656 (emit-invokespecial-init +lisp-object+ '()) 4662 4657 (emit-new-closure-binding (block-id-variable block))) 4663 4658 (dformat t "*all-variables* = ~S~%" … … 4845 4840 (emit 'dup)) 4846 4841 (compile-form (second args) 'stack nil) 4847 (emit-invokevirtual +lisp-object -class+4842 (emit-invokevirtual +lisp-object+ 4848 4843 "setCdr" 4849 4844 (lisp-object-arg-types 1) … … 4861 4856 (when target 4862 4857 (emit-dup nil :past nil)) 4863 (emit-invokevirtual +lisp-object -class+4858 (emit-invokevirtual +lisp-object+ 4864 4859 (if (eq op 'sys:set-car) "setCar" "setCdr") 4865 4860 (lisp-object-arg-types 1) … … 5064 5059 (t 5065 5060 (emit-load-externalized-object name) 5066 (emit-invokevirtual +lisp-object -class+ "getSymbolFunctionOrDie"5061 (emit-invokevirtual +lisp-object+ "getSymbolFunctionOrDie" 5067 5062 nil +lisp-object+) 5068 5063 (emit-move-from-stack target)))) … … 5198 5193 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 5199 5194 arg2 'stack :int) 5200 (emit-invokevirtual +lisp-object -class+ "ash" '("I") +lisp-object+)5195 (emit-invokevirtual +lisp-object+ "ash" '("I") +lisp-object+) 5201 5196 (fix-boxing representation result-type))) 5202 5197 (emit-move-from-stack target representation)) … … 5262 5257 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 5263 5258 arg2 'stack :int) 5264 (emit-invokevirtual +lisp-object -class+ "LOGAND" '("I") +lisp-object+)5259 (emit-invokevirtual +lisp-object+ "LOGAND" '("I") +lisp-object+) 5265 5260 (fix-boxing representation result-type) 5266 5261 (emit-move-from-stack target representation)) … … 5271 5266 ;; swap args 5272 5267 (emit 'swap) 5273 (emit-invokevirtual +lisp-object -class+ "LOGAND" '("I") +lisp-object+)5268 (emit-invokevirtual +lisp-object+ "LOGAND" '("I") +lisp-object+) 5274 5269 (fix-boxing representation result-type) 5275 5270 (emit-move-from-stack target representation)) … … 5277 5272 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 5278 5273 arg2 'stack nil) 5279 (emit-invokevirtual +lisp-object -class+ "LOGAND"5274 (emit-invokevirtual +lisp-object+ "LOGAND" 5280 5275 (lisp-object-arg-types 1) +lisp-object+) 5281 5276 (fix-boxing representation result-type) … … 5334 5329 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 5335 5330 arg2 'stack :int) 5336 (emit-invokevirtual +lisp-object -class+ "LOGIOR" '("I") +lisp-object+)5331 (emit-invokevirtual +lisp-object+ "LOGIOR" '("I") +lisp-object+) 5337 5332 (fix-boxing representation result-type) 5338 5333 (emit-move-from-stack target representation)) … … 5343 5338 ;; swap args 5344 5339 (emit 'swap) 5345 (emit-invokevirtual +lisp-object -class+ "LOGIOR" '("I") +lisp-object+)5340 (emit-invokevirtual +lisp-object+ "LOGIOR" '("I") +lisp-object+) 5346 5341 (fix-boxing representation result-type) 5347 5342 (emit-move-from-stack target representation)) … … 5349 5344 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 5350 5345 arg2 'stack nil) 5351 (emit-invokevirtual +lisp-object -class+ "LOGIOR"5346 (emit-invokevirtual +lisp-object+ "LOGIOR" 5352 5347 (lisp-object-arg-types 1) +lisp-object+) 5353 5348 (fix-boxing representation result-type) … … 5398 5393 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 5399 5394 arg2 'stack :int) 5400 (emit-invokevirtual +lisp-object -class+ "LOGXOR" '("I") +lisp-object+)5395 (emit-invokevirtual +lisp-object+ "LOGXOR" '("I") +lisp-object+) 5401 5396 (fix-boxing representation result-type)) 5402 5397 (t 5403 5398 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 5404 5399 arg2 'stack nil) 5405 (emit-invokevirtual +lisp-object -class+ "LOGXOR"5400 (emit-invokevirtual +lisp-object+ "LOGXOR" 5406 5401 (lisp-object-arg-types 1) +lisp-object+) 5407 5402 (fix-boxing representation result-type))) … … 5425 5420 (let ((arg (%cadr form))) 5426 5421 (compile-forms-and-maybe-emit-clear-values arg 'stack nil)) 5427 (emit-invokevirtual +lisp-object -class+ "LOGNOT" nil +lisp-object+)5422 (emit-invokevirtual +lisp-object+ "LOGNOT" nil +lisp-object+) 5428 5423 (fix-boxing representation nil) 5429 5424 (emit-move-from-stack target representation)))) … … 5482 5477 (emit-push-constant-int size) 5483 5478 (emit-push-constant-int position) 5484 (emit-invokevirtual +lisp-object -class+ "LDB" '("I" "I") +lisp-object+)5479 (emit-invokevirtual +lisp-object+ "LDB" '("I" "I") +lisp-object+) 5485 5480 (fix-boxing representation nil) 5486 5481 (emit-move-from-stack target representation)))) … … 5492 5487 (emit 'dup_x2) ;; use not supported by emit-dup: 3 values involved 5493 5488 (emit 'pop) 5494 (emit-invokevirtual +lisp-object -class+ "LDB" '("I" "I") +lisp-object+)5489 (emit-invokevirtual +lisp-object+ "LDB" '("I" "I") +lisp-object+) 5495 5490 (fix-boxing representation nil) 5496 5491 (emit-move-from-stack target representation)) … … 5516 5511 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 5517 5512 arg2 'stack :int) 5518 (emit-invokevirtual +lisp-object -class+ "MOD" '("I") +lisp-object+)5513 (emit-invokevirtual +lisp-object+ "MOD" '("I") +lisp-object+) 5519 5514 (fix-boxing representation nil) ; FIXME use derived result type 5520 5515 (emit-move-from-stack target representation)) … … 5522 5517 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 5523 5518 arg2 'stack nil) 5524 (emit-invokevirtual +lisp-object -class+ "MOD"5519 (emit-invokevirtual +lisp-object+ "MOD" 5525 5520 (lisp-object-arg-types 1) +lisp-object+) 5526 5521 (fix-boxing representation nil) ; FIXME use derived result type … … 5617 5612 (emit 'swap) 5618 5613 (cond (target 5619 (emit-invokevirtual +lisp-object -class+ "VECTOR_PUSH_EXTEND"5614 (emit-invokevirtual +lisp-object+ "VECTOR_PUSH_EXTEND" 5620 5615 (lisp-object-arg-types 1) +lisp-object+) 5621 5616 (fix-boxing representation nil) 5622 5617 (emit-move-from-stack target representation)) 5623 5618 (t 5624 (emit-invokevirtual +lisp-object -class+ "vectorPushExtend"5619 (emit-invokevirtual +lisp-object+ "vectorPushExtend" 5625 5620 (lisp-object-arg-types 1) nil)))) 5626 5621 (t … … 5635 5630 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 5636 5631 arg2 'stack nil) 5637 (emit-invokevirtual +lisp-object -class+ "SLOT_VALUE"5632 (emit-invokevirtual +lisp-object+ "SLOT_VALUE" 5638 5633 (lisp-object-arg-types 1) +lisp-object+) 5639 5634 (fix-boxing representation nil) … … 5656 5651 (emit 'dup) 5657 5652 (astore value-register)) 5658 (emit-invokevirtual +lisp-object -class+ "setSlotValue"5653 (emit-invokevirtual +lisp-object+ "setSlotValue" 5659 5654 (lisp-object-arg-types 2) nil) 5660 5655 (when value-register … … 5732 5727 (compile-form (%caddr form) 'stack nil) 5733 5728 (maybe-emit-clear-values (%cadr form) (%caddr form)) 5734 (emit-invokevirtual +lisp-object -class+ "copyToArray"5729 (emit-invokevirtual +lisp-object+ "copyToArray" 5735 5730 nil +lisp-object-array+) 5736 5731 (emit-invokespecial-init +lisp-structure-object+ … … 6404 6399 (ecase representation 6405 6400 (:int 6406 (emit-invokevirtual +lisp-object -class+ "length" nil "I"))6401 (emit-invokevirtual +lisp-object+ "length" nil "I")) 6407 6402 ((:long :float :double) 6408 (emit-invokevirtual +lisp-object -class+ "length" nil "I")6403 (emit-invokevirtual +lisp-object+ "length" nil "I") 6409 6404 (convert-representation :int representation)) 6410 6405 (:boolean 6411 6406 ;; FIXME We could optimize this all away in unsafe calls. 6412 (emit-invokevirtual +lisp-object -class+ "length" nil "I")6407 (emit-invokevirtual +lisp-object+ "length" nil "I") 6413 6408 (emit 'pop) 6414 6409 (emit 'iconst_1)) … … 6417 6412 (aver nil)) 6418 6413 ((nil) 6419 (emit-invokevirtual +lisp-object -class+ "LENGTH" nil +lisp-object+)))6414 (emit-invokevirtual +lisp-object+ "LENGTH" nil +lisp-object+))) 6420 6415 (emit-move-from-stack target representation))) 6421 6416 … … 6467 6462 list-form 'stack nil) 6468 6463 (emit 'swap) 6469 (emit-invokevirtual +lisp-object -class+ "NTH" '("I") +lisp-object+)6464 (emit-invokevirtual +lisp-object+ "NTH" '("I") +lisp-object+) 6470 6465 (fix-boxing representation nil) ; FIXME use derived result type 6471 6466 (emit-move-from-stack target representation))) … … 6506 6501 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil) 6507 6502 (emit-push-int arg2) 6508 (emit-invokevirtual +lisp-object -class+ "multiplyBy" '("I") +lisp-object+)6503 (emit-invokevirtual +lisp-object+ "multiplyBy" '("I") +lisp-object+) 6509 6504 (fix-boxing representation result-type) 6510 6505 (emit-move-from-stack target representation)) … … 6556 6551 (compile-form arg2 'stack nil) 6557 6552 (emit-dup nil :past nil) 6558 (emit-invokevirtual +lisp-object -class+6553 (emit-invokevirtual +lisp-object+ 6559 6554 (if (eq op 'max) 6560 6555 "isLessThanOrEqualTo" … … 6624 6619 (when (fixnum-type-p type1) 6625 6620 (emit 'swap)) 6626 (emit-invokevirtual +lisp-object -class+ "add"6621 (emit-invokevirtual +lisp-object+ "add" 6627 6622 '("I") +lisp-object+) 6628 6623 (fix-boxing representation result-type) … … 6663 6658 (t 6664 6659 (compile-forms-and-maybe-emit-clear-values arg 'stack nil) 6665 (emit-invokevirtual +lisp-object -class+ "negate"6660 (emit-invokevirtual +lisp-object+ "negate" 6666 6661 nil +lisp-object+) 6667 6662 (fix-boxing representation nil) … … 6695 6690 arg1 'stack nil 6696 6691 arg2 'stack :int) 6697 (emit-invokevirtual +lisp-object -class+6692 (emit-invokevirtual +lisp-object+ 6698 6693 "subtract" 6699 6694 '("I") +lisp-object+) … … 6739 6734 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 6740 6735 arg2 'stack :int) 6741 (emit-invokevirtual +lisp-object -class+6736 (emit-invokevirtual +lisp-object+ 6742 6737 (symbol-name op) ;; "CHAR" or "SCHAR" 6743 6738 '("I") +lisp-object+) … … 6794 6789 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 6795 6790 arg2 'stack :int) 6796 (emit-invokevirtual +lisp-object -class+ "SVREF" '("I") +lisp-object+)6791 (emit-invokevirtual +lisp-object+ "SVREF" '("I") +lisp-object+) 6797 6792 (fix-boxing representation nil) 6798 6793 (emit-move-from-stack target representation))) … … 6814 6809 (emit-move-from-stack value-register nil)) 6815 6810 (maybe-emit-clear-values arg1 arg2 arg3) 6816 (emit-invokevirtual +lisp-object -class+ "svset" (list "I" +lisp-object+) nil)6811 (emit-invokevirtual +lisp-object+ "svset" (list "I" +lisp-object+) nil) 6817 6812 (when value-register 6818 6813 (aload value-register) … … 6839 6834 (compile-form arg1 'stack nil) 6840 6835 (compile-form arg2 'stack nil) 6841 (emit-invokevirtual +lisp-object -class+ "truncate" (lisp-object-arg-types 1) +lisp-object+)6836 (emit-invokevirtual +lisp-object+ "truncate" (lisp-object-arg-types 1) +lisp-object+) 6842 6837 (fix-boxing representation nil) ; FIXME use derived result type 6843 6838 (emit-move-from-stack target representation))) … … 6849 6844 (compile-form (second form) 'stack nil) 6850 6845 (compile-form (third form) 'stack :int) 6851 (emit-invokevirtual +lisp-object -class+ "elt" '("I") +lisp-object+)6846 (emit-invokevirtual +lisp-object+ "elt" '("I") +lisp-object+) 6852 6847 (fix-boxing representation nil) ; FIXME use derived result type 6853 6848 (emit-move-from-stack target representation)) … … 6866 6861 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 6867 6862 arg2 'stack :int) 6868 (emit-invokevirtual +lisp-object -class+ "aref" '("I") "I"))6863 (emit-invokevirtual +lisp-object+ "aref" '("I") "I")) 6869 6864 (:long 6870 6865 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 6871 6866 arg2 'stack :int) 6872 (emit-invokevirtual +lisp-object -class+ "aref_long" '("I") "J"))6867 (emit-invokevirtual +lisp-object+ "aref_long" '("I") "J")) 6873 6868 (:char 6874 6869 (cond ((compiler-subtypep type1 'string) … … 6882 6877 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 6883 6878 arg2 'stack :int) 6884 (emit-invokevirtual +lisp-object -class+ "AREF" '("I") +lisp-object+)6879 (emit-invokevirtual +lisp-object+ "AREF" '("I") +lisp-object+) 6885 6880 (emit-unbox-character)))) 6886 6881 ((nil :float :double :boolean) … … 6889 6884 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 6890 6885 arg2 'stack :int) 6891 (emit-invokevirtual +lisp-object -class+ "AREF" '("I") +lisp-object+)6886 (emit-invokevirtual +lisp-object+ "AREF" '("I") +lisp-object+) 6892 6887 (convert-representation nil representation))) 6893 6888 (emit-move-from-stack target representation))) … … 6922 6917 (maybe-emit-clear-values arg1 arg2 arg3) 6923 6918 (cond ((fixnum-type-p type3) 6924 (emit-invokevirtual +lisp-object -class+ "aset" '("I" "I") nil))6919 (emit-invokevirtual +lisp-object+ "aset" '("I" "I") nil)) 6925 6920 (t 6926 (emit-invokevirtual +lisp-object -class+ "aset" (list "I" +lisp-object+) nil)))6921 (emit-invokevirtual +lisp-object+ "aset" (list "I" +lisp-object+) nil))) 6927 6922 (when value-register 6928 6923 (cond ((fixnum-type-p type3) … … 6947 6942 (case arg2 6948 6943 (0 6949 (emit-invokevirtual +lisp-object -class+ "getSlotValue_0"6944 (emit-invokevirtual +lisp-object+ "getSlotValue_0" 6950 6945 nil +lisp-object+)) 6951 6946 (1 6952 (emit-invokevirtual +lisp-object -class+ "getSlotValue_1"6947 (emit-invokevirtual +lisp-object+ "getSlotValue_1" 6953 6948 nil +lisp-object+)) 6954 6949 (2 6955 (emit-invokevirtual +lisp-object -class+ "getSlotValue_2"6950 (emit-invokevirtual +lisp-object+ "getSlotValue_2" 6956 6951 nil +lisp-object+)) 6957 6952 (3 6958 (emit-invokevirtual +lisp-object -class+ "getSlotValue_3"6953 (emit-invokevirtual +lisp-object+ "getSlotValue_3" 6959 6954 nil +lisp-object+)) 6960 6955 (t 6961 6956 (emit-push-constant-int arg2) 6962 (emit-invokevirtual +lisp-object -class+ "getSlotValue"6957 (emit-invokevirtual +lisp-object+ "getSlotValue" 6963 6958 '("I") +lisp-object+))) 6964 6959 (emit-move-from-stack target representation)) … … 6968 6963 (ecase representation 6969 6964 (:int 6970 (emit-invokevirtual +lisp-object -class+ "getFixnumSlotValue"6965 (emit-invokevirtual +lisp-object+ "getFixnumSlotValue" 6971 6966 '("I") "I")) 6972 6967 ((nil :char :long :float :double) 6973 (emit-invokevirtual +lisp-object -class+ "getSlotValue"6968 (emit-invokevirtual +lisp-object+ "getSlotValue" 6974 6969 '("I") +lisp-object+) 6975 6970 ;; (convert-representation NIL NIL) is a no-op 6976 6971 (convert-representation nil representation)) 6977 6972 (:boolean 6978 (emit-invokevirtual +lisp-object -class+ "getSlotValueAsBoolean"6973 (emit-invokevirtual +lisp-object+ "getSlotValueAsBoolean" 6979 6974 '("I") "Z"))) 6980 6975 (emit-move-from-stack target representation)) … … 6998 6993 (emit 'dup) 6999 6994 (astore value-register)) 7000 (emit-invokevirtual +lisp-object -class+6995 (emit-invokevirtual +lisp-object+ 7001 6996 (format nil "setSlotValue_~D" arg2) 7002 6997 (lisp-object-arg-types 1) nil) … … 7015 7010 (emit 'dup) 7016 7011 (astore value-register)) 7017 (emit-invokevirtual +lisp-object -class+ "setSlotValue"7012 (emit-invokevirtual +lisp-object+ "setSlotValue" 7018 7013 (list "I" +lisp-object+) nil) 7019 7014 (when value-register … … 7081 7076 arg2 'stack nil) 7082 7077 (emit 'swap) 7083 (emit-invokevirtual +lisp-object -class+ "nthcdr" '("I") +lisp-object+)7078 (emit-invokevirtual +lisp-object+ "nthcdr" '("I") +lisp-object+) 7084 7079 (fix-boxing representation nil) 7085 7080 (emit-move-from-stack target representation)) … … 7396 7391 (let ((arg (%cadr form))) 7397 7392 (compile-forms-and-maybe-emit-clear-values arg 'stack nil) 7398 (emit-invokevirtual +lisp-object -class+ "sxhash" nil "I")7393 (emit-invokevirtual +lisp-object+ "sxhash" nil "I") 7399 7394 (convert-representation :int representation) 7400 7395 (emit-move-from-stack target representation))) … … 7617 7612 (EXIT (gensym))) 7618 7613 (compile-form (cadr form) 'stack nil) 7619 (emit-invokevirtual +lisp-object -class+ "lockableInstance" nil7614 (emit-invokevirtual +lisp-object+ "lockableInstance" nil 7620 7615 +java-object+) ; value to synchronize 7621 7616 (emit 'dup) -
branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
r12790 r12791 105 105 (define-class-name +java-object+ "java.lang.Object") 106 106 (define-class-name +java-string+ "java.lang.String") 107 (define-class-name + !lisp-object+ "org.armedbear.lisp.LispObject")107 (define-class-name +lisp-object+ "org.armedbear.lisp.LispObject") 108 108 (define-class-name +lisp-simple-string+ "org.armedbear.lisp.SimpleString") 109 109 (define-class-name +lisp+ "org.armedbear.lisp.Lisp")
Note: See TracChangeset
for help on using the changeset viewer.
