| Copyright | (c) Christian Gram Kalhauge 2018 |
|---|---|
| License | MIT |
| Maintainer | kalhuage@cs.ucla.edu |
| Safe Haskell | None |
| Language | Haskell2010 |
Language.JVM.ByteCode
Description
- newtype ByteCode i = ByteCode {
- unByteCode :: Choice (Word32, Vector (ByteCodeInst Low)) (Vector (ByteCodeOpr High)) i
- evolveByteCode :: EvolveM m => ByteCode Low -> m (OffsetMap, ByteCode High)
- devolveByteCode :: DevolveM m => ByteCode High -> m (ByteCode Low)
- evolveOffset :: EvolveM m => OffsetMap -> ByteCodeOffset -> m ByteCodeIndex
- devolveOffset :: DevolveM m => ByteCode Low -> ByteCodeIndex -> m ByteCodeOffset
- class ByteCodeStaged s where
- data ByteCodeInst r = ByteCodeInst {
- offset :: !ByteCodeOffset
- opcode :: !(ByteCodeOpr r)
- type ByteCodeRef i = Choice ByteCodeOffset ByteCodeIndex i
- type ByteCodeOffset = Word16
- type ByteCodeIndex = Int
- type OffsetMap = IntMap ByteCodeIndex
- indexOffset :: ByteCode Low -> ByteCodeIndex -> Maybe ByteCodeOffset
- offsetIndex :: OffsetMap -> ByteCodeOffset -> Maybe ByteCodeIndex
- offsetMap :: ByteCode Low -> OffsetMap
- data ByteCodeOpr r
- = ArrayLoad ArrayType
- | ArrayStore ArrayType
- | Push (BConstant r)
- | Load LocalType LocalAddress
- | Store LocalType LocalAddress
- | BinaryOpr BinOpr ArithmeticType
- | Neg ArithmeticType
- | BitOpr BitOpr WordSize
- | IncrLocal !LocalAddress !IncrementAmount
- | Cast CastOpr
- | CompareLongs
- | CompareFloating Bool WordSize
- | If CmpOpr OneOrTwo (ShortRelativeRef r)
- | IfRef Bool OneOrTwo (ShortRelativeRef r)
- | Goto (LongRelativeRef r)
- | Jsr (LongRelativeRef r)
- | Ret LocalAddress
- | TableSwitch Int32 (SwitchTable r)
- | LookupSwitch Int32 (Vector (Int32, Int32))
- | Get FieldAccess (DeepRef (InClass FieldId) r)
- | Put FieldAccess (DeepRef (InClass FieldId) r)
- | Invoke (Invocation r)
- | New (Ref ClassName r)
- | NewArray (ExactArrayType r)
- | ArrayLength
- | Throw
- | CheckCast (Ref ClassName r)
- | InstanceOf (Ref ClassName r)
- | Monitor Bool
- | MultiNewArray (Ref ClassName r) Word8
- | Return (Maybe LocalType)
- | Nop
- | Pop WordSize
- | Dup WordSize
- | DupX1 WordSize
- | DupX2 WordSize
- | Swap
- data CConstant r
- data OneOrTwo
- data SwitchTable r = SwitchTable {
- switchLow :: Int32
- switchOffsets :: Vector (LongRelativeRef r)
- switchHigh :: SwitchTable Low -> Int32
- data FieldAccess
- data Invocation r
- data BinOpr
- data BitOpr
- data CmpOpr
- data CastOpr
- data ArithmeticType
- data SmallArithmeticType
- data LocalType
- data ArrayType
- data ExactArrayType r
- type WordSize = OneOrTwo
- type ByteOffset = Int64
- type LocalAddress = Word16
- type IncrementAmount = Int16
Documentation
ByteCode is a newtype wrapper around a list of ByteCode instructions. if the ByteCode is in the Low stage then the byte code instructions are annotated with the byte code offsets.
Constructors
| ByteCode | |
Fields
| |
Instances
| Eq (ByteCode High) Source # | |
| Eq (ByteCode Low) Source # | |
| Ord (ByteCode Low) Source # | |
| Show (ByteCode High) Source # | |
| Show (ByteCode Low) Source # | |
| Generic (ByteCode High) Source # | |
| Generic (ByteCode Low) Source # | |
| Binary (ByteCode Low) Source # | |
| NFData (ByteCode High) Source # | |
| NFData (ByteCode Low) Source # | |
| type Rep (ByteCode High) Source # | |
| type Rep (ByteCode Low) Source # | |
evolve and devolve
evolveOffset :: EvolveM m => OffsetMap -> ByteCodeOffset -> m ByteCodeIndex Source #
Given an OffsetMap turn a offset into a bytecode index
devolveOffset :: DevolveM m => ByteCode Low -> ByteCodeIndex -> m ByteCodeOffset Source #
Given an OffsetMap turn a offset into a bytecode index
class ByteCodeStaged s where Source #
Methods
evolveBC :: EvolveM m => (ByteCodeOffset -> m ByteCodeIndex) -> s Low -> m (s High) Source #
devolveBC :: DevolveM m => (ByteCodeIndex -> m ByteCodeOffset) -> s High -> m (s Low) Source #
Managing offsets
data ByteCodeInst r Source #
The byte code instruction is mostly used to succinctly read and write an bytecode instruction from a bytestring.
Constructors
| ByteCodeInst | |
Fields
| |
Instances
| ByteCodeStaged ByteCodeInst Source # | |
| Eq (ByteCodeInst High) Source # | |
| Eq (ByteCodeInst Low) Source # | |
| Ord (ByteCodeInst Low) Source # | |
| Show (ByteCodeInst High) Source # | |
| Show (ByteCodeInst Low) Source # | |
| Generic (ByteCodeInst High) Source # | |
| Generic (ByteCodeInst Low) Source # | |
| Binary (ByteCodeInst Low) Source # | |
| NFData (ByteCodeInst High) Source # | |
| NFData (ByteCodeInst Low) Source # | |
| type Rep (ByteCodeInst High) Source # | |
| type Rep (ByteCodeInst Low) Source # | |
type ByteCodeRef i = Choice ByteCodeOffset ByteCodeIndex i Source #
A ByteCode reference is either byte code offset in the low stage, and a byte code index in the high state
type ByteCodeOffset = Word16 Source #
The offset in the byte code
type ByteCodeIndex = Int Source #
The index of the byte code.
type OffsetMap = IntMap ByteCodeIndex Source #
The offset map, maps offset to instruction ids.
indexOffset :: ByteCode Low -> ByteCodeIndex -> Maybe ByteCodeOffset Source #
Return the bytecode offset from the bytecode.
offsetIndex :: OffsetMap -> ByteCodeOffset -> Maybe ByteCodeIndex Source #
Given an OffsetMap turn a offset into a bytecode index
ByteCode Operations
data ByteCodeOpr r Source #
Constructors
| ArrayLoad ArrayType | aaload baload ... |
| ArrayStore ArrayType | aastore bastore ... |
| Push (BConstant r) | |
| Load LocalType LocalAddress | aload_0, bload_2, iload 5 ... |
| Store LocalType LocalAddress | aload, bload ... |
| BinaryOpr BinOpr ArithmeticType | iadd ... |
| Neg ArithmeticType | ineg ... |
| BitOpr BitOpr WordSize | Exclusively on int and long, identified by the word-size |
| IncrLocal !LocalAddress !IncrementAmount | |
| Cast CastOpr | Only valid on different types |
| CompareLongs | |
| CompareFloating Bool WordSize | Compare two floating values, 2 is if float or double should be used. |
| If CmpOpr OneOrTwo (ShortRelativeRef r) | compare with 0 if #2 is False, and two ints from the stack if True. the last value is the offset |
| IfRef Bool OneOrTwo (ShortRelativeRef r) | check if two objects are equal, or not equal. If #2 is True, compare with null. |
| Goto (LongRelativeRef r) | |
| Jsr (LongRelativeRef r) | |
| Ret LocalAddress | |
| TableSwitch Int32 (SwitchTable r) | a table switch has 2 values a `default` and a |
| LookupSwitch Int32 (Vector (Int32, Int32)) | a lookup switch has a `default` value and a list of pairs. |
| Get FieldAccess (DeepRef (InClass FieldId) r) | |
| Put FieldAccess (DeepRef (InClass FieldId) r) | |
| Invoke (Invocation r) | |
| New (Ref ClassName r) | |
| NewArray (ExactArrayType r) | |
| ArrayLength | |
| Throw | |
| CheckCast (Ref ClassName r) | |
| InstanceOf (Ref ClassName r) | |
| Monitor Bool | True => Enter, False => Exit |
| MultiNewArray (Ref ClassName r) Word8 | Create a new multi array of 2 dimensions ^ This might point to an array type. |
| Return (Maybe LocalType) | |
| Nop | |
| Pop WordSize | |
| Dup WordSize | |
| DupX1 WordSize | |
| DupX2 WordSize | |
| Swap |
Instances
| Eq (ByteCodeOpr High) Source # | |
| Eq (ByteCodeOpr Low) Source # | |
| Ord (ByteCodeOpr Low) Source # | |
| Show (ByteCodeOpr High) Source # | |
| Show (ByteCodeOpr Low) Source # | |
| Generic (ByteCodeOpr High) Source # | |
| Generic (ByteCodeOpr Low) Source # | |
| Binary (ByteCodeOpr Low) Source # | |
| NFData (ByteCodeOpr High) Source # | |
| NFData (ByteCodeOpr Low) Source # | |
| type Rep (ByteCodeOpr High) Source # | |
| type Rep (ByteCodeOpr Low) Source # | |
Constructors
| CNull | |
| CIntM1 |
|
| CInt0 | |
| CInt1 | |
| CInt2 | |
| CInt3 | |
| CInt4 | |
| CInt5 | |
| CLong0 | |
| CLong1 | |
| CFloat0 | |
| CFloat1 | |
| CFloat2 | |
| CDouble0 | |
| CDouble1 | |
| CByte Int8 | |
| CShort Int16 | |
| CRef (Maybe WordSize) (Ref JValue r) |
Instances
| Staged CConstant Source # | |
| Eq (CConstant High) Source # | |
| Eq (CConstant Low) Source # | |
| Ord (CConstant Low) Source # | |
| Show (CConstant High) Source # | |
| Show (CConstant Low) Source # | |
| Generic (CConstant High) Source # | |
| Generic (CConstant Low) Source # | |
| NFData (CConstant High) Source # | |
| NFData (CConstant Low) Source # | |
| type Rep (CConstant High) Source # | |
| type Rep (CConstant Low) Source # | |
data SwitchTable r Source #
Constructors
| SwitchTable | |
Fields
| |
Instances
| Eq (SwitchTable High) Source # | |
| Eq (SwitchTable Low) Source # | |
| Ord (SwitchTable Low) Source # | |
| Show (SwitchTable High) Source # | |
| Show (SwitchTable Low) Source # | |
| Generic (SwitchTable High) Source # | |
| Generic (SwitchTable Low) Source # | |
| NFData (SwitchTable High) Source # | |
| NFData (SwitchTable Low) Source # | |
| type Rep (SwitchTable High) Source # | |
| type Rep (SwitchTable Low) Source # | |
switchHigh :: SwitchTable Low -> Int32 Source #
data FieldAccess Source #
Instances
data Invocation r Source #
Constructors
| InvkSpecial (DeepRef AbsVariableMethodId r) | Variable since 52.0 |
| InvkVirtual (DeepRef AbsMethodId r) | |
| InvkStatic (DeepRef AbsVariableMethodId r) | Variable since 52.0 |
| InvkInterface Word8 (DeepRef AbsInterfaceMethodId r) | Should be a positive number |
| InvkDynamic (DeepRef InvokeDynamic r) |
Instances
| Staged Invocation Source # | |
| Eq (Invocation High) Source # | |
| Eq (Invocation Low) Source # | |
| Ord (Invocation Low) Source # | |
| Show (Invocation High) Source # | |
| Show (Invocation Low) Source # | |
| Generic (Invocation High) Source # | |
| Generic (Invocation Low) Source # | |
| NFData (Invocation High) Source # | |
| NFData (Invocation Low) Source # | |
| type Rep (Invocation High) Source # | |
| type Rep (Invocation Low) Source # | |
Operations
Constructors
| CastDown SmallArithmeticType | Cast from Int to a smaller type |
| CastTo ArithmeticType ArithmeticType | Cast from any to any arithmetic type. Cannot be the same type. |
Type sets
data ArithmeticType Source #
data SmallArithmeticType Source #
data ExactArrayType r Source #
Instances
| Staged ExactArrayType Source # | |
| Eq (ExactArrayType High) Source # | |
| Eq (ExactArrayType Low) Source # | |
| Ord (ExactArrayType Low) Source # | |
| Show (ExactArrayType High) Source # | |
| Show (ExactArrayType Low) Source # | |
| Generic (ExactArrayType High) Source # | |
| Generic (ExactArrayType Low) Source # | |
| NFData (ExactArrayType High) Source # | |
| NFData (ExactArrayType Low) Source # | |
| type Rep (ExactArrayType High) Source # | |
| type Rep (ExactArrayType Low) Source # | |
Renames
type ByteOffset = Int64 #
An offset, counted in bytes.
type LocalAddress = Word16 Source #
type IncrementAmount = Int16 Source #