Ldtoken (for types) (#49)

CSharpExample/Class1.cs

@@ -1,4 +1,5 @@
-using System.Collections.Generic;
+using System;
+using System.Collections.Generic;
 using System.Linq;
 
 namespace HelloWorldApp
@@ -7,12 +8,8 @@ namespace HelloWorldApp
     {
         static int Main(string[] args)
         {
-            var l = new List<int>();
+            Console.WriteLine("Hello");
-            l.Add(3);
+            return 0;
-            l.Add(100);
-            var m = l.Select(x => x.ToString()).ToList();
-            // 2 + 103 + (1 + 3) = 109
-            return m.Count + l.Sum() + m.Select(x => x.Length).Sum();
         }
     }
 }

WoofWare.PawPrint/AbstractMachineDomain.fs

@@ -6,3 +6,14 @@ type ThreadId =
     override this.ToString () =
         match this with
         | ThreadId.ThreadId i -> $"%i{i}"
+
+/// Currently this is just an opaque handle; it can't be treated as a pointer.
+type ManagedHeapAddress =
+    | ManagedHeapAddress of int
+
+    override this.ToString () : string =
+        match this with
+        | ManagedHeapAddress.ManagedHeapAddress i -> $"<object #%i{i}>"
+
+[<Measure>]
+type typeHandle

WoofWare.PawPrint/BasicCliType.fs

@@ -5,14 +5,6 @@ open System.Collections.Immutable
 open System.Reflection
 open System.Reflection.Metadata
 
-/// Currently this is just an opaque handle; it can't be treated as a pointer.
-type ManagedHeapAddress =
-    | ManagedHeapAddress of int
-
-    override this.ToString () : string =
-        match this with
-        | ManagedHeapAddress.ManagedHeapAddress i -> $"<object #%i{i}>"
-
 /// Source:
 /// Table I.6: Data Types Directly Supported by the CLI
 type CliSupportedObject =
@@ -58,6 +50,8 @@ type CliNumericType =
     | Float64 of float
     /// Not a real CLI numeric type! Represents an int64 obtained by taking a NativeInt from the eval stack.
     | ProvenanceTrackedNativeInt64 of MethodInfo<FakeUnit, WoofWare.PawPrint.GenericParameter>
+    /// Not a real CLI numeric type! An opaque TypeHandle pointer.
+    | TypeHandlePtr of int64<typeHandle>
 
 type CliValueType =
     private

WoofWare.PawPrint/EvalStack.fs

@@ -20,6 +20,7 @@ type NativeIntSource =
     | Verbatim of int64
     | ManagedPointer of ManagedPointerSource
     | FunctionPointer of MethodInfo<FakeUnit, GenericParameter>
+    | TypeHandlePtr of int64<typeHandle>
 
     override this.ToString () : string =
         match this with
@@ -27,12 +28,14 @@ type NativeIntSource =
         | NativeIntSource.ManagedPointer ptr -> $"<managed pointer {ptr}>"
         | NativeIntSource.FunctionPointer methodDefinition ->
             $"<pointer to {methodDefinition.Name} in {methodDefinition.DeclaringType.Assembly.Name}>"
+        | NativeIntSource.TypeHandlePtr ptr -> $"<type ID %i{ptr}>"
 
 [<RequireQualifiedAccess>]
 module NativeIntSource =
     let isZero (n : NativeIntSource) : bool =
         match n with
         | NativeIntSource.Verbatim i -> i = 0L
+        | NativeIntSource.TypeHandlePtr _ -> false
         | NativeIntSource.FunctionPointer _ -> failwith "TODO"
         | NativeIntSource.ManagedPointer src ->
             match src with
@@ -43,6 +46,7 @@ module NativeIntSource =
         match n with
         | NativeIntSource.Verbatim i -> i >= 0L
         | NativeIntSource.FunctionPointer _ -> failwith "TODO"
