Changeset 11780

Timestamp:

04/24/09 19:51:45 (14 years ago)

Author:

ehuelsmann

Message:

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

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• compiler-pass2.lisp (modified) (3 diffs)
• known-symbols.lisp (modified) (2 diffs)

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

@@ -2958 +2958 @@
                (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)
@@ -4922 +4924 @@
            (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.
@@ -8009 +8008 @@
                    (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

trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp

@@ -32 +32 @@
 (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)))
@@ -47 +46 @@
             (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)