Exceptions (#34)

This commit is contained in:
Patrick Stevens
2025-06-01 23:46:40 +01:00
committed by GitHub
parent 3c2541c699
commit 3b1349a076
7 changed files with 594 additions and 39 deletions

View File

@@ -21,36 +21,6 @@ module TestCases =
NativeImpls = MockEnv.make ()
LocalVariablesOfMain = []
}
{
FileName = "ExceptionWithNoOpCatch.cs"
ExpectedReturnCode = 10
NativeImpls = MockEnv.make ()
LocalVariablesOfMain = []
}
{
FileName = "ExceptionWithNoOpFinally.cs"
ExpectedReturnCode = 3
NativeImpls = MockEnv.make ()
LocalVariablesOfMain =
[
// Variable 1 is `x`, variable 2 is the implicit return value
4
3
]
|> List.map (fun i -> CliType.Numeric (CliNumericType.Int32 i))
}
{
FileName = "TryCatchWithThrowInBody.cs"
ExpectedReturnCode = 4
NativeImpls = MockEnv.make ()
LocalVariablesOfMain =
[
// one variable is x, one variable is the return value which also happens to have the same value
4
4
]
|> List.map (fun i -> CliType.Numeric (CliNumericType.Int32 i))
}
{
FileName = "ComplexTryCatch.cs"
ExpectedReturnCode = 14
@@ -146,6 +116,36 @@ module TestCases =
}
LocalVariablesOfMain = []
}
{
FileName = "ExceptionWithNoOpFinally.cs"
ExpectedReturnCode = 3
NativeImpls = MockEnv.make ()
LocalVariablesOfMain =
[
// Variable 1 is `x`, variable 2 is the implicit return value
4
3
]
|> List.map (fun i -> CliType.Numeric (CliNumericType.Int32 i))
}
{
FileName = "ExceptionWithNoOpCatch.cs"
ExpectedReturnCode = 10
NativeImpls = MockEnv.make ()
LocalVariablesOfMain = [ CliType.Numeric (CliNumericType.Int32 10) ]
}
{
FileName = "TryCatchWithThrowInBody.cs"
ExpectedReturnCode = 4
NativeImpls = MockEnv.make ()
LocalVariablesOfMain =
[
// one variable is x, one variable is the return value which also happens to have the same value
4
4
]
|> List.map (fun i -> CliType.Numeric (CliNumericType.Int32 i))
}
]
[<TestCaseSource(nameof cases)>]

View File

