[armedbear-cvs] r12234 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Thu Oct 29 18:31:31 2009
New Revision: 12234

Log:
Don't create 2 fields to store/retrieve a single (cached!) value.

Modified:
   trunk/abcl/src/org/armedbear/lisp/Lisp.java
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java	Thu Oct 29 18:31:31 2009
@@ -2129,9 +2129,14 @@
   private static final Hashtable<String,LispObject> objectTable =
           new Hashtable<String,LispObject>();
 
+  public static final LispObject recall(String key)
+  {
+    return objectTable.remove(key);
+  }
+
   public static final LispObject recall(SimpleString key)
   {
-    return (LispObject) objectTable.remove(key.getStringValue());
+    return objectTable.remove(key.getStringValue());
   }
 
   // ### remember

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Thu Oct 29 18:31:31 2009
@@ -2271,21 +2271,19 @@
 loading the object value into a field upon class-creation time.
 
 The field type of the object is specified by OBJ-REF."
-  (let ((key (symbol-name (gensym "OBJ"))))
+  (let ((g (symbol-name (gensym "OBJ"))))
     ;; fixme *declare-inline*?
-    (remember key obj)
-    (let* ((g1 (declare-string key))
-           (g2 (symbol-name (gensym "O2BJ"))))
-      (let* ((*code* *static-code*))
-        (declare-field g2 obj-ref +field-access-private+)
-        (emit 'getstatic *this-class* g1 +lisp-simple-string+)
-        (emit-invokestatic +lisp-class+ "recall"
-                           (list +lisp-simple-string+) +lisp-object+)
-        (when (and obj-class (string/= obj-class +lisp-object-class+))
-          (emit 'checkcast obj-class))
-        (emit 'putstatic *this-class* g2 obj-ref)
-        (setf *static-code* *code*)
-        g2))))
+    (remember g obj)
+    (let* ((*code* *static-code*))
+      (declare-field g obj-ref +field-access-private+)
+      (emit 'ldc (pool-string g))
+      (emit-invokestatic +lisp-class+ "recall"
+                         (list +java-string+) +lisp-object+)
+      (when (and obj-class (string/= obj-class +lisp-object-class+))
+        (emit 'checkcast obj-class))
+      (emit 'putstatic *this-class* g obj-ref)
+      (setf *static-code* *code*)
+      g)))
 
 (defun declare-lambda (obj)
   (let (saved-code