[armedbear-cvs] r12858 - branches/generic-class-file/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Mon Aug  2 17:44:02 2010
New Revision: 12858

Log:
Finalize CLASS-NAME integration: decommission !CLASS-REF.

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

Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Mon Aug  2 17:44:02 2010
@@ -108,7 +108,8 @@
   (declare (optimize speed))
   (pool-get (list 9
                   (pool-class class-name)
-                  (pool-name-and-type field-name type-name))))
+                  (pool-name-and-type field-name
+                                      (internal-field-ref type-name)))))
 
 ;; (tag class-index name-and-type-index)
 (declaim (ftype (function (string string string) fixnum) pool-method))
@@ -211,13 +212,6 @@
       (code-add-exception-handler *current-code-attribute*
                                   start end handler type)))
 
-(defun !class-ref (class-name)
-  "To be eliminated when all hard-coded strings are
-replaced by `class-name' structures"
-  (if (or (symbolp class-name) (typep class-name 'class-name))
-      (internal-field-ref class-name)
-      class-name))
-
 (defstruct (instruction (:constructor %make-instruction (opcode args)))
   (opcode 0 :type (integer 0 255))
   args
@@ -504,14 +498,14 @@
 (defknown emit-getstatic (t t t) t)
 (defun emit-getstatic (class-name field-name type)
   (let ((index (if (null *current-code-attribute*)
-                   (pool-field class-name field-name (!class-ref type))
+                   (pool-field class-name field-name type)
                    (pool-add-field-ref *pool* class-name field-name type))))
     (apply #'%emit 'getstatic (u2 index))))
 
 (defknown emit-putstatic (t t t) t)
 (defun emit-putstatic (class-name field-name type)
   (let ((index (if (null *current-code-attribute*)
-                   (pool-field class-name field-name (!class-ref type))
+                   (pool-field class-name field-name type)
                    (pool-add-field-ref *pool* class-name field-name type))))
     (apply #'%emit 'putstatic (u2 index))))
 
@@ -1169,7 +1163,7 @@
 (define-resolver (180 181) (instruction)
   (let* ((args (instruction-args instruction))
          (index (pool-field (first args)
-                            (second args) (!class-ref (third args)))))
+                            (second args) (third args))))
     (inst (instruction-opcode instruction) (u2 index))))
 
 ;; new, anewarray, checkcast, instanceof class-name
@@ -1915,7 +1909,7 @@
 
 (defknown declare-field (t t t) t)
 (defun declare-field (name descriptor access-flags)
-  (let ((field (make-field name (!class-ref descriptor))))
+  (let ((field (make-field name (internal-field-ref descriptor))))
     ;; final static <access-flags>
     (setf (field-access-flags field)
           (logior +field-flag-final+ +field-flag-static+ access-flags))