@@ -0,0 +1,141 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
open System.Reflection.Metadata
/// Represents a location in the code where an exception occurred
type ExceptionStackFrame =
{
Method : WoofWare.PawPrint.MethodInfo<TypeDefn>
/// The number of bytes into the IL of the method we were in
IlOffset : int
}
/// Represents a CLI exception being propagated
type CliException =
{
/// The exception object allocated on the heap
ExceptionObject : ManagedHeapAddress
/// Stack trace built during unwinding
StackTrace : ExceptionStackFrame list
}
/// Represents what to do after executing a finally/filter block
type ExceptionContinuation =
| ResumeAfterFinally of targetPC : int
| PropagatingException of exn : CliException
| ResumeAfterFilter of handlerPC : int * exn : CliException
/// Helper functions for exception handling
[<RequireQualifiedAccess>]
module ExceptionHandling =
/// Check if an exception type matches a catch handler type
let private isExceptionAssignableTo
(exceptionTypeCrate : TypeInfoCrate)
(catchTypeToken : MetadataToken)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
: bool
=
// TODO: Implement proper type assignability checking
true
/// Find the first matching exception handler for the given exception at the given PC.
/// Also returns `isFinally : bool`: whether this is a `finally` block (as opposed to e.g. a `catch`).
let findExceptionHandler
(currentPC : int)
(exceptionTypeCrate : TypeInfoCrate)
(method : WoofWare.PawPrint.MethodInfo<TypeDefn>)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
: (WoofWare.PawPrint.ExceptionRegion * bool) option // handler, isFinally
=
match method.Instructions with
| None -> None
| Some instructions ->
// Find all handlers that cover the current PC
instructions.ExceptionRegions
|> Seq.choose (fun region ->
match region with
| ExceptionRegion.Catch (typeToken, offset) ->
if currentPC >= offset.TryOffset && currentPC < offset.TryOffset + offset.TryLength then
// Check if exception type matches
if isExceptionAssignableTo exceptionTypeCrate typeToken assemblies then
Some (region, false)
else
None
else
None
| ExceptionRegion.Filter (filterOffset, offset) ->
if currentPC >= offset.TryOffset && currentPC < offset.TryOffset + offset.TryLength then
failwith "TODO: filter needs to be evaluated"
else
None
| ExceptionRegion.Finally offset ->
if currentPC >= offset.TryOffset && currentPC < offset.TryOffset + offset.TryLength then
Some (region, true)
else
None
| ExceptionRegion.Fault offset ->
if currentPC >= offset.TryOffset && currentPC < offset.TryOffset + offset.TryLength then
Some (region, true)
else
None
)
|> Seq.toList
|> fun x ->
match x with
| [] -> None
| [ x ] -> Some x
| _ -> failwith "multiple exception regions"
/// Find finally blocks that need to run when leaving a try region
let findFinallyBlocksToRun
(currentPC : int)
(targetPC : int)
(method : WoofWare.PawPrint.MethodInfo<TypeDefn>)
: ExceptionOffset list
=
match method.Instructions with
| None -> []
| Some instructions ->
instructions.ExceptionRegions
|> Seq.choose (fun region ->
match region with
| ExceptionRegion.Finally offset ->
// We're leaving if we're in the try block and target is outside
if
currentPC >= offset.TryOffset
&& currentPC < offset.TryOffset + offset.TryLength
&& (targetPC < offset.TryOffset || targetPC >= offset.TryOffset + offset.TryLength)
then
Some offset
else
None
| _ -> None
)
|> Seq.sortBy (fun offset ->
// Inner to outer
-offset.TryOffset
)
|> Seq.toList
/// Get the active exception regions at a given offset
let getActiveRegionsAtOffset
(offset : int)
(method : WoofWare.PawPrint.MethodInfo<TypeDefn>)
: WoofWare.PawPrint.ExceptionRegion list
=
match method.Instructions with
| None -> []
| Some instructions ->
instructions.ExceptionRegions
|> Seq.filter (fun region ->
match region with
| ExceptionRegion.Catch (_, exOffset)
| ExceptionRegion.Finally exOffset
| ExceptionRegion.Fault exOffset
| ExceptionRegion.Filter (_, exOffset) ->
offset >= exOffset.TryOffset && offset < exOffset.TryOffset + exOffset.TryLength
)
|> Seq.toList

View File

