diff --git a/.gitignore b/.gitignore index 132e4f3..34dbeef 100644 --- a/.gitignore +++ b/.gitignore @@ -10,3 +10,5 @@ result .fake .vscode/ + +**/Generated*.fs diff --git a/WoofWare.PawPrint.App/Program.fs b/WoofWare.PawPrint.App/Program.fs index 70a1e61..1b293be 100644 --- a/WoofWare.PawPrint.App/Program.fs +++ b/WoofWare.PawPrint.App/Program.fs @@ -4,6 +4,7 @@ open System.Collections.Immutable open System.IO open Microsoft.Extensions.Logging open WoofWare.DotnetRuntimeLocator +open WoofWare.PawPrint.ExternImplementations module Program = let reallyMain (argv : string[]) : int = @@ -22,10 +23,12 @@ module Program = let dotnetRuntimes = DotnetRuntime.SelectForDll dllPath |> ImmutableArray.CreateRange + let impls = NativeImpls.PassThru () + use fileStream = new FileStream (dllPath, FileMode.Open, FileAccess.Read) let terminalState = - Program.run loggerFactory (Some dllPath) fileStream dotnetRuntimes args + Program.run loggerFactory (Some dllPath) fileStream dotnetRuntimes impls args 0 | _ -> diff --git a/WoofWare.PawPrint.Test/TestBasicLock.fs b/WoofWare.PawPrint.Test/TestBasicLock.fs index 17629ea..84de995 100644 --- a/WoofWare.PawPrint.Test/TestBasicLock.fs +++ b/WoofWare.PawPrint.Test/TestBasicLock.fs @@ -21,11 +21,13 @@ module TestBasicLock = let dotnetRuntimes = DotnetRuntime.SelectForDll assy.Location |> ImmutableArray.CreateRange + let impls = NativeImpls.Mock () + use peImage = new MemoryStream (image) try let terminalState, terminatingThread = - Program.run loggerFactory (Some "BasicLock.cs") peImage dotnetRuntimes [] + Program.run loggerFactory (Some "BasicLock.cs") peImage dotnetRuntimes impls [] let exitCode = match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with diff --git a/WoofWare.PawPrint.Test/TestCases.fs b/WoofWare.PawPrint.Test/TestCases.fs index df9f7b2..1988ea7 100644 --- a/WoofWare.PawPrint.Test/TestCases.fs +++ b/WoofWare.PawPrint.Test/TestCases.fs @@ -6,6 +6,7 @@ open FsUnitTyped open NUnit.Framework open WoofWare.DotnetRuntimeLocator open WoofWare.PawPrint +open WoofWare.PawPrint.ExternImplementations open WoofWare.PawPrint.Test [] @@ -17,14 +18,17 @@ module TestCases = { FileName = "BasicException.cs" ExpectedReturnCode = 10 + NativeImpls = NativeImpls.Mock () } { FileName = "BasicLock.cs" ExpectedReturnCode = 10 + NativeImpls = NativeImpls.Mock () } { FileName = "WriteLine.cs" ExpectedReturnCode = 1 + NativeImpls = NativeImpls.Mock () } ] @@ -33,10 +37,34 @@ module TestCases = { FileName = "NoOp.cs" ExpectedReturnCode = 1 + NativeImpls = NativeImpls.Mock () } { FileName = "TriangleNumber.cs" ExpectedReturnCode = 10 + NativeImpls = NativeImpls.Mock () + } + { + FileName = "InstaQuit.cs" + ExpectedReturnCode = 1 + NativeImpls = + let mock = NativeImpls.Mock () + + { mock with + System_Env = + { System_EnvironmentMock.Empty with + GetProcessorCount = + fun thread state -> + let state = + state |> IlMachineState.pushToEvalStack' (EvalStackValue.Int32 1) thread + + (state, WhatWeDid.Executed) |> ExecutionResult.Stepped + _Exit = + fun thread state -> + let state = state |> IlMachineState.loadArgument thread 0 + ExecutionResult.Terminated (state, thread) + } + } } ] @@ -53,7 +81,7 @@ module TestCases = try let terminalState, terminatingThread = - Program.run loggerFactory (Some case.FileName) peImage dotnetRuntimes [] + Program.run loggerFactory (Some case.FileName) peImage dotnetRuntimes case.NativeImpls [] let exitCode = match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with @@ -81,11 +109,13 @@ module TestCases = let dotnetRuntimes = DotnetRuntime.SelectForDll assy.Location |> ImmutableArray.CreateRange + let impls = NativeImpls.Mock () + use peImage = new MemoryStream (image) try let terminalState, terminatingThread = - Program.run loggerFactory (Some case.FileName) peImage dotnetRuntimes [] + Program.run loggerFactory (Some case.FileName) peImage dotnetRuntimes impls [] let exitCode = match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with diff --git a/WoofWare.PawPrint.Test/TestHarness.fs b/WoofWare.PawPrint.Test/TestHarness.fs index 1bb59a7..c8d7e95 100644 --- a/WoofWare.PawPrint.Test/TestHarness.fs +++ b/WoofWare.PawPrint.Test/TestHarness.fs @@ -1,6 +1,7 @@ namespace WoofWare.PawPrint.Test open WoofWare.PawPrint +open WoofWare.PawPrint.ExternImplementations /// Result of executing (some steps of) the program under PawPrint. type RunResult = @@ -16,8 +17,22 @@ type RunResult = FinalState : IlMachineState } +type NativeImpls = + { + System_Env : ISystem_Environment + } + + interface ISystem_Environment_Env with + member this.System_Environment = this.System_Env + + static member Mock () = + { + System_Env = System_EnvironmentMock.Empty + } + type TestCase = { FileName : string ExpectedReturnCode : int + NativeImpls : NativeImpls } diff --git a/WoofWare.PawPrint.Test/TestHelloWorld.fs b/WoofWare.PawPrint.Test/TestHelloWorld.fs index 30eaeca..bdb7618 100644 --- a/WoofWare.PawPrint.Test/TestHelloWorld.fs +++ b/WoofWare.PawPrint.Test/TestHelloWorld.fs @@ -22,11 +22,13 @@ module TestHelloWorld = let dotnetRuntimes = DotnetRuntime.SelectForDll assy.Location |> ImmutableArray.CreateRange + let impls = NativeImpls.Mock () + try use peImage = new MemoryStream (image) let terminalState, terminatingThread = - Program.run loggerFactory (Some "HelloWorld.cs") peImage dotnetRuntimes [] + Program.run loggerFactory (Some "HelloWorld.cs") peImage dotnetRuntimes impls [] let exitCode = match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with diff --git a/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj index e441d28..4881930 100644 --- a/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj +++ b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj @@ -22,6 +22,7 @@ + diff --git a/WoofWare.PawPrint.Test/sources/InstaQuit.cs b/WoofWare.PawPrint.Test/sources/InstaQuit.cs new file mode 100644 index 0000000..d2a18de --- /dev/null +++ b/WoofWare.PawPrint.Test/sources/InstaQuit.cs @@ -0,0 +1,13 @@ +using System; + +namespace HelloWorldApp +{ + class Program + { + static int Main(string[] args) + { + Environment.Exit(1); + return 100; + } + } +} diff --git a/WoofWare.PawPrint/AbstractMachine.fs b/WoofWare.PawPrint/AbstractMachine.fs index 5cd6e2a..528bf0f 100644 --- a/WoofWare.PawPrint/AbstractMachine.fs +++ b/WoofWare.PawPrint/AbstractMachine.fs @@ -5,6 +5,7 @@ open System.Reflection open System.Reflection.Metadata open Microsoft.Extensions.Logging open Microsoft.FSharp.Core +open WoofWare.PawPrint.ExternImplementations type ManagedObject = { @@ -18,6 +19,7 @@ module AbstractMachine = let executeOneStep (loggerFactory : ILoggerFactory) + impls (baseClassTypes : BaseClassTypes) (state : IlMachineState) (thread : ThreadId) @@ -28,8 +30,45 @@ module AbstractMachine = match instruction.ExecutingMethod.Instructions with | None -> - failwith - $"TODO: tried to IL-interpret a method in {snd(instruction.ExecutingMethod.DeclaringType).Name} named {instruction.ExecutingMethod.Name} with no implementation" + let targetAssy = + state.LoadedAssembly (snd instruction.ExecutingMethod.DeclaringType) + |> Option.get + + let targetType = targetAssy.TypeDefs.[fst instruction.ExecutingMethod.DeclaringType] + + let outcome = + match + targetAssy.Name.Name, + targetType.Namespace, + targetType.Name, + instruction.ExecutingMethod.Name, + instruction.ExecutingMethod.Signature.ParameterTypes, + instruction.ExecutingMethod.Signature.ReturnType + with + | "System.Private.CoreLib", + "System", + "Environment", + "GetProcessorCount", + [], + TypeDefn.PrimitiveType PrimitiveType.Int32 -> + let env = ISystem_Environment_Env.get impls + env.GetProcessorCount thread state + | "System.Private.CoreLib", + "System", + "Environment", + "_Exit", + [ TypeDefn.PrimitiveType PrimitiveType.Int32 ], + TypeDefn.Void -> + let env = ISystem_Environment_Env.get impls + env._Exit thread state + | assy, ns, typeName, methName, param, retType -> + failwith + $"TODO: tried to IL-interpret a method in {assy} {ns}.{typeName} named {methName} with no implementation; {param} -> {retType}" + + match outcome with + | ExecutionResult.Terminated (state, terminating) -> ExecutionResult.Terminated (state, terminating) + | ExecutionResult.Stepped (state, whatWeDid) -> + ExecutionResult.Stepped (IlMachineState.returnStackFrame thread state |> Option.get, whatWeDid) | Some instructions -> diff --git a/WoofWare.PawPrint/ExternImplementations/NativeImpls.fs b/WoofWare.PawPrint/ExternImplementations/NativeImpls.fs new file mode 100644 index 0000000..08ebe5f --- /dev/null +++ b/WoofWare.PawPrint/ExternImplementations/NativeImpls.fs @@ -0,0 +1,14 @@ +namespace WoofWare.PawPrint.ExternImplementations + +type NativeImpls = + { + System_Environment : ISystem_Environment + } + + static member PassThru () = + { + System_Environment = System_Environment.passThru + } + + interface ISystem_Environment_Env with + member this.System_Environment = this.System_Environment diff --git a/WoofWare.PawPrint/ExternImplementations/System.Environment.fs b/WoofWare.PawPrint/ExternImplementations/System.Environment.fs new file mode 100644 index 0000000..7521d16 --- /dev/null +++ b/WoofWare.PawPrint/ExternImplementations/System.Environment.fs @@ -0,0 +1,32 @@ +namespace WoofWare.PawPrint.ExternImplementations + +open WoofWare.PawPrint + +type ISystem_Environment = + /// The expected side-effect is to push an Int32 to the stack. + abstract GetProcessorCount : ThreadId -> IlMachineState -> ExecutionResult + /// The expected side effect is to terminate execution. + abstract _Exit : ThreadId -> IlMachineState -> ExecutionResult + +[] +module System_Environment = + let passThru : ISystem_Environment = + { new ISystem_Environment with + member _.GetProcessorCount currentThread state = + IlMachineState.pushToEvalStack' + (EvalStackValue.Int32 System.Environment.ProcessorCount) + currentThread + state + |> Tuple.withRight WhatWeDid.Executed + |> ExecutionResult.Stepped + + member _._Exit currentThread state = + ExecutionResult.Terminated (state, currentThread) + } + +type ISystem_Environment_Env = + abstract System_Environment : ISystem_Environment + +[] +module ISystem_Environment_Env = + let inline get (env : ISystem_Environment_Env) : ISystem_Environment = env.System_Environment diff --git a/WoofWare.PawPrint/IlMachineState.fs b/WoofWare.PawPrint/IlMachineState.fs index 834acf7..5caf691 100644 --- a/WoofWare.PawPrint/IlMachineState.fs +++ b/WoofWare.PawPrint/IlMachineState.fs @@ -834,3 +834,59 @@ module IlMachineState = $"Multiple overloads matching signature for call to {targetType.Namespace}.{targetType.Name}'s {memberName}!" state, assy.Name, Choice1Of2 method + + /// There might be no stack frame to return to, so you might get None. + let returnStackFrame (currentThread : ThreadId) (state : IlMachineState) : IlMachineState option = + let threadStateAtEndOfMethod = state.ThreadState.[currentThread] + + match threadStateAtEndOfMethod.MethodState.ReturnState with + | None -> None + | Some returnState -> + + let state = + match returnState.WasInitialisingType with + | None -> state + | Some finishedInitialising -> state.WithTypeEndInit currentThread finishedInitialising + + // Return to previous stack frame + let state = + { state with + ThreadState = + state.ThreadState + |> Map.add + currentThread + { threadStateAtEndOfMethod with + ActiveMethodState = returnState.JumpTo + ActiveAssembly = + snd + threadStateAtEndOfMethod.MethodStates.[returnState.JumpTo].ExecutingMethod + .DeclaringType + } + } + + match returnState.WasConstructingObj with + | Some constructing -> + // Assumption: a constructor can't also return a value. + state |> pushToEvalStack (CliType.OfManagedObject constructing) currentThread + | None -> + match threadStateAtEndOfMethod.MethodState.EvaluationStack.Values with + | [] -> + // no return value + state + | [ retVal ] -> + let retType = + threadStateAtEndOfMethod.MethodState.ExecutingMethod.Signature.ReturnType + + match retType with + | TypeDefn.Void -> state + | retType -> + // TODO: generics + let toPush = + EvalStackValue.toCliTypeCoerced (CliType.zeroOf ImmutableArray.Empty retType) retVal + + state |> pushToEvalStack toPush currentThread + | _ -> + failwith + "Unexpected interpretation result has a local evaluation stack with more than one element on RET" + + |> Some diff --git a/WoofWare.PawPrint/NullaryIlOp.fs b/WoofWare.PawPrint/NullaryIlOp.fs index 63ae9c7..83183cd 100644 --- a/WoofWare.PawPrint/NullaryIlOp.fs +++ b/WoofWare.PawPrint/NullaryIlOp.fs @@ -81,62 +81,9 @@ module NullaryIlOp = |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped | Ret -> - let threadStateAtEndOfMethod = state.ThreadState.[currentThread] - - match threadStateAtEndOfMethod.MethodState.ReturnState with + match IlMachineState.returnStackFrame currentThread state with | None -> ExecutionResult.Terminated (state, currentThread) - | Some returnState -> - - let state = - match returnState.WasInitialisingType with - | None -> state - | Some finishedInitialising -> state.WithTypeEndInit currentThread finishedInitialising - - // Return to previous stack frame - let state = - { state with - ThreadState = - state.ThreadState - |> Map.add - currentThread - { threadStateAtEndOfMethod with - ActiveMethodState = returnState.JumpTo - ActiveAssembly = - snd - threadStateAtEndOfMethod.MethodStates.[returnState.JumpTo].ExecutingMethod - .DeclaringType - } - } - - let state = - match returnState.WasConstructingObj with - | Some constructing -> - // Assumption: a constructor can't also return a value. - state - |> IlMachineState.pushToEvalStack (CliType.OfManagedObject constructing) currentThread - | None -> - match threadStateAtEndOfMethod.MethodState.EvaluationStack.Values with - | [] -> - // no return value - state - | [ retVal ] -> - let retType = - threadStateAtEndOfMethod.MethodState.ExecutingMethod.Signature.ReturnType - - match retType with - | TypeDefn.Void -> state - | retType -> - // TODO: generics - let toPush = - EvalStackValue.toCliTypeCoerced (CliType.zeroOf ImmutableArray.Empty retType) retVal - - state |> IlMachineState.pushToEvalStack toPush currentThread - | _ -> - failwith - "Unexpected interpretation result has a local evaluation stack with more than one element on RET" - - state |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped - + | Some state -> (state, WhatWeDid.Executed) |> ExecutionResult.Stepped | LdcI4_0 -> state |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 0)) currentThread diff --git a/WoofWare.PawPrint/Program.fs b/WoofWare.PawPrint/Program.fs index 46bb345..fcd767e 100644 --- a/WoofWare.PawPrint/Program.fs +++ b/WoofWare.PawPrint/Program.fs @@ -47,6 +47,7 @@ module Program = (originalPath : string option) (fileStream : Stream) (dotnetRuntimeDirs : ImmutableArray) + impls (argv : string list) : IlMachineState * ThreadId = @@ -125,7 +126,7 @@ module Program = } let rec go (state : IlMachineState) = - match AbstractMachine.executeOneStep loggerFactory baseClassTypes state mainThread with + match AbstractMachine.executeOneStep loggerFactory impls baseClassTypes state mainThread with | ExecutionResult.Terminated (state, terminatingThread) -> state, terminatingThread | ExecutionResult.Stepped (state', whatWeDid) -> diff --git a/WoofWare.PawPrint/WoofWare.PawPrint.fsproj b/WoofWare.PawPrint/WoofWare.PawPrint.fsproj index 0e70106..f60f4a7 100644 --- a/WoofWare.PawPrint/WoofWare.PawPrint.fsproj +++ b/WoofWare.PawPrint/WoofWare.PawPrint.fsproj @@ -1,6 +1,7 @@  + 7.0.7 net8.0 @@ -33,12 +34,25 @@ + + + ExternImplementations\System.Environment.fs + + GenerateMock(false) + + + + + + + + diff --git a/WoofWare.PawPrint/myriad.toml b/WoofWare.PawPrint/myriad.toml new file mode 100644 index 0000000..e69de29 diff --git a/nix/deps.json b/nix/deps.json index 0321ed9..ee7f769 100644 --- a/nix/deps.json +++ b/nix/deps.json @@ -4,6 +4,16 @@ "version": "7.0.0", "hash": "sha256-v4bXmvjZOYxl5RSIHuqVfDzBQdRz5SrmzZtD6SeEYTY=" }, + { + "pname": "Fantomas.Core", + "version": "6.1.1", + "hash": "sha256-FcTLHQFvKkQY/kV08jhhy/St/+FmXpp3epp/R3zUXMA=" + }, + { + "pname": "Fantomas.FCS", + "version": "6.1.1", + "hash": "sha256-NuZ8msPEHYA8T3EYREB28F1RcNgUU8V54eg2+UttYxw=" + }, { "pname": "fsharp-analyzers", "version": "0.28.0", @@ -129,6 +139,26 @@ "version": "8.0.15", "hash": "sha256-qraVbQtSG/gVKXAy2PHi1ua7SY6iasveIN2ayYFmE9U=" }, + { + "pname": "Microsoft.NETCore.Platforms", + "version": "1.1.0", + "hash": "sha256-FeM40ktcObQJk4nMYShB61H/E8B7tIKfl9ObJ0IOcCM=" + }, + { + "pname": "Microsoft.NETCore.Platforms", + "version": "1.1.1", + "hash": "sha256-8hLiUKvy/YirCWlFwzdejD2Db3DaXhHxT7GSZx/znJg=" + }, + { + "pname": "Microsoft.NETCore.Targets", + "version": "1.1.0", + "hash": "sha256-0AqQ2gMS8iNlYkrD+BxtIg7cXMnr9xZHtKAuN4bjfaQ=" + }, + { + "pname": "Microsoft.NETCore.Targets", + "version": "1.1.3", + "hash": "sha256-WLsf1NuUfRWyr7C7Rl9jiua9jximnVvzy6nk2D2bVRc=" + }, { "pname": "Microsoft.Testing.Extensions.Telemetry", "version": "1.5.3", @@ -169,6 +199,16 @@ "version": "17.13.0", "hash": "sha256-L/CJzou7dhmShUgXq3aXL3CaLTJll17Q+JY2DBdUUpo=" }, + { + "pname": "Myriad.Core", + "version": "0.8.3", + "hash": "sha256-vBOxfq8QriX/yUtaXN69rEQaY/psRNJWxqATLidrt2g=" + }, + { + "pname": "Myriad.Sdk", + "version": "0.8.3", + "hash": "sha256-7O397WKhskKOvE3MkJT37BvxorDWngDR6gTUogtDZ2M=" + }, { "pname": "Nerdbank.GitVersioning", "version": "3.8.38-alpha", @@ -189,6 +229,21 @@ "version": "5.0.0", "hash": "sha256-7jZM4qAbIzne3AcdFfMbvbgogqpxvVe6q2S7Ls8xQy0=" }, + { + "pname": "runtime.any.System.Runtime", + "version": "4.3.0", + "hash": "sha256-qwhNXBaJ1DtDkuRacgHwnZmOZ1u9q7N8j0cWOLYOELM=" + }, + { + "pname": "runtime.native.System", + "version": "4.3.0", + "hash": "sha256-ZBZaodnjvLXATWpXXakFgcy6P+gjhshFXmglrL5xD5Y=" + }, + { + "pname": "runtime.unix.System.Private.Uri", + "version": "4.3.0", + "hash": "sha256-c5tXWhE/fYbJVl9rXs0uHh3pTsg44YD1dJvyOA0WoMs=" + }, { "pname": "System.Collections.Immutable", "version": "7.0.0", @@ -199,11 +254,26 @@ "version": "5.0.0", "hash": "sha256-6mW3N6FvcdNH/pB58pl+pFSCGWgyaP4hfVtC/SMWDV4=" }, + { + "pname": "System.Diagnostics.DiagnosticSource", + "version": "7.0.0", + "hash": "sha256-9Wk8cHSkjKtqkN6xW7KnXoQVtF/VNbKeBq79WqDesMs=" + }, { "pname": "System.Diagnostics.DiagnosticSource", "version": "9.0.2", "hash": "sha256-vhlhNgWeEosMB3DyneAUgH2nlpHORo7vAIo5Bx5Dgrc=" }, + { + "pname": "System.Memory", + "version": "4.5.5", + "hash": "sha256-EPQ9o1Kin7KzGI5O3U3PUQAZTItSbk9h/i4rViN3WiI=" + }, + { + "pname": "System.Private.Uri", + "version": "4.3.0", + "hash": "sha256-fVfgcoP4AVN1E5wHZbKBIOPYZ/xBeSIdsNF+bdukIRM=" + }, { "pname": "System.Reflection.Metadata", "version": "1.6.0", @@ -214,14 +284,39 @@ "version": "7.0.0", "hash": "sha256-GwAKQhkhPBYTqmRdG9c9taqrKSKDwyUgOEhWLKxWNPI=" }, + { + "pname": "System.Runtime", + "version": "4.3.1", + "hash": "sha256-R9T68AzS1PJJ7v6ARz9vo88pKL1dWqLOANg4pkQjkA0=" + }, { "pname": "System.Runtime.CompilerServices.Unsafe", "version": "6.0.0", "hash": "sha256-bEG1PnDp7uKYz/OgLOWs3RWwQSVYm+AnPwVmAmcgp2I=" }, + { + "pname": "TypeEquality", + "version": "0.3.0", + "hash": "sha256-V50xAOzzyUJrY+MYPRxtnqW5MVeATXCes89wPprv1r4=" + }, { "pname": "WoofWare.DotnetRuntimeLocator", "version": "0.3.2", "hash": "sha256-Pnm8gnULh33Iog3eN2lTqqxGuaKUFiM9yLLgiAvyFkU=" + }, + { + "pname": "WoofWare.Myriad.Plugins", + "version": "7.0.7", + "hash": "sha256-89jJuslFlqng6VNMpM73VAB23mZ3+ST1Z9tMDxWViWM=" + }, + { + "pname": "WoofWare.Myriad.Plugins.Attributes", + "version": "3.6.10", + "hash": "sha256-oupju6kC6EhuZgWaX5C9nKJr3t5+QDqMEtHzUmKIA3c=" + }, + { + "pname": "WoofWare.Whippet.Fantomas", + "version": "0.6.3", + "hash": "sha256-FkW/HtVp8/HE2k6d7yFpnJcnP3FNNe9kGlkoIWmNgDw=" } ]