Add native call implementations (#18)

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

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

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
+
+[<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

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

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

WoofWare.PawPrint/Program.fs

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

WoofWare.PawPrint/WoofWare.PawPrint.fsproj

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