Changeset 11781


Ignore:
Timestamp:
04/25/09 05:42:28 (14 years ago)
Author:
ehuelsmann
Message:

Instead of interning symbols over and over,
use the ones already interned.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11780 r11781  
    747747
    748748(defun emit-push-variable-name (variable)
    749   (emit 'getstatic *this-class* (declare-symbol (variable-name variable))
    750         +lisp-symbol+))
     749  (multiple-value-bind
     750        (name class)
     751      (lookup-or-declare-symbol (variable-name variable))
     752  (emit 'getstatic class name +lisp-symbol+)))
    751753
    752754(defknown generate-instanceof-type-check-for-variable (t t) t)
     
    20392041      (setf (gethash symbol ht) g))))))
    20402042
     2043(defun lookup-or-declare-symbol (symbol)
     2044  "Returns the value-pair (VALUES field class) from which
     2045the Java object representing SYMBOL can be retrieved."
     2046  (multiple-value-bind
     2047        (name class)
     2048      (lookup-known-symbol symbol)
     2049    (if name
     2050        (values name class)
     2051        (values (declare-symbol symbol) *this-class*))))
     2052
    20412053(defknown declare-keyword (symbol) string)
    20422054(defun declare-keyword (symbol)
     
    20632075     (when s
    20642076       (setf f (concatenate 'string f "_" s))))
    2065    (let ((*code* *static-code*)
    2066    (g (gethash1 symbol (the hash-table *declared-symbols*))))
    2067      (cond (g
    2068       (emit 'getstatic *this-class* g +lisp-symbol+))
    2069      (t
    2070       (emit 'ldc (pool-string (symbol-name symbol)))
    2071       (emit 'ldc (pool-string (package-name (symbol-package symbol))))
    2072       (emit-invokestatic +lisp-class+ "internInPackage"
    2073              (list +java-string+ +java-string+)
    2074              +lisp-symbol+)))
    2075      (declare-field f +lisp-object+)
    2076      (emit-invokevirtual +lisp-symbol-class+ "getSymbolFunctionOrDie"
    2077        nil +lisp-object+)
    2078      (emit 'putstatic *this-class* f +lisp-object+)
    2079      (setf *static-code* *code*)
    2080      (setf (gethash symbol ht) f))))
     2077   (declare-field f +lisp-object+)
     2078   (multiple-value-bind
     2079         (name class)
     2080       (lookup-or-declare-symbol symbol)
     2081     (let ((*code* *static-code*))
     2082       (emit 'getstatic class name +lisp-symbol+)
     2083       (emit-invokevirtual +lisp-symbol-class+ "getSymbolFunctionOrDie"
     2084                           nil +lisp-object+)
     2085       (emit 'putstatic *this-class* f +lisp-object+)
     2086       (setf *static-code* *code*)
     2087       (setf (gethash symbol ht) f)))))
    20812088
    20822089(defknown declare-setf-function (name) string)
     
    20902097       (when s
    20912098   (setf f (concatenate 'string f "_SETF_" s))))
    2092      (let ((*code* *static-code*)
    2093      (g (gethash1 symbol (the hash-table *declared-symbols*))))
    2094        (cond (g
    2095         (emit 'getstatic *this-class* g +lisp-symbol+))
    2096        (t
    2097         (emit 'ldc (pool-string (symbol-name symbol)))
    2098         (emit 'ldc (pool-string (package-name (symbol-package symbol))))
    2099         (emit-invokestatic +lisp-class+ "internInPackage"
    2100          (list +java-string+ +java-string+)
    2101          +lisp-symbol+)))
    2102        (declare-field f +lisp-object+)
    2103        (emit-invokevirtual +lisp-symbol-class+ "getSymbolSetfFunctionOrDie"
    2104          nil +lisp-object+)
    2105        (emit 'putstatic *this-class* f +lisp-object+)
    2106        (setf *static-code* *code*)
    2107        (setf (gethash name ht) f)))))
     2099     (multiple-value-bind
     2100           (name class)
     2101         (lookup-or-declare-symbol symbol)
     2102       (let ((*code* *static-code*))
     2103         (emit 'getstatic class name +lisp-symbol+)
     2104         (declare-field f +lisp-object+)
     2105         (emit-invokevirtual +lisp-symbol-class+ "getSymbolSetfFunctionOrDie"
     2106                             nil +lisp-object+)
     2107         (emit 'putstatic *this-class* f +lisp-object+)
     2108         (setf *static-code* *code*)
     2109         (setf (gethash name ht) f))))))
    21082110
    21092111
     
    29502952      (cond ((eq op (compiland-name *current-compiland*)) ; recursive call
    29512953             (if (notinline-p op)
    2952                  (emit 'getstatic *this-class* (declare-symbol op) +lisp-symbol+)
     2954                 (multiple-value-bind
     2955                       (name class)
     2956                     (lookup-or-declare-symbol op)
     2957                   (emit 'getstatic class name +lisp-symbol+))
    29532958                 (aload 0)))
    2954             ((null (symbol-package op))
    2955              (let ((g (if *file-compilation*
    2956                           (declare-object-as-string op)
    2957                           (declare-object op))))
    2958                (emit 'getstatic *this-class* g +lisp-object+)))
    29592959            (t
    29602960             (multiple-value-bind
    29612961                   (name class)
    2962                  (lookup-known-symbol op)
    2963                (if name
    2964                    (emit 'getstatic class name +lisp-symbol+)
    2965                    (emit 'getstatic *this-class* (declare-symbol op) +lisp-symbol+)))))
     2962                 (lookup-or-declare-symbol op)
     2963               (emit 'getstatic class name +lisp-symbol+))))
    29662964      (process-args args)
    29672965      (if (or (<= *speed* *debug*) *require-stack-frame*)
     
    49274925           (multiple-value-bind
    49284926                 (name class)
    4929                (lookup-known-symbol obj)
    4930              (cond (name
    4931                     (emit 'getstatic class name +lisp-symbol+))
    4932                    ((symbol-package (truly-the symbol obj))
    4933                     (emit 'getstatic *this-class* (declare-symbol obj)
    4934                           +lisp-symbol+))
    4935                    (t
    4936                     ;; An uninterned symbol.
    4937                     (let ((g (if *file-compilation*
    4938                                  (declare-object-as-string obj)
    4939                                  (declare-object obj))))
    4940                       (emit 'getstatic *this-class* g +lisp-object+))))
    4941              (emit-move-from-stack target representation)))
     4927               (lookup-or-declare-symbol obj)
     4928             (emit 'getstatic class name +lisp-symbol+))
     4929           (emit-move-from-stack target representation))
    49424930          ((listp obj)
    49434931           (let ((g (if *file-compilation*
     
    51915179                  (emit-move-from-stack target))
    51925180                 (t
    5193                   (emit 'getstatic *this-class*
    5194                         (declare-symbol name) +lisp-symbol+)
    5195                   (emit-invokevirtual +lisp-object-class+ "getSymbolFunctionOrDie"
     5181                  (multiple-value-bind
     5182                        (name class)
     5183                      (lookup-or-declare-symbol name)
     5184                    (emit 'getstatic class name +lisp-symbol+))
     5185                  (emit-invokevirtual +lisp-object-class+
     5186                                      "getSymbolFunctionOrDie"
    51965187                                      nil +lisp-object+)
    51975188                  (emit-move-from-stack target))))
     
    52275218                  (emit-move-from-stack target))
    52285219                 (t
    5229                   (emit 'getstatic *this-class*
    5230                         (declare-symbol (cadr name)) +lisp-symbol+)
     5220                  (multiple-value-bind
     5221                        (name class)
     5222                      (lookup-or-declare-symbol (cadr name))
     5223                    (emit 'getstatic class name +lisp-symbol+))
    52315224                  (emit-invokevirtual +lisp-symbol-class+
    52325225                                      "getSymbolSetfFunctionOrDie"
     
    74877480        (compile-constant value target representation)
    74887481        (return-from compile-special-reference))))
    7489   (emit 'getstatic *this-class* (declare-symbol name) +lisp-symbol+)
     7482  (multiple-value-bind
     7483        (name class)
     7484      (lookup-or-declare-symbol name)
     7485    (emit 'getstatic class name +lisp-symbol+))
    74907486  (cond ((constantp name)
    74917487         ;; "... a reference to a symbol declared with DEFCONSTANT always
     
    75627558      ;; We're setting a special variable.
    75637559      (emit-push-current-thread)
    7564       (emit 'getstatic *this-class* (declare-symbol name) +lisp-symbol+)
     7560      (multiple-value-bind
     7561            (name class)
     7562          (lookup-or-declare-symbol name)
     7563        (emit 'getstatic class name +lisp-symbol+))
    75657564;;       (let ((*print-structure* nil))
    75667565;;         (format t "p2-setq name = ~S value-form = ~S~%" name value-form))
     
    80108009                   (multiple-value-bind
    80118010                         (name class)
    8012                        (lookup-known-symbol form)
    8013                      (if name
    8014                          (emit 'getstatic class name +lisp-symbol+)
    8015                          (emit 'getstatic *this-class* (declare-keyword form)
    8016                                +lisp-symbol+)))))
     8011                       (lookup-or-declare-symbol form)
     8012                     (emit 'getstatic class name +lisp-symbol+))))
    80178013                (emit-move-from-stack target representation))
    80188014               (t
Note: See TracChangeset for help on using the changeset viewer.