Implement the lock keyword (#35)

WoofWare.PawPrint.Test/TestBasicLock.fs

@@ -1,46 +0,0 @@
-namespace WoofWare.Pawprint.Test
-
-open System.Collections.Immutable
-open System.IO
-open FsUnitTyped
-open NUnit.Framework
-open WoofWare.PawPrint
-open WoofWare.PawPrint.ExternImplementations
-open WoofWare.PawPrint.Test
-open WoofWare.DotnetRuntimeLocator
-
-[<TestFixture>]
-module TestBasicLock =
-    let assy = typeof<RunResult>.Assembly
-
-    [<Test ; Explicit "This test doesn't run yet">]
-    let ``Can run BasicLock`` () : unit =
-        let source = Assembly.getEmbeddedResourceAsString "BasicLock.cs" assy
-        let image = Roslyn.compile [ source ]
-        let messages, loggerFactory = LoggerFactory.makeTest ()
-
-        let dotnetRuntimes =
-            DotnetRuntime.SelectForDll assy.Location |> ImmutableArray.CreateRange
-
-        let impls = NativeImpls.PassThru ()
-
-        use peImage = new MemoryStream (image)
-
-        try
-            let terminalState, terminatingThread =
-                Program.run loggerFactory (Some "BasicLock.cs") peImage dotnetRuntimes impls []
-
-            let exitCode =
-                match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with
-                | [] -> failwith "expected program to return 1, but it returned void"
-                | head :: _ ->
-                    match head with
-                    | EvalStackValue.Int32 i -> i
-                    | _ -> failwith "TODO"
-
-            exitCode |> shouldEqual 0
-        finally
-            let messages = messages ()
-
-            for message in messages do
-                System.Console.WriteLine $"%O{message}"

WoofWare.PawPrint.Test/TestCases.fs

@@ -50,17 +50,6 @@ module TestCases =
                     ]
                     |> List.map (fun i -> CliType.Numeric (CliNumericType.Int32 i))
             }
-            {
-                FileName = "BasicLock.cs"
-                ExpectedReturnCode = 10
-                NativeImpls =
-                    let mock = MockEnv.make ()
-
-                    { mock with
-                        System_Threading_Monitor = System_Threading_Monitor.passThru
-                    }
-                LocalVariablesOfMain = []
-            }
             {
                 FileName = "WriteLine.cs"
                 ExpectedReturnCode = 1
@@ -77,6 +66,28 @@ module TestCases =
                 NativeImpls = MockEnv.make ()
                 LocalVariablesOfMain = [ CliType.Numeric (CliNumericType.Int32 1) ]
             }
+            {
+                FileName = "BasicLock.cs"
+                ExpectedReturnCode = 1
+                NativeImpls =
+                    let mock = MockEnv.make ()
+
+                    { mock with
+                        System_Threading_Monitor = System_Threading_Monitor.passThru
+                    }
+                LocalVariablesOfMain =
+                    [
+                        // Four variables:
+                        // locker
+                        CliType.ObjectRef (Some (ManagedHeapAddress 2))
+                        // a copy of locker, taken so that the contents of the implicit `finally` have a stable copy
+                        CliType.ObjectRef (Some (ManagedHeapAddress 2))
+                        // out param of `ReliableEnter`
+                        CliType.OfBool true
+                        // return value
+                        CliType.Numeric (CliNumericType.Int32 1)
+                    ]
+            }
             {
                 FileName = "TriangleNumber.cs"
                 ExpectedReturnCode = 10

WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj

@@ -16,7 +16,6 @@
     <Compile Include="TestHarness.fs"/>
     <Compile Include="TestCases.fs" />
     <Compile Include="TestHelloWorld.fs" />
-    <Compile Include="TestBasicLock.fs" />
     <EmbeddedResource Include="sources\BasicLock.cs" />
     <EmbeddedResource Include="sources\NoOp.cs" />
     <EmbeddedResource Include="sources\ExceptionWithNoOpCatch.cs" />

WoofWare.PawPrint/AbstractMachine.fs

@@ -62,6 +62,14 @@ module AbstractMachine =
                   TypeDefn.Void ->
                     let env = ISystem_Threading_Monitor_Env.get impls
                     env.ReliableEnter thread state
+                | "System.Private.CoreLib",
+                  "System.Threading",
+                  "Monitor",
+                  "Exit",
+                  [ TypeDefn.PrimitiveType PrimitiveType.Object ],
+                  TypeDefn.Void ->
+                    let env = ISystem_Threading_Monitor_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}"

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

