From fb5c4a6313c62274da7934b2a697181c4b04410a Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Sat, 30 Aug 2025 20:07:05 +0100 Subject: [PATCH] Progress towards advanced struct layout (#126) --- .../TypeConcretisation.fs | 17 +++ WoofWare.PawPrint.Domain/TypeDefn.fs | 2 + WoofWare.PawPrint.Test/LoggerFactory.fs | 2 +- WoofWare.PawPrint/BinaryArithmetic.fs | 103 +++++++++++------- WoofWare.PawPrint/EvalStack.fs | 17 +++ WoofWare.PawPrint/IlMachineState.fs | 5 +- WoofWare.PawPrint/Intrinsics.fs | 79 ++++++++++++++ WoofWare.PawPrint/NullaryIlOp.fs | 32 +++++- 8 files changed, 212 insertions(+), 45 deletions(-) diff --git a/WoofWare.PawPrint.Domain/TypeConcretisation.fs b/WoofWare.PawPrint.Domain/TypeConcretisation.fs index c42a4c6..5a5a801 100644 --- a/WoofWare.PawPrint.Domain/TypeConcretisation.fs +++ b/WoofWare.PawPrint.Domain/TypeConcretisation.fs @@ -337,6 +337,23 @@ module ConcreteActivePatterns = | None -> None | _ -> None + let (|ConcreteUInt64|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option = + match handle with + | ConcreteTypeHandle.Concrete id -> + match concreteTypes.Mapping |> Map.tryFind id with + | Some ct -> + if + ct.Assembly.Name = "System.Private.CoreLib" + && ct.Namespace = "System" + && ct.Name = "UInt64" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + let (|ConcreteSingle|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option = match handle with | ConcreteTypeHandle.Concrete id -> diff --git a/WoofWare.PawPrint.Domain/TypeDefn.fs b/WoofWare.PawPrint.Domain/TypeDefn.fs index d761e2e..829bc8a 100644 --- a/WoofWare.PawPrint.Domain/TypeDefn.fs +++ b/WoofWare.PawPrint.Domain/TypeDefn.fs @@ -6,6 +6,8 @@ open System.Reflection.Metadata open System.Reflection.Metadata.Ecma335 open Microsoft.FSharp.Core +[] +[] type ResolvedBaseType = | Enum | ValueType diff --git a/WoofWare.PawPrint.Test/LoggerFactory.fs b/WoofWare.PawPrint.Test/LoggerFactory.fs index 2d23c54..7046a09 100644 --- a/WoofWare.PawPrint.Test/LoggerFactory.fs +++ b/WoofWare.PawPrint.Test/LoggerFactory.fs @@ -23,7 +23,7 @@ module LoggerFactory = let makeTest () : (unit -> LogLine list) * ILoggerFactory = // Shared sink for all loggers created by the factory. let sink = ResizeArray () - let isEnabled (logLevel : LogLevel) : bool = logLevel >= LogLevel.Debug + let isEnabled (logLevel : LogLevel) : bool = logLevel >= LogLevel.Information let createLogger (category : string) : ILogger = { new ILogger with diff --git a/WoofWare.PawPrint/BinaryArithmetic.fs b/WoofWare.PawPrint/BinaryArithmetic.fs index 0acfc33..d460c7b 100644 --- a/WoofWare.PawPrint/BinaryArithmetic.fs +++ b/WoofWare.PawPrint/BinaryArithmetic.fs @@ -10,6 +10,7 @@ type IArithmeticOperation = abstract FloatFloat : float -> float -> float abstract NativeIntNativeInt : nativeint -> nativeint -> nativeint abstract Int32ManagedPtr : IlMachineState -> int32 -> ManagedPointerSource -> Choice + abstract ManagedPtrInt32 : IlMachineState -> ManagedPointerSource -> int32 -> Choice abstract ManagedPtrManagedPtr : IlMachineState -> ManagedPointerSource -> ManagedPointerSource -> Choice @@ -18,6 +19,35 @@ type IArithmeticOperation = [] module ArithmeticOperation = + let private addInt32ManagedPtr state v ptr = + match ptr with + | LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "refusing to add to a local variable address" + | Argument (sourceThread, methodFrame, whichVar) -> failwith "refusing to add to an argument address" + | Heap managedHeapAddress -> failwith "refusing to add to a heap address" + | ArrayIndex (arr, index) -> failwith "TODO: arrays" + | Field (src, fieldName) -> + let obj = IlMachineState.dereferencePointer state src + let offset, _ = CliType.getFieldLayout fieldName obj + + match CliType.getFieldAt (offset + v) obj with + | None -> failwith "TODO: couldn't identify field at offset" + | Some field -> + ManagedPointerSource.Field (src, CliConcreteField.ToCliField(field).Name) + |> Choice1Of2 + | Null -> Choice2Of2 v + | InterpretedAsType (managedPointerSource, concreteType) -> failwith "todo" + + let private mulInt32ManagedPtr (state : IlMachineState) v ptr = + if v = 0 then + Choice2Of2 0 + elif v = 1 then + Choice1Of2 ptr + else + + match ptr with + | ManagedPointerSource.Null -> Choice2Of2 0 + | _ -> failwith "refusing to multiply pointers" + let add = { new IArithmeticOperation with member _.Int32Int32 a b = (# "add" a b : int32 #) @@ -33,24 +63,8 @@ module ArithmeticOperation = | _, ManagedPointerSource.Null -> Choice1Of2 ptr1 | _, _ -> failwith "refusing to add two managed pointers" - member _.Int32ManagedPtr state val1 ptr2 = - match ptr2 with - | LocalVariable (sourceThread, methodFrame, whichVar) -> - failwith "refusing to add to a local variable address" - | Argument (sourceThread, methodFrame, whichVar) -> failwith "refusing to add to an argument address" - | Heap managedHeapAddress -> failwith "refusing to add to a heap address" - | ArrayIndex (arr, index) -> failwith "TODO: arrays" - | Field (src, fieldName) -> - let obj = IlMachineState.dereferencePointer state src - let offset, _ = CliType.getFieldLayout fieldName obj - - match CliType.getFieldAt (offset + val1) obj with - | None -> failwith "TODO: couldn't identify field at offset" - | Some field -> - ManagedPointerSource.Field (src, CliConcreteField.ToCliField(field).Name) - |> Choice1Of2 - | Null -> Choice2Of2 val1 - | InterpretedAsType (managedPointerSource, concreteType) -> failwith "todo" + member _.Int32ManagedPtr state val1 ptr2 = addInt32ManagedPtr state val1 ptr2 + member _.ManagedPtrInt32 state ptr1 val2 = addInt32ManagedPtr state val2 ptr1 member _.Name = "add" } @@ -94,6 +108,8 @@ module ArithmeticOperation = | ManagedPointerSource.Null -> Choice2Of2 val1 | _ -> failwith "refusing to subtract a pointer" + member _.ManagedPtrInt32 state ptr1 val2 = failwith "TODO: subtract from pointer" + member _.Name = "sub" } @@ -112,16 +128,26 @@ module ArithmeticOperation = | _, ManagedPointerSource.Null -> Choice2Of2 (nativeint 0) | _, _ -> failwith "refusing to multiply two managed pointers" - member _.Int32ManagedPtr _ a ptr = - if a = 0 then - Choice2Of2 0 - elif a = 1 then - Choice1Of2 ptr - else + member _.Int32ManagedPtr state a ptr = mulInt32ManagedPtr state a ptr + member _.ManagedPtrInt32 state ptr a = mulInt32ManagedPtr state a ptr - match ptr with - | ManagedPointerSource.Null -> Choice2Of2 0 - | _ -> failwith "refusing to multiply pointers" + member _.Name = "mul" + } + + let rem = + { new IArithmeticOperation with + member _.Int32Int32 a b = (# "rem" a b : int32 #) + member _.Int64Int64 a b = (# "rem" a b : int64 #) + member _.FloatFloat a b = (# "rem" a b : float #) + member _.NativeIntNativeInt a b = (# "rem" a b : nativeint #) + member _.Int32NativeInt a b = (# "rem" a b : nativeint #) + member _.NativeIntInt32 a b = (# "rem" a b : nativeint #) + + member _.ManagedPtrManagedPtr _ ptr1 ptr2 = failwith "refusing to rem pointers" + + member _.Int32ManagedPtr _ a ptr = failwith "refusing to rem pointer" + + member _.ManagedPtrInt32 _ ptr a = failwith "refusing to rem pointer" member _.Name = "mul" } @@ -141,16 +167,8 @@ module ArithmeticOperation = | _, ManagedPointerSource.Null -> Choice2Of2 (nativeint 0) | _, _ -> failwith "refusing to multiply two managed pointers" - member _.Int32ManagedPtr _ a ptr = - if a = 0 then - Choice2Of2 0 - elif a = 1 then - Choice1Of2 ptr - else - - match ptr with - | ManagedPointerSource.Null -> Choice2Of2 0 - | _ -> failwith "refusing to multiply pointers" + member _.Int32ManagedPtr state a ptr = mulInt32ManagedPtr state a ptr + member _.ManagedPtrInt32 state a ptr = mulInt32ManagedPtr state ptr a member _.Name = "mul_ovf" } @@ -175,6 +193,12 @@ module ArithmeticOperation = else failwith "refusing to divide pointers" + member _.ManagedPtrInt32 _ ptr a = + if a = 1 then + Choice1Of2 ptr + else + failwith "refusing to divide a pointer" + member _.Name = "div" } @@ -238,7 +262,10 @@ module BinaryArithmetic = | EvalStackValue.ManagedPointer val1, EvalStackValue.NativeInt val2 -> failwith "" |> EvalStackValue.ManagedPointer | EvalStackValue.ObjectRef val1, EvalStackValue.NativeInt val2 -> failwith "" |> EvalStackValue.ObjectRef - | EvalStackValue.ManagedPointer val1, EvalStackValue.Int32 val2 -> failwith "" |> EvalStackValue.ManagedPointer + | EvalStackValue.ManagedPointer val1, EvalStackValue.Int32 val2 -> + match op.ManagedPtrInt32 state val1 val2 with + | Choice1Of2 result -> EvalStackValue.ManagedPointer result + | Choice2Of2 result -> EvalStackValue.NativeInt (NativeIntSource.Verbatim (int64 result)) | EvalStackValue.ObjectRef val1, EvalStackValue.Int32 val2 -> failwith "" |> EvalStackValue.ObjectRef | EvalStackValue.ManagedPointer val1, EvalStackValue.ManagedPointer val2 -> match op.ManagedPtrManagedPtr state val1 val2 with diff --git a/WoofWare.PawPrint/EvalStack.fs b/WoofWare.PawPrint/EvalStack.fs index 20145dd..ab0e4cb 100644 --- a/WoofWare.PawPrint/EvalStack.fs +++ b/WoofWare.PawPrint/EvalStack.fs @@ -1,5 +1,7 @@ namespace WoofWare.PawPrint +#nowarn "42" + /// See I.12.3.2.1 for definition type EvalStackValue = | Int32 of int32 @@ -100,6 +102,21 @@ module EvalStackValue = | EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo" | EvalStackValue.UserDefinedValueType evalStackValues -> failwith "todo" + /// Then truncates to int32. + let convToUInt8 (value : EvalStackValue) : int32 option = + match value with + | EvalStackValue.Int32 (i : int32) -> + let v = (# "conv.u1" i : uint8 #) + Some (int32 v) + | EvalStackValue.Int64 int64 -> + let v = (# "conv.u1" int64 : uint8 #) + Some (int32 v) + | EvalStackValue.NativeInt nativeIntSource -> failwith "todo" + | EvalStackValue.Float f -> failwith "todo" + | EvalStackValue.ManagedPointer managedPointerSource -> failwith "todo" + | EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo" + | EvalStackValue.UserDefinedValueType evalStackValues -> failwith "todo" + let rec ofCliType (v : CliType) : EvalStackValue = match v with | CliType.Numeric numeric -> diff --git a/WoofWare.PawPrint/IlMachineState.fs b/WoofWare.PawPrint/IlMachineState.fs index 1145b88..a209f03 100644 --- a/WoofWare.PawPrint/IlMachineState.fs +++ b/WoofWare.PawPrint/IlMachineState.fs @@ -1670,7 +1670,10 @@ module IlMachineState = state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables.[int whichVar] | ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int whichVar] - | ManagedPointerSource.Heap addr -> failwith "todo" + | ManagedPointerSource.Heap addr -> + let result = ManagedHeap.get addr state.ManagedHeap + // TODO: this is awfully dubious, this ain't no value type + CliType.ValueType result.Contents | ManagedPointerSource.ArrayIndex (arr, index) -> getArrayValue arr index state | ManagedPointerSource.Field (addr, name) -> let obj = dereferencePointer state addr diff --git a/WoofWare.PawPrint/Intrinsics.fs b/WoofWare.PawPrint/Intrinsics.fs index b0acc62..52b803d 100644 --- a/WoofWare.PawPrint/Intrinsics.fs +++ b/WoofWare.PawPrint/Intrinsics.fs @@ -192,6 +192,44 @@ module Intrinsics = |> IlMachineState.advanceProgramCounter currentThread Some state + | "System.Private.CoreLib", "Type", "get_IsValueType" -> + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [], ConcreteBool state.ConcreteTypes -> () + | _ -> failwith "bad signature Type.get_IsValueType" + + let this, state = IlMachineState.popEvalStack currentThread state + + let this = + match this with + | EvalStackValue.ObjectRef ptr -> + IlMachineState.dereferencePointer state (ManagedPointerSource.Heap ptr) + | EvalStackValue.ManagedPointer ptr -> IlMachineState.dereferencePointer state ptr + | EvalStackValue.Float _ + | EvalStackValue.Int32 _ + | EvalStackValue.Int64 _ -> failwith "refusing to dereference literal" + | _ -> failwith "TODO" + // `this` should be of type Type + let ty = + match this with + | CliType.ValueType cvt -> + match CliValueType.DereferenceField "m_handle" cvt with + | CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr cth)) -> cth + | _ -> failwith "" + | _ -> failwith "expected a Type" + + let ty = AllConcreteTypes.lookup ty state.ConcreteTypes |> Option.get + let ty = state.LoadedAssembly(ty.Assembly).Value.TypeDefs.[ty.Definition.Get] + + let isValueType = + match DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies ty.Assembly ty.BaseType with + | ResolvedBaseType.Enum + | ResolvedBaseType.ValueType -> true + | ResolvedBaseType.Object + | ResolvedBaseType.Delegate -> false + + IlMachineState.pushToEvalStack (CliType.ofBool isValueType) currentThread state + |> IlMachineState.advanceProgramCounter currentThread + |> Some | "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 = IlMachineState.popEvalStack currentThread state @@ -235,6 +273,47 @@ module Intrinsics = let result = BitConverter.Int32BitsToSingle arg |> CliNumericType.Float32 |> CliType.Numeric + state + |> IlMachineState.pushToEvalStack result currentThread + |> IlMachineState.advanceProgramCounter currentThread + |> Some + | "System.Private.CoreLib", "BitConverter", "DoubleToUInt64Bits" -> + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteDouble state.ConcreteTypes ], ConcreteUInt64 state.ConcreteTypes -> () + | _ -> failwith "bad signature BitConverter.DoubleToUInt64Bits" + + let arg, state = IlMachineState.popEvalStack currentThread state + + let arg = + match arg with + | EvalStackValue.Float i -> i + | _ -> failwith "$TODO: {arr}" + + let result = + BitConverter.DoubleToUInt64Bits arg + |> int64 + |> CliNumericType.Int64 + |> CliType.Numeric + + state + |> IlMachineState.pushToEvalStack result currentThread + |> IlMachineState.advanceProgramCounter currentThread + |> Some + | "System.Private.CoreLib", "BitConverter", "UInt64BitsToDouble" -> + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteUInt64 state.ConcreteTypes ], ConcreteDouble state.ConcreteTypes -> () + | _ -> failwith "bad signature BitConverter.DoubleToUInt64Bits" + + let arg, state = IlMachineState.popEvalStack currentThread state + + let arg = + match arg with + | EvalStackValue.Int64 i -> uint64 i + | _ -> failwith "$TODO: {arr}" + + let result = + BitConverter.UInt64BitsToDouble arg |> CliNumericType.Float64 |> CliType.Numeric + state |> IlMachineState.pushToEvalStack result currentThread |> IlMachineState.advanceProgramCounter currentThread diff --git a/WoofWare.PawPrint/NullaryIlOp.fs b/WoofWare.PawPrint/NullaryIlOp.fs index f97b57c..6361385 100644 --- a/WoofWare.PawPrint/NullaryIlOp.fs +++ b/WoofWare.PawPrint/NullaryIlOp.fs @@ -443,8 +443,8 @@ module NullaryIlOp = | Sub_ovf -> failwith "TODO: Sub_ovf unimplemented" | Sub_ovf_un -> failwith "TODO: Sub_ovf_un unimplemented" | Add -> - let val1, state = IlMachineState.popEvalStack currentThread state let val2, state = IlMachineState.popEvalStack currentThread state + let val1, state = IlMachineState.popEvalStack currentThread state let result = BinaryArithmetic.execute ArithmeticOperation.add state val1 val2 state @@ -455,8 +455,8 @@ module NullaryIlOp = | Add_ovf -> failwith "TODO: Add_ovf unimplemented" | Add_ovf_un -> failwith "TODO: Add_ovf_un unimplemented" | Mul -> - let val1, state = IlMachineState.popEvalStack currentThread state let val2, state = IlMachineState.popEvalStack currentThread state + let val1, state = IlMachineState.popEvalStack currentThread state let result = BinaryArithmetic.execute ArithmeticOperation.mul state val1 val2 state @@ -465,8 +465,8 @@ module NullaryIlOp = |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped | Mul_ovf -> - let val1, state = IlMachineState.popEvalStack currentThread state let val2, state = IlMachineState.popEvalStack currentThread state + let val1, state = IlMachineState.popEvalStack currentThread state let result = try @@ -688,7 +688,20 @@ module NullaryIlOp = let state = state |> IlMachineState.advanceProgramCounter currentThread (state, WhatWeDid.Executed) |> ExecutionResult.Stepped - | Conv_U1 -> failwith "TODO: Conv_U1 unimplemented" + | Conv_U1 -> + let popped, state = IlMachineState.popEvalStack currentThread state + let converted = EvalStackValue.convToUInt8 popped + + let state = + match converted with + | None -> failwith "TODO: Conv_U8 conversion failure unimplemented" + | Some conv -> + state + |> IlMachineState.pushToEvalStack' (EvalStackValue.Int32 conv) currentThread + + let state = state |> IlMachineState.advanceProgramCounter currentThread + + (state, WhatWeDid.Executed) |> ExecutionResult.Stepped | Conv_U2 -> failwith "TODO: Conv_U2 unimplemented" | Conv_U4 -> failwith "TODO: Conv_U4 unimplemented" | Conv_U8 -> @@ -896,7 +909,16 @@ module NullaryIlOp = | Ldind_u8 -> failwith "TODO: Ldind_u8 unimplemented" | Ldind_r4 -> executeLdind LdindTargetType.LdindR4 currentThread state | Ldind_r8 -> executeLdind LdindTargetType.LdindR8 currentThread state - | Rem -> failwith "TODO: Rem unimplemented" + | Rem -> + let val2, state = IlMachineState.popEvalStack currentThread state + let val1, state = IlMachineState.popEvalStack currentThread state + let result = BinaryArithmetic.execute ArithmeticOperation.rem state val1 val2 + + state + |> IlMachineState.pushToEvalStack' result currentThread + |> IlMachineState.advanceProgramCounter currentThread + |> Tuple.withRight WhatWeDid.Executed + |> ExecutionResult.Stepped | Rem_un -> failwith "TODO: Rem_un unimplemented" | Volatile -> failwith "TODO: Volatile unimplemented" | Tail -> failwith "TODO: Tail unimplemented"