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