Changeset 12790
- Timestamp:
- 07/07/10 22:15:14 (13 years ago)
- Location:
- branches/generic-class-file/abcl/src/org/armedbear/lisp
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r12789 r12790 211 211 (defconstant +lisp-fixnum+ "Lorg/armedbear/lisp/Fixnum;") 212 212 (defconstant +lisp-fixnum-array+ "[Lorg/armedbear/lisp/Fixnum;") 213 (defconstant +lisp-function-proxy-class+214 "org/armedbear/lisp/AutoloadedFunctionProxy")213 ;(defconstant +lisp-function-proxy-class+ 214 ; "org/armedbear/lisp/AutoloadedFunctionProxy") 215 215 (defconstant +lisp-bignum-class+ "org/armedbear/lisp/Bignum") 216 216 (defconstant +lisp-bignum+ "Lorg/armedbear/lisp/Bignum;") … … 222 222 (defconstant +lisp-character+ "Lorg/armedbear/lisp/LispCharacter;") 223 223 (defconstant +lisp-character-array+ "[Lorg/armedbear/lisp/LispCharacter;") 224 (defconstant +lisp-abstract-bit-vector-class+ "org/armedbear/lisp/AbstractBitVector")225 (defconstant +lisp-abstract-vector-class+ "org/armedbear/lisp/AbstractVector")226 (defconstant +lisp-abstract-string-class+ "org/armedbear/lisp/AbstractString")227 (defconstant +lisp-abstract-string+ "Lorg/armedbear/lisp/AbstractString;")228 (defconstant +lisp-simple-vector-class+ "org/armedbear/lisp/SimpleVector")229 (defconstant +lisp-simple-string-class+ "org/armedbear/lisp/SimpleString")230 (defconstant +lisp-simple-string+ "Lorg/armedbear/lisp/SimpleString;")231 (defconstant +lisp-special-binding+ "Lorg/armedbear/lisp/SpecialBinding;")232 (defconstant +lisp-special-binding-class+ "org/armedbear/lisp/SpecialBinding")233 (defconstant +lisp-closure-parameter-class+ "org/armedbear/lisp/Closure$Parameter")234 224 (defconstant +lisp-closure-parameter-array+ "[Lorg/armedbear/lisp/Closure$Parameter;") 235 225 … … 763 753 (FIXNUM +lisp-fixnum-class+) 764 754 (STREAM +lisp-stream+) 765 (STRING +lisp-abstract-string -class+)766 (VECTOR +lisp-abstract-vector -class+)))755 (STRING +lisp-abstract-string+) 756 (VECTOR +lisp-abstract-vector+))) 767 757 (expected-type-java-symbol-name (case expected-type 768 758 (HASH-TABLE "HASH_TABLE") … … 1200 1190 (let* ((args (instruction-args instruction)) 1201 1191 (index (pool-field (!class-name (first args)) 1202 (second args) ( third args))))1192 (second args) (!class-ref (third args))))) 1203 1193 (inst (instruction-opcode instruction) (u2 index)))) 1204 1194 … … 1243 1233 (let* ((args (instruction-args instruction)) 1244 1234 (index (pool-field (!class-name (first args)) 1245 (second args) ( third args))))1235 (second args) (!class-ref (third args))))) 1246 1236 (inst (instruction-opcode instruction) (u2 index)))) 1247 1237 … … 1815 1805 `(progn 1816 1806 (emit-push-constant-int (length ,params)) 1817 (emit 'anewarray +lisp-closure-parameter -class+)1807 (emit 'anewarray +lisp-closure-parameter+) 1818 1808 (astore (setf ,register (method-max-locals constructor))) 1819 1809 (incf (method-max-locals constructor)) … … 1825 1815 (aload ,register) 1826 1816 (emit-push-constant-int ,count-sym) 1827 (emit 'new +lisp-closure-parameter -class+)1817 (emit 'new +lisp-closure-parameter+) 1828 1818 (emit 'dup) 1829 1819 ,@body … … 1832 1822 (parameters-to-array (ignore req req-params-register) 1833 1823 (emit-push-t) ;; we don't need the actual symbol 1834 (emit-invokespecial-init +lisp-closure-parameter -class+1824 (emit-invokespecial-init +lisp-closure-parameter+ 1835 1825 (list +lisp-symbol+))) 1836 1826 … … 1842 1832 (emit-push-t)) ;; we don't need the actual supplied-p symbol 1843 1833 (emit 'getstatic +lisp-closure+ "OPTIONAL" "I") 1844 (emit-invokespecial-init +lisp-closure-parameter -class+1834 (emit-invokespecial-init +lisp-closure-parameter+ 1845 1835 (list +lisp-symbol+ +lisp-object+ 1846 1836 +lisp-object+ "I"))) … … 1866 1856 (emit-push-nil) 1867 1857 (emit-push-t)) ;; we don't need the actual supplied-p symbol 1868 (emit-invokespecial-init +lisp-closure-parameter -class+1858 (emit-invokespecial-init +lisp-closure-parameter+ 1869 1859 (list +lisp-symbol+ +lisp-symbol+ 1870 1860 +lisp-object+ +lisp-object+)))))) … … 1986 1976 (defknown declare-field (t t t) t) 1987 1977 (defun declare-field (name descriptor access-flags) 1988 (let ((field (make-field name descriptor)))1978 (let ((field (make-field name (!class-ref descriptor)))) 1989 1979 ;; final static <access-flags> 1990 1980 (setf (field-access-flags field) … … 2080 2070 (defun serialize-string (string) 2081 2071 "Generate code to restore a serialized string." 2082 (emit 'new +lisp-simple-string -class+)2072 (emit 'new +lisp-simple-string+) 2083 2073 (emit 'dup) 2084 2074 (emit 'ldc (pool-string string)) 2085 (emit-invokespecial-init +lisp-simple-string -class+ (list +java-string+)))2075 (emit-invokespecial-init +lisp-simple-string+ (list +java-string+))) 2086 2076 2087 2077 (defun serialize-package (pkg) … … 2126 2116 2127 2117 (defvar serialization-table 2128 `((integer "INT" ,#'eql ,#'serialize-integer ,+ lisp-integer+)2129 (character "CHR" ,#'eql ,#'serialize-character ,+ lisp-character+)2130 (single-float "FLT" ,#'eql ,#'serialize-float ,+ lisp-single-float+)2131 (double-float "DBL" ,#'eql ,#'serialize-double ,+ lisp-double-float+)2118 `((integer "INT" ,#'eql ,#'serialize-integer ,+!lisp-integer+) 2119 (character "CHR" ,#'eql ,#'serialize-character ,+!lisp-character+) 2120 (single-float "FLT" ,#'eql ,#'serialize-float ,+!lisp-single-float+) 2121 (double-float "DBL" ,#'eql ,#'serialize-double ,+!lisp-double-float+) 2132 2122 (string "STR" ,#'equal ,#'serialize-string 2133 2123 ,+lisp-abstract-string+) ;; because of (not compile-file) 2134 (package "PKG" ,#'eq ,#'serialize-package ,+ lisp-object+)2135 (symbol "SYM" ,#'eq ,#'serialize-symbol ,+ lisp-symbol+)2136 (T "OBJ" ,#'eq ,#'serialize-object ,+ lisp-object+))2124 (package "PKG" ,#'eq ,#'serialize-package ,+!lisp-object+) 2125 (symbol "SYM" ,#'eq ,#'serialize-symbol ,+!lisp-symbol+) 2126 (T "OBJ" ,#'eq ,#'serialize-object ,+!lisp-object+)) 2137 2127 "A list of 5-element lists. The elements of the sublists mean: 2138 2128 … … 2187 2177 (emit-invokestatic +lisp+ "recall" 2188 2178 (list +java-string+) +lisp-object+) 2189 (when ( string/= field-type +lisp-object+)2190 (emit 'checkcast (subseq field-type 1 (1- (length field-type)))))2179 (when (not (eq field-type +!lisp-object+)) 2180 (emit 'checkcast field-type)) 2191 2181 (emit 'putstatic *this-class* field-name field-type) 2192 2182 (setf *static-code* *code*))) … … 3297 3287 3298 3288 (defun p2-test-bit-vector-p (form) 3299 (p2-test-instanceof-predicate form +lisp-abstract-bit-vector -class+))3289 (p2-test-instanceof-predicate form +lisp-abstract-bit-vector+)) 3300 3290 3301 3291 (defun p2-test-characterp (form) … … 3396 3386 3397 3387 (defun p2-test-stringp (form) 3398 (p2-test-instanceof-predicate form +lisp-abstract-string -class+))3388 (p2-test-instanceof-predicate form +lisp-abstract-string+)) 3399 3389 3400 3390 (defun p2-test-vectorp (form) 3401 (p2-test-instanceof-predicate form +lisp-abstract-vector -class+))3391 (p2-test-instanceof-predicate form +lisp-abstract-vector+)) 3402 3392 3403 3393 (defun p2-test-simple-vector-p (form) 3404 (p2-test-instanceof-predicate form +lisp-simple-vector -class+))3394 (p2-test-instanceof-predicate form +lisp-simple-vector+)) 3405 3395 3406 3396 (defknown compile-test-form (t) t) … … 4618 4608 4619 4609 (defun p2-bit-vector-p (form target representation) 4620 (p2-instanceof-predicate form target representation +lisp-abstract-bit-vector -class+))4610 (p2-instanceof-predicate form target representation +lisp-abstract-bit-vector+)) 4621 4611 4622 4612 (defun p2-characterp (form target representation) … … 4636 4626 4637 4627 (defun p2-simple-vector-p (form target representation) 4638 (p2-instanceof-predicate form target representation +lisp-simple-vector -class+))4628 (p2-instanceof-predicate form target representation +lisp-simple-vector+)) 4639 4629 4640 4630 (defun p2-stringp (form target representation) 4641 (p2-instanceof-predicate form target representation +lisp-abstract-string -class+))4631 (p2-instanceof-predicate form target representation +lisp-abstract-string+)) 4642 4632 4643 4633 (defun p2-symbolp (form target representation) … … 4645 4635 4646 4636 (defun p2-vectorp (form target representation) 4647 (p2-instanceof-predicate form target representation +lisp-abstract-vector -class+))4637 (p2-instanceof-predicate form target representation +lisp-abstract-vector+)) 4648 4638 4649 4639 (define-inlined-function p2-coerce-to-function (form target representation) … … 5681 5671 (null representation)) 5682 5672 (let ((arg (second form))) 5683 (emit 'new +lisp-simple-vector -class+)5673 (emit 'new +lisp-simple-vector+) 5684 5674 (emit 'dup) 5685 5675 (compile-forms-and-maybe-emit-clear-values arg 'stack :int) 5686 (emit-invokespecial-init +lisp-simple-vector -class+ '("I"))5676 (emit-invokespecial-init +lisp-simple-vector+ '("I")) 5687 5677 (emit-move-from-stack target representation))) 5688 5678 (t … … 5706 5696 (case result-type 5707 5697 ((STRING SIMPLE-STRING) 5708 (setf class +lisp-simple-string -class+))5698 (setf class +lisp-simple-string+)) 5709 5699 ((VECTOR SIMPLE-VECTOR) 5710 (setf class +lisp-simple-vector -class+)))))5700 (setf class +lisp-simple-vector+))))) 5711 5701 (when class 5712 5702 (emit 'new class) … … 5725 5715 (null representation)) 5726 5716 (let ((arg (second form))) 5727 (emit 'new +lisp-simple-string -class+)5717 (emit 'new +lisp-simple-string+) 5728 5718 (emit 'dup) 5729 5719 (compile-forms-and-maybe-emit-clear-values arg 'stack :int) 5730 (emit-invokespecial-init +lisp-simple-string -class+ '("I"))5720 (emit-invokespecial-init +lisp-simple-string+ '("I")) 5731 5721 (emit-move-from-stack target representation))) 5732 5722 (t … … 6396 6386 (compile-form arg1 'stack nil) 6397 6387 (compile-form arg2 'stack nil) 6398 (emit 'checkcast +lisp-abstract-vector -class+)6388 (emit 'checkcast +lisp-abstract-vector+) 6399 6389 (maybe-emit-clear-values arg1 arg2) 6400 6390 (emit 'swap) 6401 (emit-invokevirtual +lisp-abstract-vector -class+6391 (emit-invokevirtual +lisp-abstract-vector+ 6402 6392 (if (eq test 'eq) "deleteEq" "deleteEql") 6403 6393 (lisp-object-arg-types 1) +lisp-object+) … … 6729 6719 (zerop *safety*)) 6730 6720 (compile-form arg1 'stack nil) 6731 (emit 'checkcast +lisp-abstract-string -class+)6721 (emit 'checkcast +lisp-abstract-string+) 6732 6722 (compile-form arg2 'stack :int) 6733 6723 (maybe-emit-clear-values arg1 arg2) 6734 (emit-invokevirtual +lisp-abstract-string -class+ "charAt"6724 (emit-invokevirtual +lisp-abstract-string+ "charAt" 6735 6725 '("I") "C") 6736 6726 (emit-move-from-stack target representation)) … … 6740 6730 (fixnum-type-p type2)) 6741 6731 (compile-form arg1 'stack nil) 6742 (emit 'checkcast +lisp-abstract-string -class+)6732 (emit 'checkcast +lisp-abstract-string+) 6743 6733 (compile-form arg2 'stack :int) 6744 6734 (maybe-emit-clear-values arg1 arg2) 6745 (emit-invokevirtual +lisp-abstract-string -class+ "charAt"6735 (emit-invokevirtual +lisp-abstract-string+ "charAt" 6746 6736 '("I") "C") 6747 6737 (emit-move-from-stack target representation)) … … 6778 6768 (value-register (when target (allocate-register))) 6779 6769 (class (if (eq op 'SCHAR) 6780 +lisp-simple-string -class+6781 +lisp-abstract-string -class+)))6770 +lisp-simple-string+ 6771 +lisp-abstract-string+))) 6782 6772 (compile-form arg1 'stack nil) 6783 6773 (emit 'checkcast class) … … 6884 6874 (cond ((compiler-subtypep type1 'string) 6885 6875 (compile-form arg1 'stack nil) ; array 6886 (emit 'checkcast +lisp-abstract-string -class+)6876 (emit 'checkcast +lisp-abstract-string+) 6887 6877 (compile-form arg2 'stack :int) ; index 6888 6878 (maybe-emit-clear-values arg1 arg2) 6889 (emit-invokevirtual +lisp-abstract-string -class+6879 (emit-invokevirtual +lisp-abstract-string+ 6890 6880 "charAt" '("I") "C")) 6891 6881 (t … … 7231 7221 (variable-block variable)))) 7232 7222 (aload (variable-binding-register variable)) 7233 (emit 'getfield +lisp-special-binding -class+ "value"7223 (emit 'getfield +lisp-special-binding+ "value" 7234 7224 +lisp-object+)) 7235 7225 (t … … 7311 7301 (compile-forms-and-maybe-emit-clear-values value-form 'stack nil) 7312 7302 (emit 'dup_x1) ;; copy past th 7313 (emit 'putfield +lisp-special-binding -class+ "value"7303 (emit 'putfield +lisp-special-binding+ "value" 7314 7304 +lisp-object+)) 7315 7305 ((and (consp value-form) … … 7465 7455 (FIXNUM +lisp-fixnum-class+) 7466 7456 (STREAM +lisp-stream+) 7467 (STRING +lisp-abstract-string -class+)7468 (VECTOR +lisp-abstract-vector -class+)))7457 (STRING +lisp-abstract-string+) 7458 (VECTOR +lisp-abstract-vector+))) 7469 7459 (expected-type-java-symbol-name (case expected-type 7470 7460 (HASH-TABLE "HASH_TABLE") -
branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
r12789 r12790 106 106 (define-class-name +java-string+ "java.lang.String") 107 107 (define-class-name +!lisp-object+ "org.armedbear.lisp.LispObject") 108 (define-class-name + !lisp-simple-string+ "org.armedbear.lisp.SimpleString")108 (define-class-name +lisp-simple-string+ "org.armedbear.lisp.SimpleString") 109 109 (define-class-name +lisp+ "org.armedbear.lisp.Lisp") 110 110 (define-class-name +lisp-nil+ "org.armedbear.lisp.Nil") … … 113 113 (define-class-name +lisp-thread+ "org.armedbear.lisp.LispThread") 114 114 (define-class-name +lisp-closure-binding+ "org.armedbear.lisp.ClosureBinding") 115 (define-class-name +!lisp-integer+ "org.armedbear.lisp. Integer")115 (define-class-name +!lisp-integer+ "org.armedbear.lisp.LispInteger") 116 116 (define-class-name +!lisp-fixnum+ "org.armedbear.lisp.Fixnum") 117 117 (define-class-name +!lisp-bignum+ "org.armedbear.lisp.Bignum") … … 120 120 (define-class-name +lisp-cons+ "org.armedbear.lisp.Cons") 121 121 (define-class-name +lisp-load+ "org.armedbear.lisp.Load") 122 (define-class-name +!lisp-character+ "org.armedbear.lisp. Character")122 (define-class-name +!lisp-character+ "org.armedbear.lisp.LispCharacter") 123 123 (define-class-name +lisp-structure-object+ "org.armedbear.lisp.StructureObject") 124 (define-class-name + !lisp-simple-vector+ "org.armedbear.lisp.SimpleVector")125 (define-class-name + !lisp-abstract-string+ "org.armedbear.lisp.AbstractString")126 (define-class-name + !lisp-abstract-vector+ "org.armedbear.lisp.AbstractVector")127 (define-class-name + !lisp-abstract-bit-vector+124 (define-class-name +lisp-simple-vector+ "org.armedbear.lisp.SimpleVector") 125 (define-class-name +lisp-abstract-string+ "org.armedbear.lisp.AbstractString") 126 (define-class-name +lisp-abstract-vector+ "org.armedbear.lisp.AbstractVector") 127 (define-class-name +lisp-abstract-bit-vector+ 128 128 "org.armedbear.lisp.AbstractBitVector") 129 129 (define-class-name +lisp-environment+ "org.armedbear.lisp.Environment") 130 (define-class-name + !lisp-special-binding+ "org.armedbear.lisp.SpecialBinding")130 (define-class-name +lisp-special-binding+ "org.armedbear.lisp.SpecialBinding") 131 131 (define-class-name +lisp-special-bindings-mark+ 132 132 "org.armedbear.lisp.SpecialBindingsMark") … … 142 142 (define-class-name +lisp-closure+ "org.armedbear.lisp.Closure") 143 143 (define-class-name +lisp-compiled-closure+ "org.armedbear.lisp.CompiledClosure") 144 (define-class-name + !lisp-closure-parameter+144 (define-class-name +lisp-closure-parameter+ 145 145 "org.armedbear.lisp.Closure$Parameter") 146 146 (define-class-name +!fasl-loader+ "org.armedbear.lisp.FaslClassLoader")
Note: See TracChangeset
for help on using the changeset viewer.