Changeset 12772


Ignore:
Timestamp:
06/27/10 22:07:04 (12 years ago)
Author:
ehuelsmann
Message:

Implement most of the constant pool functionality.

File:
1 edited

Legend:

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

    r12770 r12772  
    138138(define-class-name +!fasl-loader+ "org.armedbear.lisp.FaslClassLoader")
    139139
     140#|
     141
     142Lisp-side descriptor representation:
     143
     144 - list: a list starting with a method return value, followed by
     145     the argument types
     146 - keyword: the primitive type associated with that keyword
     147 - class-name structure instance: the class-ref value
     148
     149The latter two can be converted to a Java representation using
     150the `internal-field-ref' function, the former is to be fed to
     151`descriptor'.
     152
     153|#
    140154
    141155(defun internal-field-type (field-type)
     
    179193    (:utf8           1 1)))
    180194
    181 (defstruct (constant-class (:include constant
     195(defstruct (constant-class (:constructor make-constant-class (index name-index))
     196                           (:include constant
    182197                                     (tag 7)))
    183   name)
     198  name-index)
    184199
    185200(defstruct (constant-member-ref (:include constant))
     
    187202  name/type)
    188203
    189 (defstruct (constant-string (:constructor make-constant-string
    190                                          (index value-index))
     204(defstruct (constant-string (:constructor
     205                             make-constant-string (index value-index))
    191206                            (:include constant
    192207                                      (tag 8)))
    193208  value-index) ;;; #### is this the value or the value index???
    194209
    195 (defstruct (constant-float/int (:include constant))
     210(defstruct (constant-float/int (:constructor
     211                                %make-constant-float/int (tag index value))
     212                               (:include constant))
    196213  value)
    197214
    198 (defstruct (constant-double/long (:include constant))
     215(declaim (inline make-constant-float make-constant-int))
     216(defun make-constant-float (index value)
     217  (%make-constant-float/int 4 index value))
     218
     219(defun make-constant-int (index value)
     220  (%make-constant-float/int 3 index value))
     221
     222(defstruct (constant-double/long (:constructor
     223                                  %make-constant-double/long (tag index value))
     224                                 (:include constant))
    199225  value)
    200226
    201 (defstruct (constant-name/type (:include constant))
     227(declaim (inline make-constant-double make-constant-float))
     228(defun make-constant-double (index value)
     229  (%make-constant-double/long 6 index value))
     230
     231(defun make-constant-long (index value)
     232  (%make-constant-double/long 5 index value))
     233
     234(defstruct (constant-name/type (:include constant
     235                                         (tag 12)))
    202236  name-index
    203237  descriptor-index)
     
    209243
    210244
     245(defun pool-add-class (pool class)
     246  ;; ### do we make class a string or class-name structure?
     247  (let ((entry (gethash class (pool-entries pool))))
     248    (unless entry
     249      (setf entry
     250            (make-constant-class (incf (pool-count pool))
     251                                 (pool-add-utf8 pool
     252                                                (class-name-internal class)))
     253            (gethash class (pool-entries pool)) entry)
     254      (push entry (pool-entries-list pool)))
     255    (constant-index entry)))
     256
     257(defun pool-add-member-ref (pool class name type)
     258  (let ((entry (gethash (acons name type class) (pool-entries pool))))
     259    (unless entry
     260      (setf entry (make-constant-member-ref (incf (pool-count pool))
     261                                            (pool-add-class pool class)
     262                                            (pool-add-name/type pool name type))
     263            (gethash (acons name type class) (pool-entries pool)) entry)
     264      (push entry (pool-entries-list pool)))
     265    (constant-index entry)))
     266
    211267(defun pool-add-string (pool string)
    212268  (let ((entry (gethash (cons 8 string) ;; 8 == string-tag
    213269                        (pool-entries pool))))
    214270    (unless entry
    215       (setf entry (make-constant-string (pool-add-utf8 pool string))
     271      (setf entry (make-constant-string (incf (pool-count pool))
     272                                        (pool-add-utf8 pool string))
    216273            (gethash (cons 8 string) (pool-entries pool)) entry)
    217       (incf (pool-count pool))
     274      (push entry (pool-entries-list pool)))
     275    (constant-index entry)))
     276
     277(defun pool-add-name/type (pool name type)
     278  (let ((entry (gethash (cons name type) (pool-entries pool)))
     279        (internal-type (if (listp type)
     280                           (apply #'descriptor type)
     281                           (internal-field-ref type))))
     282    (unless entry
     283      (setf entry (make-constant-name/type (incf (pool-count pool))
     284                                           (pool-add-utf8 pool name)
     285                                           (pool-add-utf8 pool internal-type))
     286            (gethash (cons name type) (pool-entries pool)) entry)
    218287      (push entry (pool-entries-list pool)))
    219288    (constant-index entry)))
     
    223292                        (pool-entries pool))))
    224293    (unless entry
    225       (setf entry (make-constant-utf8 (pool-count pool) utf8-as-string)
     294      (setf entry (make-constant-utf8 (incf (pool-count pool)) utf8-as-string)
    226295            (gethash (cons 11 utf8-as-string) (pool-entries pool)) entry)
    227       (incf (pool-count pool))
    228296      (push entry (pool-entries-list pool)))
    229297    (constant-index entry)))
     
    329397       (write-u2 (third entry) stream))
    330398      ((7 8) ; class string
    331        (write-u2 (constant-class-name entry) stream))
     399       (write-u2 (constant-class-name-index entry) stream))
    332400      (t
    333401       (error "write-constant-pool-entry unhandled tag ~D~%" tag))))))
Note: See TracChangeset for help on using the changeset viewer.