Changeset 11792

Timestamp:

04/28/09 19:38:42 (14 years ago)

Author:

vvoutilainen

Message:

Little combination fix for pool-long and pool-double.

File:

• trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (3 diffs)

trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -135 +135 @@
   (pool-get (list 4 (%float-bits n))))
 
-(defknown pool-long (integer) (integer 1 65535))
-(defun pool-long (n)
-  (declare (optimize speed))
-  (declare (type java-long n))
-  (let* ((entry (list 5
-                      (logand (ash n -32) #xffffffff)
-                      (logand n #xffffffff)))
-         (ht *pool-entries*)
+(defun pool-long/double (n entry)
+  (let* ((ht *pool-entries*)
          (index (gethash1 entry ht)))
     (declare (type hash-table ht))
@@ -158 +152 @@
     index))
 
+(defknown pool-long (integer) (integer 1 65535))
+(defun pool-long (n)
+  (declare (optimize speed))
+  (declare (type java-long n))
+  (let* ((entry (list 5
+                      (logand (ash n -32) #xffffffff)
+                      (logand n #xffffffff))))
+    (pool-long/double n entry)))
+
 (defknown pool-double (double-float) (integer 1 65535))
 (defun pool-double (n)
@@ -164 +167 @@
          (entry (list 6
                       (logand (ash n -32) #xffffffff)
-                      (logand n #xffffffff)))
-         (ht *pool-entries*)
-         (index (gethash1 entry ht)))
-    (declare (type hash-table ht))
-    (unless index
-      (setf index *pool-count*)
-      (push entry *pool*)
-      (setf (gethash entry ht) index)
-      ;; The Java Virtual Machine Specification, Section 4.4.5: "All 8-byte
-      ;; constants take up two entries in the constant_pool table of the class
-      ;; file. If a CONSTANT_Long_info or CONSTANT_Double_info structure is the
-      ;; item in the constant_pool table at index n, then the next usable item in
-      ;; the pool is located at index n+2. The constant_pool index n+1 must be
-      ;; valid but is considered unusable." So:
-      (setf *pool-count* (+ index 2)))
-    index))
+                      (logand n #xffffffff))))
+    (pool-long/double n entry)))
 
 (defknown u2 (fixnum) cons)