Changeset 12785


Ignore:
Timestamp:
07/04/10 21:31:17 (12 years ago)
Author:
ehuelsmann
Message:

Documentation.

File:
1 edited

Legend:

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

    r12783 r12785  
    5959
    6060(defun map-primitive-type (type)
     61  "Maps a symbolic primitive type name to its Java string representation."
    6162  (case type
    6263    (:int        "I")
     
    8788
    8889(defun make-class-name (name)
     90  "Creates a `class-name' structure for the class or interface `name'.
     91
     92`name' should be specified using Java representation, which is converted
     93to 'internal' (JVM) representation by this function."
    8994  (setf name (substitute #\/ #\. name))
    9095  (%make-class-name :name-internal name
     
    9398
    9499(defmacro define-class-name (symbol java-dotted-name &optional documentation)
     100  "Convenience macro to define constants for `class-name' structures,
     101initialized from the `java-dotted-name'."
    95102  `(defconstant ,symbol (make-class-name ,java-dotted-name)
    96103     ,documentation))
     
    154161
    155162(defun internal-field-type (field-type)
     163  "Returns a string containing the JVM-internal representation
     164of `field-type', which should either be a symbol identifying a primitive
     165type, or a `class-name' structure identifying a class or interface."
    156166  (if (symbolp field-type)
    157167      (map-primitive-type field-type)
     
    159169
    160170(defun internal-field-ref (field-type)
     171  "Returns a string containing the JVM-internal representation of a reference
     172to `field-type', which should either be a symbol identifying a primitive
     173type, or a `class-name' structure identifying a class or interface."
    161174  (if (symbolp field-type)
    162175      (map-primitive-type field-type)
     
    164177
    165178(defun descriptor (return-type &rest argument-types)
     179  "Returns a string describing the `return-type' and `argument-types'
     180in JVM-internal representation."
    166181  (format nil "(~{~A~})~A" (mapcar #'internal-field-ref argument-types)
    167182          (internal-field-type return-type)))
     
    178193  (entries (make-hash-table :test #'equal :size 2048 :rehash-size 2.0)))
    179194
     195
    180196(defstruct constant
     197  "Structure to be included in all constant sub-types."
    181198  tag
    182199  index)
     
    210227                 make-constant-interface-method-ref))
    211228(defun make-constant-field-ref (index class-index name/type-index)
     229  "Creates a `constant-member-ref' instance containing a field reference."
    212230  (%make-constant-member-ref 9 index class-index name/type-index))
    213231
    214232(defun make-constant-method-ref (index class-index name/type-index)
     233  "Creates a `constant-member-ref' instance containing a method reference."
    215234  (%make-constant-member-ref 10 index class-index name/type-index))
    216235
    217236(defun make-constant-interface-method-ref (index class-index name/type-index)
     237  "Creates a `constant-member-ref' instance containing an
     238interface-method reference."
    218239  (%make-constant-member-ref 11 index class-index name/type-index))
    219240
     
    222243                            (:include constant
    223244                                      (tag 8)))
    224   value-index) ;;; #### is this the value or the value index???
     245  value-index)
    225246
    226247(defstruct (constant-float/int (:constructor
     
    231252(declaim (inline make-constant-float make-constant-int))
    232253(defun make-constant-float (index value)
     254  "Creates a `constant-float/int' structure instance containing a float."
    233255  (%make-constant-float/int 4 index value))
    234256
    235257(defun make-constant-int (index value)
     258  "Creates a `constant-float/int' structure instance containing an int."
    236259  (%make-constant-float/int 3 index value))
    237260
     
    243266(declaim (inline make-constant-double make-constant-float))
    244267(defun make-constant-double (index value)
     268  "Creates a `constant-double/long' structure instance containing a double."
    245269  (%make-constant-double/long 6 index value))
    246270
    247271(defun make-constant-long (index value)
     272  "Creates a `constant-double/long' structure instance containing a long."
    248273  (%make-constant-double/long 5 index value))
    249274
     
    264289
    265290(defun pool-add-class (pool class)
    266   ;; ### do we make class a string or class-name structure?
     291  "Returns the index of the constant-pool class item for `class'.
     292
     293`class' must be an instance of `class-name'."
    267294  (let ((entry (gethash class (pool-entries pool))))
    268295    (unless entry
     
    276303
    277304(defun pool-add-field-ref (pool class name type)
     305  "Returns the index of the constant-pool item which denotes a reference
     306to the `name' field of the `class', being of `type'.
     307
     308`class' should be an instance of `class-name'.
     309`name' is a string.
     310`type' is a field-type (see `internal-field-type')"
    278311  (let ((entry (gethash (acons name type class) (pool-entries pool))))
    279312    (unless entry
     
    286319
    287320(defun pool-add-method-ref (pool class name type)
     321  "Returns the index of the constant-pool item which denotes a reference
     322to the method with `name' in `class', which is of `type'.
     323
     324Here, `type' is a method descriptor, which defines the argument types
     325and return type. `class' is an instance of `class-name'."
    288326  (let ((entry (gethash (acons name type class) (pool-entries pool))))
    289327    (unless entry
     
    296334
    297335(defun pool-add-interface-method-ref (pool class name type)
     336  "Returns the index of the constant-pool item which denotes a reference to
     337the method `name' in the interface `class', which is of `type'.
     338
     339See `pool-add-method-ref' for remarks."
    298340  (let ((entry (gethash (acons name type class) (pool-entries pool))))
    299341    (unless entry
     
    308350
    309351(defun pool-add-string (pool string)
     352  "Returns the index of the constant-pool item denoting the string."
    310353  (let ((entry (gethash (cons 8 string) ;; 8 == string-tag
    311354                        (pool-entries pool))))
     
    318361
    319362(defun pool-add-int (pool int)
     363  "Returns the index of the constant-pool item denoting the int."
    320364  (let ((entry (gethash (cons 3 int) (pool-entries pool))))
    321365    (unless entry
     
    326370
    327371(defun pool-add-float (pool float)
     372  "Returns the index of the constant-pool item denoting the float."
    328373  (let ((entry (gethash (cons 4 float) (pool-entries pool))))
    329374    (unless entry
     
    334379
    335380(defun pool-add-long (pool long)
     381  "Returns the index of the constant-pool item denoting the long."
    336382  (let ((entry (gethash (cons 5 long) (pool-entries pool))))
    337383    (unless entry
     
    343389
    344390(defun pool-add-double (pool double)
     391  "Returns the index of the constant-pool item denoting the double."
    345392  (let ((entry (gethash (cons 6 double) (pool-entries pool))))
    346393    (unless entry
     
    352399
    353400(defun pool-add-name/type (pool name type)
     401  "Returns the index of the constant-pool item denoting
     402the name/type identifier."
    354403  (let ((entry (gethash (cons name type) (pool-entries pool)))
    355404        (internal-type (if (listp type)
     
    365414
    366415(defun pool-add-utf8 (pool utf8-as-string)
     416  "Returns the index of the textual value that will be stored in the
     417class file as UTF-8 encoded data."
    367418  (let ((entry (gethash (cons 11 utf8-as-string) ;; 11 == utf8
    368419                        (pool-entries pool))))
     
    385436
    386437(defun class-add-field (class field)
     438  "Adds a `field' created by `make-field'."
    387439  (push field (class-file-fields class)))
    388440
    389441(defun class-field (class name)
     442  "Finds a field by name." ;; ### strictly speaking, a field is uniquely
     443  ;; identified by its name and type, not by the name alone.
    390444  (find name (class-file-fields class)
    391445        :test #'string= :key #'field-name))
    392446
    393447(defun class-add-method (class method)
     448  "Adds a `method' to `class'; the method must have been created using
     449`make-method'."
    394450  (push method (class-file-methods class)))
    395451
    396452(defun class-methods-by-name (class name)
     453  "Returns all methods which have `name'."
    397454  (remove name (class-file-methods class)
    398455          :test-not #'string= :key #'method-name))
    399456
    400457(defun class-method (class name return &rest args)
     458  "Return the method which is (uniquely) identified by its name AND descriptor."
    401459  (let ((return-and-args (cons return args)))
    402460    (find-if #'(lambda (c)
     
    406464
    407465(defun class-add-attribute (class attribute)
     466  "Adds `attribute' to the class; attributes must be instances of
     467structure classes which include the `attribute' structure class."
    408468  (push attribute (class-file-attributes class)))
    409469
    410470(defun class-attribute (class name)
     471  "Returns the attribute which is named `name'."
    411472  (find name (class-file-attributes class)
    412473        :test #'string= :key #'attribute-name))
     
    414475
    415476(defun finalize-class-file (class)
    416 
     477  "Transforms the representation of the class-file from one
     478which allows easy modification to one which works best for serialization.
     479
     480The class can't be modified after serialization."
    417481  ;; constant pool contains constants finalized on addition;
    418482  ;; no need for additional finalization
     
    429493    (finalize-method method class))
    430494  ;; top-level attributes (no parent attributes to refer to)
    431   (finalize-attributes (class-file-attributes class) nil class)
    432 
    433 )
     495  (finalize-attributes (class-file-attributes class) nil class))
    434496
    435497(defun !write-class-file (class stream)
    436   ;; all components need to finalize themselves:
    437   ;;  the constant pool needs to be complete before we start
    438   ;;  writing our output.
     498  "Serializes `class' to `stream', after it has been finalized."
    439499
    440500  ;; header
     
    474534    (write-u1 tag stream)
    475535    (case tag
    476       (1 ; UTF8
     536      (1         ; UTF8
    477537       (write-utf8 (constant-utf8-value entry) stream))
    478       ((3 4) ; int
     538      ((3 4)     ; int
    479539       (write-u4 (constant-float/int-value entry) stream))
    480       ((5 6) ; long double
     540      ((5 6)     ; long double
    481541       (write-u4 (logand (ash (constant-double/long-value entry) -32)
    482542                         #xFFFFffff) stream)
     
    485545       (write-u2 (constant-member-ref-class-index entry) stream)
    486546       (write-u2 (constant-member-ref-name/type-index entry) stream))
    487       (12 ; nameAndType
     547      (12        ; nameAndType
    488548       (write-u2 (constant-name/type-name-index entry) stream)
    489549       (write-u2 (constant-name/type-descriptor-index entry) stream))
    490       (7  ; class
     550      (7         ; class
    491551       (write-u2 (constant-class-name-index entry) stream))
    492       (8  ; string
     552      (8         ; string
    493553       (write-u2 (constant-string-value-index entry) stream))
    494554      (t
     
    518578
    519579(defun map-flags (flags)
     580  "Calculates the bitmap of the flags from a list of symbols."
    520581  (reduce #'(lambda (y x)
    521582              (logior (or (when (member (car x) flags)
     
    529590  name
    530591  descriptor
    531   attributes
    532   )
     592  attributes)
    533593
    534594(defun make-field (name type &key (flags '(:public)))
     
    565625  name
    566626  descriptor
    567   attributes
    568   )
     627  attributes)
    569628
    570629
    571630(defun map-method-name (name)
     631  "Methods should be identified by strings containing their names, or,
     632be one of two keyword identifiers to identify special methods:
     633
     634 * :class-constructor
     635 * :constructor
     636"
    572637  (cond
    573638    ((eq name :class-constructor)
Note: See TracChangeset for help on using the changeset viewer.