+        | NativeIntSource.TypeHandlePtr _ -> true
         | NativeIntSource.ManagedPointer _ -> true
 
     /// True if a < b.
@@ -106,6 +110,7 @@ module EvalStackValue =
                     failwith "todo"
             | NativeIntSource.ManagedPointer _ -> failwith "TODO"
             | NativeIntSource.FunctionPointer _ -> failwith "TODO"
+            | NativeIntSource.TypeHandlePtr _ -> failwith "TODO"
         | EvalStackValue.Float f -> failwith "todo"
         | EvalStackValue.ManagedPointer managedPointerSource ->
             UnsignedNativeIntSource.FromManagedPointer managedPointerSource |> Some
@@ -159,6 +164,7 @@ module EvalStackValue =
                 | EvalStackValue.Int32 i -> CliType.Numeric (CliNumericType.Int32 i)
                 | EvalStackValue.UserDefinedValueType [ popped ] -> toCliTypeCoerced target popped
                 | i -> failwith $"TODO: %O{i}"
+            | CliNumericType.TypeHandlePtr _
             | CliNumericType.ProvenanceTrackedNativeInt64 _
             | CliNumericType.Int64 _ ->
                 match popped with
@@ -169,6 +175,7 @@ module EvalStackValue =
                     | NativeIntSource.ManagedPointer ptr -> failwith "TODO"
                     | NativeIntSource.FunctionPointer f ->
                         CliType.Numeric (CliNumericType.ProvenanceTrackedNativeInt64 f)
+                    | NativeIntSource.TypeHandlePtr f -> CliType.Numeric (CliNumericType.TypeHandlePtr f)
                 | i -> failwith $"TODO: %O{i}"
             | CliNumericType.NativeInt int64 -> failwith "todo"
             | CliNumericType.NativeFloat f -> failwith "todo"
@@ -215,6 +222,7 @@ module EvalStackValue =
                 | NativeIntSource.Verbatim 0L -> CliType.ObjectRef None
                 | NativeIntSource.Verbatim i -> failwith $"refusing to interpret verbatim native int {i} as a pointer"
                 | NativeIntSource.FunctionPointer _ -> failwith "TODO"
+                | NativeIntSource.TypeHandlePtr _ -> failwith "refusing to interpret type handle ID as an object ref"
                 | NativeIntSource.ManagedPointer ptr ->
                     match ptr with
                     | ManagedPointerSource.Null -> CliType.ObjectRef None
@@ -263,6 +271,7 @@ module EvalStackValue =
                         CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.Argument (a, b, c)))
                 | NativeIntSource.FunctionPointer methodInfo ->
                     CliType.Numeric (CliNumericType.ProvenanceTrackedNativeInt64 methodInfo)
+                | NativeIntSource.TypeHandlePtr int64 -> failwith "todo"
             | _ -> failwith $"TODO: %O{popped}"
         | CliType.Char _ ->
             match popped with
@@ -301,6 +310,7 @@ module EvalStackValue =
             | CliNumericType.NativeFloat f -> EvalStackValue.Float f
             | CliNumericType.ProvenanceTrackedNativeInt64 f ->
                 EvalStackValue.NativeInt (NativeIntSource.FunctionPointer f)
+            | CliNumericType.TypeHandlePtr f -> EvalStackValue.NativeInt (NativeIntSource.TypeHandlePtr f)
         | CliType.ObjectRef i ->
             match i with
             | None -> EvalStackValue.ManagedPointer ManagedPointerSource.Null

WoofWare.PawPrint/IlMachineState.fs

@@ -25,6 +25,7 @@ type IlMachineState =
         /// For each type, specialised to each set of generic args, a map of string field name to static value contained therein.
         _Statics : ImmutableDictionary<ConcreteType<FakeUnit>, ImmutableDictionary<string, CliType>>
         DotnetRuntimeDirs : string ImmutableArray
