Changeset 12855


Ignore:
Timestamp:
08/02/10 11:33:39 (12 years ago)
Author:
ehuelsmann
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12853 r12855  
    100100(defun pool-class (class-name)
    101101  (declare (optimize speed))
    102   (pool-get (list 7 (pool-name class-name))))
     102  (pool-get (list 7 (pool-name (class-name-internal class-name)))))
    103103
    104104;; (tag class-index name-and-type-index)
     
    207207                          :catch-type (if (null type)
    208208                                          0
    209                                           (pool-class (!class-name type))))
     209                                          (pool-class type)))
    210210            *handlers*)
    211211      (code-add-exception-handler *current-code-attribute*
    212212                                  start end handler type)))
    213 
    214 (defun !class-name (class-name)
    215   "To be eliminated when all hard-coded strings are replaced by `class-name'
    216 structures"
    217   (if (typep class-name 'class-name)
    218       (class-name-internal class-name)
    219       class-name))
    220213
    221214(defun !class-ref (class-name)
     
    462455         (stack-effect (cdr info))
    463456         (index (if (null *current-code-attribute*)
    464                     (pool-method (!class-name class-name) method-name descriptor)
     457                    (pool-method class-name method-name descriptor)
    465458                    (pool-add-method-ref *pool* class-name
    466459                                         method-name (cons return-type arg-types))))
     
    472465(declaim (ftype (function t string) pretty-java-class))
    473466(defun pretty-java-class (class)
    474   (cond ((equal (!class-name class) (!class-name +lisp-object+))
     467  (cond ((equal class +lisp-object+)
    475468         "LispObject")
    476469        ((equal class +lisp-symbol+)
     
    487480         (stack-effect (cdr info))
    488481         (index (if (null *current-code-attribute*)
    489                     (pool-method (!class-name class-name) method-name descriptor)
     482                    (pool-method class-name method-name descriptor)
    490483                    (pool-add-method-ref *pool* class-name
    491484                                         method-name (cons return-type arg-types))))
     
    508501         (stack-effect (cdr info))
    509502         (index (if (null *current-code-attribute*)
    510                     (pool-method (!class-name  class-name) "<init>" descriptor)
     503                    (pool-method class-name "<init>" descriptor)
    511504                    (pool-add-method-ref *pool* class-name
    512505                                         "<init>" (cons nil arg-types))))
     
    550543(defun emit-getstatic (class-name field-name type)
    551544  (let ((index (if (null *current-code-attribute*)
    552                    (pool-field (!class-name class-name)
    553                            field-name (!class-ref type))
     545                   (pool-field class-name field-name (!class-ref type))
    554546                   (pool-add-field-ref *pool* class-name field-name type))))
    555547    (apply #'%emit 'getstatic (u2 index))))
     
    558550(defun emit-putstatic (class-name field-name type)
    559551  (let ((index (if (null *current-code-attribute*)
    560                    (pool-field (!class-name class-name)
    561                            field-name (!class-ref type))
     552                   (pool-field class-name field-name (!class-ref type))
    562553                   (pool-add-field-ref *pool* class-name field-name type))))
    563554    (apply #'%emit 'putstatic (u2 index))))
     
    12281219(define-resolver (180 181) (instruction)
    12291220  (let* ((args (instruction-args instruction))
    1230          (index (pool-field (!class-name (first args))
     1221         (index (pool-field (first args)
    12311222                            (second args) (!class-ref (third args)))))
    12321223    (inst (instruction-opcode instruction) (u2 index))))
     
    12351226(define-resolver (187 189 192 193) (instruction)
    12361227  (let* ((args (instruction-args instruction))
    1237          (index (pool-class (!class-name (first args)))))
     1228         (index (pool-class (first args))))
    12381229    (inst (instruction-opcode instruction) (u2 index))))
    12391230
     
    78777868  (let* ((super (abcl-class-file-superclass class-file))
    78787869         (this (abcl-class-file-class class-file))
    7879          (this-index (pool-class (!class-name this)))
    7880          (super-index (pool-class (!class-name super)))
     7870         (this-index (pool-class this))
     7871         (super-index (pool-class super))
    78817872         (constructor (make-constructor super
    78827873                                        (abcl-class-file-lambda-name class-file)
Note: See TracChangeset for help on using the changeset viewer.