module Language.JVM.Attribute.StackMapTable
( StackMapTable (..)
, DeltaOffset
, StackMapFrame (..)
, StackMapFrameType (..)
, VerificationTypeInfo (..)
) where
import GHC.Generics (Generic)
import Data.Binary
import Numeric
import Control.Monad (replicateM)
import Language.JVM.Constant (ConstantRef (..))
import Language.JVM.Utils
data StackMapTable = StackMapTable
{ stackMapTable :: SizedList16 StackMapFrame
} deriving (Show, Eq, Generic)
instance Binary StackMapTable where
type DeltaOffset = Word8
data StackMapFrame = StackMapFrame
{ deltaOffset :: DeltaOffset
, frameType :: StackMapFrameType
} deriving (Show, Eq)
data StackMapFrameType
= SameFrame
| SameLocals1StackItemFrame VerificationTypeInfo
| ChopFrame Word8
| AppendFrame [VerificationTypeInfo]
| FullFrame
(SizedList16 VerificationTypeInfo)
(SizedList16 VerificationTypeInfo)
deriving (Show, Eq)
instance Binary StackMapFrame where
get = do
ft <- getWord8
let
framegetter
| 0 <= ft && ft <= 63
= return $ StackMapFrame ft SameFrame
| 64 <= ft && ft <= 127
= StackMapFrame (ft 64) . SameLocals1StackItemFrame <$> get
| 128 <= ft && ft <= 246
= fail $ "Reserved for further use: '0x" ++ showHex ft "'"
| ft == 247
= StackMapFrame <$> get <*> (SameLocals1StackItemFrame <$> get)
| 248 <= ft && ft <= 250
= StackMapFrame <$> get <*> pure (ChopFrame (251 ft))
| ft == 251
= StackMapFrame <$> get <*> pure SameFrame
| 252 <= ft && ft <= 254
= do
offset <- get
locals <- replicateM (fromIntegral $ ft 251) get
return $ StackMapFrame offset (AppendFrame locals)
| ft == 255
= StackMapFrame <$> get <*> (FullFrame <$> get <*> get)
| otherwise
= fail $ "Unknown frame type '0x" ++ showHex ft "'"
framegetter
put (StackMapFrame off frame) = do
case frame of
SameFrame
| off <= 63 ->
putWord8 off
| otherwise -> do
putWord8 251
putWord8 off
SameLocals1StackItemFrame vt
| off <= 63 -> do
putWord8 (64 + off)
put vt
| otherwise -> do
putWord8 247
putWord8 off
put vt
ChopFrame w
| 0 < w && w <= 3 -> do
putWord8 (251 w)
putWord8 off
| otherwise ->
fail $ "Can't write a cutoff value outside ]0,3], but was: " ++ show w
AppendFrame vs
| length vs <= 3 && 0 < length vs -> do
putWord8 (fromIntegral $ 251 + length vs)
putWord8 off
mapM_ put vs
| otherwise ->
fail $ "The AppendFrame has to contain at least 1 and at most 3 elements: " ++ show vs
FullFrame ls1 ls2 -> do
putWord8 255
put off
put ls1
put ls2
data VerificationTypeInfo
= VTop
| VInteger
| VFloat
| VLong
| VDouble
| VNull
| VUninitializedThis
| VObject !ConstantRef
| VUninitialized !Word16
deriving (Show, Eq)
instance Binary VerificationTypeInfo where
get = do
tag <- getWord8
case tag of
0 -> pure VTop
1 -> pure VInteger
2 -> pure VFloat
3 -> pure VLong
4 -> pure VDouble
5 -> pure VNull
6 -> pure VUninitializedThis
7 -> VObject <$> get
8 -> VUninitialized <$> get
_ -> fail $ "Unexpected tag : '0x" ++ showHex tag "'"
put a = do
case a of
VTop -> putWord8 0
VInteger -> putWord8 1
VFloat -> putWord8 2
VLong -> putWord8 3
VDouble -> putWord8 4
VNull -> putWord8 5
VUninitializedThis -> putWord8 6
VObject s -> do putWord8 7; put s
VUninitialized s -> do putWord8 8; put s