+        TypeHandles : TypeHandleRegistry
     }
 
     member this.WithTypeBeginInit (thread : ThreadId) (ty : RuntimeConcreteType) =
@@ -547,15 +548,50 @@ module IlMachineState =
         match methodToCall.DeclaringType.Assembly.Name, methodToCall.DeclaringType.Name, methodToCall.Name with
         | "System.Private.CoreLib", "Type", "get_TypeHandle" ->
             // https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Type.cs#L470
-            // no args, returns RuntimeTypeHandle, a struct with a single field
+            // no args, returns RuntimeTypeHandle, a struct with a single field (a RuntimeType class)
-            let desiredType = baseClassTypes.RuntimeTypeHandle
-            let resultField = desiredType.Fields |> List.exactlyOne
 
-            if resultField.Name <> "m_type" then
+            // The thing on top of the stack will be a RuntimeType.
-                failwith $"unexpected field name {resultField.Name}"
+            let arg, state = popEvalStack currentThread state
 
-            let resultFieldType = resultField.Signature
+            let arg =
-            failwith "TODO"
+                let rec go (arg : EvalStackValue) =
+                    match arg with
+                    | EvalStackValue.UserDefinedValueType [ s ] -> go s
+                    | EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
+                    | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) -> Some addr
+                    | s -> failwith $"TODO: called with unrecognised arg %O{s}"
+
+                go arg
+
+            let state =
+                pushToEvalStack (CliType.ValueType [ CliType.ObjectRef arg ]) currentThread state
+                |> advanceProgramCounter currentThread
+
+            Some state
+        | "System.Private.CoreLib", "Unsafe", "AsPointer" ->
+            // Method signature: 1 generic parameter, we take a Byref of that parameter, and return a TypeDefn.Pointer(Void)
+            let arg, state = popEvalStack currentThread state
+
+            let toPush =
+                match arg with
+                | EvalStackValue.ManagedPointer ptr ->
+                    match ptr with
+                    | ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
+                        CliRuntimePointer.Managed (
+                            CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, whichVar)
+                        )
+                    | ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
+                        CliRuntimePointer.Managed (
+                            CliRuntimePointerSource.Argument (sourceThread, methodFrame, whichVar)
+                        )
+                    | ManagedPointerSource.Heap managedHeapAddress ->
+                        CliRuntimePointer.Managed (CliRuntimePointerSource.Heap managedHeapAddress)
+                    | ManagedPointerSource.Null -> failwith "todo"
+                | x -> failwith $"TODO: Unsafe.AsPointer(%O{x})"
+
+            pushToEvalStack (CliType.RuntimePointer toPush) currentThread state
+            |> advanceProgramCounter currentThread
+            |> Some
         | "System.Private.CoreLib", "BitConverter", "SingleToInt32Bits" ->
             let arg, state = popEvalStack currentThread state
 
@@ -989,6 +1025,7 @@ module IlMachineState =
                 _Statics = ImmutableDictionary.Empty
                 TypeInitTable = ImmutableDictionary.Empty
                 DotnetRuntimeDirs = dotnetRuntimeDirs
+                TypeHandles = TypeHandleRegistry.empty ()
             }
 
         state.WithLoadedAssembly assyName entryAssembly
@@ -1197,6 +1234,7 @@ module IlMachineState =
             let availableMethods =
                 targetType.Methods
                 |> List.filter (fun mi -> mi.Name = memberName)
+                // TODO: this needs to resolve the TypeMethodSignature to e.g. remove references to generic parameters
                 |> List.filter (fun mi -> mi.Signature = memberSig)
 
             let method =
@@ -1287,6 +1325,27 @@ module IlMachineState =
             ManagedHeap = updatedHeap
         }
 
