asm: add `areturn'
[hs-java.git] / JVM / Assembler.hs
1 {-# LANGUAGE TypeFamilies, StandaloneDeriving, FlexibleInstances,
2    FlexibleContexts, UndecidableInstances, RecordWildCards, OverloadedStrings,
3    TypeSynonymInstances, MultiParamTypeClasses #-}
4 -- | This module declares data type for JVM instructions, and BinaryState
5 -- instances to read/write them.
6 module JVM.Assembler 
7   (Instruction (..),
8    ArrayType (..),
9    CodeException (..),
10    Code (..),
11    IMM (..),
12    CMP (..),
13    atype2byte,
14    encodeInstructions,
15    encodeMethod,
16    decodeMethod
17   )
18   where
19
20 import Control.Monad
21 import Control.Applicative
22 import Data.Ix (inRange)
23 import Data.Word
24 import qualified Data.Binary as Binary
25 import qualified Data.ByteString.Lazy as B
26
27 import Data.BinaryState
28 import JVM.ClassFile
29
30 -- | Immediate constant. Corresponding value will be added to base opcode.
31 data IMM =
32     I0     -- ^ 0
33   | I1     -- ^ 1
34   | I2     -- ^ 2
35   | I3     -- ^ 3
36   deriving (Eq, Ord, Enum, Show)
37
38 -- | Comparation operation type. Not all CMP instructions support all operations.
39 data CMP =
40     C_EQ
41   | C_NE
42   | C_LT
43   | C_GE
44   | C_GT
45   | C_LE
46   deriving (Eq, Ord, Enum, Show)
47
48 -- | Format of Code method attribute.
49 data Code = Code {
50     codeStackSize :: Word16,
51     codeMaxLocals :: Word16,
52     codeLength :: Word32,
53     codeInstructions :: [Instruction],
54     codeExceptionsN :: Word16,
55     codeExceptions :: [CodeException],
56     codeAttrsN :: Word16,
57     codeAttributes :: Attributes File }
58   deriving (Eq, Show)
59
60 -- | Exception descriptor
61 data CodeException = CodeException {
62     eStartPC :: Word16,
63     eEndPC :: Word16,
64     eHandlerPC :: Word16,
65     eCatchType :: Word16 }
66   deriving (Eq, Show)
67
68 instance BinaryState Integer CodeException where
69   put (CodeException {..}) = do
70     put eStartPC
71     put eEndPC
72     put eHandlerPC
73     put eCatchType
74
75   get = CodeException <$> get <*> get <*> get <*> get
76
77 instance BinaryState Integer Attribute where
78   put a = do
79     let sz = 6 + attributeLength a      -- full size of AttributeInfo structure
80     liftOffset (fromIntegral sz) Binary.put a
81
82   get = getZ
83
84 instance BinaryState Integer Code where
85   put (Code {..}) = do
86     put codeStackSize
87     put codeMaxLocals
88     put codeLength
89     forM_ codeInstructions put
90     put codeExceptionsN
91     forM_ codeExceptions put
92     put codeAttrsN
93     forM_ (attributesList codeAttributes) put
94
95   get = do
96     stackSz <- get
97     locals <- get
98     len <- get
99     bytes <- replicateM (fromIntegral len) get
100     let bytecode = B.pack bytes
101         code = decodeWith readInstructions 0 bytecode
102     excn <- get
103     excs <- replicateM (fromIntegral excn) get
104     nAttrs <- get
105     attrs <- replicateM (fromIntegral nAttrs) get
106     return $ Code stackSz locals len code excn excs nAttrs (AP attrs)
107
108 -- | Read sequence of instructions (to end of stream)
109 readInstructions :: GetState Integer [Instruction]
110 readInstructions = do
111    end <- isEmpty
112    if end
113      then return []
114      else do
115           x <- get
116           next <- readInstructions
117           return (x: next)
118
119 -- | JVM instruction set. For comments, see JVM specification.
120 data Instruction =
121     NOP            -- ^ 0
122   | ACONST_NULL    -- ^ 1
123   | ICONST_M1      -- ^ 2
124   | ICONST_0       -- ^ 3
125   | ICONST_1       -- ^ 4
126   | ICONST_2       -- ^ 5
127   | ICONST_3       -- ^ 6
128   | ICONST_4       -- ^ 7
129   | ICONST_5       -- ^ 8
130   | LCONST_0       -- ^ 9
131   | LCONST_1       -- ^ 10
132   | FCONST_0       -- ^ 11
133   | FCONST_1       -- ^ 12
134   | FCONST_2       -- ^ 13
135   | DCONST_0       -- ^ 14
136   | DCONST_1       -- ^ 15
137   | BIPUSH Word8   -- ^ 16
138   | SIPUSH Word16  -- ^ 17
139   | LDC1 Word8     -- ^ 18
140   | LDC2 Word16    -- ^ 19
141   | LDC2W Word16   -- ^ 20
142   | ILOAD Word8    -- ^ 21
143   | LLOAD Word8    -- ^ 22
144   | FLOAD Word8    -- ^ 23
145   | DLOAD Word8    -- ^ 24
146   | ALOAD Word8    -- ^ 25
147   | ILOAD_ IMM     -- ^ 26, 27, 28, 29
148   | LLOAD_ IMM     -- ^ 30, 31, 32, 33
149   | FLOAD_ IMM     -- ^ 34, 35, 36, 37
150   | DLOAD_ IMM     -- ^ 38, 39, 40, 41
151   | ALOAD_ IMM     -- ^ 42, 43, 44, 45
152   | IALOAD         -- ^ 46
153   | LALOAD         -- ^ 47
154   | FALOAD         -- ^ 48
155   | DALOAD         -- ^ 49
156   | AALOAD         -- ^ 50
157   | BALOAD         -- ^ 51
158   | CALOAD         -- ^ 52
159   | SALOAD         -- ^ 53
160   | ISTORE Word8   -- ^ 54
161   | LSTORE Word8   -- ^ 55
162   | FSTORE Word8   -- ^ 56
163   | DSTORE Word8   -- ^ 57
164   | ASTORE Word8   -- ^ 58
165   | ISTORE_ IMM    -- ^ 59, 60, 61, 62
166   | LSTORE_ IMM    -- ^ 63, 64, 65, 66
167   | FSTORE_ IMM    -- ^ 67, 68, 69, 70
168   | DSTORE_ IMM    -- ^ 71, 72, 73, 74
169   | ASTORE_ IMM    -- ^ 75, 76, 77, 78
170   | IASTORE        -- ^ 79
171   | LASTORE        -- ^ 80
172   | FASTORE        -- ^ 81
173   | DASTORE        -- ^ 82
174   | AASTORE        -- ^ 83
175   | BASTORE        -- ^ 84
176   | CASTORE        -- ^ 85
177   | SASTORE        -- ^ 86
178   | POP            -- ^ 87
179   | POP2           -- ^ 88
180   | DUP            -- ^ 89
181   | DUP_X1         -- ^ 90
182   | DUP_X2         -- ^ 91
183   | DUP2           -- ^ 92
184   | DUP2_X1        -- ^ 93 
185   | DUP2_X2        -- ^ 94
186   | SWAP           -- ^ 95
187   | IADD           -- ^ 96
188   | LADD           -- ^ 97
189   | FADD           -- ^ 98
190   | DADD           -- ^ 99
191   | ISUB           -- ^ 100
192   | LSUB           -- ^ 101
193   | FSUB           -- ^ 102
194   | DSUB           -- ^ 103
195   | IMUL           -- ^ 104
196   | LMUL           -- ^ 105
197   | FMUL           -- ^ 106
198   | DMUL           -- ^ 107
199   | IDIV           -- ^ 108
200   | LDIV           -- ^ 109
201   | FDIV           -- ^ 110
202   | DDIV           -- ^ 111
203   | IREM           -- ^ 112
204   | LREM           -- ^ 113
205   | FREM           -- ^ 114
206   | DREM           -- ^ 115
207   | INEG           -- ^ 116
208   | LNEG           -- ^ 117
209   | FNEG           -- ^ 118
210   | DNEG           -- ^ 119
211   | ISHL           -- ^ 120
212   | LSHL           -- ^ 121
213   | ISHR           -- ^ 122
214   | LSHR           -- ^ 123
215   | IUSHR          -- ^ 124
216   | LUSHR          -- ^ 125
217   | IAND           -- ^ 126
218   | LAND           -- ^ 127
219   | IOR            -- ^ 128
220   | LOR            -- ^ 129
221   | IXOR           -- ^ 130
222   | LXOR           -- ^ 131
223   | IINC Word8 Word8       -- ^ 132
224   | I2L                    -- ^ 133
225   | I2F                    -- ^ 134
226   | I2D                    -- ^ 135
227   | L2I                    -- ^ 136
228   | L2F                    -- ^ 137
229   | L2D                    -- ^ 138
230   | F2I                    -- ^ 139
231   | F2L                    -- ^ 140
232   | F2D                    -- ^ 141
233   | D2I                    -- ^ 142
234   | D2L                    -- ^ 143
235   | D2F                    -- ^ 144
236   | I2B                    -- ^ 145
237   | I2C                    -- ^ 146
238   | I2S                    -- ^ 147
239   | LCMP                   -- ^ 148
240   | FCMP CMP               -- ^ 149, 150
241   | DCMP CMP               -- ^ 151, 152
242   | IF CMP Word16          -- ^ 153, 154, 155, 156, 157, 158
243   | IF_ICMP CMP Word16     -- ^ 159, 160, 161, 162, 163, 164
244   | IF_ACMP CMP Word16     -- ^ 165, 166
245   | GOTO Word16            -- ^ 167
246   | JSR Word16             -- ^ 168
247   | RET                    -- ^ 169
248   | TABLESWITCH Word32 Word32 Word32 [Word32]     -- ^ 170
249   | LOOKUPSWITCH Word32 Word32 [(Word32, Word32)] -- ^ 171
250   | IRETURN                -- ^ 172
251   | LRETURN                -- ^ 173
252   | FRETURN                -- ^ 174
253   | DRETURN                -- ^ 175
254   | ARETURN                -- ^ 176
255   | RETURN                 -- ^ 177
256   | GETSTATIC Word16       -- ^ 178
257   | PUTSTATIC Word16       -- ^ 179
258   | GETFIELD Word16        -- ^ 180
259   | PUTFIELD Word16        -- ^ 181
260   | INVOKEVIRTUAL Word16   -- ^ 182
261   | INVOKESPECIAL Word16   -- ^ 183
262   | INVOKESTATIC Word16    -- ^ 184
263   | INVOKEINTERFACE Word16 Word8 -- ^ 185
264   | NEW Word16             -- ^ 187
265   | NEWARRAY Word8         -- ^ 188, see @ArrayType@
266   | ANEWARRAY Word16       -- ^ 189
267   | ARRAYLENGTH            -- ^ 190
268   | ATHROW                 -- ^ 191
269   | CHECKCAST Word16       -- ^ 192
270   | INSTANCEOF Word16      -- ^ 193
271   | MONITORENTER           -- ^ 194
272   | MONITOREXIT            -- ^ 195
273   | WIDE Word8 Instruction -- ^ 196
274   | MULTINANEWARRAY Word16 Word8 -- ^ 197
275   | IFNULL Word16          -- ^ 198
276   | IFNONNULL Word16       -- ^ 199
277   | GOTO_W Word32          -- ^ 200
278   | JSR_W Word32           -- ^ 201
279   deriving (Eq, Show)
280
281 -- | JVM array type (primitive types)
282 data ArrayType =
283     T_BOOLEAN  -- ^ 4
284   | T_CHAR     -- ^ 5
285   | T_FLOAT    -- ^ 6
286   | T_DOUBLE   -- ^ 7
287   | T_BYTE     -- ^ 8
288   | T_SHORT    -- ^ 9
289   | T_INT      -- ^ 10
290   | T_LONG     -- ^ 11
291   deriving (Eq, Show, Enum)
292
293 -- | Parse opcode with immediate constant
294 imm :: Word8                   -- ^ Base opcode
295     -> (IMM -> Instruction)    -- ^ Instruction constructor
296     -> Word8                   -- ^ Opcode to parse
297     -> GetState s Instruction
298 imm base constr x = return $ constr $ toEnum $ fromIntegral (x-base)
299
300 -- | Put opcode with immediate constant
301 putImm :: Word8                -- ^ Base opcode
302        -> IMM                  -- ^ Constant to add to opcode
303        -> PutState Integer ()
304 putImm base i = putByte $ base + (fromIntegral $ fromEnum i)
305
306 atype2byte :: ArrayType -> Word8
307 atype2byte T_BOOLEAN  = 4
308 atype2byte T_CHAR     = 5
309 atype2byte T_FLOAT    = 6
310 atype2byte T_DOUBLE   = 7
311 atype2byte T_BYTE     = 8
312 atype2byte T_SHORT    = 9
313 atype2byte T_INT      = 10
314 atype2byte T_LONG     = 11
315
316 byte2atype :: Word8 -> GetState s ArrayType
317 byte2atype 4  = return T_BOOLEAN
318 byte2atype 5  = return T_CHAR
319 byte2atype 6  = return T_FLOAT
320 byte2atype 7  = return T_DOUBLE
321 byte2atype 8  = return T_BYTE
322 byte2atype 9  = return T_SHORT
323 byte2atype 10 = return T_INT
324 byte2atype 11 = return T_LONG
325 byte2atype x  = fail $ "Unknown array type byte: " ++ show x
326
327 instance BinaryState Integer ArrayType where
328   get = do
329     x <- getByte
330     byte2atype x
331
332   put t = putByte (atype2byte t)
333
334 -- | Put opcode with one argument
335 put1 :: (BinaryState Integer a)
336       => Word8                  -- ^ Opcode
337       -> a                      -- ^ First argument
338       -> PutState Integer ()
339 put1 code x = do
340   putByte code
341   put x
342
343 put2 :: (BinaryState Integer a, BinaryState Integer b)
344      => Word8                   -- ^ Opcode
345      -> a                       -- ^ First argument
346      -> b                       -- ^ Second argument
347      -> PutState Integer ()
348 put2 code x y = do
349   putByte code
350   put x
351   put y
352
353 instance BinaryState Integer Instruction where
354   put  NOP         = putByte 0
355   put  ACONST_NULL = putByte 1
356   put  ICONST_M1   = putByte 2
357   put  ICONST_0    = putByte 3
358   put  ICONST_1    = putByte 4
359   put  ICONST_2    = putByte 5
360   put  ICONST_3    = putByte 6
361   put  ICONST_4    = putByte 7
362   put  ICONST_5    = putByte 8
363   put  LCONST_0    = putByte 9
364   put  LCONST_1    = putByte 10
365   put  FCONST_0    = putByte 11
366   put  FCONST_1    = putByte 12
367   put  FCONST_2    = putByte 13
368   put  DCONST_0    = putByte 14
369   put  DCONST_1    = putByte 15
370   put (BIPUSH x)   = put1 16 x
371   put (SIPUSH x)   = put1 17 x
372   put (LDC1 x)     = put1 18 x
373   put (LDC2 x)     = put1 19 x
374   put (LDC2W x)    = put1 20 x
375   put (ILOAD x)    = put1 21 x
376   put (LLOAD x)    = put1 22 x
377   put (FLOAD x)    = put1 23 x
378   put (DLOAD x)    = put1 24 x
379   put (ALOAD x)    = put1 25 x
380   put (ILOAD_ i)   = putImm 26 i
381   put (LLOAD_ i)   = putImm 30 i
382   put (FLOAD_ i)   = putImm 34 i
383   put (DLOAD_ i)   = putImm 38 i
384   put (ALOAD_ i)   = putImm 42 i
385   put  IALOAD      = putByte 46
386   put  LALOAD      = putByte 47
387   put  FALOAD      = putByte 48
388   put  DALOAD      = putByte 49
389   put  AALOAD      = putByte 50
390   put  BALOAD      = putByte 51
391   put  CALOAD      = putByte 52
392   put  SALOAD      = putByte 53
393   put (ISTORE x)   = put1  54 x
394   put (LSTORE x)   = put1  55 x
395   put (FSTORE x)   = put1  56 x
396   put (DSTORE x)   = put1  57 x
397   put (ASTORE x)   = put1  58 x
398   put (ISTORE_ i)  = putImm 59 i
399   put (LSTORE_ i)  = putImm 63 i
400   put (FSTORE_ i)  = putImm 67 i
401   put (DSTORE_ i)  = putImm 71 i
402   put (ASTORE_ i)  = putImm 75 i
403   put  IASTORE     = putByte 79
404   put  LASTORE     = putByte 80
405   put  FASTORE     = putByte 81
406   put  DASTORE     = putByte 82
407   put  AASTORE     = putByte 83
408   put  BASTORE     = putByte 84
409   put  CASTORE     = putByte 85
410   put  SASTORE     = putByte 86
411   put  POP         = putByte 87
412   put  POP2        = putByte 88
413   put  DUP         = putByte 89
414   put  DUP_X1      = putByte 90
415   put  DUP_X2      = putByte 91
416   put  DUP2        = putByte 92
417   put  DUP2_X1     = putByte 93 
418   put  DUP2_X2     = putByte 94
419   put  SWAP        = putByte 95
420   put  IADD        = putByte 96
421   put  LADD        = putByte 97
422   put  FADD        = putByte 98
423   put  DADD        = putByte 99
424   put  ISUB        = putByte 100
425   put  LSUB        = putByte 101
426   put  FSUB        = putByte 102
427   put  DSUB        = putByte 103
428   put  IMUL        = putByte 104
429   put  LMUL        = putByte 105
430   put  FMUL        = putByte 106
431   put  DMUL        = putByte 107
432   put  IDIV        = putByte 108
433   put  LDIV        = putByte 109
434   put  FDIV        = putByte 110
435   put  DDIV        = putByte 111
436   put  IREM        = putByte 112
437   put  LREM        = putByte 113
438   put  FREM        = putByte 114
439   put  DREM        = putByte 115
440   put  INEG        = putByte 116
441   put  LNEG        = putByte 117
442   put  FNEG        = putByte 118
443   put  DNEG        = putByte 119
444   put  ISHL        = putByte 120
445   put  LSHL        = putByte 121
446   put  ISHR        = putByte 122
447   put  LSHR        = putByte 123
448   put  IUSHR       = putByte 124
449   put  LUSHR       = putByte 125
450   put  IAND        = putByte 126
451   put  LAND        = putByte 127
452   put  IOR         = putByte 128
453   put  LOR         = putByte 129
454   put  IXOR        = putByte 130
455   put  LXOR        = putByte 131
456   put (IINC x y)      = put2 132 x y
457   put  I2L            = putByte 133
458   put  I2F            = putByte 134
459   put  I2D            = putByte 135
460   put  L2I            = putByte 136
461   put  L2F            = putByte 137
462   put  L2D            = putByte 138
463   put  F2I            = putByte 139
464   put  F2L            = putByte 140
465   put  F2D            = putByte 141
466   put  D2I            = putByte 142
467   put  D2L            = putByte 143
468   put  D2F            = putByte 144
469   put  I2B            = putByte 145
470   put  I2C            = putByte 146
471   put  I2S            = putByte 147
472   put  LCMP           = putByte 148
473   put (FCMP C_LT)     = putByte 149
474   put (FCMP C_GT)     = putByte 150
475   put (FCMP c)        = fail $ "No such instruction: FCMP " ++ show c
476   put (DCMP C_LT)     = putByte 151
477   put (DCMP C_GT)     = putByte 152
478   put (DCMP c)        = fail $ "No such instruction: DCMP " ++ show c
479   put (IF c x)        = putByte (fromIntegral $ 153 + fromEnum c) >> put x
480   put (IF_ACMP C_EQ x) = put1 165 x
481   put (IF_ACMP C_NE x) = put1 166 x
482   put (IF_ACMP c _)   = fail $ "No such instruction: IF_ACMP " ++ show c
483   put (IF_ICMP c x)   = putByte (fromIntegral $ 159 + fromEnum c) >> put x
484   put (GOTO x)        = put1 167 x
485   put (JSR x)         = put1 168 x
486   put  RET            = putByte 169
487   put (TABLESWITCH def low high offs) = do
488                                    putByte 170
489                                    offset <- getOffset
490                                    let pads = 4 - (offset `mod` 4)
491                                    replicateM (fromIntegral pads) (putByte 0)
492                                    put low
493                                    put high
494                                    forM_ offs put
495   put (LOOKUPSWITCH def n pairs) = do
496                                    putByte 171
497                                    offset <- getOffset
498                                    let pads = 4 - (offset `mod` 4)
499                                    replicateM (fromIntegral pads) (putByte 0)
500                                    put def
501                                    put n
502                                    forM_ pairs put
503   put  IRETURN        = putByte 172
504   put  LRETURN        = putByte 173
505   put  FRETURN        = putByte 174
506   put  DRETURN        = putByte 175
507   put  ARETURN        = putByte 176
508   put  RETURN         = putByte 177
509   put (GETSTATIC x)   = put1 178 x
510   put (PUTSTATIC x)   = put1 179 x
511   put (GETFIELD x)    = put1 180 x
512   put (PUTFIELD x)    = put1 181 x
513   put (INVOKEVIRTUAL x)     = put1 182 x
514   put (INVOKESPECIAL x)     = put1 183 x
515   put (INVOKESTATIC x)      = put1 184 x
516   put (INVOKEINTERFACE x c) = put2 185 x c >> putByte 0
517   put (NEW x)         = put1 187 x
518   put (NEWARRAY x)    = put1 188 x
519   put (ANEWARRAY x)   = put1 189 x
520   put  ARRAYLENGTH    = putByte 190
521   put  ATHROW         = putByte 191
522   put (CHECKCAST x)   = put1 192 x
523   put (INSTANCEOF x)  = put1 193 x
524   put  MONITORENTER   = putByte 194
525   put  MONITOREXIT    = putByte 195
526   put (WIDE x inst)   = put2 196 x inst
527   put (MULTINANEWARRAY x y) = put2 197 x y
528   put (IFNULL x)      = put1 198 x
529   put (IFNONNULL x)   = put1 199 x
530   put (GOTO_W x)      = put1 200 x
531   put (JSR_W x)       = put1 201 x
532
533   get = do
534     c <- getByte
535     case c of
536       0 -> return NOP
537       1 -> return ACONST_NULL
538       2 -> return ICONST_M1
539       3 -> return ICONST_0
540       4 -> return ICONST_1
541       5 -> return ICONST_2
542       6 -> return ICONST_3
543       7 -> return ICONST_4
544       8 -> return ICONST_5
545       9 -> return LCONST_0
546       10 -> return LCONST_1
547       11 -> return FCONST_0
548       12 -> return FCONST_1
549       13 -> return FCONST_2
550       14 -> return DCONST_0
551       15 -> return DCONST_1
552       16 -> BIPUSH <$> get
553       17 -> SIPUSH <$> get
554       18 -> LDC1 <$> get
555       19 -> LDC2 <$> get
556       20 -> LDC2W <$> get
557       21 -> ILOAD <$> get
558       22 -> LLOAD <$> get
559       23 -> FLOAD <$> get
560       24 -> DLOAD <$> get
561       25 -> ALOAD <$> get
562       46 -> return IALOAD
563       47 -> return LALOAD
564       48 -> return FALOAD
565       49 -> return DALOAD
566       50 -> return AALOAD
567       51 -> return BALOAD
568       52 -> return CALOAD
569       53 -> return SALOAD
570       54 -> ISTORE <$> get
571       55 -> LSTORE <$> get
572       56 -> FSTORE <$> get
573       57 -> DSTORE <$> get
574       58 -> ASTORE <$> get
575       79 -> return IASTORE
576       80 -> return LASTORE
577       81 -> return FASTORE
578       82 -> return DASTORE
579       83 -> return AASTORE
580       84 -> return BASTORE
581       85 -> return CASTORE
582       86 -> return SASTORE
583       87 -> return POP
584       88 -> return POP2
585       89 -> return DUP
586       90 -> return DUP_X1
587       91 -> return DUP_X2
588       92 -> return DUP2
589       93 -> return DUP2_X1 
590       94 -> return DUP2_X2
591       95 -> return SWAP
592       96 -> return IADD
593       97 -> return LADD
594       98 -> return FADD
595       99 -> return DADD
596       100 -> return ISUB
597       101 -> return LSUB
598       102 -> return FSUB
599       103 -> return DSUB
600       104 -> return IMUL
601       105 -> return LMUL
602       106 -> return FMUL
603       107 -> return DMUL
604       108 -> return IDIV
605       109 -> return LDIV
606       110 -> return FDIV
607       111 -> return DDIV
608       112 -> return IREM
609       113 -> return LREM
610       114 -> return FREM
611       115 -> return DREM
612       116 -> return INEG
613       117 -> return LNEG
614       118 -> return FNEG
615       119 -> return DNEG
616       120 -> return ISHL
617       121 -> return LSHL
618       122 -> return ISHR
619       123 -> return LSHR
620       124 -> return IUSHR
621       125 -> return LUSHR
622       126 -> return IAND
623       127 -> return LAND
624       128 -> return IOR
625       129 -> return LOR
626       130 -> return IXOR
627       131 -> return LXOR
628       132 -> IINC <$> get <*> get
629       133 -> return I2L
630       134 -> return I2F
631       135 -> return I2D
632       136 -> return L2I
633       137 -> return L2F
634       138 -> return L2D
635       139 -> return F2I
636       140 -> return F2L
637       141 -> return F2D
638       142 -> return D2I
639       143 -> return D2L
640       144 -> return D2F
641       145 -> return I2B
642       146 -> return I2C
643       147 -> return I2S
644       148 -> return LCMP
645       149 -> return $ FCMP C_LT
646       150 -> return $ FCMP C_GT
647       151 -> return $ DCMP C_LT
648       152 -> return $ DCMP C_GT
649       165 -> IF_ACMP C_EQ <$> get
650       166 -> IF_ACMP C_NE <$> get
651       167 -> GOTO <$> get
652       168 -> JSR <$> get
653       169 -> return RET
654       170 -> do
655              offset <- bytesRead
656              let pads = 4 - (offset `mod` 4)
657              skip (fromIntegral pads)
658              def <- get
659              low <- get
660              high <- get
661              offs <- replicateM (fromIntegral $ high - low + 1) get
662              return $ TABLESWITCH def low high offs
663       171 -> do
664              offset <- bytesRead
665              let pads = 4 - (offset `mod` 4)
666              skip (fromIntegral pads)
667              def <- get
668              n <- get
669              pairs <- replicateM (fromIntegral n) get
670              return $ LOOKUPSWITCH def n pairs
671       172 -> return IRETURN
672       173 -> return LRETURN
673       174 -> return FRETURN
674       175 -> return DRETURN
675       176 -> return ARETURN
676       177 -> return RETURN
677       178 -> GETSTATIC <$> get
678       179 -> PUTSTATIC <$> get
679       180 -> GETFIELD <$> get
680       181 -> PUTFIELD <$> get
681       182 -> INVOKEVIRTUAL <$> get
682       183 -> INVOKESPECIAL <$> get
683       184 -> INVOKESTATIC <$> get
684       185 -> (INVOKEINTERFACE <$> get <*> get) <* skip 1
685       187 -> NEW <$> get
686       188 -> NEWARRAY <$> get
687       189 -> ANEWARRAY <$> get
688       190 -> return ARRAYLENGTH
689       191 -> return ATHROW
690       192 -> CHECKCAST <$> get
691       193 -> INSTANCEOF <$> get
692       194 -> return MONITORENTER
693       195 -> return MONITOREXIT
694       196 -> WIDE <$> get <*> get
695       197 -> MULTINANEWARRAY <$> get <*> get
696       198 -> IFNULL <$> get
697       199 -> IFNONNULL <$> get
698       200 -> GOTO_W <$> get
699       201 -> JSR_W <$> get
700       _ | inRange (59, 62) c -> imm 59 ISTORE_ c
701         | inRange (63, 66) c -> imm 63 LSTORE_ c
702         | inRange (67, 70) c -> imm 67 FSTORE_ c
703         | inRange (71, 74) c -> imm 71 DSTORE_ c
704         | inRange (75, 78) c -> imm 75 ASTORE_ c
705         | inRange (26, 29) c -> imm 26 ILOAD_ c
706         | inRange (30, 33) c -> imm 30 LLOAD_ c
707         | inRange (34, 37) c -> imm 34 FLOAD_ c
708         | inRange (38, 41) c -> imm 38 DLOAD_ c
709         | inRange (42, 45) c -> imm 42 ALOAD_ c
710         | inRange (153, 158) c -> IF (toEnum $ fromIntegral $ c-153) <$> get
711         | inRange (159, 164) c -> IF_ICMP (toEnum $ fromIntegral $ c-159) <$> get
712         | otherwise -> fail $ "Unknown instruction byte code: " ++ show c
713
714 -- | Encode list of instructions
715 encodeInstructions :: [Instruction] -> B.ByteString
716 encodeInstructions code =
717   let p list = forM_ list put
718   in  encodeWith p (0 :: Integer) code
719   
720 -- | Decode Java method
721 decodeMethod :: B.ByteString -> Code
722 decodeMethod str = decodeS (0 :: Integer) str
723
724 -- | Encode Java method
725 encodeMethod :: Code -> B.ByteString
726 encodeMethod code = encodeS (0 :: Integer) code
727