Changeset 12839
- Timestamp:
- 07/31/10 19:21:20 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r12838 r12839 309 309 (declaim (inline emit-push-nil)) 310 310 (defun emit-push-nil () 311 (emit 'getstatic +lisp+ "NIL" +lisp-object+))311 (emit-getstatic +lisp+ "NIL" +lisp-object+)) 312 312 313 313 (defknown emit-push-nil-symbol () t) 314 314 (declaim (inline emit-push-nil-symbol)) 315 315 (defun emit-push-nil-symbol () 316 (emit 'getstatic +lisp-nil+ "NIL" +lisp-symbol+))316 (emit-getstatic +lisp-nil+ "NIL" +lisp-symbol+)) 317 317 318 318 (defknown emit-push-t () t) 319 319 (declaim (inline emit-push-t)) 320 320 (defun emit-push-t () 321 (emit 'getstatic +lisp+ "T" +lisp-symbol+))321 (emit-getstatic +lisp+ "T" +lisp-symbol+)) 322 322 323 323 (defknown emit-push-false (t) t) … … 541 541 (setf pretty-string (concatenate 'string pretty-string "[]"))) 542 542 pretty-string)) 543 544 (declaim (inline emit-getstatic emit-putstatic)) 545 (defknown emit-getstatic (t t t) t) 546 (defun emit-getstatic (class-name field-name type) 547 (let ((index (pool-field (!class-name class-name) 548 field-name (!class-ref type)))) 549 (apply #'%emit 'getstatic (u2 index)))) 550 551 (defknown emit-putstatic (t t t) t) 552 (defun emit-putstatic (class-name field-name type) 553 (let ((index (pool-field (!class-name class-name) 554 field-name (!class-ref type)))) 555 (apply #'%emit 'putstatic (u2 index)))) 543 556 544 557 (defvar type-representations '((:int fixnum) … … 744 757 (emit 'ifne LABEL1) 745 758 (emit-load-local-variable variable) 746 (emit 'getstatic +lisp-symbol+ expected-type-java-symbol-name759 (emit-getstatic +lisp-symbol+ expected-type-java-symbol-name 747 760 +lisp-symbol+) 748 761 (emit-invokestatic +lisp+ "type_error" … … 804 817 (unless (> *speed* *safety*) 805 818 (let ((label1 (gensym))) 806 (emit 'getstatic +lisp+ "interrupted" "Z")819 (emit-getstatic +lisp+ "interrupted" "Z") 807 820 (emit 'ifeq label1) 808 821 (emit-invokestatic +lisp+ "handleInterrupt" nil nil) … … 1168 1181 ;; getstatic, putstatic 1169 1182 (define-resolver (178 179) (instruction) 1170 (let* ((args (instruction-args instruction)) 1171 (index (pool-field (!class-name (first args)) 1172 (second args) (!class-ref (third args))))) 1173 (inst (instruction-opcode instruction) (u2 index)))) 1183 ;; we used to create the pool-field here; that moved to the emit-* layer 1184 instruction) 1174 1185 1175 1186 ;; bipush, sipush … … 1811 1822 (emit-push-nil) 1812 1823 (emit-push-t)) ;; we don't need the actual supplied-p symbol 1813 (emit 'getstatic +lisp-closure+ "OPTIONAL" "I")1824 (emit-getstatic +lisp-closure+ "OPTIONAL" "I") 1814 1825 (emit-invokespecial-init +lisp-closure-parameter+ 1815 1826 (list +lisp-symbol+ +lisp-object+ … … 2009 2020 "Generates code to restore a serialized integer." 2010 2021 (cond((<= 0 n 255) 2011 (emit 'getstatic +lisp-fixnum-class+ "constants" +lisp-fixnum-array+)2022 (emit-getstatic +lisp-fixnum-class+ "constants" +lisp-fixnum-array+) 2012 2023 (emit-push-constant-int n) 2013 2024 (emit 'aaload)) … … 2078 2089 (cond 2079 2090 (name 2080 (emit 'getstatic class name +lisp-symbol+))2091 (emit-getstatic class name +lisp-symbol+)) 2081 2092 ((null (symbol-package symbol)) 2082 2093 (emit-push-constant-int (dump-uninterned-symbol-index symbol)) … … 2140 2151 (let ((existing (assoc object *externalized-objects* :test similarity-fn))) 2141 2152 (when existing 2142 (emit 'getstatic *this-class* (cdr existing) field-type)2153 (emit-getstatic *this-class* (cdr existing) field-type) 2143 2154 (when cast 2144 2155 (emit 'checkcast cast)) … … 2159 2170 (when (not (eq field-type +lisp-object+)) 2160 2171 (emit 'checkcast field-type)) 2161 (emit 'putstatic *this-class* field-name field-type)2172 (emit-putstatic *this-class* field-name field-type) 2162 2173 (setf *static-code* *code*))) 2163 2174 (*declare-inline* 2164 2175 (funcall dispatch-fn object) 2165 (emit 'putstatic *this-class* field-name field-type))2176 (emit-putstatic *this-class* field-name field-type)) 2166 2177 (t 2167 2178 (let ((*code* *static-code*)) 2168 2179 (funcall dispatch-fn object) 2169 (emit 'putstatic *this-class* field-name field-type)2180 (emit-putstatic *this-class* field-name field-type) 2170 2181 (setf *static-code* *code*)))) 2171 2182 2172 (emit 'getstatic *this-class* field-name field-type)2183 (emit-getstatic *this-class* field-name field-type) 2173 2184 (when cast 2174 2185 (emit 'checkcast cast)) … … 2202 2213 (if (eq class *this-class*) 2203 2214 (progn ;; generated by the DECLARE-OBJECT*'s above 2204 (emit 'getstatic class name +lisp-object+)2215 (emit-getstatic class name +lisp-object+) 2205 2216 (emit 'checkcast +lisp-symbol+)) 2206 (emit 'getstatic class name +lisp-symbol+))2217 (emit-getstatic class name +lisp-symbol+)) 2207 2218 (emit-invokevirtual +lisp-symbol+ 2208 2219 (if setf … … 2214 2225 (emit-invokevirtual +lisp-object+ 2215 2226 "resolve" nil +lisp-object+) 2216 (emit 'putstatic *this-class* f +lisp-object+)2227 (emit-putstatic *this-class* f +lisp-object+) 2217 2228 (if *declare-inline* 2218 2229 (setf saved-code *code*) … … 2241 2252 (emit 'dup) 2242 2253 (emit-invokespecial-init class-name '()) 2243 (emit 'putstatic *this-class* g +lisp-object+)2254 (emit-putstatic *this-class* g +lisp-object+) 2244 2255 (setf *static-code* *code*) 2245 2256 (setf (gethash local-function ht) g)))) … … 2266 2277 (emit-invokestatic +lisp+ "readObjectFromString" 2267 2278 (list +java-string+) +lisp-object+) 2268 (emit 'putstatic *this-class* g +lisp-object+)2279 (emit-putstatic *this-class* g +lisp-object+) 2269 2280 (if *declare-inline* 2270 2281 (setf saved-code *code*) … … 2288 2299 (emit-invokestatic +lisp+ "loadTimeValue" 2289 2300 (lisp-object-arg-types 1) +lisp-object+) 2290 (emit 'putstatic *this-class* g +lisp-object+)2301 (emit-putstatic *this-class* g +lisp-object+) 2291 2302 (if *declare-inline* 2292 2303 (setf saved-code *code*) … … 2310 2321 (emit-invokestatic +lisp+ "recall" 2311 2322 (list +java-string+) +lisp-object+) 2312 (emit 'putstatic *this-class* g +lisp-object+)2323 (emit-putstatic *this-class* g +lisp-object+) 2313 2324 (setf *static-code* *code*) 2314 2325 g))) … … 3033 3044 (declare-object 3034 3045 (local-function-function local-function))))) 3035 (emit 'getstatic *this-class* g +lisp-object+)3046 (emit-getstatic *this-class* g +lisp-object+) 3036 3047 ; Stack: template-function 3037 3048 (when *closure-variables* … … 4754 4765 (defun p2-load-time-value (form target representation) 4755 4766 (cond (*file-compilation* 4756 (emit 'getstatic *this-class*4767 (emit-getstatic *this-class* 4757 4768 (declare-load-time-value (second form)) +lisp-object+) 4758 4769 (fix-boxing representation nil) … … 4885 4896 (defun emit-make-compiled-closure-for-labels 4886 4897 (local-function compiland declaration) 4887 (emit 'getstatic *this-class* declaration +lisp-object+)4898 (emit-getstatic *this-class* declaration +lisp-object+) 4888 4899 (let ((parent (compiland-parent compiland))) 4889 4900 (when (compiland-closure-register parent) … … 4970 4981 (with-open-class-file (f class-file) 4971 4982 (compile-and-write-to-stream class-file compiland f)) 4972 (emit 'getstatic *this-class*4983 (emit-getstatic *this-class* 4973 4984 (declare-local-function (make-local-function :class-file 4974 4985 class-file)) … … 5016 5027 (declare-object 5017 5028 (local-function-function local-function))))) 5018 (emit 'getstatic *this-class* g +lisp-object+)5029 (emit-getstatic *this-class* g +lisp-object+) 5019 5030 ; Stack: template-function 5020 5031 … … 5027 5038 (emit-move-from-stack target)) 5028 5039 ((inline-ok name) 5029 (emit 'getstatic *this-class*5040 (emit-getstatic *this-class* 5030 5041 (declare-function name) +lisp-object+) 5031 5042 (emit-move-from-stack target)) … … 5057 5068 (declare-object 5058 5069 (local-function-function local-function))))) 5059 (emit 'getstatic *this-class*5070 (emit-getstatic *this-class* 5060 5071 g +lisp-object+))))) ; Stack: template-function 5061 5072 ((and (member name *functions-defined-in-current-file* :test #'equal) 5062 5073 (not (notinline-p name))) 5063 (emit 'getstatic *this-class*5074 (emit-getstatic *this-class* 5064 5075 (declare-setf-function name) +lisp-object+) 5065 5076 (emit-move-from-stack target)) … … 7433 7444 (emit 'instanceof instanceof-class) 7434 7445 (emit 'ifne LABEL1) 7435 (emit 'getstatic +lisp-symbol+ expected-type-java-symbol-name +lisp-symbol+)7446 (emit-getstatic +lisp-symbol+ expected-type-java-symbol-name +lisp-symbol+) 7436 7447 (emit-invokestatic +lisp+ "type_error" 7437 7448 (lisp-object-arg-types 2) +lisp-object+)
Note: See TracChangeset
for help on using the changeset viewer.
