Changeset 12776


Ignore:
Timestamp:
07/03/10 20:35:42 (12 years ago)
Author:
ehuelsmann
Message:

More pool functions.

File:
1 edited

Legend:

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

    r12772 r12776  
    169169
    170170(defstruct pool
    171   (count 1)  ;; "A constant pool entry is considered valid if it has
    172              ;; an index greater than 0 (zero) and less than pool-count"
     171  ;; `count' contains a reference to the last-used slot (0 being empty)
     172  ;; "A constant pool entry is considered valid if it has
     173  ;; an index greater than 0 (zero) and less than pool-count"
     174  (count 0)
    173175  entries-list
    174176  ;; the entries hash stores raw values, except in case of string and
     
    273275            (gethash (cons 8 string) (pool-entries pool)) entry)
    274276      (push entry (pool-entries-list pool)))
     277    (constant-index entry)))
     278
     279(defun pool-add-int (pool int)
     280  (let ((entry (gethash (cons 3 int) (pool-entries pool))))
     281    (unless entry
     282      (setf entry (make-constant-int (incf (pool-count pool)) int)
     283            (gethash (cons 3 int) (pool-entries pool)) entry)
     284      (push entry (pool-entries-list pool)))
     285    (constant-index entry)))
     286
     287(defun pool-add-float (pool float)
     288  (let ((entry (gethash (cons 4 float) (pool-entries pool))))
     289    (unless entry
     290      (setf entry (make-constant-float (incf (pool-count pool)) float)
     291            (gethash (cons 4 float) (pool-entries pool)) entry)
     292      (push entry (pool-entries-list pool)))
     293    (constant-index entry)))
     294
     295(defun pool-add-long (pool long)
     296  (let ((entry (gethash (cons 5 long) (pool-entries pool))))
     297    (unless entry
     298      (setf entry (make-constant-long (incf (pool-count pool)) long)
     299            (gethash (cons 5 long) (pool-entries pool)) entry)
     300      (push entry (pool-entries-list pool))
     301      (incf (pool-count pool))) ;; double index increase; long takes 2 slots
     302    (constant-index entry)))
     303
     304(defun pool-add-double (pool double)
     305  (let ((entry (gethash (cons 6 double) (pool-entries pool))))
     306    (unless entry
     307      (setf entry (make-constant-double (incf (pool-count pool)) double)
     308            (gethash (cons 6 double) (pool-entries pool)) entry)
     309      (push entry (pool-entries-list pool))
     310      (incf (pool-count pool))) ;; double index increase; 'double' takes 2 slots
    275311    (constant-index entry)))
    276312
Note: See TracChangeset for help on using the changeset viewer.