@@ -174,6 +174,154 @@ type NullaryIlOp =
| Readonly
| Refanytype
override this.ToString () =
match this with
| NullaryIlOp.Nop -> "Nop"
| NullaryIlOp.LdArg0 -> "LdArg0"
| NullaryIlOp.LdArg1 -> "LdArg1"
| NullaryIlOp.LdArg2 -> "LdArg2"
| NullaryIlOp.LdArg3 -> "LdArg3"
| NullaryIlOp.Ldloc_0 -> "Ldloc_0"
| NullaryIlOp.Ldloc_1 -> "Ldloc_1"
| NullaryIlOp.Ldloc_2 -> "Ldloc_2"
| NullaryIlOp.Ldloc_3 -> "Ldloc_3"
| NullaryIlOp.Pop -> "Pop"
| NullaryIlOp.Dup -> "Dup"
| NullaryIlOp.Ret -> "Ret"
| NullaryIlOp.LdcI4_0 -> "LdcI4_0"
| NullaryIlOp.LdcI4_1 -> "LdcI4_1"
| NullaryIlOp.LdcI4_2 -> "LdcI4_2"
| NullaryIlOp.LdcI4_3 -> "LdcI4_3"
| NullaryIlOp.LdcI4_4 -> "LdcI4_4"
| NullaryIlOp.LdcI4_5 -> "LdcI4_5"
| NullaryIlOp.LdcI4_6 -> "LdcI4_6"
| NullaryIlOp.LdcI4_7 -> "LdcI4_7"
| NullaryIlOp.LdcI4_8 -> "LdcI4_8"
| NullaryIlOp.LdcI4_m1 -> "LdcI4_m1"
| NullaryIlOp.LdNull -> "LdNull"
| NullaryIlOp.Ceq -> "Ceq"
| NullaryIlOp.Cgt -> "Cgt"
| NullaryIlOp.Cgt_un -> "Cgt_un"
| NullaryIlOp.Clt -> "Clt"
| NullaryIlOp.Clt_un -> "Clt_un"
| NullaryIlOp.Stloc_0 -> "Stloc_0"
| NullaryIlOp.Stloc_1 -> "Stloc_1"
| NullaryIlOp.Stloc_2 -> "Stloc_2"
| NullaryIlOp.Stloc_3 -> "Stloc_3"
| NullaryIlOp.Sub -> "Sub"
| NullaryIlOp.Sub_ovf -> "Sub_ovf"
| NullaryIlOp.Sub_ovf_un -> "Sub_ovf_un"
| NullaryIlOp.Add -> "Add"
| NullaryIlOp.Add_ovf -> "Add_ovf"
| NullaryIlOp.Add_ovf_un -> "Add_ovf_un"
| NullaryIlOp.Mul -> "Mul"
| NullaryIlOp.Mul_ovf -> "Mul_ovf"
| NullaryIlOp.Mul_ovf_un -> "Mul_ovf_un"
| NullaryIlOp.Div -> "Div"
| NullaryIlOp.Div_un -> "Div_un"
| NullaryIlOp.Rem -> "Rem"
| NullaryIlOp.Rem_un -> "Rem_un"
| NullaryIlOp.Neg -> "Neg"
| NullaryIlOp.Not -> "Not"
| NullaryIlOp.Shr -> "Shr"
| NullaryIlOp.Shr_un -> "Shr_un"
| NullaryIlOp.Shl -> "Shl"
| NullaryIlOp.Conv_ovf_i -> "Conv_ovf_i"
| NullaryIlOp.Conv_ovf_u -> "Conv_ovf_u"
| NullaryIlOp.And -> "And"
| NullaryIlOp.Or -> "Or"
| NullaryIlOp.Xor -> "Xor"
| NullaryIlOp.Conv_I -> "Conv_I"
| NullaryIlOp.Conv_I1 -> "Conv_I1"
| NullaryIlOp.Conv_I2 -> "Conv_I2"
| NullaryIlOp.Conv_I4 -> "Conv_I4"
| NullaryIlOp.Conv_I8 -> "Conv_I8"
| NullaryIlOp.Conv_R4 -> "Conv_R4"
| NullaryIlOp.Conv_R8 -> "Conv_R8"
| NullaryIlOp.Conv_U -> "Conv_U"
| NullaryIlOp.Conv_U1 -> "Conv_U1"
| NullaryIlOp.Conv_U2 -> "Conv_U2"
| NullaryIlOp.Conv_U4 -> "Conv_U4"
| NullaryIlOp.Conv_U8 -> "Conv_U8"
| NullaryIlOp.Conv_ovf_u1 -> "Conv_ovf_u1"
| NullaryIlOp.Conv_ovf_u2 -> "Conv_ovf_u2"
| NullaryIlOp.Conv_ovf_u4 -> "Conv_ovf_u4"
| NullaryIlOp.Conv_ovf_u8 -> "Conv_ovf_u8"
| NullaryIlOp.Conv_ovf_i1 -> "Conv_ovf_i1"
| NullaryIlOp.Conv_ovf_i2 -> "Conv_ovf_i2"
| NullaryIlOp.Conv_ovf_i4 -> "Conv_ovf_i4"
| NullaryIlOp.Conv_ovf_i8 -> "Conv_ovf_i8"
| NullaryIlOp.LdLen -> "LdLen"
| NullaryIlOp.Endfilter -> "Endfilter"
| NullaryIlOp.Endfinally -> "Endfinally"
| NullaryIlOp.Rethrow -> "Rethrow"
| NullaryIlOp.Throw -> "Throw"
| NullaryIlOp.Localloc -> "Localloc"
| NullaryIlOp.Ldind_ref -> "Ldind_ref"
| NullaryIlOp.Stind_ref -> "Stind_ref"
| NullaryIlOp.Stind_I -> "Stind_I"
| NullaryIlOp.Stind_I1 -> "Stind_I1"
| NullaryIlOp.Stind_I2 -> "Stind_I2"
| NullaryIlOp.Stind_I4 -> "Stind_I4"
| NullaryIlOp.Stind_I8 -> "Stind_I8"
| NullaryIlOp.Stind_R4 -> "Stind_R4"
| NullaryIlOp.Stind_R8 -> "Stind_R8"
| NullaryIlOp.Ldind_i -> "Ldind_i"
| NullaryIlOp.Ldind_i1 -> "Ldind_i1"
| NullaryIlOp.Ldind_i2 -> "Ldind_i2"
| NullaryIlOp.Ldind_i4 -> "Ldind_i4"
| NullaryIlOp.Ldind_i8 -> "Ldind_i8"
| NullaryIlOp.Ldind_u1 -> "Ldind_u1"
| NullaryIlOp.Ldind_u2 -> "Ldind_u2"
| NullaryIlOp.Ldind_u4 -> "Ldind_u4"
| NullaryIlOp.Ldind_u8 -> "Ldind_u8"
| NullaryIlOp.Ldind_r4 -> "Ldind_r4"
| NullaryIlOp.Ldind_r8 -> "Ldind_r8"
| NullaryIlOp.Volatile -> "Volatile"
| NullaryIlOp.Tail -> "Tail"
| NullaryIlOp.Conv_ovf_i_un -> "Conv_ovf_i_un"
| NullaryIlOp.Conv_ovf_u_un -> "Conv_ovf_u_un"
| NullaryIlOp.Conv_ovf_i1_un -> "Conv_ovf_i1_un"
| NullaryIlOp.Conv_ovf_u1_un -> "Conv_ovf_u1_un"
| NullaryIlOp.Conv_ovf_i2_un -> "Conv_ovf_i2_un"
| NullaryIlOp.Conv_ovf_u2_un -> "Conv_ovf_u2_un"
| NullaryIlOp.Conv_ovf_i4_un -> "Conv_ovf_i4_un"
| NullaryIlOp.Conv_ovf_u4_un -> "Conv_ovf_u4_un"
| NullaryIlOp.Conv_ovf_i8_un -> "Conv_ovf_i8_un"
| NullaryIlOp.Conv_ovf_u8_un -> "Conv_ovf_u8_un"
| NullaryIlOp.Ldelem_i -> "Ldelem_i"
| NullaryIlOp.Ldelem_i1 -> "Ldelem_i1"
| NullaryIlOp.Ldelem_u1 -> "Ldelem_u1"
| NullaryIlOp.Ldelem_i2 -> "Ldelem_i2"
| NullaryIlOp.Ldelem_u2 -> "Ldelem_u2"
| NullaryIlOp.Ldelem_i4 -> "Ldelem_i4"
| NullaryIlOp.Ldelem_u4 -> "Ldelem_u4"
| NullaryIlOp.Ldelem_i8 -> "Ldelem_i8"
| NullaryIlOp.Ldelem_u8 -> "Ldelem_u8"
| NullaryIlOp.Ldelem_r4 -> "Ldelem_r4"
| NullaryIlOp.Ldelem_r8 -> "Ldelem_r8"
| NullaryIlOp.Ldelem_ref -> "Ldelem_ref"
| NullaryIlOp.Stelem_i -> "Stelem_i"
| NullaryIlOp.Stelem_i1 -> "Stelem_i1"
| NullaryIlOp.Stelem_u1 -> "Stelem_u1"
| NullaryIlOp.Stelem_i2 -> "Stelem_i2"
| NullaryIlOp.Stelem_u2 -> "Stelem_u2"
| NullaryIlOp.Stelem_i4 -> "Stelem_i4"
| NullaryIlOp.Stelem_u4 -> "Stelem_u4"
| NullaryIlOp.Stelem_i8 -> "Stelem_i8"
| NullaryIlOp.Stelem_u8 -> "Stelem_u8"
| NullaryIlOp.Stelem_r4 -> "Stelem_r4"
| NullaryIlOp.Stelem_r8 -> "Stelem_r8"
| NullaryIlOp.Stelem_ref -> "Stelem_ref"
| NullaryIlOp.Cpblk -> "Cpblk"
| NullaryIlOp.Initblk -> "Initblk"
| NullaryIlOp.Break -> "Break"
| NullaryIlOp.Conv_r_un -> "Conv_r_un"
| NullaryIlOp.Arglist -> "Arglist"
| NullaryIlOp.Ckfinite -> "Ckfinite"
| NullaryIlOp.Readonly -> "Readonly"
| NullaryIlOp.Refanytype -> "Refanytype"
/// The number of bytes this instruction takes in memory.
static member NumberOfBytes (op : NullaryIlOp) : int =
match op with
@@ -233,6 +381,10 @@ type UnaryConstIlOp =
| Ldarga of uint16
| Ldarg_s of uint8
| Ldarga_s of uint8
/// Unconditionally transfer control to this offset from the next instruction;
/// like Br but can leave a try/filter/catch block too, and ensures surrounding `finally` blocks execute.
/// Unconditionally empties the evaluation stack; so a Leave outside an exception-handling block is just a Br which
/// also clears the eval stack.
| Leave of int32
/// Unconditionally transfer control to this offset from the next instruction;
/// like Br but can leave a try/filter/catch block too, and ensures surrounding `finally` blocks execute.
@@ -297,6 +449,55 @@ type UnaryConstIlOp =
| Ldc_R4 _ -> 1 + 4 // One-byte opcode + 4-byte argument
| Ldc_R8 _ -> 1 + 8 // One-byte opcode + 8-byte argument
override this.ToString () =
match this with
| UnaryConstIlOp.Stloc i -> $"Stloc %i{i}"
| UnaryConstIlOp.Stloc_s i -> $"Stloc_s %i{i}"
| UnaryConstIlOp.Ldc_I8 i -> $"Ldc_I8 %i{i}"
| UnaryConstIlOp.Ldc_I4 i -> $"Ldc_I4 %i{i}"
| UnaryConstIlOp.Ldc_R4 f -> $"Ldc_R4 %f{f}"
| UnaryConstIlOp.Ldc_R8 f -> $"Ldc_R8 %f{f}"
| UnaryConstIlOp.Ldc_I4_s i -> $"Ldc_I4_s %i{i}"
| UnaryConstIlOp.Br i -> $"Br %i{i}"
| UnaryConstIlOp.Br_s i -> $"Br_s %i{i}"
| UnaryConstIlOp.Brfalse_s i -> $"Brfalse_s %i{i}"
| UnaryConstIlOp.Brtrue_s i -> $"Brtrue_s %i{i}"
| UnaryConstIlOp.Brfalse i -> $"Brfalse %i{i}"
| UnaryConstIlOp.Brtrue i -> $"Brtrue %i{i}"
| UnaryConstIlOp.Beq_s i -> $"Beq_s %i{i}"
| UnaryConstIlOp.Blt_s i -> $"Blt_s %i{i}"
| UnaryConstIlOp.Ble_s i -> $"Ble_s %i{i}"
| UnaryConstIlOp.Bgt_s i -> $"Bgt_s %i{i}"
| UnaryConstIlOp.Bge_s i -> $"Bge_s %i{i}"
| UnaryConstIlOp.Beq i -> $"Beq %i{i}"
| UnaryConstIlOp.Blt i -> $"Blt %i{i}"
| UnaryConstIlOp.Ble i -> $"Ble %i{i}"
| UnaryConstIlOp.Bgt i -> $"Bgt %i{i}"
| UnaryConstIlOp.Bge i -> $"Bge %i{i}"
| UnaryConstIlOp.Bne_un_s i -> $"Bne_un_s %i{i}"
| UnaryConstIlOp.Bge_un_s i -> $"Bge_un_s %i{i}"
| UnaryConstIlOp.Bgt_un_s i -> $"Bgt_un_s %i{i}"
| UnaryConstIlOp.Ble_un_s i -> $"Ble_un_s %i{i}"
| UnaryConstIlOp.Blt_un_s i -> $"Blt_un_s %i{i}"
| UnaryConstIlOp.Bne_un i -> $"Bne_un %i{i}"
| UnaryConstIlOp.Bge_un i -> $"Bge_un %i{i}"
| UnaryConstIlOp.Bgt_un i -> $"Bgt_un %i{i}"
| UnaryConstIlOp.Ble_un i -> $"Ble_un %i{i}"
| UnaryConstIlOp.Blt_un i -> $"Blt_un %i{i}"
| UnaryConstIlOp.Ldloc_s i -> $"Ldloc_s %i{i}"
| UnaryConstIlOp.Ldloca_s i -> $"Ldloca_s %i{i}"
| UnaryConstIlOp.Ldarga i -> $"Ldarga %i{i}"
| UnaryConstIlOp.Ldarg_s i -> $"Ldarg_s %i{i}"
| UnaryConstIlOp.Ldarga_s i -> $"Ldarga_s %i{i}"
| UnaryConstIlOp.Leave i -> $"Leave %i{i}"
| UnaryConstIlOp.Leave_s i -> $"Leave_s %i{i}"
| UnaryConstIlOp.Starg_s i -> $"Starg_s %i{i}"
| UnaryConstIlOp.Starg i -> $"Starg %i{i}"
| UnaryConstIlOp.Unaligned i -> $"Unaligned %i{i}"
| UnaryConstIlOp.Ldloc i -> $"Ldloc %i{i}"
| UnaryConstIlOp.Ldloca i -> $"Ldloca %i{i}"
| UnaryConstIlOp.Ldarg i -> $"Ldarg %i{i}"
type UnaryMetadataTokenIlOp =
| Call
| Calli