+    /// Returns the type handle and an allocated System.RuntimeType.
+    let getOrAllocateType<'corelib>
+        (baseClassTypes : BaseClassTypes<'corelib>)
+        (defn : CanonicalTypeIdentity)
+        (state : IlMachineState)
+        : (int64<typeHandle> * ManagedHeapAddress) * IlMachineState
+        =
+        let result, reg, state =
+            TypeHandleRegistry.getOrAllocate
+                state
+                (fun fields state -> allocateManagedObject baseClassTypes.RuntimeType fields state)
+                defn
+                state.TypeHandles
+
+        let state =
+            { state with
+                TypeHandles = reg
+            }
+
+        result, state
+
     let setStatic
         (ty : RuntimeConcreteType)
         (field : string)
@@ -1316,3 +1375,70 @@ module IlMachineState =
             match v.TryGetValue field with
             | false, _ -> None
             | true, v -> Some v
+
+    let rec canonicaliseTypeReference
+        (assy : AssemblyName)
+        (ty : TypeReferenceHandle)
+        (state : IlMachineState)
+        : Result<CanonicalTypeIdentity, AssemblyName>
+        =
+        match state.LoadedAssembly assy with
+        | None -> Error assy
+        | Some assy ->
+
+        match assy.TypeRefs.TryGetValue ty with
+        | false, _ -> failwith $"could not find type reference in assembly %s{assy.Name.FullName}"
+        | true, v ->
+
+        match v.ResolutionScope with
+        | TypeRefResolutionScope.Assembly newAssy ->
+            let newAssy = assy.AssemblyReferences.[newAssy].Name
+
+            match state.LoadedAssembly newAssy with
+            | None -> Error newAssy
+            | Some newAssy ->
+                {
+                    AssemblyFullName = newAssy.Name.FullName
+                    FullyQualifiedTypeName = $"%s{v.Namespace}.%s{v.Name}"
+                    // TODO: I think TypeRef can't have generics?
+                    Generics = []
+                }
+                |> Ok
+        | TypeRefResolutionScope.ModuleRef _ -> failwith "todo"
+        | TypeRefResolutionScope.TypeRef r ->
+            if (r.GetHashCode ()) <> (ty.GetHashCode ()) then
+                failwith "apparently this doesn't do what I thought"
+
+            {
+
+                AssemblyFullName = assy.Name.FullName
+                FullyQualifiedTypeName = $"%s{v.Namespace}.%s{v.Name}"
+                Generics = []
+            }
+            |> Ok
+
+    let canonicaliseTypeDef
+        (assy : AssemblyName)
+        (ty : TypeDefinitionHandle)
+        (typeGenerics : CanonicalTypeIdentity list)
+        (methodGenerics : CanonicalTypeIdentity list)
+        (state : IlMachineState)
+        : Result<CanonicalTypeIdentity, AssemblyName>
+        =
+        match state.LoadedAssembly assy with
+        | None -> Error assy
+        | Some assy ->
+
+        match assy.TypeDefs.TryGetValue ty with
+        | false, _ -> failwith $"could not find type def in assembly %s{assy.Name.FullName}"
+        | true, v ->
+
+        if not (typeGenerics.IsEmpty && methodGenerics.IsEmpty) then
+            failwith "TODO: generics"
+
+        {
+            AssemblyFullName = assy.Name.FullName
+            FullyQualifiedTypeName = $"%s{v.Namespace}.%s{v.Name}"
+            Generics = []
+        }
+        |> Ok

WoofWare.PawPrint/NullaryIlOp.fs

@@ -776,7 +776,29 @@ module NullaryIlOp =
         | Conv_ovf_u -> failwith "TODO: Conv_ovf_u unimplemented"
         | Neg -> failwith "TODO: Neg unimplemented"
         | Not -> failwith "TODO: Not unimplemented"
-        | Ldind_ref -> failwith "TODO: Ldind_ref unimplemented"
+        | Ldind_ref ->
+            let addr, state = IlMachineState.popEvalStack currentThread state
+
+            let referenced =
+                match addr with
+                | EvalStackValue.ManagedPointer src ->
+                    match src with
+                    | ManagedPointerSource.Null -> failwith "TODO: throw NRE"
+                    | ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
+                        state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables
+                            .[int<uint16> whichVar]
+                    | ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
+                        state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int<uint16> whichVar]
+                    | ManagedPointerSource.Heap managedHeapAddress -> failwith "todo"
+                | a -> failwith $"TODO: {a}"
+
+            let state =
+                match referenced with
+                | CliType.ObjectRef _ -> IlMachineState.pushToEvalStack referenced currentThread state
+                | _ -> failwith $"Unexpected non-reference {referenced}"
+                |> IlMachineState.advanceProgramCounter currentThread
+
+            (state, WhatWeDid.Executed) |> ExecutionResult.Stepped
         | Stind_ref -> failwith "TODO: Stind_ref unimplemented"
         | Ldelem_i -> failwith "TODO: Ldelem_i unimplemented"
         | Ldelem_i1 -> failwith "TODO: Ldelem_i1 unimplemented"

