Add infra for Monitor.ReliableEnter (#21)

WoofWare.PawPrint.Test/TestBasicLock.fs

@@ -21,7 +21,7 @@ module TestBasicLock =
         let dotnetRuntimes =
             DotnetRuntime.SelectForDll assy.Location |> ImmutableArray.CreateRange
 
-        let impls = NativeImpls.Mock ()
+        let impls = MockEnv.make ()
 
         use peImage = new MemoryStream (image)
 

WoofWare.PawPrint.Test/TestCases.fs

@@ -18,17 +18,22 @@ module TestCases =
             {
                 FileName = "BasicException.cs"
                 ExpectedReturnCode = 10
-                NativeImpls = NativeImpls.Mock ()
+                NativeImpls = MockEnv.make ()
             }
             {
                 FileName = "BasicLock.cs"
                 ExpectedReturnCode = 10
-                NativeImpls = NativeImpls.Mock ()
+                NativeImpls =
+                    let mock = MockEnv.make ()
+
+                    { mock with
+                        System_Threading_Monitor = System_Threading_Monitor.passThru
+                    }
             }
             {
                 FileName = "WriteLine.cs"
                 ExpectedReturnCode = 1
-                NativeImpls = NativeImpls.Mock ()
+                NativeImpls = MockEnv.make ()
             }
         ]
 
