Changeset 12777


Ignore:
Timestamp:
07/03/10 21:40:17 (11 years ago)
Author:
ehuelsmann
Message:

More pool management and serialization.

File:
1 edited

Legend:

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

    r12776 r12777  
    200200  name-index)
    201201
    202 (defstruct (constant-member-ref (:include constant))
    203   class
    204   name/type)
     202(defstruct (constant-member-ref (:constructor
     203                                 %make-constant-member-ref
     204                                     (tag index class-index name/type-index))
     205                                (:include constant))
     206  class-index
     207  name/type-index)
     208
     209(declaim (inline make-constant-field-ref make-constant-method-ref
     210                 make-constant-interface-method-ref))
     211(defun make-constant-field-ref (index class-index name/type-index)
     212  (%make-constant-member-ref 9 index class-index name/type-index))
     213
     214(defun make-constant-method-ref (index class-index name/type-index)
     215  (%make-constant-member-ref 10 index class-index name/type-index))
     216
     217(defun make-constant-interface-method-ref (index class-index name/type-index)
     218  (%make-constant-member-ref 11 index class-index name/type-index))
    205219
    206220(defstruct (constant-string (:constructor
     
    257271    (constant-index entry)))
    258272
    259 (defun pool-add-member-ref (pool class name type)
     273(defun pool-add-field-ref (pool class name type)
    260274  (let ((entry (gethash (acons name type class) (pool-entries pool))))
    261275    (unless entry
    262       (setf entry (make-constant-member-ref (incf (pool-count pool))
     276      (setf entry (make-constant-field-ref (incf (pool-count pool))
     277                                           (pool-add-class pool class)
     278                                           (pool-add-name/type pool name type))
     279            (gethash (acons name type class) (pool-entries pool)) entry)
     280      (push entry (pool-entries-list pool)))
     281    (constant-index entry)))
     282
     283(defun pool-add-method-ref (pool class name type)
     284  (let ((entry (gethash (acons name type class) (pool-entries pool))))
     285    (unless entry
     286      (setf entry (make-constant-method-ref (incf (pool-count pool))
    263287                                            (pool-add-class pool class)
    264288                                            (pool-add-name/type pool name type))
     289            (gethash (acons name type class) (pool-entries pool)) entry)
     290      (push entry (pool-entries-list pool)))
     291    (constant-index entry)))
     292
     293(defun pool-add-interface-method-ref (pool class name type)
     294  (let ((entry (gethash (acons name type class) (pool-entries pool))))
     295    (unless entry
     296      (setf entry
     297            (make-constant-interface-method-ref (incf (pool-count pool))
     298                                                (pool-add-class pool class)
     299                                                (pool-add-name/type pool
     300                                                                    name type))
    265301            (gethash (acons name type class) (pool-entries pool)) entry)
    266302      (push entry (pool-entries-list pool)))
     
    370406  (setf (class-file-access-flags class)
    371407        (map-flags (class-file-access-flags class)))
    372   ;; (finalize-class-name )
     408  (setf (class-file-class-name class)
     409        (pool-add-class (class-name-internal (class-file-class-name class))))
    373410  ;;  (finalize-interfaces)
    374411  (dolist (field (class-file-fields class))
     
    427464       (write-u4 (constant-float/int-value entry) stream))
    428465      ((5 6) ; long double
    429        (write-u4 (second entry) stream)
    430        (write-u4 (third entry) stream))
    431       ((9 10 11 12) ; fieldref methodref InterfaceMethodref nameAndType
    432        (write-u2 (second entry) stream)
    433        (write-u2 (third entry) stream))
    434       ((7 8) ; class string
     466       (write-u4 (logand (ash (constant-double/long-value entry) -32)
     467                         #xFFFFffff) stream)
     468       (write-u4 (logand (constant-double/long-value entry) #xFFFFffff) stream))
     469      ((9 10 11) ; fieldref methodref InterfaceMethodref
     470       (write-u2 (constant-member-ref-class-index entry) stream)
     471       (write-u2 (constant-member-ref-name/type-index entry) stream))
     472      (12 ; nameAndType
     473       (write-u2 (constant-name/type-name-index entry) stream)
     474       (write-u2 (constant-name/type-descriptor-index entry) stream))
     475      (7  ; class
    435476       (write-u2 (constant-class-name-index entry) stream))
     477      (8  ; string
     478       (write-u2 (constant-string-value-index entry) stream))
    436479      (t
    437480       (error "write-constant-pool-entry unhandled tag ~D~%" tag))))))
     
    518561    (t name)))
    519562
    520 (defun !make-method-descriptor (name return &rest args)
    521   (apply #'concatenate (append (list 'string (map-method-name name) "(")
    522                                (mapcar #'map-primitive-type args)
    523                                (list ")" return))))
    524 
    525563(defun !make-method (name return args &key (flags '(:public)))
    526   (setf name (map-method-name name))
    527   (%make-method :descriptor (apply #'make-method-descriptor
    528                                    name return args)
     564  (%make-method :descriptor (cons return args)
    529565                :access-flags flags
    530566                :name name
Note: See TracChangeset for help on using the changeset viewer.