Ignore:
Timestamp:
10/25/10 22:17:28 (12 years ago)
Author:
astalla
Message:

[invokedynamic]

  • instructions simulate their effect on the stack and locals (adapted from ASM, with limitations)
  • p2 uses with-code-to-method instead of *static-code* to generate <init> and <clinit> (bugged)
  • in general, functions that add constants to the pool have been changed to return the constant's struct rather than its index. However I haven't thorougly changed them all, only more or less the ones I needed.
  • and other changes to keep all the above stuff together.

Compilation is still broken: the superclass is set too late.

File:
1 edited

Legend:

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

    r12980 r12983  
    3232(in-package #:jvm)
    3333
    34 
    3534;;    OPCODES
    3635
     
    3938(defconst *opcodes* (make-hash-table :test 'equalp))
    4039
    41 (defstruct jvm-opcode name number size stack-effect)
    42 
    43 (defun %define-opcode (name number size stack-effect)
     40(defstruct jvm-opcode name number size stack-effect effect-function)
     41
     42(defun %define-opcode (name number size stack-effect effect-function)
    4443  (declare (type fixnum number size))
    4544  (let* ((name (string name))
     
    4746                                  :number number
    4847                                  :size size
    49                                   :stack-effect stack-effect)))
     48                                  :stack-effect stack-effect
     49          :effect-function effect-function)))
    5050     (setf (svref *opcode-table* number) opcode)
    5151     (setf (gethash name *opcodes*) opcode)
    5252     (setf (gethash number *opcodes*) opcode)))
    5353
    54 (defmacro define-opcode (name number size stack-effect)
    55   `(%define-opcode ',name ,number ,size ,stack-effect))
     54(defmacro define-opcode (name number size stack-effect &body body)
     55  `(%define-opcode ',name ,number ,size ,stack-effect
     56       ,(if (and (symbolp (car body)) (null (cdr body)))
     57      (if (null (car body))
     58          #'identity
     59          `(function ,(car body)))
     60      `(lambda (instruction)
     61         (declare (ignorable instruction))
     62         ,@body))))
    5663
    5764;; name number size stack-effect (nil if unknown)
    5865(define-opcode nop 0 1 0)
    59 (define-opcode aconst_null 1 1 1)
    60 (define-opcode iconst_m1 2 1 1)
    61 (define-opcode iconst_0 3 1 1)
    62 (define-opcode iconst_1 4 1 1)
    63 (define-opcode iconst_2 5 1 1)
    64 (define-opcode iconst_3 6 1 1)
    65 (define-opcode iconst_4 7 1 1)
    66 (define-opcode iconst_5 8 1 1)
    67 (define-opcode lconst_0 9 1 2)
    68 (define-opcode lconst_1 10 1 2)
    69 (define-opcode fconst_0 11 1 1)
    70 (define-opcode fconst_1 12 1 1)
    71 (define-opcode fconst_2 13 1 1)
    72 (define-opcode dconst_0 14 1 2)
    73 (define-opcode dconst_1 15 1 2)
    74 (define-opcode bipush 16 2 1)
    75 (define-opcode sipush 17 3 1)
    76 (define-opcode ldc 18 2 1)
    77 (define-opcode ldc_w 19 3 1)
    78 (define-opcode ldc2_w 20 3 2)
    79 (define-opcode iload 21 2 1)
    80 (define-opcode lload 22 2 2)
    81 (define-opcode fload 23 2 nil)
    82 (define-opcode dload 24 2 nil)
    83 (define-opcode aload 25 2 1)
    84 (define-opcode iload_0 26 1 1)
    85 (define-opcode iload_1 27 1 1)
    86 (define-opcode iload_2 28 1 1)
    87 (define-opcode iload_3 29 1 1)
    88 (define-opcode lload_0 30 1 2)
    89 (define-opcode lload_1 31 1 2)
    90 (define-opcode lload_2 32 1 2)
    91 (define-opcode lload_3 33 1 2)
    92 (define-opcode fload_0 34 1 nil)
    93 (define-opcode fload_1 35 1 nil)
    94 (define-opcode fload_2 36 1 nil)
    95 (define-opcode fload_3 37 1 nil)
    96 (define-opcode dload_0 38 1 nil)
    97 (define-opcode dload_1 39 1 nil)
    98 (define-opcode dload_2 40 1 nil)
    99 (define-opcode dload_3 41 1 nil)
    100 (define-opcode aload_0 42 1 1)
    101 (define-opcode aload_1 43 1 1)
    102 (define-opcode aload_2 44 1 1)
    103 (define-opcode aload_3 45 1 1)
    104 (define-opcode iaload 46 1 -1)
    105 (define-opcode laload 47 1 0)
    106 (define-opcode faload 48 1 -1)
    107 (define-opcode daload 49 1 0)
    108 (define-opcode aaload 50 1 -1)
    109 (define-opcode baload 51 1 nil)
    110 (define-opcode caload 52 1 nil)
    111 (define-opcode saload 53 1 nil)
    112 (define-opcode istore 54 2 -1)
    113 (define-opcode lstore 55 2 -2)
    114 (define-opcode fstore 56 2 nil)
    115 (define-opcode dstore 57 2 nil)
    116 (define-opcode astore 58 2 -1)
    117 (define-opcode istore_0 59 1 -1)
    118 (define-opcode istore_1 60 1 -1)
    119 (define-opcode istore_2 61 1 -1)
    120 (define-opcode istore_3 62 1 -1)
    121 (define-opcode lstore_0 63 1 -2)
    122 (define-opcode lstore_1 64 1 -2)
    123 (define-opcode lstore_2 65 1 -2)
    124 (define-opcode lstore_3 66 1 -2)
    125 (define-opcode fstore_0 67 1 nil)
    126 (define-opcode fstore_1 68 1 nil)
    127 (define-opcode fstore_2 69 1 nil)
    128 (define-opcode fstore_3 70 1 nil)
    129 (define-opcode dstore_0 71 1 nil)
    130 (define-opcode dstore_1 72 1 nil)
    131 (define-opcode dstore_2 73 1 nil)
    132 (define-opcode dstore_3 74 1 nil)
    133 (define-opcode astore_0 75 1 -1)
    134 (define-opcode astore_1 76 1 -1)
    135 (define-opcode astore_2 77 1 -1)
    136 (define-opcode astore_3 78 1 -1)
    137 (define-opcode iastore 79 1 -3)
    138 (define-opcode lastore 80 1 -4)
    139 (define-opcode fastore 81 1 -3)
    140 (define-opcode dastore 82 1 -4)
    141 (define-opcode aastore 83 1 -3)
    142 (define-opcode bastore 84 1 nil)
    143 (define-opcode castore 85 1 nil)
    144 (define-opcode sastore 86 1 nil)
    145 (define-opcode pop 87 1 -1)
    146 (define-opcode pop2 88 1 -2)
    147 (define-opcode dup 89 1 1)
    148 (define-opcode dup_x1 90 1 1)
    149 (define-opcode dup_x2 91 1 1)
    150 (define-opcode dup2 92 1 2)
    151 (define-opcode dup2_x1 93 1 2)
    152 (define-opcode dup2_x2 94 1 2)
    153 (define-opcode swap 95 1 0)
    154 (define-opcode iadd 96 1 -1)
    155 (define-opcode ladd 97 1 -2)
    156 (define-opcode fadd 98 1 -1)
    157 (define-opcode dadd 99 1 -2)
    158 (define-opcode isub 100 1 -1)
    159 (define-opcode lsub 101 1 -2)
    160 (define-opcode fsub 102 1 -1)
    161 (define-opcode dsub 103 1 -2)
    162 (define-opcode imul 104 1 -1)
    163 (define-opcode lmul 105 1 -2)
    164 (define-opcode fmul 106 1 -1)
    165 (define-opcode dmul 107 1 -2)
    166 (define-opcode idiv 108 1 nil)
    167 (define-opcode ldiv 109 1 nil)
    168 (define-opcode fdiv 110 1 nil)
    169 (define-opcode ddiv 111 1 nil)
    170 (define-opcode irem 112 1 nil)
    171 (define-opcode lrem 113 1 nil)
    172 (define-opcode frem 114 1 nil)
    173 (define-opcode drem 115 1 nil)
     66(define-opcode aconst_null 1 1 1 (smf-push :null))
     67(define-opcode iconst_m1 2 1 1 (smf-push :int))
     68(define-opcode iconst_0 3 1 1 (smf-push :int))
     69(define-opcode iconst_1 4 1 1 (smf-push :int))
     70(define-opcode iconst_2 5 1 1 (smf-push :int))
     71(define-opcode iconst_3 6 1 1 (smf-push :int))
     72(define-opcode iconst_4 7 1 1 (smf-push :int))
     73(define-opcode iconst_5 8 1 1 (smf-push :int))
     74(define-opcode lconst_0 9 1 2 (smf-push :long))
     75(define-opcode lconst_1 10 1 2 (smf-push :long))
     76(define-opcode fconst_0 11 1 1 (smf-push :float))
     77(define-opcode fconst_1 12 1 1 (smf-push :float))
     78(define-opcode fconst_2 13 1 1 (smf-push :float))
     79(define-opcode dconst_0 14 1 2 (smf-push :double))
     80(define-opcode dconst_1 15 1 2 (smf-push :duble))
     81(define-opcode bipush 16 2 1 (smf-push :int))
     82(define-opcode sipush 17 3 1 (smf-push :int))
     83(define-opcode ldc 18 2 1 (smf-push (car (instruction-args instruction))))
     84(define-opcode ldc_w 19 3 1 (smf-push (car (instruction-args instruction))))
     85(define-opcode ldc2_w 20 3 2
     86  (smf-push (car (instruction-args instruction)))
     87  (smf-push :top))
     88(define-opcode iload 21 2 1 (smf-push :int))
     89(define-opcode lload 22 2 2 (smf-push :long))
     90(define-opcode fload 23 2 nil (smf-push :float))
     91(define-opcode dload 24 2 nil (smf-push :double))
     92(define-opcode aload 25 2 1
     93  (smf-push (smf-get (car (instruction-args instruction)))))
     94(define-opcode iload_0 26 1 1 (smf-push :int))
     95(define-opcode iload_1 27 1 1 (smf-push :int))
     96(define-opcode iload_2 28 1 1 (smf-push :int))
     97(define-opcode iload_3 29 1 1 (smf-push :int))
     98(define-opcode lload_0 30 1 2 (smf-push :long))
     99(define-opcode lload_1 31 1 2 (smf-push :long))
     100(define-opcode lload_2 32 1 2 (smf-push :long))
     101(define-opcode lload_3 33 1 2 (smf-push :long))
     102(define-opcode fload_0 34 1 nil (smf-push :float))
     103(define-opcode fload_1 35 1 nil (smf-push :float))
     104(define-opcode fload_2 36 1 nil (smf-push :float))
     105(define-opcode fload_3 37 1 nil (smf-push :float))
     106(define-opcode dload_0 38 1 nil (smf-push :double))
     107(define-opcode dload_1 39 1 nil (smf-push :double))
     108(define-opcode dload_2 40 1 nil (smf-push :double))
     109(define-opcode dload_3 41 1 nil (smf-push :double))
     110(define-opcode aload_0 42 1 1 (smf-push (smf-get 0)))
     111(define-opcode aload_1 43 1 1 (smf-push (smf-get 1)))
     112(define-opcode aload_2 44 1 1 (smf-push (smf-get 2)))
     113(define-opcode aload_3 45 1 1 (smf-push (smf-get 3)))
     114(define-opcode iaload 46 1 -1 (smf-popn 2) (smf-push :int))
     115(define-opcode laload 47 1 0 (smf-popn 2) (smf-push :long))
     116(define-opcode faload 48 1 -1 (smf-popn 2) (smf-push :float))
     117(define-opcode daload 49 1 0 (smf-popn 2) (smf-push :double))
     118(define-opcode aaload 50 1 -1
     119  (progn
     120    (smf-pop)
     121    (smf-push (smf-element-of (smf-pop)))))
     122(define-opcode baload 51 1 nil (smf-popn 2) (smf-push :int))
     123(define-opcode caload 52 1 nil (smf-popn 2) (smf-push :int))
     124(define-opcode saload 53 1 nil (smf-popn 2) (smf-push :int))
     125
     126(defun iaf-store-effect (arg)
     127  (let ((t1 (smf-pop)))
     128    (sys::%format t "iaf-store ~S~%" (list arg t1))
     129    (smf-set arg t1)
     130    (when (> arg 0)
     131      (let ((t2 (smf-get (1- arg))))
     132  (when (or (eq t2 :long) (eq t2 :double))
     133    (smf-set (1- arg) :top))))))
     134
     135(defun ld-store-effect (arg)
     136  (smf-pop)
     137  (let ((t1 (smf-pop)))
     138    (smf-set arg t1)
     139    (smf-set (1+ arg) :top)
     140    (when (> arg 0)
     141      (let ((t2 (smf-get (1- arg))))
     142  (when (or (eq t2 :long) (eq t2 :double))
     143    (smf-set (1- arg) :top))))))
     144
     145(define-opcode istore 54 2 -1
     146  (iaf-store-effect (car (instruction-args instruction))))
     147(define-opcode lstore 55 2 -2
     148  (ld-store-effect (car (instruction-args instruction))))
     149(define-opcode fstore 56 2 nil
     150  (iaf-store-effect (car (instruction-args instruction))))
     151(define-opcode dstore 57 2 nil
     152  (ld-store-effect (car (instruction-args instruction))))
     153(define-opcode astore 58 2 -1
     154  (iaf-store-effect (car (instruction-args instruction))))
     155(define-opcode istore_0 59 1 -1 (iaf-store-effect 0))
     156(define-opcode istore_1 60 1 -1 (iaf-store-effect 1))
     157(define-opcode istore_2 61 1 -1 (iaf-store-effect 2))
     158(define-opcode istore_3 62 1 -1 (iaf-store-effect 3))
     159(define-opcode lstore_0 63 1 -2 (ld-store-effect 0))
     160(define-opcode lstore_1 64 1 -2 (ld-store-effect 1))
     161(define-opcode lstore_2 65 1 -2 (ld-store-effect 2))
     162(define-opcode lstore_3 66 1 -2 (ld-store-effect 3))
     163(define-opcode fstore_0 67 1 nil (iaf-store-effect 0))
     164(define-opcode fstore_1 68 1 nil (iaf-store-effect 1))
     165(define-opcode fstore_2 69 1 nil (iaf-store-effect 2))
     166(define-opcode fstore_3 70 1 nil (iaf-store-effect 3))
     167(define-opcode dstore_0 71 1 nil (dl-store-effect 0))
     168(define-opcode dstore_1 72 1 nil (dl-store-effect 1))
     169(define-opcode dstore_2 73 1 nil (dl-store-effect 2))
     170(define-opcode dstore_3 74 1 nil (dl-store-effect 3))
     171(define-opcode astore_0 75 1 -1 (iaf-store-effect 0))
     172(define-opcode astore_1 76 1 -1 (iaf-store-effect 1))
     173(define-opcode astore_2 77 1 -1 (iaf-store-effect 2))
     174(define-opcode astore_3 78 1 -1 (iaf-store-effect 3))
     175(define-opcode iastore 79 1 -3 (smf-popn 3))
     176(define-opcode lastore 80 1 -4 (smf-popn 4))
     177(define-opcode fastore 81 1 -3 (smf-popn 3))
     178(define-opcode dastore 82 1 -4 (smf-popn 4))
     179(define-opcode aastore 83 1 -3 (smf-popn 3))
     180(define-opcode bastore 84 1 nil (smf-popn 3))
     181(define-opcode castore 85 1 nil (smf-popn 3))
     182(define-opcode sastore 86 1 nil (smf-popn 3))
     183(define-opcode pop 87 1 -1 (smf-pop))
     184(define-opcode pop2 88 1 -2 (smf-popn 2))
     185(define-opcode dup 89 1 1
     186  (let ((t1 (smf-pop)))
     187    (smf-push t1)
     188    (smf-push t1)))
     189(define-opcode dup_x1 90 1 1
     190  (let ((t1 (smf-pop)) (t2 (smf-pop)))
     191    (smf-push t1)
     192    (smf-push t2)
     193    (smf-push t1)))
     194(define-opcode dup_x2 91 1 1
     195  (let ((t1 (smf-pop)) (t2 (smf-pop)) (t3 (smf-pop)))
     196    (smf-push t1)
     197    (smf-push t3)
     198    (smf-push t2)
     199    (smf-push t1)))
     200(define-opcode dup2 92 1 2
     201  (let ((t1 (smf-pop)) (t2 (smf-pop)))
     202    (smf-push t2)
     203    (smf-push t1)
     204    (smf-push t2)
     205    (smf-push t1)))
     206(define-opcode dup2_x1 93 1 2
     207  (let ((t1 (smf-pop)) (t2 (smf-pop)) (t3 (smf-pop)))
     208    (smf-push t2)
     209    (smf-push t1)
     210    (smf-push t3)
     211    (smf-push t2)
     212    (smf-push t1)))
     213(define-opcode dup2_x2 94 1 2
     214  (let ((t1 (smf-pop)) (t2 (smf-pop))
     215  (t3 (smf-pop)) (t4 (smf-pop)))
     216    (smf-push t2)
     217    (smf-push t1)
     218    (smf-push t4)
     219    (smf-push t3)
     220    (smf-push t2)
     221    (smf-push t1)))
     222(define-opcode swap 95 1 0
     223  (let ((t1 (smf-pop)) (t2 (smf-pop)))
     224    (smf-push t1)
     225    (smf-push t2)))
     226(define-opcode iadd 96 1 -1 (smf-popn 2) (smf-push :int))
     227(define-opcode ladd 97 1 -2 (smf-popn 4) (smf-push :long))
     228(define-opcode fadd 98 1 -1 (smf-popn 2) (smf-push :float))
     229(define-opcode dadd 99 1 -2 (smf-popn 4) (smf-push :double))
     230(define-opcode isub 100 1 -1 (smf-popn 2) (smf-push :int))
     231(define-opcode lsub 101 1 -2 (smf-popn 4) (smf-push :long))
     232(define-opcode fsub 102 1 -1 (smf-popn 2) (smf-push :float))
     233(define-opcode dsub 103 1 -2 (smf-popn 4) (smf-push :double))
     234(define-opcode imul 104 1 -1 (smf-popn 2) (smf-push :int))
     235(define-opcode lmul 105 1 -2 (smf-popn 4) (smf-push :long))
     236(define-opcode fmul 106 1 -1 (smf-popn 2) (smf-push :float))
     237(define-opcode dmul 107 1 -2 (smf-popn 4) (smf-push :double))
     238(define-opcode idiv 108 1 nil (smf-popn 2) (smf-push :int))
     239(define-opcode ldiv 109 1 nil (smf-popn 4) (smf-push :long))
     240(define-opcode fdiv 110 1 nil (smf-popn 2) (smf-push :float))
     241(define-opcode ddiv 111 1 nil (smf-popn 4) (smf-push :double))
     242(define-opcode irem 112 1 nil (smf-popn 2) (smf-push :int))
     243(define-opcode lrem 113 1 nil (smf-popn 4) (smf-push :long))
     244(define-opcode frem 114 1 nil (smf-popn 2) (smf-push :float))
     245(define-opcode drem 115 1 nil (smf-popn 4) (smf-push :double))
    174246(define-opcode ineg 116 1 0)
    175247(define-opcode lneg 117 1 0)
    176248(define-opcode fneg 118 1 0)
    177249(define-opcode dneg 119 1 0)
    178 (define-opcode ishl 120 1 -1)
    179 (define-opcode lshl 121 1 -1)
    180 (define-opcode ishr 122 1 -1)
    181 (define-opcode lshr 123 1 -1)
    182 (define-opcode iushr 124 1 nil)
    183 (define-opcode lushr 125 1 nil)
    184 (define-opcode iand 126 1 -1)
    185 (define-opcode land 127 1 -2)
    186 (define-opcode ior 128 1 -1)
    187 (define-opcode lor 129 1 -2)
    188 (define-opcode ixor 130 1 -1)
    189 (define-opcode lxor 131 1 -2)
    190 (define-opcode iinc 132 3 0)
    191 (define-opcode i2l 133 1 1)
    192 (define-opcode i2f 134 1 0)
    193 (define-opcode i2d 135 1 1)
    194 (define-opcode l2i 136 1 -1)
    195 (define-opcode l2f 137 1 -1)
    196 (define-opcode l2d 138 1 0)
    197 (define-opcode f2i 139 1 nil)
    198 (define-opcode f2l 140 1 nil)
    199 (define-opcode f2d 141 1 1)
    200 (define-opcode d2i 142 1 nil)
    201 (define-opcode d2l 143 1 nil)
    202 (define-opcode d2f 144 1 -1)
     250(define-opcode ishl 120 1 -1 (smf-popn 2) (smf-push :int))
     251(define-opcode lshl 121 1 -1 (smf-popn 3) (smf-push :long))
     252(define-opcode ishr 122 1 -1 (smf-popn 2) (smf-push :int))
     253(define-opcode lshr 123 1 -1 (smf-popn 3) (smf-push :long))
     254(define-opcode iushr 124 1 nil (smf-popn 2) (smf-push :int))
     255(define-opcode lushr 125 1 nil (smf-popn 3) (smf-push :long))
     256(define-opcode iand 126 1 -1 (smf-popn 2) (smf-push :int))
     257(define-opcode land 127 1 -2 (smf-popn 4) (smf-push :long))
     258(define-opcode ior 128 1 -1 (smf-popn 2) (smf-push :int))
     259(define-opcode lor 129 1 -2 (smf-popn 4) (smf-push :long))
     260(define-opcode ixor 130 1 -1 (smf-popn 2) (smf-push :int))
     261(define-opcode lxor 131 1 -2 (smf-popn 4) (smf-push :long))
     262(define-opcode iinc 132 3 0
     263  (sys::%format t "AAAAAAAAAAAA ~A~%" (instruction-args instruction))
     264  (smf-set (car (instruction-args instruction)) :int))
     265(define-opcode i2l 133 1 1 (smf-pop) (smf-push :long))
     266(define-opcode i2f 134 1 0 (smf-pop) (smf-push :float))
     267(define-opcode i2d 135 1 1 (smf-pop) (smf-push :double))
     268(define-opcode l2i 136 1 -1 (smf-popn 2) (smf-push :int))
     269(define-opcode l2f 137 1 -1 (smf-popn 2) (smf-push :float))
     270(define-opcode l2d 138 1 0 (smf-popn 2) (smf-push :double))
     271(define-opcode f2i 139 1 nil (smf-pop) (smf-push :int))
     272(define-opcode f2l 140 1 nil (smf-pop) (smf-push :long))
     273(define-opcode f2d 141 1 1 (smf-pop) (smf-push :double))
     274(define-opcode d2i 142 1 nil (smf-popn 2) (smf-push :int))
     275(define-opcode d2l 143 1 nil (smf-popn 2) (smf-push :long))
     276(define-opcode d2f 144 1 -1 (smf-popn 2) (smf-push :float))
    203277(define-opcode i2b 145 1 nil)
    204278(define-opcode i2c 146 1 nil)
    205279(define-opcode i2s 147 1 nil)
    206 (define-opcode lcmp 148 1 -3)
    207 (define-opcode fcmpl 149 1 -1)
    208 (define-opcode fcmpg 150 1 -1)
    209 (define-opcode dcmpl 151 1 -3)
    210 (define-opcode dcmpg 152 1 -3)
    211 (define-opcode ifeq 153 3 -1)
    212 (define-opcode ifne 154 3 -1)
    213 (define-opcode iflt 155 3 -1)
    214 (define-opcode ifge 156 3 -1)
    215 (define-opcode ifgt 157 3 -1)
    216 (define-opcode ifle 158 3 -1)
    217 (define-opcode if_icmpeq 159 3 -2)
    218 (define-opcode if_icmpne 160 3 -2)
    219 (define-opcode if_icmplt 161 3 -2)
    220 (define-opcode if_icmpge 162 3 -2)
    221 (define-opcode if_icmpgt 163 3 -2)
    222 (define-opcode if_icmple 164 3 -2)
    223 (define-opcode if_acmpeq 165 3 -2)
    224 (define-opcode if_acmpne 166 3 -2)
     280(define-opcode lcmp 148 1 -3 (smf-popn 4) (smf-push :int))
     281(define-opcode fcmpl 149 1 -1 (smf-popn 2) (smf-push :int))
     282(define-opcode fcmpg 150 1 -1 (smf-popn 2) (smf-push :int))
     283(define-opcode dcmpl 151 1 -3 (smf-popn 4) (smf-push :int))
     284(define-opcode dcmpg 152 1 -3 (smf-popn 4) (smf-push :int))
     285(define-opcode ifeq 153 3 -1 (smf-pop))
     286(define-opcode ifne 154 3 -1 (smf-pop))
     287(define-opcode iflt 155 3 -1 (smf-pop))
     288(define-opcode ifge 156 3 -1 (smf-pop))
     289(define-opcode ifgt 157 3 -1 (smf-pop))
     290(define-opcode ifle 158 3 -1 (smf-pop))
     291(define-opcode if_icmpeq 159 3 -2 (smf-popn 2))
     292(define-opcode if_icmpne 160 3 -2 (smf-popn 2))
     293(define-opcode if_icmplt 161 3 -2 (smf-popn 2))
     294(define-opcode if_icmpge 162 3 -2 (smf-popn 2))
     295(define-opcode if_icmpgt 163 3 -2 (smf-popn 2))
     296(define-opcode if_icmple 164 3 -2 (smf-popn 2))
     297(define-opcode if_acmpeq 165 3 -2 (smf-popn 2))
     298(define-opcode if_acmpne 166 3 -2 (smf-popn 2))
    225299(define-opcode goto 167 3 0)
    226300;;(define-opcode jsr 168 3 1) Don't use these 2 opcodes: deprecated
    227301;;(define-opcode ret 169 2 0) their use results in JVM verifier errors
    228 (define-opcode tableswitch 170 0 nil)
    229 (define-opcode lookupswitch 171 0 nil)
    230 (define-opcode ireturn 172 1 nil)
    231 (define-opcode lreturn 173 1 nil)
    232 (define-opcode freturn 174 1 nil)
    233 (define-opcode dreturn 175 1 nil)
    234 (define-opcode areturn 176 1 -1)
     302(define-opcode tableswitch 170 0 nil (smf-pop))
     303(define-opcode lookupswitch 171 0 nil (smf-pop))
     304(define-opcode ireturn 172 1 nil (smf-pop))
     305(define-opcode lreturn 173 1 nil (smf-popn 2))
     306(define-opcode freturn 174 1 nil (smf-pop))
     307(define-opcode dreturn 175 1 nil (smf-popn 2))
     308(define-opcode areturn 176 1 -1 (smf-pop))
    235309(define-opcode return 177 1 0)
    236 (define-opcode getstatic 178 3 1)
    237 (define-opcode putstatic 179 3 -1)
    238 (define-opcode getfield 180 3 0)
    239 (define-opcode putfield 181 3 -2)
    240 (define-opcode invokevirtual 182 3 nil)
    241 (define-opcode invokespecial 183 3 nil)
    242 (define-opcode invokestatic 184 3 nil)
    243 (define-opcode invokeinterface 185 5 nil)
    244 (define-opcode unused 186 0 nil)
    245 (define-opcode new 187 3 1)
    246 (define-opcode newarray 188 2 nil)
    247 (define-opcode anewarray 189 3 0)
    248 (define-opcode arraylength 190 1 0)
    249 (define-opcode athrow 191 1 0)
    250 (define-opcode checkcast 192 3 0)
    251 (define-opcode instanceof 193 3 0)
    252 (define-opcode monitorenter 194 1 -1)
    253 (define-opcode monitorexit 195 1 -1)
     310(define-opcode getstatic 178 3 1
     311  (sys::%format t "GETSTATIC ~A~%" (third (instruction-args instruction)))
     312  ;;TODO!!!
     313  (smf-push (third (instruction-args instruction))))
     314(define-opcode putstatic 179 3 -1
     315  (sys::%format t "PUTSTATIC ~A~%" (third (instruction-args instruction)))
     316  (smf-popt (third (instruction-args instruction))))
     317(define-opcode getfield 180 3 0
     318  (smf-pop)
     319  (smf-push (third (instruction-args instruction))))
     320(define-opcode putfield 181 3 -2
     321  (smf-popt (third (instruction-args instruction)))
     322  (smf-pop))
     323(define-opcode invokevirtual 182 3 nil
     324  (smf-popt (third (instruction-args instruction)))
     325  (smf-pop)
     326  (smf-push (third (instruction-args instruction))))
     327(define-opcode invokespecial 183 3 nil
     328  (smf-popt (third (instruction-args instruction)))
     329  (smf-pop)
     330  (smf-push (third (instruction-args instruction))))
     331(define-opcode invokestatic 184 3 nil
     332  (sys::%format t "invokestatic ~S~%" (instruction-args instruction))
     333  (smf-popt (third (instruction-args instruction)))
     334  (smf-push (third (instruction-args instruction))))
     335(define-opcode invokeinterface 185 5 nil
     336  (smf-popt (third (instruction-args instruction)))
     337  (smf-pop)
     338  (smf-push (third (instruction-args instruction))))
     339(define-opcode invokedynamic 186 0 nil
     340  (smf-popt (second (instruction-args instruction)))
     341  (smf-push (second (instruction-args instruction))))
     342(define-opcode new 187 3 1
     343  (smf-push (first (instruction-args instruction))))
     344(define-opcode newarray 188 2 nil
     345  (smf-pop)
     346  (smf-push `(:array-of ,(first (instruction-args instruction)))))
     347(define-opcode anewarray 189 3 0
     348  (smf-pop)
     349  (smf-push `(:array-of ,(first (instruction-args instruction)))))
     350(define-opcode arraylength 190 1 0
     351  (smf-pop)
     352  (smf-push :int))
     353(define-opcode athrow 191 1 0 (smf-pop))
     354(define-opcode checkcast 192 3 0
     355  (smf-pop)
     356  (smf-push (first (instruction-args instruction))))
     357(define-opcode instanceof 193 3 0
     358  (smf-pop)
     359  (smf-push :int))
     360(define-opcode monitorenter 194 1 -1 (smf-pop))
     361(define-opcode monitorexit 195 1 -1 (smf-pop))
    254362(define-opcode wide 196 0 nil)
    255363(define-opcode multianewarray 197 4 nil)
    256 (define-opcode ifnull 198 3 -1)
    257 (define-opcode ifnonnull 199 3 nil)
     364(define-opcode ifnull 198 3 -1 (smf-pop))
     365(define-opcode ifnonnull 199 3 nil (smf-pop))
    258366(define-opcode goto_w 200 5 nil)
    259367;; (define-opcode jsr_w 201 5 nil) Don't use: deprecated
     
    279387        (error "Unknown opcode ~S." opcode-name))))
    280388
     389
    281390(declaim (ftype (function (t) fixnum) opcode-size))
    282391(defun opcode-size (opcode-number)
     
    290399  (jvm-opcode-stack-effect (svref *opcode-table* opcode-number)))
    291400
    292 
    293 
     401(declaim (ftype (function (t) t) opcode-effect-function))
     402(defun opcode-effect-function (opcode-number)
     403  (declare (optimize speed))
     404  (jvm-opcode-effect-function (svref *opcode-table* opcode-number)))
     405
     406;;Stack map table functions
     407(defun smf-get (pos)
     408  (or (nth pos *code-locals*)
     409      (sys::%format t "Locals inconsistency: get ~A but locals are ~A~%" ;;TODO error
     410        pos *code-locals*)))
     411
     412(defun smf-set (pos type)
     413  (if (< pos (length *code-locals*))
     414      (setf (nth pos *code-locals*) type)
     415      (progn
     416  (setf *code-locals*
     417        (append *code-locals* (list nil)))
     418  (smf-set pos type))))
     419
     420(defun smf-push (type)
     421  (push type *code-stack*)
     422  (when (or (eq type :long) (eq type :double))
     423    (push :top *code-stack)))
     424
     425(defun smf-pop ()
     426  ;(sys::%format t "smf-pop ~A~%" *code-stack*)
     427  (pop *code-stack*))
     428
     429(defun smf-popt (type)
     430  (declare (ignore type)) ;TODO
     431  (pop *code-stack*))
     432
     433(defun smf-popn (n)
     434  (dotimes (i n)
     435    (pop *code-stack*)))
     436
     437(defun smf-element-of (type)
     438  (if (and (consp type) (eq (car type) :array-of))
     439      (cdr type)
     440      (cons :element-of type)))
     441
     442(defun smf-array-of (type)
     443  (if (and (consp type) (eq (car type) :element-of))
     444      (cdr type)
     445      (cons :array-of type)))
    294446
    295447;;   INSTRUCTION
     
    300452  stack
    301453  depth
    302   wide)
     454  wide
     455  input-locals
     456  input-stack
     457  output-locals
     458  output-stack
     459  ;;the calculated offset of the instruction
     460  offset)
    303461
    304462(defun make-instruction (opcode args)
     
    308466    (when (memq :wide-prefix args)
    309467      (setf (inst-wide inst) t))
     468    (setf (instruction-input-locals inst) *code-locals*)
     469    (setf (instruction-input-stack inst) *code-stack*)
    310470    inst))
    311471
     
    341501;; our only user and we'll hard-code the use of *code*.
    342502(defvar *code* nil)
     503(defvar *code-locals* nil)
     504(defvar *code-stack* nil)
    343505
    344506(defknown %%emit * t)
     
    361523             (symbolp (cadr instr)))
    362524    (setf instr (opcode-number (cadr instr))))
    363   (if (fixnump instr)
    364       `(%%emit ,instr ,@args)
    365       `(%emit ,instr ,@args)))
     525  (let ((instruction (gensym)))
     526    `(let ((,instruction
     527      ,(if (fixnump instr)
     528     `(%%emit ,instr ,@args)
     529     `(%emit ,instr ,@args))))
     530       ;(sys::%format t "EMIT ~S ~S~%" ',instr ',args)
     531       (funcall (opcode-effect-function (instruction-opcode ,instruction))
     532    ,instruction)
     533       (setf (instruction-output-locals ,instruction) *code-locals*)
     534       (setf (instruction-output-stack ,instruction) *code-stack*)
     535       ,instruction)))
    366536
    367537
     
    396566         (inline branch-p))
    397567(defun branch-p (opcode)
    398 ;;  (declare (optimize speed))
    399 ;;  (declare (type '(integer 0 255) opcode))
     568  (declare (optimize speed))
     569  (declare (type '(integer 0 255) opcode))
    400570  (or (<= 153 opcode 167)
    401571      (<= 198 opcode 200))) ;; ifnull / ifnonnull / goto_w
Note: See TracChangeset for help on using the changeset viewer.