@@ -37,21 +42,21 @@ module TestCases =
             {
                 FileName = "NoOp.cs"
                 ExpectedReturnCode = 1
-                NativeImpls = NativeImpls.Mock ()
+                NativeImpls = MockEnv.make ()
             }
             {
                 FileName = "TriangleNumber.cs"
                 ExpectedReturnCode = 10
-                NativeImpls = NativeImpls.Mock ()
+                NativeImpls = MockEnv.make ()
             }
             {
                 FileName = "InstaQuit.cs"
                 ExpectedReturnCode = 1
                 NativeImpls =
-                    let mock = NativeImpls.Mock ()
+                    let mock = MockEnv.make ()
 
                     { mock with
-                        System_Env =
+                        System_Environment =
                             { System_EnvironmentMock.Empty with
                                 GetProcessorCount =
                                     fun thread state ->
@@ -109,13 +114,11 @@ 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 impls []
+                Program.run loggerFactory (Some case.FileName) peImage dotnetRuntimes case.NativeImpls []
 
             let exitCode =
                 match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with

WoofWare.PawPrint.Test/TestHarness.fs

@@ -17,17 +17,12 @@ type RunResult =
         FinalState : IlMachineState
     }
 
-type NativeImpls =
+[<RequireQualifiedAccess>]
-    {
+module MockEnv =
-        System_Env : ISystem_Environment
+    let make () : NativeImpls =
-    }
-
-    interface ISystem_Environment_Env with
-        member this.System_Environment = this.System_Env
-
-    static member Mock () =
         {
-            System_Env = System_EnvironmentMock.Empty
+            System_Environment = System_EnvironmentMock.Empty
+            System_Threading_Monitor = System_Threading_MonitorMock.Empty
         }
 
 type TestCase =

WoofWare.PawPrint.Test/TestHelloWorld.fs

@@ -22,7 +22,7 @@ module TestHelloWorld =
         let dotnetRuntimes =
             DotnetRuntime.SelectForDll assy.Location |> ImmutableArray.CreateRange
 
-        let impls = NativeImpls.Mock ()
+        let impls = MockEnv.make ()
 
         try
             use peImage = new MemoryStream (image)

WoofWare.PawPrint/AbstractMachine.fs

@@ -1,18 +1,9 @@
 namespace WoofWare.PawPrint
 
-open System.Collections.Immutable
-open System.Reflection
-open System.Reflection.Metadata
 open Microsoft.Extensions.Logging
 open Microsoft.FSharp.Core
 open WoofWare.PawPrint.ExternImplementations
 
-type ManagedObject =
-    {
-        Fields : (string * CliType) list
-        SyncBlock : unit
-    }
-
 [<RequireQualifiedAccess>]
 module AbstractMachine =
     type private Dummy = class end
@@ -61,6 +52,15 @@ module AbstractMachine =
                   TypeDefn.Void ->
                     let env = ISystem_Environment_Env.get impls
                     env._Exit thread state
+                | "System.Private.CoreLib",
+                  "System.Threading",
+                  "Monitor",
+                  "ReliableEnter",
+                  [ TypeDefn.PrimitiveType PrimitiveType.Object
+                    TypeDefn.Byref (TypeDefn.PrimitiveType PrimitiveType.Boolean) ],
+                  TypeDefn.Void ->
+                    let env = ISystem_Threading_Monitor_Env.get impls
+                    env.ReliableEnter 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}"

WoofWare.PawPrint/ExternImplementations/NativeImpls.fs

@@ -3,12 +3,17 @@ namespace WoofWare.PawPrint.ExternImplementations
 type NativeImpls =
     {
         System_Environment : ISystem_Environment
+        System_Threading_Monitor : ISystem_Threading_Monitor
     }
 
     static member PassThru () =
         {
             System_Environment = System_Environment.passThru
+            System_Threading_Monitor = System_Threading_Monitor.passThru
         }
 
     interface ISystem_Environment_Env with
         member this.System_Environment = this.System_Environment
+
+    interface ISystem_Threading_Monitor_Env with
+        member this.System_Threading_Monitor = this.System_Threading_Monitor

WoofWare.PawPrint/ExternImplementations/System.Threading.Monitor.fs

@@ -0,0 +1,81 @@
+namespace WoofWare.PawPrint.ExternImplementations
+
+open WoofWare.PawPrint
+
+type ISystem_Threading_Monitor =
+    /// Signature: (PrimitiveType Object, Byref (PrimitiveType Boolean)) -> Void
+    ///
+    /// That is, the object on which to wait, and the result of the attempt to acquire the lock.
+    /// <param name="lockTaken">The result of the attempt to acquire the lock, passed by reference. The input must be <see langword="false" />. The output is <see langword="true" /> if the lock is acquired; otherwise, the output is <see langword="false" />. The output is set even if an exception occurs during the attempt to acquire the lock.
+    ///
+    /// Note   If no exception occurs, the output of this method is always <see langword="true" />.</param>
+    /// <exception cref="T:System.ArgumentException">The input to <paramref name="lockTaken" /> is <see langword="true" />.</exception>
+    /// <exception cref="T:System.ArgumentNullException">The <paramref name="obj" /> parameter is <see langword="null" />.</exception>
+    abstract ReliableEnter : ThreadId -> IlMachineState -> ExecutionResult
+
+[<RequireQualifiedAccess>]
+module System_Threading_Monitor =
+    let passThru : ISystem_Threading_Monitor =
+        { new ISystem_Threading_Monitor with
+            member _.ReliableEnter currentThread state =
+                let lockObj, state =
+                    state
+                    |> IlMachineState.loadArgument currentThread 0
+                    |> IlMachineState.popEvalStack currentThread
+
+                let outVar, state =
+                    state
+                    |> IlMachineState.loadArgument currentThread 1
+                    |> IlMachineState.popEvalStack currentThread
+
+                let outVar =
+                    match outVar with
+                    | EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
+                        failwith "null byref was passed to Monitor.ReliableEnter"
+                    | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap _ as outVar) ->
+                        failwith "TODO: passed a heap-allocated bool"
+                    | EvalStackValue.ManagedPointer (ManagedPointerSource.LocalVariable (sourceThread,
+                                                                                         methodFrame,
+                                                                                         whichVar) as outVar) ->
+                        match
+                            state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables
+                                .[int<uint16> whichVar]
+                        with
+                        | CliType.Bool b ->
+                            if b <> 0uy then
+                                failwith "TODO: raise ArgumentException"
+                            else
+                                outVar
+                        | c -> failwith $"Bad IL: in ReliableEnter, expected bool, got {c}"
+                    | _ -> failwith $"expected out var of ReliableEnter to be byref<bool>, got {outVar}"
+
+                let state =
+                    match lockObj with
+                    | EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
+                        failwith "TODO: throw ArgumentNullException"
+                    | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
+                        match IlMachineState.getSyncBlock addr state with
+                        | false -> state |> IlMachineState.setSyncBlock addr true
+                        | true -> failwith "TODO: somehow need to block on the monitor"
+                    | EvalStackValue.ManagedPointer (ManagedPointerSource.LocalVariable _) ->
+                        failwith "TODO: local variable holds object to lock"
+                    | lockObj -> failwith $"TODO: lock object in Monitor.ReliableEnter was {lockObj}"
+
+                // Set result to True
+                let state =
+                    match outVar with
+                    | Null -> failwith "logic error"
+                    | LocalVariable (sourceThread, methodFrame, whichVar) ->
+                        state
+                        |> IlMachineState.setLocalVariable sourceThread methodFrame whichVar (CliType.OfBool true)
+                    | Heap addr -> failwith "todo: managed heap"
+
+                (state, WhatWeDid.Executed) |> ExecutionResult.Stepped
+        }
+
+type ISystem_Threading_Monitor_Env =
+    abstract System_Threading_Monitor : ISystem_Threading_Monitor
+
+[<RequireQualifiedAccess>]
+module ISystem_Threading_Monitor_Env =
+    let inline get (env : ISystem_Threading_Monitor_Env) : ISystem_Threading_Monitor = env.System_Threading_Monitor

