Changeset 12769


Ignore:
Timestamp:
06/27/10 19:48:41 (11 years ago)
Author:
ehuelsmann
Message:

README.BRANCH update, pool-management and method finalization.

Location:
branches/generic-class-file/abcl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/generic-class-file/abcl/README.BRANCH

    r12767 r12769  
    3939======
    4040
     41The code uses structures and structure inclusion for the class file and
     42class file attributes. Each attribute type has an associated specific
     43finalizer and writer function. This should allow for future ease of
     44extension.
    4145
     46There are three phases in the design. Read about that in the file itself.
     47
     48Structure inclusion is used as a means of single inheritance.
    4249
    4350
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

    • Property svn:eol-style set to native
    • Property svn:keywords set to Id
    r12767 r12769  
    22;;;
    33;;; Copyright (C) 2010 Erik Huelsmann
    4 ;;; $Id: compiler-pass2.lisp 12311 2009-12-28 23:11:35Z ehuelsmann $
     4;;; $Id$
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    6060(defun map-primitive-type (type)
    6161  (case type
    62     (:int      "I")
    63     (:long     "J")
    64     (:float    "F")
    65     (:double   "D")
    66     (:boolean  "Z")
    67     (:char     "C")
    68     (:byte     "B")
    69     (:short    "S")
    70     (:void    "V")))
     62    (:int        "I")
     63    (:long       "J")
     64    (:float      "F")
     65    (:double     "D")
     66    (:boolean    "Z")
     67    (:char       "C")
     68    (:byte       "B")
     69    (:short      "S")
     70    ((nil :void) "V")))
    7171
    7272
     
    139139
    140140
    141 (defun descriptor (method-name return-type &rest argument-types)
    142   (format nil "~A(~{~A~}~A)" method-name
    143           (mapcar #'(lambda (arg-type)
    144                       (if (keywordp arg-type)
    145                           (map-primitive-type arg-type)
    146                           (class-ref arg-type)))
    147                   argument-types)
    148           (if (keywordp return-type)
    149               (map-primitive-type return-type)
    150               (class-name-internal return-type))))
    151 
    152 
    153 
     141(defun internal-field-type (field-type)
     142  (if (keywordp field-type)
     143      (map-primitive-type field-type)
     144      (class-name-internal field-type)))
     145
     146(defun internal-field-ref (field-type)
     147  (if (keywordp field-type)
     148      (map-primitive-type field-type)
     149      (class-ref field-type)))
     150
     151(defun descriptor (return-type &rest argument-types)
     152  (format nil "(~{~A~}~A)" (mapcar #'internal-field-ref argument-types)
     153          (internal-field-type return-type)))
    154154
    155155
    156156(defstruct pool
    157   (count 1)  ;; ####  why count 1???
     157  (count 1)  ;; "A constant pool entry is considered valid if it has
     158             ;; an index greater than 0 (zero) and less than pool-count"
    158159  entries-list
     160  ;; the entries hash stores raw values, except in case of string and
     161  ;; utf8, because both are string values
    159162  (entries (make-hash-table :test #'equal :size 2048 :rehash-size 2.0)))
    160163
     
    184187  name/type)
    185188
    186 (defstruct (constant-string (:constructor make-constant-string (value-index))
     189(defstruct (constant-string (:constructor make-constant-string
     190                                          (index value-index))
    187191                            (:include constant
    188192                                      (tag 8)))
     
    199203  descriptor-index)
    200204
    201 (defstruct (constant-utf8 (:include constant))
     205(defstruct (constant-utf8 (:constructor make-constant-utf8 (index value))
     206                          (:include constant
     207                                    (tag 11)))
    202208  value)
    203209
    204210
    205 ;; Need to add pool/constant creation addition routines here;
    206 ;; all routines have 2 branches: return existing or push new.
    207 
    208211(defun pool-add-string (pool string)
    209   (let ((entry (gethash (pool-entries string))))
     212  (let ((entry (gethash (cons 8 string) ;; 8 == string-tag
     213                        (pool-entries pool))))
    210214    (unless entry
    211       (setf entry (make-constant-string (pool-count pool) string))
    212       (push entry (pool-entries-list pool))
    213       (incf (pool-count pool)))
     215      (setf entry (make-constant-string (pool-add-utf8 pool string))
     216            (gethash (cons 8 string) (pool-entries pool)) entry)
     217      (incf (pool-count pool))
     218      (push entry (pool-entries-list pool)))
    214219    (constant-index entry)))
    215220
    216 
     221(defun pool-add-utf8 (pool utf8-as-string)
     222  (let ((entry (gethash (cons 11 utf8-as-string) ;; 11 == utf8
     223                        (pool-entries pool))))
     224    (unless entry
     225      (setf entry (make-constant-utf8 (pool-count pool) utf8-as-string)
     226            (gethash (cons 11 utf8-as-string) (pool-entries pool)) entry)
     227      (incf (pool-count pool))
     228      (push entry (pool-entries-list pool)))
     229    (constant-index entry)))
    217230
    218231(defstruct (class-file (:constructor %make-class-file))
     
    417430
    418431(defun finalize-method (method class)
    419   (declare (ignore method class))
    420   (error "Not implemented"))
     432  (setf (method-access-flags method)
     433        (map-flags (method-access-flags method))
     434        (method-descriptor method)
     435        (pool-add-utf8 (apply #'descriptor (method-descriptor method)))
     436        (method-name method)
     437        (pool-add-utf8 (map-method-name (method-name method))))
     438  (finalize-attributes attributes nil class))
    421439
    422440
Note: See TracChangeset for help on using the changeset viewer.