Changeset 12681
- Timestamp:
- 05/13/10 22:06:48 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r12650 r12681 2185 2185 (setf (gethash local-function ht) g)))) 2186 2186 2187 (defknown declare-fixnum (fixnum) string) 2188 (defun declare-fixnum (n) 2189 (declare (type fixnum n)) 2187 (defknown declare-integer (integer) string) 2188 (defun declare-integer (n) 2190 2189 (declare-with-hashtable 2191 2190 n *declared-integers* ht g 2192 (let ((*code* *static-code*)) 2193 ;; no need to *declare-inline*: constants 2194 (setf g (format nil "FIXNUM_~A~D" 2195 (if (minusp n) "MINUS_" "") 2196 (abs n))) 2197 (declare-field g +lisp-integer+ +field-access-private+) 2198 (cond ((<= 0 n 255) 2199 (emit 'getstatic +lisp-fixnum-class+ "constants" +lisp-fixnum-array+) 2200 (emit-push-constant-int n) 2201 (emit 'aaload)) 2202 (t 2203 (emit-push-constant-int n) 2204 (convert-representation :int nil))) 2205 (emit 'putstatic *this-class* g +lisp-integer+) 2206 (setf *static-code* *code*) 2207 (setf (gethash n ht) g)))) 2208 2209 (defknown declare-bignum (integer) string) 2210 (defun declare-bignum (n) 2211 (declare-with-hashtable 2212 n *declared-integers* ht g 2213 (setf g (concatenate 'string "BIGNUM_" (symbol-name (gensym)))) 2191 (setf g (concatenate 'string "INT_" (symbol-name (gensym)))) 2214 2192 (let ((*code* *static-code*)) 2215 2193 ;; no need to *declare-inline*: constants 2216 2194 (declare-field g +lisp-integer+ +field-access-private+) 2217 (cond ((<= most-negative-java-long n most-positive-java-long) 2218 ;; (setf g (format nil "BIGNUM_~A~D" 2219 ;; (if (minusp n) "MINUS_" "") 2220 ;; (abs n))) 2221 (emit 'ldc2_w (pool-long n)) 2222 (emit-invokestatic +lisp-bignum-class+ "getInstance" 2223 '("J") +lisp-integer+)) 2224 (t 2225 (let* ((*print-base* 10) 2226 (s (with-output-to-string (stream) (dump-form n stream)))) 2227 (emit 'ldc (pool-string s)) 2228 (emit-push-constant-int 10) 2229 (emit-invokestatic +lisp-bignum-class+ "getInstance" 2230 (list +java-string+ "I") +lisp-integer+)))) 2195 (cond((<= 0 n 255) 2196 (emit 'getstatic +lisp-fixnum-class+ "constants" +lisp-fixnum-array+) 2197 (emit-push-constant-int n) 2198 (emit 'aaload)) 2199 ((<= most-negative-fixnum n most-positive-fixnum) 2200 (emit-push-constant-int n) 2201 (emit-invokestatic +lisp-fixnum-class+ "getInstance" 2202 '("I") +lisp-fixnum+)) 2203 ((<= most-negative-java-long n most-positive-java-long) 2204 (emit-push-constant-long n) 2205 (emit-invokestatic +lisp-bignum-class+ "getInstance" 2206 '("J") +lisp-integer+)) 2207 (t 2208 (let* ((*print-base* 10) 2209 (s (with-output-to-string (stream) (dump-form n stream)))) 2210 (emit 'ldc (pool-string s)) 2211 (emit-push-constant-int 10) 2212 (emit-invokestatic +lisp-bignum-class+ "getInstance" 2213 (list +java-string+ "I") +lisp-integer+)))) 2231 2214 (emit 'putstatic *this-class* g +lisp-integer+) 2232 2215 (setf *static-code* *code*)) … … 2436 2419 (emit-push-constant-int form)) 2437 2420 ((integerp form) 2438 (emit 'getstatic *this-class* (declare- bignumform) +lisp-integer+)2421 (emit 'getstatic *this-class* (declare-integer form) +lisp-integer+) 2439 2422 (emit-invokevirtual +lisp-object-class+ "intValue" nil "I")) 2440 2423 (t … … 2447 2430 (emit-push-constant-long form)) 2448 2431 ((integerp form) 2449 (emit 'getstatic *this-class* (declare- bignumform) +lisp-integer+)2432 (emit 'getstatic *this-class* (declare-integer form) +lisp-integer+) 2450 2433 (emit-invokevirtual +lisp-object-class+ "longValue" nil "J")) 2451 2434 (t … … 2491 2474 (return-from compile-constant)) 2492 2475 ((NIL))) 2493 (cond ((fixnump form) 2494 (let ((translation (case form 2495 (0 "ZERO") 2496 (1 "ONE") 2497 (2 "TWO") 2498 (3 "THREE") 2499 (-1 "MINUS_ONE")))) 2500 (if translation 2501 (emit 'getstatic +lisp-fixnum-class+ translation +lisp-fixnum+) 2502 (emit 'getstatic *this-class* (declare-fixnum form) 2503 +lisp-integer+)))) 2504 ((integerp form) 2505 ;; A bignum. 2506 (emit 'getstatic *this-class* (declare-bignum form) +lisp-integer+)) 2476 (cond ((integerp form) 2477 (emit 'getstatic *this-class* (declare-integer form) +lisp-integer+)) 2507 2478 ((typep form 'single-float) 2508 2479 (emit 'getstatic *this-class*
Note: See TracChangeset
for help on using the changeset viewer.