WoofWare.PawPrint/IlMachineState.fs

@@ -656,6 +656,7 @@ module IlMachineState =
             {
                 Fields = Map.ofList fields
                 Type = TypeInfoCrate.make typeInfo
+                SyncBlock = false
             }
 
         let alloc, heap = state.ManagedHeap |> ManagedHeap.AllocateNonArray o
@@ -890,3 +891,36 @@ module IlMachineState =
                     "Unexpected interpretation result has a local evaluation stack with more than one element on RET"
 
         |> Some
+
+    let setLocalVariable
+        (thread : ThreadId)
+        (stackFrame : int)
+        (varIndex : uint16)
+        (value : CliType)
+        (state : IlMachineState)
+        : IlMachineState
+        =
+        { state with
+            ThreadState =
+                state.ThreadState
+                |> Map.change
+                    thread
+                    (fun existing ->
+                        match existing with
+                        | None -> failwith "tried to set variable in nonactive thread"
+                        | Some existing -> existing |> ThreadState.setLocalVariable stackFrame varIndex value |> Some
+                    )
+        }
+
+    let setSyncBlock
+        (addr : ManagedHeapAddress)
+        (syncBlockValue : SyncBlock)
+        (state : IlMachineState)
+        : IlMachineState
+        =
+        { state with
+            ManagedHeap = state.ManagedHeap |> ManagedHeap.SetSyncBlock addr syncBlockValue
+        }
+
+    let getSyncBlock (addr : ManagedHeapAddress) (state : IlMachineState) : SyncBlock =
+        state.ManagedHeap |> ManagedHeap.GetSyncBlock addr

WoofWare.PawPrint/ManagedHeap.fs

@@ -2,10 +2,13 @@ namespace WoofWare.PawPrint
 
 open System.Collections.Immutable
 
+type SyncBlock = bool
+
 type AllocatedNonArrayObject =
     {
         Fields : Map<string, CliType>
         Type : WoofWare.PawPrint.TypeInfoCrate
+        SyncBlock : SyncBlock
     }
 
 type AllocatedArray =
@@ -32,6 +35,24 @@ type ManagedHeap =
             StringArrayData = ImmutableArray.Empty
         }
 
+    static member GetSyncBlock (addr : ManagedHeapAddress) (heap : ManagedHeap) : SyncBlock =
+        match heap.NonArrayObjects.TryGetValue addr with
+        | false, _ -> failwith "TODO: getting sync block of array"
+        | true, v -> v.SyncBlock
+
+    static member SetSyncBlock (addr : ManagedHeapAddress) (syncValue : SyncBlock) (heap : ManagedHeap) : ManagedHeap =
+        match heap.NonArrayObjects.TryGetValue addr with
+        | false, _ -> failwith "TODO: locked on an array object"
+        | true, v ->
+            let newV =
+                { v with
+                    SyncBlock = syncValue
+                }
+
+            { heap with
+                NonArrayObjects = heap.NonArrayObjects |> Map.add addr newV
+            }
+
     static member AllocateArray (ty : AllocatedArray) (heap : ManagedHeap) : ManagedHeapAddress * ManagedHeap =
         let addr = heap.FirstAvailableAddress
 

WoofWare.PawPrint/ThreadState.fs

@@ -90,3 +90,15 @@ type ThreadState =
         { state with
             MethodStates = methodState
         }
+
+    static member setLocalVariable (stackFrame : int) (localVariable : uint16) (value : CliType) (s : ThreadState) =
+        let frame = s.MethodStates.[stackFrame]
+
+        let newFrame =
+            { frame with
+                LocalVariables = frame.LocalVariables.SetItem (int<uint16> localVariable, value)
+            }
+
+        { s with
+            MethodStates = s.MethodStates.SetItem (stackFrame, newFrame)
+        }

WoofWare.PawPrint/WoofWare.PawPrint.fsproj

@@ -41,6 +41,13 @@
         <ISystem_Environment>GenerateMock(false)</ISystem_Environment>
       </MyriadParams>
     </Compile>
+    <Compile Include="ExternImplementations\System.Threading.Monitor.fs" />
+    <Compile Include="ExternImplementations\GeneratedSystem.Threading.Monitor.fs">
+      <MyriadFile>ExternImplementations\System.Threading.Monitor.fs</MyriadFile>
+      <MyriadParams>
+        <ISystem_Threading_Monitor>GenerateMock(false)</ISystem_Threading_Monitor>
+      </MyriadParams>
+    </Compile>
     <Compile Include="ExternImplementations\NativeImpls.fs" />
     <Compile Include="AbstractMachine.fs" />
     <Compile Include="Program.fs" />