View File

@@ -16,7 +16,7 @@ and MethodState =
// TODO: local variables are initialised to 0 if the localsinit flag is set for the method
LocalVariables : CliType ImmutableArray
/// Index into the stream of IL bytes.
IlOpIndex : int
_IlOpIndex : int
EvaluationStack : EvalStack
Arguments : CliType ImmutableArray
ExecutingMethod : WoofWare.PawPrint.MethodInfo<TypeDefn>
@@ -25,13 +25,32 @@ and MethodState =
/// On return, we restore this state. This should be Some almost always; an exception is the entry point.
ReturnState : MethodReturnState option
Generics : ImmutableArray<TypeDefn> option
/// Track which exception regions are currently active (innermost first)
ActiveExceptionRegions : ExceptionRegion list
/// When executing a finally/fault/filter, we need to know where to return
ExceptionContinuation : ExceptionContinuation option
}
static member jumpProgramCounter (bytes : int) (state : MethodState) =
member this.IlOpIndex = this._IlOpIndex
/// Set the program counter to an absolute byte offset from the start of the method.
static member setProgramCounter (absoluteOffset : int) (state : MethodState) =
let jumped =
{ state with
IlOpIndex = state.IlOpIndex + bytes
_IlOpIndex = absoluteOffset
}
let newActiveRegions =
ExceptionHandling.getActiveRegionsAtOffset jumped.IlOpIndex state.ExecutingMethod
{ jumped with
ActiveExceptionRegions = newActiveRegions
}
static member jumpProgramCounter (bytes : int) (state : MethodState) =
MethodState.setProgramCounter (state._IlOpIndex + bytes) state
static member advanceProgramCounter (state : MethodState) =
MethodState.jumpProgramCounter
(IlOp.NumberOfBytes state.ExecutingMethod.Instructions.Value.Locations.[state.IlOpIndex])
@@ -39,6 +58,21 @@ and MethodState =
static member peekEvalStack (state : MethodState) : EvalStackValue option = EvalStack.Peek state.EvaluationStack
static member clearEvalStack (state : MethodState) : MethodState =
{ state with
EvaluationStack = EvalStack.Empty
}
static member setExceptionContinuation (cont : ExceptionContinuation) (state : MethodState) : MethodState =
{ state with
ExceptionContinuation = Some cont
}
static member clearExceptionContinuation (state : MethodState) : MethodState =
{ state with
ExceptionContinuation = None
}
static member pushToEvalStack' (e : EvalStackValue) (state : MethodState) : MethodState =
{ state with
EvaluationStack = EvalStack.Push' e state.EvaluationStack
@@ -146,14 +180,18 @@ and MethodState =
Error (requiredAssemblies |> Seq.toList)
else
let activeRegions = ExceptionHandling.getActiveRegionsAtOffset 0 method
{
EvaluationStack = EvalStack.Empty
LocalVariables = localVars
IlOpIndex = 0
_IlOpIndex = 0
Arguments = args
ExecutingMethod = method
LocalMemoryPool = ()
ReturnState = returnState
Generics = methodGenerics
ActiveExceptionRegions = activeRegions
ExceptionContinuation = None
}
|> Ok

View File

@@ -436,9 +436,136 @@ module NullaryIlOp =
| Conv_U8 -> failwith "TODO: Conv_U8 unimplemented"
| LdLen -> failwith "TODO: LdLen unimplemented"
| Endfilter -> failwith "TODO: Endfilter unimplemented"
| Endfinally -> failwith "TODO: Endfinally unimplemented"
| Endfinally ->
let threadState = state.ThreadState.[currentThread]
let currentMethodState = threadState.MethodStates.[threadState.ActiveMethodState]
match currentMethodState.ExceptionContinuation with
| None ->
// Not in a finally block, just advance PC
state
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Some (ExceptionContinuation.ResumeAfterFinally targetPC) ->
// Resume at the leave target
let newMethodState =
currentMethodState
|> MethodState.setProgramCounter targetPC
|> MethodState.clearExceptionContinuation
let newThreadState =
{ threadState with
MethodStates = threadState.MethodStates.SetItem (threadState.ActiveMethodState, newMethodState)
}
{ state with
ThreadState = state.ThreadState |> Map.add currentThread newThreadState
}
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Some (ExceptionContinuation.PropagatingException exn) ->
// Continue exception propagation after finally block
let updatedExn =
{ exn with
StackTrace =
{
Method = currentMethodState.ExecutingMethod
IlOffset = currentMethodState.IlOpIndex
}
:: exn.StackTrace
}
// Search for next handler
// TODO: Need to get exception type from heap object
failwith "TODO: Exception type lookup from heap address not yet implemented"
| Some (ExceptionContinuation.ResumeAfterFilter (handlerPC, exn)) ->
// Filter evaluated, continue propagation or jump to handler based on filter result
failwith "TODO: ResumeAfterFilter not yet implemented"
| Rethrow -> failwith "TODO: Rethrow unimplemented"
| Throw -> failwith "TODO: Throw unimplemented"
| Throw ->
// Pop exception object from stack and begin exception handling
let exceptionObject, state = IlMachineState.popEvalStack currentThread state
let addr =
match exceptionObject with
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr)
| EvalStackValue.ObjectRef addr -> addr
| existing -> failwith $"Throw instruction requires an object reference on the stack; got %O{existing}"
let threadState = state.ThreadState.[currentThread]
let currentMethodState = threadState.MethodStates.[threadState.ActiveMethodState]
// Get exception type from heap object
let heapObject =
match state.ManagedHeap.NonArrayObjects |> Map.tryFind addr with
| Some obj -> obj
| None -> failwith "Exception object not found in heap"
// Build initial stack trace
let stackFrame =
{
Method = currentMethodState.ExecutingMethod
IlOffset = currentMethodState.IlOpIndex
}
let cliException =
{
ExceptionObject = addr
StackTrace = [ stackFrame ]
}
// Search for handler in current method
match
ExceptionHandling.findExceptionHandler
currentMethodState.IlOpIndex
heapObject.Type
currentMethodState.ExecutingMethod
state._LoadedAssemblies
with
| Some (handler, isFinally) ->
match handler with
| ExceptionRegion.Catch (_, offset) ->
// Jump to catch handler, push exception
let newMethodState =
currentMethodState
|> MethodState.setProgramCounter offset.HandlerOffset
|> MethodState.clearEvalStack
|> MethodState.pushToEvalStack' exceptionObject
let newThreadState =
{ threadState with
MethodStates =
threadState.MethodStates.SetItem (threadState.ActiveMethodState, newMethodState)
}
{ state with
ThreadState = state.ThreadState |> Map.add currentThread newThreadState
}
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| ExceptionRegion.Finally offset ->
// Jump to finally handler with exception continuation
let newMethodState =
currentMethodState
|> MethodState.setProgramCounter offset.HandlerOffset
|> MethodState.clearEvalStack
|> MethodState.setExceptionContinuation (PropagatingException cliException)
let newThreadState =
{ threadState with
MethodStates =
threadState.MethodStates.SetItem (threadState.ActiveMethodState, newMethodState)
}
{ state with
ThreadState = state.ThreadState |> Map.add currentThread newThreadState
}
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| _ -> failwith "TODO: Filter and Fault handlers not yet implemented"
| None -> failwith "TODO: Implement stack unwinding when no handler in current method"
| Localloc -> failwith "TODO: Localloc unimplemented"
| Stind_I ->
let state =

