Add native call implementations (#18)

This commit is contained in:
Patrick Stevens
2025-05-26 19:24:28 +01:00
committed by GitHub
parent 70f78f9729
commit 7599dd05c9
17 changed files with 329 additions and 63 deletions

2
.gitignore vendored
View File

@@ -10,3 +10,5 @@ result
.fake
.vscode/
**/Generated*.fs

View File

@@ -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
| _ ->

View File

@@ -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

View File

@@ -6,6 +6,7 @@ open FsUnitTyped
open NUnit.Framework
open WoofWare.DotnetRuntimeLocator
open WoofWare.PawPrint
open WoofWare.PawPrint.ExternImplementations
open WoofWare.PawPrint.Test
[<TestFixture>]
@@ -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

View File

@@ -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
}

View File

@@ -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

View File

@@ -22,6 +22,7 @@
<EmbeddedResource Include="sources\BasicException.cs" />
<EmbeddedResource Include="sources\TriangleNumber.cs" />
<EmbeddedResource Include="sources\WriteLine.cs" />
<EmbeddedResource Include="sources\InstaQuit.cs" />
</ItemGroup>
<ItemGroup>

View File

@@ -0,0 +1,13 @@
using System;
namespace HelloWorldApp
{
class Program
{
static int Main(string[] args)
{
Environment.Exit(1);
return 100;
}
}
}

View File

@@ -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<DumpedAssembly>)
(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 ->

View File

@@ -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

View File

@@ -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
[<RequireQualifiedAccess>]
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
[<RequireQualifiedAccess>]
module ISystem_Environment_Env =
let inline get (env : ISystem_Environment_Env) : ISystem_Environment = env.System_Environment

View File

@@ -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

View File

@@ -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

View File

@@ -47,6 +47,7 @@ module Program =
(originalPath : string option)
(fileStream : Stream)
(dotnetRuntimeDirs : ImmutableArray<string>)
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) ->

View File

@@ -1,6 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<WoofWareMyriadPluginsVersion>7.0.7</WoofWareMyriadPluginsVersion>
<TargetFramework>net8.0</TargetFramework>
</PropertyGroup>
@@ -33,12 +34,25 @@
<Compile Include="UnaryMetadataIlOp.fs" />
<Compile Include="UnaryStringTokenIlOp.fs" />
<Compile Include="UnaryConstIlOp.fs" />
<Compile Include="ExternImplementations\System.Environment.fs" />
<Compile Include="ExternImplementations\GeneratedSystem.Environment.fs">
<MyriadFile>ExternImplementations\System.Environment.fs</MyriadFile>
<MyriadParams>
<ISystem_Environment>GenerateMock(false)</ISystem_Environment>
</MyriadParams>
</Compile>
<Compile Include="ExternImplementations\NativeImpls.fs" />
<Compile Include="AbstractMachine.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Microsoft.Extensions.Logging.Abstractions" Version="9.0.2" />
<PackageReference Include="WoofWare.Myriad.Plugins" Version="$(WoofWareMyriadPluginsVersion)" PrivateAssets="all" />
<PackageReference Include="Myriad.Sdk" Version="0.8.3" PrivateAssets="all" />
</ItemGroup>
<ItemGroup>
<MyriadSdkGenerator Include="$(NuGetPackageRoot)/woofware.myriad.plugins/$(WoofWareMyriadPluginsVersion)/lib/net6.0/WoofWare.Myriad.Plugins.dll" />
</ItemGroup>
</Project>

View File

View File

@@ -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="
}
]