Changeset 12993


Ignore:
Timestamp:
11/01/10 22:45:00 (11 years ago)
Author:
astalla
Message:

[invokedynamic] Stack map table written to class (sample); errors.

File:
1 edited

Legend:

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

    r12984 r12993  
    10181018            (code-labels code) labels)
    10191019      (when compute-stack-map-table-p
    1020   #+todo (code-add-attribute code stack-map-table))))
     1020  (code-add-attribute
     1021   code
     1022   (make-stack-map-table-attribute :entries stack-map-table)))))
    10211023
    10221024  (setf (code-exception-handlers code)
     
    10951097(defun resolve-code (code-attr code class method compute-stack-map-table-p)
    10961098  "Walks the code, replacing symbolic labels with numeric offsets, and optionally computing the stack map table."
    1097   (declare (ignore class))
    10981099  (let* ((length 0)
    10991100   labels ;; alist
     
    11241125      (progn
    11251126        (when (= opcode 202) ;;label: simulate a jump
    1126     (record-jump-to-label (car (instruction-args instruction))))
     1127    (record-jump-to-label (first (instruction-args instruction))))
    11271128        (simulate-instruction-effect instruction)
    11281129        ;;Simulation must be stopped if we encounter a goto, it will be
     
    11401141                    (acons label length labels)))
    11411142      (incf length (opcode-size opcode)))))
    1142     ;; Pass 2: replace labels with calculated offsets.
     1143    ;;Pass 2 (optional): compute the stack map table
     1144    (when compute-stack-map-table-p
     1145      (let ((last-frame-offset 0)
     1146      (must-emit-frame nil))
     1147  (dotimes (i (length code))
     1148    (let ((instruction (aref code i))
     1149    (make-variable-info (lambda (type)
     1150              (smf-type->variable-info type class))))
     1151      (cond
     1152        ((= (instruction-opcode instruction) 202) ; LABEL
     1153         (let* ((label (car (instruction-args instruction)))
     1154          (offset (symbol-value label))
     1155          (*print-circle* t))
     1156     (if (get label 'jump-target-p)
     1157         (let ((frame
     1158          (make-stack-map-full-frame
     1159           :offset-delta (- offset last-frame-offset)
     1160           :locals
     1161           (mapcar make-variable-info
     1162             (instruction-input-locals instruction))
     1163           :stack-items
     1164           (mapcar make-variable-info
     1165             (instruction-input-stack instruction)))))
     1166           (push frame stack-map-table)
     1167           (sys::%format t "emit frame ~S @ ~A (~A)~%"
     1168             frame offset (- offset last-frame-offset))
     1169           (setf last-frame-offset offset))
     1170         (sys::%format t "error - label not target of a jump: ~S~%" label))
     1171     )))))))
     1172    ;;Pass 3: replace labels with calculated offsets.
    11431173    (let ((index 0))
    11441174      (declare (type (unsigned-byte 16) index))
     
    11511181                                (symbol-value (the symbol label)))
    11521182                              index)))
    1153         (unless (get label 'jump-target-p)
    1154     (sys::%format "error - label not target of a jump ~S~%" label))
    11551183              (setf (instruction-args instruction) (s2 offset))))
    11561184          (unless (= (instruction-opcode instruction) 202) ; LABEL
    11571185            (incf index (opcode-size (instruction-opcode instruction)))))))
    1158     ;; Expand instructions into bytes, skipping LABEL pseudo-instructions.
     1186    ;;Pass 4: expand instructions into bytes,
     1187    ;;skipping LABEL pseudo-instructions.
    11591188    (let ((bytes (make-array length))
    11601189          (index 0))
     
    11701199      (let ((idx (constant-index arg))
    11711200      (opcode (instruction-opcode instruction)))
    1172         ;;(sys::%format t "constant ~A ~A index-size ~A index ~A~%" (type-of arg) idx (constant-index-size arg) index)
    11731201        (if (or (<= 178 opcode 187)
    11741202          (= opcode 189)
     
    11851213        (setf (svref bytes index) arg)
    11861214        (incf index)))))))
    1187       (sys::%format t "~%~%~%BYTES ~S~%~%~%" bytes)
    1188       (values bytes labels stack-map-table))))
     1215      (values bytes labels (nreverse stack-map-table)))))
    11891216
    11901217(defun unconditional-jump-p (opcode)
     
    14021429  entries)
    14031430
    1404 (defun add-stack-map-frame (stack-map-table instruction-offset locals
    1405           stack-items)
    1406   (error "TODO!"))
    1407 
    14081431(defun finalize-stack-map-table-attribute (table parent class)
    14091432  "Prepares the `stack-map-table' attribute for serialization, within method `parent': replaces all virtual types in the stack map frames with variable-info objects."
     
    14141437  (write-u2 (length (stack-map-table-entries table)) stream)
    14151438  (dolist (frame (stack-map-table-entries table))
    1416     (funcall (frame-writer frame) stream)))
     1439    (funcall (frame-writer frame) frame stream)))
    14171440
    14181441(defstruct (stack-map-frame (:conc-name frame-))
     
    14301453  (write-u1 255 stream)
    14311454  (write-u2 (frame-offset-delta frame) stream)
     1455;;  (write-u2 0 stream)
     1456;;  (write-u2 0 stream)
     1457;;  (return-from write-stack-map-full-frame)
    14321458  (write-u2 (length (full-frame-locals frame)) stream)
    14331459  (dolist (local (full-frame-locals frame))
     
    14571483(defun write-simple-verification-type-info (vti stream)
    14581484  (write-u1 (verification-type-info-tag vti) stream))
    1459 (defun write-object-variable-type-info (vti stream)
     1485(defun write-object-variable-info (vti stream)
    14601486  (write-u1 (verification-type-info-tag vti) stream)
    14611487  (write-u2 (object-variable-info-constant-pool-index vti) stream))
    1462 (defun write-uninitialized-verification-type-info (vti stream)
     1488(defun write-uninitialized-variable-info (vti stream)
    14631489  (write-u1 (verification-type-info-tag vti) stream)
    14641490  (write-u2 (uninitialized-variable-info-offset vti) stream))
     
    14761502    (nreverse locals)))
    14771503
    1478 (defun smf-type->variable-info (type)
    1479   :todo)
     1504(defun smf-type->variable-info (type class)
     1505  (cond
     1506    ((eq type :this)
     1507     (make-object-variable-info :constant-pool-index (class-file-class class)))
     1508    ((eq type :int) (make-integer-variable-info))
     1509    ((typep type 'constant-class)
     1510     (make-object-variable-info :constant-pool-index (constant-index type)))
     1511    ((typep type 'class-name)
     1512     (make-object-variable-info
     1513      :constant-pool-index
     1514      (constant-index (pool-add-class (class-file-constants class) type))))
     1515    (t (sys::%format t "Don't know how to translate type ~S~%" type) type)))
    14801516
    14811517#|
Note: See TracChangeset for help on using the changeset viewer.