View File

@@ -3,6 +3,53 @@ namespace WoofWare.PawPrint
[<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module internal UnaryConstIlOp =
let private leave (currentThread : ThreadId) (offset : int) (state : IlMachineState) : IlMachineState * WhatWeDid =
let threadState = state.ThreadState.[currentThread]
let currentMethodState = threadState.MethodStates.[threadState.ActiveMethodState]
let targetPc =
(MethodState.advanceProgramCounter currentMethodState).IlOpIndex + offset
let finallyBlocksToRun =
let currentPC = currentMethodState.IlOpIndex
ExceptionHandling.findFinallyBlocksToRun currentPC targetPc currentMethodState.ExecutingMethod
// TODO: check that finallyBlocksToRun are indeed sorted by closeness
match finallyBlocksToRun with
| [] ->
// No finallys to run, just jump and clear eval stack
let newMethodState =
currentMethodState
|> MethodState.clearEvalStack
|> MethodState.setProgramCounter targetPc
let newThreadState =
{ threadState with
MethodStates = threadState.MethodStates.SetItem (threadState.ActiveMethodState, newMethodState)
}
{ state with
ThreadState = state.ThreadState |> Map.add currentThread newThreadState
},
WhatWeDid.Executed
| finallyOffset :: _ ->
// Jump to first finally, set up continuation, clear eval stack
let newMethodState =
currentMethodState
|> MethodState.clearEvalStack
|> MethodState.setExceptionContinuation (ExceptionContinuation.ResumeAfterFinally targetPc)
|> MethodState.setProgramCounter finallyOffset.HandlerOffset
let newThreadState =
{ threadState with
MethodStates = threadState.MethodStates.SetItem (threadState.ActiveMethodState, newMethodState)
}
{ state with
ThreadState = state.ThreadState |> Map.add currentThread newThreadState
},
WhatWeDid.Executed
let execute (state : IlMachineState) (currentThread : ThreadId) (op : UnaryConstIlOp) : IlMachineState * WhatWeDid =
match op with
| Stloc s ->
@@ -175,8 +222,8 @@ module internal UnaryConstIlOp =
| Ldarga s -> failwith "TODO: Ldarga unimplemented"
| Ldarg_s b -> failwith "TODO: Ldarg_s unimplemented"
| Ldarga_s b -> failwith "TODO: Ldarga_s unimplemented"
| Leave i -> failwith "TODO: Leave unimplemented"
| Leave_s b -> failwith "TODO: Leave_s unimplemented"
| Leave i -> leave currentThread i state
| Leave_s b -> leave currentThread (int<int8> b) state
| Starg_s b -> failwith "TODO: Starg_s unimplemented"
| Starg s -> failwith "TODO: Starg unimplemented"
| Unaligned b -> failwith "TODO: Unaligned unimplemented"

View File

@@ -33,6 +33,7 @@
<Compile Include="BasicCliType.fs" />
<Compile Include="ManagedHeap.fs" />
<Compile Include="TypeInitialisation.fs" />
<Compile Include="Exceptions.fs" />
<Compile Include="EvalStack.fs" />
<Compile Include="MethodState.fs" />
<Compile Include="ThreadState.fs" />