WoofWare.PawPrint/TypeHandleRegistry.fs

@@ -0,0 +1,64 @@
+namespace WoofWare.PawPrint
+
+type CanonicalTypeIdentity =
+    {
+        AssemblyFullName : string
+        FullyQualifiedTypeName : string
+        Generics : CanonicalTypeIdentity list
+    }
+
+type TypeHandleRegistry =
+    private
+        {
+            TypeHandleToType : Map<int64<typeHandle>, CanonicalTypeIdentity>
+            TypeToHandle : Map<CanonicalTypeIdentity, int64<typeHandle> * ManagedHeapAddress>
+            NextHandle : int64<typeHandle>
+        }
+
+[<RequireQualifiedAccess>]
+module TypeHandleRegistry =
+    let empty () =
+        {
+            TypeHandleToType = Map.empty
+            TypeToHandle = Map.empty
+            NextHandle = 1L<typeHandle>
+        }
+
+    /// Returns an allocated System.RuntimeType as well.
+    let getOrAllocate
+        (allocState : 'allocState)
+        (allocate : (string * CliType) list -> 'allocState -> ManagedHeapAddress * 'allocState)
+        (def : CanonicalTypeIdentity)
+        (reg : TypeHandleRegistry)
+        : (int64<typeHandle> * ManagedHeapAddress) * TypeHandleRegistry * 'allocState
+        =
+        match Map.tryFind def reg.TypeToHandle with
+        | Some v -> v, reg, allocState
+        | None ->
+
+        let handle = reg.NextHandle
+
+        // Here follows the class System.RuntimeType, which is an internal class type with a constructor
+        // whose only purpose is to throw.
+        let fields =
+            [
+                // for the GC, I think?
+                "m_keepalive", CliType.ObjectRef None
+                // TODO: this is actually a System.IntPtr https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/coreclr/nativeaot/Runtime.Base/src/System/Primitives.cs#L339
+                "m_cache", CliType.Numeric (CliNumericType.NativeInt 0L)
+                "m_handle", CliType.Numeric (CliNumericType.TypeHandlePtr handle)
+                // This is the const -1, apparently?!
+                // https://github.com/dotnet/runtime/blob/f0168ee80ba9aca18a7e7140b2bb436defda623c/src/coreclr/System.Private.CoreLib/src/System/RuntimeType.CoreCLR.cs#L2496
+                "GenericParameterCountAny", CliType.Numeric (CliNumericType.Int32 -1)
+            ]
+
+        let alloc, state = allocate fields allocState
+
+        let reg =
+            {
+                NextHandle = handle + 1L<typeHandle>
+                TypeHandleToType = reg.TypeHandleToType |> Map.add handle def
+                TypeToHandle = reg.TypeToHandle |> Map.add def (handle, alloc)
+            }
+
+        (handle, alloc), reg, state

WoofWare.PawPrint/UnaryMetadataIlOp.fs

@@ -461,9 +461,8 @@ module internal UnaryMetadataIlOp =
                     match source with
                     | ManagedPointerSource.Null -> failwith "TODO: raise NullReferenceException"
                     | ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
-                        let threadState = state.ThreadState.[sourceThread]
+                        state
-                        let methodState = threadState.MethodStates.[methodFrame]
+                        |> IlMachineState.setLocalVariable sourceThread methodFrame whichVar valueToStore
-                        failwith "TODO"
                     | ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
                     | ManagedPointerSource.Heap addr ->
                         match state.ManagedHeap.NonArrayObjects.TryGetValue addr with
@@ -940,7 +939,53 @@ module internal UnaryMetadataIlOp =
             |> Tuple.withRight WhatWeDid.Executed
         | Stobj -> failwith "TODO: Stobj unimplemented"
         | Constrained -> failwith "TODO: Constrained unimplemented"
-        | Ldtoken -> failwith "TODO: Ldtoken unimplemented"
+        | Ldtoken ->
+            let state =
+                match metadataToken with
+                | MetadataToken.FieldDefinition h ->
+                    let ty = baseClassTypes.RuntimeFieldHandle
+                    // this is a struct; it contains one field, an IRuntimeFieldInfo
+                    // https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1097
+                    let field = ty.Fields |> List.exactlyOne
+
+                    if field.Name <> "m_ptr" then
+                        failwith $"unexpected field name ${field.Name} for BCL type RuntimeFieldHandle"
+
+                    failwith ""
+                | MetadataToken.MethodDef h ->
+                    let ty = baseClassTypes.RuntimeMethodHandle
+                    let field = ty.Fields |> List.exactlyOne
+                    failwith ""
+                | MetadataToken.TypeDefinition h ->
+                    let ty = baseClassTypes.RuntimeTypeHandle
+                    let field = ty.Fields |> List.exactlyOne
+
+                    if field.Name <> "m_type" then
+                        failwith $"unexpected field name ${field.Name} for BCL type RuntimeTypeHandle"
+
+                    let currentMethod = state.ThreadState.[thread].MethodState
+
+                    let methodGenerics =
+                        currentMethod.Generics |> Option.defaultValue ImmutableArray.Empty
+
+                    let typeGenerics = currentMethod.ExecutingMethod.DeclaringType.Generics
+
+                    if not (methodGenerics.IsEmpty && typeGenerics.IsEmpty) then
+                        failwith "TODO: generics"
+
+                    let handle =
+                        match IlMachineState.canonicaliseTypeDef (state.ActiveAssembly(thread).Name) h [] [] state with
+                        | Error e -> failwith $"TODO: somehow need to load {e.FullName} first"
+                        | Ok h -> h
+
+                    let (_, alloc), state = IlMachineState.getOrAllocateType baseClassTypes handle state
+
+                    IlMachineState.pushToEvalStack (CliType.ValueType [ CliType.ObjectRef (Some alloc) ]) thread state
+                | _ -> failwith $"Unexpected metadata token %O{metadataToken} in LdToken"
+
+            state
+            |> IlMachineState.advanceProgramCounter thread
+            |> Tuple.withRight WhatWeDid.Executed
         | Cpobj -> failwith "TODO: Cpobj unimplemented"
         | Ldobj -> failwith "TODO: Ldobj unimplemented"
         | Sizeof -> failwith "TODO: Sizeof unimplemented"

WoofWare.PawPrint/WoofWare.PawPrint.fsproj

@@ -11,6 +11,7 @@
     <Compile Include="Corelib.fs" />
     <Compile Include="AbstractMachineDomain.fs" />
     <Compile Include="BasicCliType.fs" />
+    <Compile Include="TypeHandleRegistry.fs" />
     <Compile Include="ManagedHeap.fs" />
     <Compile Include="TypeInitialisation.fs" />
     <Compile Include="Exceptions.fs" />