Ignore:
Timestamp:
10/18/10 18:03:40 (11 years ago)
Author:
astalla
Message:

[invokedynamic branch] Save current state of affairs before revolutionizing it.

File:
1 edited

Legend:

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

    r12953 r12980  
    944944  code)
    945945
    946 
    947 
    948 
    949 (defun code-bytes (code)
    950   (let ((length 0)
    951         labels ;; alist
    952         )
    953     (declare (type (unsigned-byte 16) length))
    954     ;; Pass 1: calculate label offsets and overall length.
    955     (dotimes (i (length code))
    956       (declare (type (unsigned-byte 16) i))
    957       (let* ((instruction (aref code i))
    958              (opcode (instruction-opcode instruction)))
    959         (if (= opcode 202) ; LABEL
    960             (let ((label (car (instruction-args instruction))))
    961               (set label length)
    962               (setf labels
    963                     (acons label length labels)))
    964             (incf length (opcode-size opcode)))))
    965     ;; Pass 2: replace labels with calculated offsets.
    966     (let ((index 0))
    967       (declare (type (unsigned-byte 16) index))
    968       (dotimes (i (length code))
    969         (declare (type (unsigned-byte 16) i))
    970         (let ((instruction (aref code i)))
    971           (when (branch-p (instruction-opcode instruction))
    972             (let* ((label (car (instruction-args instruction)))
    973                    (offset (- (the (unsigned-byte 16)
    974                                 (symbol-value (the symbol label)))
    975                               index)))
    976               (setf (instruction-args instruction) (s2 offset))))
    977           (unless (= (instruction-opcode instruction) 202) ; LABEL
    978             (incf index (opcode-size (instruction-opcode instruction)))))))
    979     ;; Expand instructions into bytes, skipping LABEL pseudo-instructions.
    980     (let ((bytes (make-array length))
    981           (index 0))
    982       (declare (type (unsigned-byte 16) index))
    983       (dotimes (i (length code))
    984         (declare (type (unsigned-byte 16) i))
    985         (let ((instruction (aref code i)))
    986           (unless (= (instruction-opcode instruction) 202) ; LABEL
    987             (setf (svref bytes index) (instruction-opcode instruction))
    988             (incf index)
    989             (dolist (arg (instruction-args instruction))
    990               (setf (svref bytes index)
    991         (if (constant-p arg) (constant-index arg) arg))
    992               (incf index)))))
    993       (values bytes labels))))
    994 
    995946(defun finalize-code (code handler-labels optimize)
    996947  (setf code (coerce (nreverse code) 'vector))
     
    999950  (resolve-instructions (expand-virtual-instructions code)))
    1000951
     952;;Opcode effects on locals & stack - for computing the stack map table
     953
    1001954(provide '#:opcodes)
Note: See TracChangeset for help on using the changeset viewer.