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

[Erik Huelsmann]

Author: ehuelsmann
Date: Fri Apr 24 15:51:45 2009
New Revision: 11780

Log:
Clean up the known symbols cache:

* instead of returning only the name of the field, also return the containing class
* unify the SYMBOLS and KEYWORDS hashes into a single hash allowing extension when required
* enlarge the symbols cache: there were 1057 symbols to be stored in a hash of 1024 initial size


Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
   trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp

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	Fri Apr 24 15:51:45 2009
@@ -2957,9 +2957,11 @@
                           (declare-object op))))
                (emit 'getstatic *this-class* g +lisp-object+)))
             (t
-             (let ((name (lookup-known-symbol op)))
+             (multiple-value-bind
+                   (name class)
+                 (lookup-known-symbol op)
                (if name
-                   (emit 'getstatic +lisp-symbol-class+ name +lisp-symbol+)
+                   (emit 'getstatic class name +lisp-symbol+)
                    (emit 'getstatic *this-class* (declare-symbol op) +lisp-symbol+)))))
       (process-args args)
       (if (or (<= *speed* *debug*) *require-stack-frame*)
@@ -4921,18 +4923,15 @@
           ((eq representation :boolean)
            (emit 'iconst_1)
            (emit-move-from-stack target representation))
-          ((keywordp obj)
-           (let ((name (lookup-known-keyword obj)))
-              (if name
-                  (emit 'getstatic "org/armedbear/lisp/Keyword" name +lisp-symbol+)
-                  (emit 'getstatic *this-class* (declare-keyword obj) +lisp-symbol+)))
-            (emit-move-from-stack target representation))
           ((symbolp obj)
-           (let ((name (lookup-known-symbol obj)))
+           (multiple-value-bind
+                 (name class)
+               (lookup-known-symbol obj)
              (cond (name
-                    (emit 'getstatic +lisp-symbol-class+ name +lisp-symbol+))
+                    (emit 'getstatic class name +lisp-symbol+))
                    ((symbol-package (truly-the symbol obj))
-                    (emit 'getstatic *this-class* (declare-symbol obj) +lisp-symbol+))
+                    (emit 'getstatic *this-class* (declare-symbol obj)
+                          +lisp-symbol+))
                    (t
                     ;; An uninterned symbol.
                     (let ((g (if *file-compilation*
@@ -8008,10 +8007,13 @@
                   (:boolean
                    (emit 'iconst_1))
                   ((nil)
-                   (let ((name (lookup-known-keyword form)))
+                   (multiple-value-bind
+                         (name class)
+                       (lookup-known-symbol form)
                      (if name
-                         (emit 'getstatic "org/armedbear/lisp/Keyword" name +lisp-symbol+)
-                         (emit 'getstatic *this-class* (declare-keyword form) +lisp-symbol+)))))
+                         (emit 'getstatic class name +lisp-symbol+)
+                         (emit 'getstatic *this-class* (declare-keyword form)
+                               +lisp-symbol+)))))
                 (emit-move-from-stack target representation))
                (t
                 ;; Shouldn't happen.

Modified: trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp	Fri Apr 24 15:51:45 2009
@@ -31,13 +31,12 @@
 
 (in-package #:system)
 
-(export '(lookup-known-symbol lookup-known-keyword))
+(export '(lookup-known-symbol))
 
-(let ((symbols (make-hash-table :test 'eq :size 1024))
-      (keywords (make-hash-table :test 'eq :size 128)))
+(let ((symbols (make-hash-table :test 'eq :size 2048)))
   (defun initialize-known-symbols (source ht)
-    (clrhash ht)
     (let* ((source-class (java:jclass source))
+           (class-designator (substitute #\/ #\. source))
            (symbol-class (java:jclass "org.armedbear.lisp.Symbol"))
            (fields (java:jclass-fields source-class :declared t :public t)))
       (dotimes (i (length fields))
@@ -46,16 +45,16 @@
           (when (equal type symbol-class)
             (let* ((name (java:jfield-name field))
                    (symbol (java:jfield source-class name)))
-              (puthash symbol ht name))))))
+              (puthash symbol ht (list name class-designator)))))))
     (hash-table-count ht))
 
   (initialize-known-symbols "org.armedbear.lisp.Symbol" symbols)
-  (initialize-known-symbols "org.armedbear.lisp.Keyword" keywords)
+  (initialize-known-symbols "org.armedbear.lisp.Keyword" symbols)
 
   (defun lookup-known-symbol (symbol)
-    (gethash1 symbol symbols))
+    "Returns the name of the field and its class designator
+which stores the Java object `symbol'."
+    (values-list (gethash1 symbol symbols))))
 
-  (defun lookup-known-keyword (keyword)
-    (gethash1 keyword keywords)))
 
 (provide '#:known-symbols)