@@ -13,6 +13,15 @@ type ISystem_Threading_Monitor =
     /// <exception cref="T:System.ArgumentNullException">The <paramref name="obj" /> parameter is <see langword="null" />.</exception>
     abstract ReliableEnter : ThreadId -> IlMachineState -> ExecutionResult
 
+    /// Signature: (PrimitiveType Object) -> Void
+    /// That is, the object whose lock is to be released.
+    ///
+    /// <summary>Releases an exclusive lock on the specified object.</summary>
+    /// <param name="obj">The object on which to release the lock.</param>
+    /// <exception cref="T:System.ArgumentNullException">The <paramref name="obj" /> parameter is <see langword="null" />.</exception>
+    /// <exception cref="T:System.Threading.SynchronizationLockException">The current thread does not own the lock for the specified object.</exception>
+    abstract Exit : ThreadId -> IlMachineState -> ExecutionResult
+
 [<RequireQualifiedAccess>]
 module System_Threading_Monitor =
     let passThru : ISystem_Threading_Monitor =
@@ -55,8 +64,10 @@ module System_Threading_Monitor =
                         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"
+                        | None -> state |> IlMachineState.setSyncBlock addr (Some currentThread)
+                        | Some _ ->
+                            failwith
+                                "TODO: somehow need to block on the monitor; also what happens if this thread already has the lock?"
                     | EvalStackValue.ManagedPointer (ManagedPointerSource.LocalVariable _) ->
                         failwith "TODO: local variable holds object to lock"
                     | lockObj -> failwith $"TODO: lock object in Monitor.ReliableEnter was {lockObj}"
@@ -71,6 +82,26 @@ module System_Threading_Monitor =
                     | Heap addr -> failwith "todo: managed heap"
 
                 (state, WhatWeDid.Executed) |> ExecutionResult.Stepped
+
+            member this.Exit thread state =
+                let lockObj, state =
+                    state
+                    |> IlMachineState.loadArgument thread 0
+                    |> IlMachineState.popEvalStack thread
+
+                let state =
+                    match lockObj with
+                    | EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
+                        failwith "TODO: throw ArgumentNullException"
+                    | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
+                        match IlMachineState.getSyncBlock addr state with
+                        | Some t when t = thread -> state |> IlMachineState.setSyncBlock addr None
+                        | _ -> failwith "TODO: throw SynchronizationLockException"
+                    | EvalStackValue.ManagedPointer (ManagedPointerSource.LocalVariable _) ->
+                        failwith "TODO: local variable holds object to lock"
+                    | lockObj -> failwith $"TODO: lock object in Monitor.ReliableEnter was {lockObj}"
+
+                (state, WhatWeDid.Executed) |> ExecutionResult.Stepped
         }
 
 type ISystem_Threading_Monitor_Env =

WoofWare.PawPrint/IlMachineState.fs

@@ -727,7 +727,7 @@ module IlMachineState =
             {
                 Fields = Map.ofList fields
                 Type = TypeInfoCrate.make typeInfo
-                SyncBlock = false
+                SyncBlock = None
             }
 
         let alloc, heap = state.ManagedHeap |> ManagedHeap.AllocateNonArray o

WoofWare.PawPrint/ManagedHeap.fs

@@ -2,7 +2,7 @@ namespace WoofWare.PawPrint
 
 open System.Collections.Immutable
 
-type SyncBlock = bool
+type SyncBlock = ThreadId option
 
 type AllocatedNonArrayObject =
     {