From d711d6fff5c59378a601a6366e01354cd2a43d88 Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Sun, 10 Aug 2025 23:32:23 +0100 Subject: [PATCH] Check types of JIT calls (#97) --- .../TypeConcretisation.fs | 102 ++++++++++++++++++ WoofWare.PawPrint/Intrinsics.fs | 91 ++++++++++++---- 2 files changed, 170 insertions(+), 23 deletions(-) diff --git a/WoofWare.PawPrint.Domain/TypeConcretisation.fs b/WoofWare.PawPrint.Domain/TypeConcretisation.fs index 24f1525..ac76eda 100644 --- a/WoofWare.PawPrint.Domain/TypeConcretisation.fs +++ b/WoofWare.PawPrint.Domain/TypeConcretisation.fs @@ -132,6 +132,108 @@ module ConcreteActivePatterns = | None -> None | _ -> None + let (|ConcreteBool|_|) (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 = "Boolean" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + + let (|ConcreteString|_|) (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 = "String" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + + let (|ConcreteDouble|_|) (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 = "Double" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + + let (|ConcreteInt64|_|) (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 = "Int64" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + + let (|ConcreteInt32|_|) (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 = "Int32" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + + let (|ConcreteSingle|_|) (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 = "Single" + && ct.Generics.IsEmpty + then + Some () + else + None + | None -> None + | _ -> None + /// Active pattern to match byref types let (|ConcreteByref|_|) (handle : ConcreteTypeHandle) = match handle with diff --git a/WoofWare.PawPrint/Intrinsics.fs b/WoofWare.PawPrint/Intrinsics.fs index 37b09ce..f6a98a1 100644 --- a/WoofWare.PawPrint/Intrinsics.fs +++ b/WoofWare.PawPrint/Intrinsics.fs @@ -44,6 +44,11 @@ module Intrinsics = match methodToCall.DeclaringType.Assembly.Name, methodToCall.DeclaringType.Name, methodToCall.Name with | "System.Private.CoreLib", "Type", "get_TypeHandle" -> + // TODO: check return type is RuntimeTypeHandle + match methodToCall.Signature.ParameterTypes with + | _ :: _ -> failwith "bad signature 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 (a RuntimeType class) @@ -96,6 +101,10 @@ module Intrinsics = |> IlMachineState.advanceProgramCounter currentThread |> Some | "System.Private.CoreLib", "BitConverter", "SingleToInt32Bits" -> + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteSingle state.ConcreteTypes ], ConcreteInt32 state.ConcreteTypes -> () + | _ -> failwith "bad signature BitConverter.SingleToInt32Bits" + let arg, state = IlMachineState.popEvalStack currentThread state let result = @@ -108,6 +117,10 @@ module Intrinsics = |> IlMachineState.advanceProgramCounter currentThread |> Some | "System.Private.CoreLib", "BitConverter", "Int32BitsToSingle" -> + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteInt32 state.ConcreteTypes ], ConcreteSingle state.ConcreteTypes -> () + | _ -> failwith "bad signature BitConverter.Int64BitsToSingle" + let arg, state = IlMachineState.popEvalStack currentThread state let arg = @@ -123,6 +136,10 @@ module Intrinsics = |> IlMachineState.advanceProgramCounter currentThread |> Some | "System.Private.CoreLib", "BitConverter", "Int64BitsToDouble" -> + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteInt64 state.ConcreteTypes ], ConcreteDouble state.ConcreteTypes -> () + | _ -> failwith "bad signature BitConverter.Int64BitsToDouble" + let arg, state = IlMachineState.popEvalStack currentThread state let arg = @@ -138,6 +155,10 @@ module Intrinsics = |> IlMachineState.advanceProgramCounter currentThread |> Some | "System.Private.CoreLib", "BitConverter", "DoubleToInt64Bits" -> + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteDouble state.ConcreteTypes ], ConcreteInt64 state.ConcreteTypes -> () + | _ -> failwith "bad signature BitConverter.DoubleToInt64Bits" + let arg, state = IlMachineState.popEvalStack currentThread state let result = @@ -150,33 +171,39 @@ module Intrinsics = |> IlMachineState.advanceProgramCounter currentThread |> Some | "System.Private.CoreLib", "String", "Equals" -> - let arg1, state = IlMachineState.popEvalStack currentThread state + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [ ConcreteString state.ConcreteTypes ; ConcreteString state.ConcreteTypes ], + ConcreteBool state.ConcreteTypes -> + let arg1, state = IlMachineState.popEvalStack currentThread state - let arg1 = - match arg1 with - | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h - | EvalStackValue.Int32 _ - | EvalStackValue.Int64 _ - | EvalStackValue.Float _ -> failwith $"this isn't a string! {arg1}" - | _ -> failwith $"TODO: %O{arg1}" + let arg1 = + match arg1 with + | EvalStackValue.ObjectRef h + | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h + | EvalStackValue.Int32 _ + | EvalStackValue.Int64 _ + | EvalStackValue.Float _ -> failwith $"this isn't a string! {arg1}" + | _ -> failwith $"TODO: %O{arg1}" - let arg2, state = IlMachineState.popEvalStack currentThread state + let arg2, state = IlMachineState.popEvalStack currentThread state - let arg2 = - match arg2 with - | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h - | EvalStackValue.Int32 _ - | EvalStackValue.Int64 _ - | EvalStackValue.Float _ -> failwith $"this isn't a string! {arg2}" - | _ -> failwith $"TODO: %O{arg2}" + let arg2 = + match arg2 with + | EvalStackValue.ObjectRef h + | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h + | EvalStackValue.Int32 _ + | EvalStackValue.Int64 _ + | EvalStackValue.Float _ -> failwith $"this isn't a string! {arg2}" + | _ -> failwith $"TODO: %O{arg2}" - if arg1 = arg2 then - state - |> IlMachineState.pushToEvalStack (CliType.ofBool true) currentThread - |> IlMachineState.advanceProgramCounter currentThread - |> Some - else - failwith "TODO" + if arg1 = arg2 then + state + |> IlMachineState.pushToEvalStack (CliType.ofBool true) currentThread + |> IlMachineState.advanceProgramCounter currentThread + |> Some + else + failwith "TODO" + | _ -> None | "System.Private.CoreLib", "Unsafe", "ReadUnaligned" -> let ptr, state = IlMachineState.popEvalStack currentThread state @@ -234,8 +261,26 @@ module Intrinsics = else failwith "TODO: unexpected params to String.op_Implicit" | _ -> failwith "TODO: unexpected params to String.op_Implicit" + | "System.Private.CoreLib", "RuntimeHelpers", "IsReferenceOrContainsReferences" -> + // https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/Runtime/CompilerServices/RuntimeHelpers.CoreCLR.cs#L207 + match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with + | [], ConcreteBool state.ConcreteTypes -> () + | _ -> failwith "bad signature for System.Private.CoreLib.RuntimeHelpers.IsReferenceOrContainsReference" + + let generic = + AllConcreteTypes.lookup (Seq.exactlyOne methodToCall.Generics) state.ConcreteTypes + + let generic = + match generic with + | None -> failwith "somehow have not already concretised type in IsReferenceOrContainsReferences" + | Some generic -> generic + + failwith $"TODO: do the thing on %O{generic}" | "System.Private.CoreLib", "RuntimeHelpers", "InitializeArray" -> // https://github.com/dotnet/runtime/blob/9e5e6aa7bc36aeb2a154709a9d1192030c30a2ef/src/coreclr/System.Private.CoreLib/src/System/Runtime/CompilerServices/RuntimeHelpers.CoreCLR.cs#L18 failwith "TODO: array initialization" + | "System.Private.CoreLib", "RuntimeHelpers", "CreateSpan" -> + // https://github.com/dotnet/runtime/blob/9e5e6aa7bc36aeb2a154709a9d1192030c30a2ef/src/libraries/System.Private.CoreLib/src/System/Runtime/CompilerServices/RuntimeHelpers.cs#L153 + None | a, b, c -> failwith $"TODO: implement JIT intrinsic {a}.{b}.{c}" |> Option.map (fun s -> s.WithThreadSwitchedToAssembly callerAssy currentThread |> fst)