Changeset 12855

Timestamp:

08/02/10 11:33:39 (13 years ago)

Author:

ehuelsmann

Message:

Start removing CLASS-NAME dual-mode-compatible shim code:
remove !CLASS-NAME.

File:

• branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (11 diffs)

branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -100 +100 @@
 (defun pool-class (class-name)
   (declare (optimize speed))
-  (pool-get (list 7 (pool-name class-name))))
+  (pool-get (list 7 (pool-name (class-name-internal class-name)))))
 
 ;; (tag class-index name-and-type-index)
@@ -207 +207 @@
                           :catch-type (if (null type)
                                           0
-                                          (pool-class (!class-name type))))
+                                          (pool-class type)))
             *handlers*)
       (code-add-exception-handler *current-code-attribute*
                                   start end handler type)))
-
-(defun !class-name (class-name)
-  "To be eliminated when all hard-coded strings are replaced by `class-name'
-structures"
-  (if (typep class-name 'class-name)
-      (class-name-internal class-name)
-      class-name))
 
 (defun !class-ref (class-name)
@@ -462 +455 @@
          (stack-effect (cdr info))
          (index (if (null *current-code-attribute*)
-                    (pool-method (!class-name class-name) method-name descriptor)
+                    (pool-method class-name method-name descriptor)
                     (pool-add-method-ref *pool* class-name
                                          method-name (cons return-type arg-types))))
@@ -472 +465 @@
 (declaim (ftype (function t string) pretty-java-class))
 (defun pretty-java-class (class)
-  (cond ((equal (!class-name class) (!class-name +lisp-object+))
+  (cond ((equal class +lisp-object+)
          "LispObject")
         ((equal class +lisp-symbol+)
@@ -487 +480 @@
          (stack-effect (cdr info))
          (index (if (null *current-code-attribute*)
-                    (pool-method (!class-name class-name) method-name descriptor)
+                    (pool-method class-name method-name descriptor)
                     (pool-add-method-ref *pool* class-name
                                          method-name (cons return-type arg-types))))
@@ -508 +501 @@
          (stack-effect (cdr info))
          (index (if (null *current-code-attribute*)
-                    (pool-method (!class-name  class-name) "<init>" descriptor)
+                    (pool-method class-name "<init>" descriptor)
                     (pool-add-method-ref *pool* class-name
                                          "<init>" (cons nil arg-types))))
@@ -550 +543 @@
 (defun emit-getstatic (class-name field-name type)
   (let ((index (if (null *current-code-attribute*)
-                   (pool-field (!class-name class-name)
-                           field-name (!class-ref type))
+                   (pool-field class-name field-name (!class-ref type))
                    (pool-add-field-ref *pool* class-name field-name type))))
     (apply #'%emit 'getstatic (u2 index))))
@@ -558 +550 @@
 (defun emit-putstatic (class-name field-name type)
   (let ((index (if (null *current-code-attribute*)
-                   (pool-field (!class-name class-name)
-                           field-name (!class-ref type))
+                   (pool-field class-name field-name (!class-ref type))
                    (pool-add-field-ref *pool* class-name field-name type))))
     (apply #'%emit 'putstatic (u2 index))))
@@ -1228 +1219 @@
 (define-resolver (180 181) (instruction)
   (let* ((args (instruction-args instruction))
-         (index (pool-field (!class-name (first args))
+         (index (pool-field (first args)
                             (second args) (!class-ref (third args)))))
     (inst (instruction-opcode instruction) (u2 index))))
@@ -1235 +1226 @@
 (define-resolver (187 189 192 193) (instruction)
   (let* ((args (instruction-args instruction))
-         (index (pool-class (!class-name (first args)))))
+         (index (pool-class (first args))))
     (inst (instruction-opcode instruction) (u2 index))))
 
@@ -7877 +7868 @@
   (let* ((super (abcl-class-file-superclass class-file))
          (this (abcl-class-file-class class-file))
-         (this-index (pool-class (!class-name this)))
-         (super-index (pool-class (!class-name super)))
+         (this-index (pool-class this))
+         (super-index (pool-class super))
          (constructor (make-constructor super
                                         (abcl-class-file-lambda-name class-file)