From 641040509f718f8e111d99d41fa7396097bd3166 Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Fri, 27 Jun 2025 15:06:01 +0100 Subject: [PATCH] Test float comparisons (#73) --- WoofWare.PawPrint.Test/TestPureCases.fs | 8 +- .../WoofWare.PawPrint.Test.fsproj | 1 + WoofWare.PawPrint.Test/sourcesPure/Floats.cs | 216 ++++++++++++++++++ WoofWare.PawPrint/BinaryArithmetic.fs | 8 + .../EvalStackValueComparisons.fs | 82 ++++++- WoofWare.PawPrint/IlMachineState.fs | 90 ++++++-- WoofWare.PawPrint/NullaryIlOp.fs | 47 +++- WoofWare.PawPrint/UnaryConstIlOp.fs | 114 ++++++++- 8 files changed, 538 insertions(+), 28 deletions(-) create mode 100644 WoofWare.PawPrint.Test/sourcesPure/Floats.cs diff --git a/WoofWare.PawPrint.Test/TestPureCases.fs b/WoofWare.PawPrint.Test/TestPureCases.fs index 777c24b..1de387a 100644 --- a/WoofWare.PawPrint.Test/TestPureCases.fs +++ b/WoofWare.PawPrint.Test/TestPureCases.fs @@ -172,6 +172,12 @@ module TestPureCases = NativeImpls = MockEnv.make () LocalVariablesOfMain = [ CliType.Numeric (CliNumericType.Int32 10) ] |> Some } + { + FileName = "Floats.cs" + ExpectedReturnCode = 0 + NativeImpls = MockEnv.make () + LocalVariablesOfMain = None + } { FileName = "TryCatchWithThrowInBody.cs" ExpectedReturnCode = 4 @@ -218,7 +224,7 @@ module TestPureCases = | EvalStackValue.Int32 i -> i | ret -> failwith $"expected program to return an int, but it returned %O{ret}" - realResult.ExitCode |> shouldEqual exitCode + exitCode |> shouldEqual realResult.ExitCode exitCode |> shouldEqual case.ExpectedReturnCode diff --git a/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj index 95d3dfb..33a3577 100644 --- a/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj +++ b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj @@ -20,6 +20,7 @@ + diff --git a/WoofWare.PawPrint.Test/sourcesPure/Floats.cs b/WoofWare.PawPrint.Test/sourcesPure/Floats.cs new file mode 100644 index 0000000..2dcc957 --- /dev/null +++ b/WoofWare.PawPrint.Test/sourcesPure/Floats.cs @@ -0,0 +1,216 @@ +// Thanks Gemini 2.5 Pro + +using System; + +public class Program +{ + /// + /// Main entry point for the test harness. It runs test suites for float and double comparisons. + /// + /// 0 if all tests pass, otherwise a non-zero error code indicating the first failed test. + public static int Main(string[] args) + { + int result; + + result = FloatCompareTests.RunTests(); + if (result != 0) + { + return result; + } + + result = DoubleCompareTests.RunTests(); + if (result != 0) + { + return result; + } + + return 0; // Success + } +} + +/// +/// Contains a suite of tests for System.Single (float) comparisons. +/// Each test corresponds to a specific CIL comparison instruction. +/// +public class FloatCompareTests +{ + private static int testCounter = 100; // Start error codes at 100 for this suite + + /// + /// Checks a boolean condition. If the condition is false, it prints a failure message + /// and returns a unique error code. + /// + /// The boolean result of the test. + /// A descriptive name for the test case. + /// 0 if the test passes, otherwise a unique non-zero error code. + private static int Check(bool condition, string testName) + { + testCounter++; + if (!condition) + { + return testCounter; + } + return 0; + } + + /// + /// Runs all float comparison tests. + /// + /// 0 if all tests pass, otherwise the error code of the first failing test. + public static int RunTests() + { + float pz = 0.0f; + float nz = -0.0f; + float one = 1.0f; + float negOne = -1.0f; + float two = 2.0f; + float pInf = float.PositiveInfinity; + float nInf = float.NegativeInfinity; + float nan = float.NaN; + float subnormal = BitConverter.ToSingle(new byte[] { 1, 0, 0, 0 }, 0); // Smallest positive subnormal + + int result; + + // --- Ceq Tests (==) --- + result = Check(one == one, "1.0f == 1.0f"); if (result != 0) return result; + result = Check(!(one == two), "!(1.0f == 2.0f)"); if (result != 0) return result; + result = Check(pz == nz, "0.0f == -0.0f"); if (result != 0) return result; + result = Check(pInf == pInf, "+Inf == +Inf"); if (result != 0) return result; + result = Check(nInf == nInf, "-Inf == -Inf"); if (result != 0) return result; + result = Check(!(pInf == nInf), "!(+Inf == -Inf)"); if (result != 0) return result; + result = Check(!(nan == nan), "!(NaN == NaN)"); if (result != 0) return result; + result = Check(!(nan == one), "!(NaN == 1.0f)"); if (result != 0) return result; + result = Check(!(one == nan), "!(1.0f == NaN)"); if (result != 0) return result; + + // --- Cgt Tests (>) --- + result = Check(two > one, "2.0f > 1.0f"); if (result != 0) return result; + result = Check(!(one > two), "!(1.0f > 2.0f)"); if (result != 0) return result; + result = Check(!(one > one), "!(1.0f > 1.0f)"); if (result != 0) return result; + result = Check(pInf > one, "+Inf > 1.0f"); if (result != 0) return result; + result = Check(!(nInf > one), "!( -Inf > 1.0f)"); if (result != 0) return result; + result = Check(pInf > nInf, "+Inf > -Inf"); if (result != 0) return result; + result = Check(!(nan > one), "!(NaN > 1.0f)"); if (result != 0) return result; + result = Check(!(one > nan), "!(1.0f > NaN)"); if (result != 0) return result; + result = Check(one > subnormal, "1.0f > subnormal"); if (result != 0) return result; + + // --- Cgt.un Tests (unordered >) --- + // cgt.un is equivalent to !(a <= b) for floats + result = Check(!(two <= one), "cgt.un: 2.0f > 1.0f"); if (result != 0) return result; + result = Check(one > pz, "cgt.un: 1.0f > 0.0f"); if (result != 0) return result; + result = Check(!(nan <= one), "cgt.un: NaN > 1.0f"); if (result != 0) return result; + result = Check(!(one <= nan), "cgt.un: 1.0f > NaN"); if (result != 0) return result; + result = Check(!(nan <= nan), "cgt.un: NaN > NaN"); if (result != 0) return result; + + + // --- Clt Tests (<) --- + result = Check(one < two, "1.0f < 2.0f"); if (result != 0) return result; + result = Check(!(two < one), "!(2.0f < 1.0f)"); if (result != 0) return result; + result = Check(!(one < one), "!(1.0f < 1.0f)"); if (result != 0) return result; + result = Check(one < pInf, "1.0f < +Inf"); if (result != 0) return result; + result = Check(nInf < one, "-Inf < 1.0f"); if (result != 0) return result; + result = Check(nInf < pInf, "-Inf < +Inf"); if (result != 0) return result; + result = Check(!(nan < one), "!(NaN < 1.0f)"); if (result != 0) return result; + result = Check(!(one < nan), "!(1.0f < NaN)"); if (result != 0) return result; + result = Check(subnormal < one, "subnormal < 1.0f"); if (result != 0) return result; + + // --- Clt.un Tests (unordered <) --- + // clt.un is equivalent to !(a >= b) for floats + result = Check(one < two, "clt.un: 1.0f < 2.0f"); if (result != 0) return result; + result = Check(!(one >= nan), "clt.un: 1.0f < NaN"); if (result != 0) return result; + result = Check(!(nan >= one), "clt.un: NaN < 1.0f"); if (result != 0) return result; + result = Check(!(nan >= nan), "clt.un: NaN < NaN"); if (result != 0) return result; + + // --- C# >= (bge) and <= (ble) --- + result = Check(one >= one, "1.0f >= 1.0f"); if (result != 0) return result; + result = Check(two >= one, "2.0f >= 1.0f"); if (result != 0) return result; + result = Check(!(nan >= one), "!(NaN >= 1.0f)"); if (result != 0) return result; + result = Check(one <= one, "1.0f <= 1.0f"); if (result != 0) return result; + result = Check(one <= two, "1.0f <= 2.0f"); if (result != 0) return result; + result = Check(!(nan <= one), "!(NaN <= 1.0f)"); if (result != 0) return result; + result = Check(pz >= nz, "0.0f >= -0.0f"); if (result != 0) return result; + result = Check(pz <= nz, "0.0f <= -0.0f"); if (result != 0) return result; + + return 0; // Success + } +} + +/// +/// Contains a suite of tests for System.Double comparisons. +/// +public class DoubleCompareTests +{ + private static int testCounter = 200; // Start error codes at 200 for this suite + + private static int Check(bool condition, string testName) + { + testCounter++; + if (!condition) + { + return testCounter; + } + return 0; + } + + public static int RunTests() + { + double pz = 0.0; + double nz = -0.0; + double one = 1.0; + double negOne = -1.0; + double two = 2.0; + double pInf = double.PositiveInfinity; + double nInf = double.NegativeInfinity; + double nan = double.NaN; + double subnormal = BitConverter.Int64BitsToDouble(1); // Smallest positive subnormal + + int result; + + // --- Ceq Tests (==) --- + result = Check(one == one, "1.0 == 1.0"); if (result != 0) return result; + result = Check(!(one == two), "!(1.0 == 2.0)"); if (result != 0) return result; + result = Check(pz == nz, "0.0 == -0.0"); if (result != 0) return result; + result = Check(pInf == pInf, "+Inf == +Inf"); if (result != 0) return result; + result = Check(nInf == nInf, "-Inf == -Inf"); if (result != 0) return result; + result = Check(!(pInf == nInf), "!(+Inf == -Inf)"); if (result != 0) return result; + result = Check(!(nan == nan), "!(NaN == NaN)"); if (result != 0) return result; + + // --- Cgt Tests (>) --- + result = Check(two > one, "2.0 > 1.0"); if (result != 0) return result; + result = Check(!(one > one), "!(1.0 > 1.0)"); if (result != 0) return result; + result = Check(pInf > one, "+Inf > 1.0"); if (result != 0) return result; + result = Check(!(nInf > one), "!(-Inf > 1.0)"); if (result != 0) return result; + result = Check(pInf > nInf, "+Inf > -Inf"); if (result != 0) return result; + result = Check(!(nan > one), "!(NaN > 1.0)"); if (result != 0) return result; + result = Check(one > subnormal, "1.0 > subnormal"); if (result != 0) return result; + + // --- Cgt.un Tests (unordered >) --- + result = Check(one > pz, "cgt.un: 1.0 > 0.0"); if (result != 0) return result; + result = Check(!(nan <= one), "cgt.un: NaN > 1.0"); if (result != 0) return result; + result = Check(!(one <= nan), "cgt.un: 1.0 > NaN"); if (result != 0) return result; + + // --- Clt Tests (<) --- + result = Check(one < two, "1.0 < 2.0"); if (result != 0) return result; + result = Check(!(one < one), "!(1.0 < 1.0)"); if (result != 0) return result; + result = Check(nInf < one, "-Inf < 1.0"); if (result != 0) return result; + result = Check(!(pInf < one), "!(+Inf < 1.0)"); if (result != 0) return result; + result = Check(nInf < pInf, "-Inf < +Inf"); if (result != 0) return result; + result = Check(!(nan < one), "!(NaN < 1.0)"); if (result != 0) return result; + result = Check(subnormal < one, "subnormal < 1.0"); if (result != 0) return result; + + // --- Clt.un Tests (unordered <) --- + result = Check(one < two, "clt.un: 1.0 < 2.0"); if (result != 0) return result; + result = Check(!(one >= nan), "clt.un: 1.0 < NaN"); if (result != 0) return result; + result = Check(!(nan >= one), "clt.un: NaN < 1.0"); if (result != 0) return result; + + // --- C# >= (bge) and <= (ble) --- + result = Check(one >= one, "1.0 >= 1.0"); if (result != 0) return result; + result = Check(two >= one, "2.0 >= 1.0"); if (result != 0) return result; + result = Check(!(nan >= one), "!(NaN >= 1.0)"); if (result != 0) return result; + result = Check(one <= one, "1.0 <= 1.0"); if (result != 0) return result; + result = Check(one <= two, "1.0 <= 2.0"); if (result != 0) return result; + result = Check(!(nan <= one), "!(NaN <= 1.0)"); if (result != 0) return result; + result = Check(pz >= nz, "0.0 >= -0.0"); if (result != 0) return result; + + return 0; // Success + } +} diff --git a/WoofWare.PawPrint/BinaryArithmetic.fs b/WoofWare.PawPrint/BinaryArithmetic.fs index 0d0e390..74c0df8 100644 --- a/WoofWare.PawPrint/BinaryArithmetic.fs +++ b/WoofWare.PawPrint/BinaryArithmetic.fs @@ -18,6 +18,14 @@ module ArithmeticOperation = member _.Name = "add" } + let sub = + { new IArithmeticOperation with + member _.Int32Int32 a b = (# "sub" a b : int32 #) + member _.Int64Int64 a b = (# "sub" a b : int64 #) + member _.FloatFloat a b = (# "sub" a b : float #) + member _.Name = "sub" + } + let mul = { new IArithmeticOperation with member _.Int32Int32 a b = (# "mul" a b : int32 #) diff --git a/WoofWare.PawPrint/EvalStackValueComparisons.fs b/WoofWare.PawPrint/EvalStackValueComparisons.fs index 188dfdc..512c57e 100644 --- a/WoofWare.PawPrint/EvalStackValueComparisons.fs +++ b/WoofWare.PawPrint/EvalStackValueComparisons.fs @@ -6,7 +6,7 @@ module EvalStackValueComparisons = let clt (var1 : EvalStackValue) (var2 : EvalStackValue) : bool = match var1, var2 with | EvalStackValue.Int64 var1, EvalStackValue.Int64 var2 -> var1 < var2 - | EvalStackValue.Float var1, EvalStackValue.Float var2 -> failwith "TODO: Clt float comparison unimplemented" + | EvalStackValue.Float var1, EvalStackValue.Float var2 -> var1 < var2 | EvalStackValue.ObjectRef var1, EvalStackValue.ObjectRef var2 -> failwith $"Clt instruction invalid for comparing object refs, {var1} vs {var2}" | EvalStackValue.ObjectRef var1, other -> failwith $"invalid comparison, ref %O{var1} vs %O{other}" @@ -37,7 +37,83 @@ module EvalStackValueComparisons = | EvalStackValue.UserDefinedValueType _, UserDefinedValueType _ -> failwith "TODO: Clt UserDefinedValueType vs UserDefinedValueType comparison unimplemented" - let ceq var1 var2 : bool = + let cgt (var1 : EvalStackValue) (var2 : EvalStackValue) : bool = + match var1, var2 with + | EvalStackValue.Int64 var1, EvalStackValue.Int64 var2 -> var1 > var2 + | EvalStackValue.Float var1, EvalStackValue.Float var2 -> var1 > var2 + | EvalStackValue.ObjectRef var1, EvalStackValue.ObjectRef var2 -> + failwith $"Cgt instruction invalid for comparing object refs, {var1} vs {var2}" + | EvalStackValue.ObjectRef var1, other -> failwith $"invalid comparison, ref %O{var1} vs %O{other}" + | other, EvalStackValue.ObjectRef var2 -> failwith $"invalid comparison, %O{other} vs ref %O{var2}" + | EvalStackValue.Float i, other -> failwith $"invalid comparison, float %f{i} vs %O{other}" + | other, EvalStackValue.Float i -> failwith $"invalid comparison, %O{other} vs float %f{i}" + | EvalStackValue.Int64 i, other -> failwith $"invalid comparison, int64 %i{i} vs %O{other}" + | other, EvalStackValue.Int64 i -> failwith $"invalid comparison, %O{other} vs int64 %i{i}" + | EvalStackValue.Int32 var1, EvalStackValue.Int32 var2 -> var1 > var2 + | EvalStackValue.Int32 var1, EvalStackValue.NativeInt var2 -> + failwith "TODO: Cgt Int32 vs NativeInt comparison unimplemented" + | EvalStackValue.Int32 i, other -> failwith $"invalid comparison, int32 %i{i} vs %O{other}" + | EvalStackValue.NativeInt var1, EvalStackValue.Int32 var2 -> + failwith "TODO: Cgt NativeInt vs Int32 comparison unimplemented" + | other, EvalStackValue.Int32 var2 -> failwith $"invalid comparison, {other} vs int32 {var2}" + | EvalStackValue.NativeInt var1, EvalStackValue.NativeInt var2 -> NativeIntSource.isLess var1 var2 + | EvalStackValue.NativeInt var1, other -> failwith $"invalid comparison, nativeint {var1} vs %O{other}" + | EvalStackValue.ManagedPointer managedPointerSource, NativeInt int64 -> + failwith "TODO: Cgt ManagedPointer vs NativeInt comparison unimplemented" + | EvalStackValue.ManagedPointer managedPointerSource, ManagedPointer pointerSource -> + failwith "TODO: Cgt ManagedPointer vs ManagedPointer comparison unimplemented" + | EvalStackValue.ManagedPointer managedPointerSource, UserDefinedValueType _ -> + failwith "TODO: Cgt ManagedPointer vs UserDefinedValueType comparison unimplemented" + | EvalStackValue.UserDefinedValueType _, NativeInt int64 -> + failwith "TODO: Cgt UserDefinedValueType vs NativeInt comparison unimplemented" + | EvalStackValue.UserDefinedValueType _, ManagedPointer managedPointerSource -> + failwith "TODO: Cgt UserDefinedValueType vs ManagedPointer comparison unimplemented" + | EvalStackValue.UserDefinedValueType _, UserDefinedValueType _ -> + failwith "TODO: Cgt UserDefinedValueType vs UserDefinedValueType comparison unimplemented" + + let cgtUn (var1 : EvalStackValue) (var2 : EvalStackValue) : bool = + match var1, var2 with + | EvalStackValue.Int32 var1, EvalStackValue.Int32 var2 -> uint32 var1 > uint32 var2 + | EvalStackValue.Int32 var1, EvalStackValue.NativeInt var2 -> + failwith "TODO: comparison of unsigned int32 with nativeint" + | EvalStackValue.Int32 _, _ -> failwith $"Cgt.un invalid for comparing %O{var1} with %O{var2}" + | EvalStackValue.Int64 var1, EvalStackValue.Int64 var2 -> uint64 var1 > uint64 var2 + | EvalStackValue.Int64 _, _ -> failwith $"Cgt.un invalid for comparing %O{var1} with %O{var2}" + | EvalStackValue.NativeInt var1, EvalStackValue.NativeInt var2 -> + failwith "TODO: comparison of unsigned nativeints" + | EvalStackValue.NativeInt var1, EvalStackValue.Int32 var2 -> + failwith "TODO: comparison of unsigned nativeint with int32" + | EvalStackValue.Float var1, EvalStackValue.Float var2 -> not (var1 <= var2) + | EvalStackValue.Float _, _ -> failwith $"Cgt.un invalid for comparing %O{var1} with %O{var2}" + | EvalStackValue.ManagedPointer var1, EvalStackValue.ManagedPointer var2 -> failwith "TODO" + | EvalStackValue.ObjectRef var1, EvalStackValue.ObjectRef var2 -> + // According to the spec, cgt.un is verifiable on ObjectRefs and is used to compare with null. + // A direct comparison between two object refs is not specified, so we treat it as a pointer comparison. + failwith "TODO" + | other1, other2 -> failwith $"Cgt.un instruction invalid for comparing {other1} vs {other2}" + + let cltUn (var1 : EvalStackValue) (var2 : EvalStackValue) : bool = + match var1, var2 with + | EvalStackValue.Int32 var1, EvalStackValue.Int32 var2 -> uint32 var1 < uint32 var2 + | EvalStackValue.Int32 var1, EvalStackValue.NativeInt var2 -> + failwith "TODO: comparison of unsigned int32 with nativeint" + | EvalStackValue.Int32 _, _ -> failwith $"Cgt.un invalid for comparing %O{var1} with %O{var2}" + | EvalStackValue.Int64 var1, EvalStackValue.Int64 var2 -> uint64 var1 < uint64 var2 + | EvalStackValue.Int64 _, _ -> failwith $"Cgt.un invalid for comparing %O{var1} with %O{var2}" + | EvalStackValue.NativeInt var1, EvalStackValue.NativeInt var2 -> + failwith "TODO: comparison of unsigned nativeints" + | EvalStackValue.NativeInt var1, EvalStackValue.Int32 var2 -> + failwith "TODO: comparison of unsigned nativeint with int32" + | EvalStackValue.Float var1, EvalStackValue.Float var2 -> not (var1 >= var2) + | EvalStackValue.Float _, _ -> failwith $"Cgt.un invalid for comparing %O{var1} with %O{var2}" + | EvalStackValue.ManagedPointer var1, EvalStackValue.ManagedPointer var2 -> failwith "TODO" + | EvalStackValue.ObjectRef var1, EvalStackValue.ObjectRef var2 -> + // According to the spec, cgt.un is verifiable on ObjectRefs and is used to compare with null. + // A direct comparison between two object refs is not specified, so we treat it as a pointer comparison. + failwith "TODO" + | other1, other2 -> failwith $"Cgt.un instruction invalid for comparing {other1} vs {other2}" + + let ceq (var1 : EvalStackValue) (var2 : EvalStackValue) : bool = // Table III.4 match var1, var2 with | EvalStackValue.Int32 var1, EvalStackValue.Int32 var2 -> var1 = var2 @@ -45,7 +121,7 @@ module EvalStackValueComparisons = | EvalStackValue.Int32 _, _ -> failwith $"bad ceq: Int32 vs {var2}" | EvalStackValue.Int64 var1, EvalStackValue.Int64 var2 -> var1 = var2 | EvalStackValue.Int64 _, _ -> failwith $"bad ceq: Int64 vs {var2}" - | EvalStackValue.Float var1, EvalStackValue.Float var2 -> failwith "TODO: float CEQ float" + | EvalStackValue.Float var1, EvalStackValue.Float var2 -> var1 = var2 | EvalStackValue.Float _, _ -> failwith $"bad ceq: Float vs {var2}" | EvalStackValue.NativeInt var1, EvalStackValue.NativeInt var2 -> match var1, var2 with diff --git a/WoofWare.PawPrint/IlMachineState.fs b/WoofWare.PawPrint/IlMachineState.fs index 6cedfe0..9a99a14 100644 --- a/WoofWare.PawPrint/IlMachineState.fs +++ b/WoofWare.PawPrint/IlMachineState.fs @@ -427,6 +427,22 @@ module IlMachineState = ) } + let setArrayValue + (arrayAllocation : ManagedHeapAddress) + (v : CliType) + (index : int) + (state : IlMachineState) + : IlMachineState + = + let heap = ManagedHeap.SetArrayValue arrayAllocation index v state.ManagedHeap + + { state with + ManagedHeap = heap + } + + let getArrayValue (arrayAllocation : ManagedHeapAddress) (index : int) (state : IlMachineState) : CliType = + ManagedHeap.GetArrayValue arrayAllocation index state.ManagedHeap + /// There might be no stack frame to return to, so you might get None. let returnStackFrame (loggerFactory : ILoggerFactory) @@ -605,6 +621,36 @@ module IlMachineState = |> pushToEvalStack' result currentThread |> advanceProgramCounter currentThread |> Some + | "System.Private.CoreLib", "BitConverter", "Int32BitsToSingle" -> + let arg, state = popEvalStack currentThread state + + let arg = + match arg with + | EvalStackValue.Int32 i -> i + | _ -> failwith "$TODO: {arr}" + + let result = + BitConverter.Int32BitsToSingle arg |> CliNumericType.Float32 |> CliType.Numeric + + state + |> pushToEvalStack result currentThread + |> advanceProgramCounter currentThread + |> Some + | "System.Private.CoreLib", "BitConverter", "Int64BitsToDouble" -> + let arg, state = popEvalStack currentThread state + + let arg = + match arg with + | EvalStackValue.Int64 i -> i + | _ -> failwith "$TODO: {arr}" + + let result = + BitConverter.Int64BitsToDouble arg |> CliNumericType.Float64 |> CliType.Numeric + + state + |> pushToEvalStack result currentThread + |> advanceProgramCounter currentThread + |> Some | "System.Private.CoreLib", "BitConverter", "DoubleToInt64Bits" -> let arg, state = popEvalStack currentThread state @@ -645,6 +691,34 @@ module IlMachineState = |> Some else failwith "TODO" + | "System.Private.CoreLib", "Unsafe", "ReadUnaligned" -> + let ptr, state = popEvalStack currentThread state + + let v : CliType = + let rec go ptr = + match ptr with + | EvalStackValue.ManagedPointer src -> + match src with + | ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "todo" + | ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo" + | ManagedPointerSource.Heap managedHeapAddress -> failwith "todo" + | ManagedPointerSource.ArrayIndex (arr, index) -> state |> getArrayValue arr index + | ManagedPointerSource.Null -> failwith "TODO: throw NRE" + | EvalStackValue.NativeInt src -> failwith "TODO" + | EvalStackValue.ObjectRef ptr -> failwith "TODO" + | EvalStackValue.UserDefinedValueType [ field ] -> go field + | EvalStackValue.UserDefinedValueType [] + | EvalStackValue.UserDefinedValueType (_ :: _ :: _) + | EvalStackValue.Int32 _ + | EvalStackValue.Int64 _ + | EvalStackValue.Float _ -> failwith $"this isn't a pointer! {ptr}" + + go ptr + + let state = + state |> pushToEvalStack v currentThread |> advanceProgramCounter currentThread + + Some state | a, b, c -> failwith $"TODO: implement JIT intrinsic {a}.{b}.{c}" |> Option.map (fun s -> s.WithThreadSwitchedToAssembly callerAssy currentThread |> fst) @@ -1166,22 +1240,6 @@ module IlMachineState = } } - let setArrayValue - (arrayAllocation : ManagedHeapAddress) - (v : CliType) - (index : int) - (state : IlMachineState) - : IlMachineState - = - let heap = ManagedHeap.SetArrayValue arrayAllocation index v state.ManagedHeap - - { state with - ManagedHeap = heap - } - - let getArrayValue (arrayAllocation : ManagedHeapAddress) (index : int) (state : IlMachineState) : CliType = - ManagedHeap.GetArrayValue arrayAllocation index state.ManagedHeap - let jumpProgramCounter (thread : ThreadId) (bytes : int) (state : IlMachineState) : IlMachineState = { state with ThreadState = diff --git a/WoofWare.PawPrint/NullaryIlOp.fs b/WoofWare.PawPrint/NullaryIlOp.fs index fcd304e..5295fdd 100644 --- a/WoofWare.PawPrint/NullaryIlOp.fs +++ b/WoofWare.PawPrint/NullaryIlOp.fs @@ -369,8 +369,28 @@ module NullaryIlOp = |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped - | Cgt -> failwith "TODO: Cgt unimplemented" - | Cgt_un -> failwith "TODO: Cgt_un unimplemented" + | Cgt -> + let var2, state = state |> IlMachineState.popEvalStack currentThread + let var1, state = state |> IlMachineState.popEvalStack currentThread + + let comparisonResult = if EvalStackValueComparisons.cgt var1 var2 then 1 else 0 + + state + |> IlMachineState.pushToEvalStack' (EvalStackValue.Int32 comparisonResult) currentThread + |> IlMachineState.advanceProgramCounter currentThread + |> Tuple.withRight WhatWeDid.Executed + |> ExecutionResult.Stepped + | Cgt_un -> + let var2, state = state |> IlMachineState.popEvalStack currentThread + let var1, state = state |> IlMachineState.popEvalStack currentThread + + let comparisonResult = if EvalStackValueComparisons.cgtUn var1 var2 then 1 else 0 + + state + |> IlMachineState.pushToEvalStack' (EvalStackValue.Int32 comparisonResult) currentThread + |> IlMachineState.advanceProgramCounter currentThread + |> Tuple.withRight WhatWeDid.Executed + |> ExecutionResult.Stepped | Clt -> let var2, state = state |> IlMachineState.popEvalStack currentThread let var1, state = state |> IlMachineState.popEvalStack currentThread @@ -382,7 +402,17 @@ module NullaryIlOp = |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped - | Clt_un -> failwith "TODO: Clt_un unimplemented" + | Clt_un -> + let var2, state = state |> IlMachineState.popEvalStack currentThread + let var1, state = state |> IlMachineState.popEvalStack currentThread + + let comparisonResult = if EvalStackValueComparisons.cltUn var1 var2 then 1 else 0 + + state + |> IlMachineState.pushToEvalStack' (EvalStackValue.Int32 comparisonResult) currentThread + |> IlMachineState.advanceProgramCounter currentThread + |> Tuple.withRight WhatWeDid.Executed + |> ExecutionResult.Stepped | Stloc_0 -> state |> IlMachineState.popFromStackToLocalVariable currentThread 0 @@ -407,7 +437,16 @@ module NullaryIlOp = |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped - | Sub -> failwith "TODO: Sub unimplemented" + | Sub -> + let val1, state = IlMachineState.popEvalStack currentThread state + let val2, state = IlMachineState.popEvalStack currentThread state + let result = BinaryArithmetic.execute ArithmeticOperation.sub val1 val2 + + state + |> IlMachineState.pushToEvalStack' result currentThread + |> IlMachineState.advanceProgramCounter currentThread + |> Tuple.withRight WhatWeDid.Executed + |> ExecutionResult.Stepped | Sub_ovf -> failwith "TODO: Sub_ovf unimplemented" | Sub_ovf_un -> failwith "TODO: Sub_ovf_un unimplemented" | Add -> diff --git a/WoofWare.PawPrint/UnaryConstIlOp.fs b/WoofWare.PawPrint/UnaryConstIlOp.fs index 61a2dc4..16ad15a 100644 --- a/WoofWare.PawPrint/UnaryConstIlOp.fs +++ b/WoofWare.PawPrint/UnaryConstIlOp.fs @@ -87,7 +87,11 @@ module internal UnaryConstIlOp = |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int8 b)) currentThread |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed - | Br i -> failwith "TODO: Br unimplemented" + | Br i -> + state + |> IlMachineState.advanceProgramCounter currentThread + |> IlMachineState.jumpProgramCounter currentThread i + |> Tuple.withRight WhatWeDid.Executed | Br_s b -> state |> IlMachineState.advanceProgramCounter currentThread @@ -383,9 +387,111 @@ module internal UnaryConstIlOp = else id |> Tuple.withRight WhatWeDid.Executed - | Bgt_un_s b -> failwith "TODO: Bgt_un_s unimplemented" - | Ble_un_s b -> failwith "TODO: Ble_un_s unimplemented" - | Blt_un_s b -> failwith "TODO: Blt_un_s unimplemented" + | Bgt_un_s b -> + let value2, state = IlMachineState.popEvalStack currentThread state + let value1, state = IlMachineState.popEvalStack currentThread state + + let isGreaterThan = + match value1, value2 with + | EvalStackValue.Int32 v1, EvalStackValue.Int32 v2 -> + if v1 < 0 || v2 < 0 then + failwith "TODO" + + v1 > v2 + | EvalStackValue.Int32 i, EvalStackValue.NativeInt nativeIntSource -> failwith "todo" + | EvalStackValue.Int32 i, _ -> failwith $"invalid comparison, {i} with {value2}" + | EvalStackValue.Int64 v1, EvalStackValue.Int64 v2 -> + if v1 < 0L || v2 < 0L then + failwith "TODO" + + v1 > v2 + | EvalStackValue.Int64 i, _ -> failwith $"invalid comparison, {i} with {value2}" + | EvalStackValue.NativeInt nativeIntSource, _ -> failwith "todo" + | EvalStackValue.Float v1, EvalStackValue.Float v2 -> failwith "todo" + | EvalStackValue.Float f, _ -> failwith $"invalid comparison, {f} with {value2}" + | EvalStackValue.ManagedPointer v1, EvalStackValue.ManagedPointer v2 -> failwith "todo" + | EvalStackValue.ManagedPointer v1, _ -> failwith $"invalid comparison, {v1} with {value2}" + | EvalStackValue.ObjectRef _, _ -> failwith "todo" + | EvalStackValue.UserDefinedValueType _, _ -> + failwith "unexpectedly tried to compare user-defined value type" + + state + |> IlMachineState.advanceProgramCounter currentThread + |> if isGreaterThan then + IlMachineState.jumpProgramCounter currentThread (int b) + else + id + |> Tuple.withRight WhatWeDid.Executed + | Ble_un_s b -> + let value2, state = IlMachineState.popEvalStack currentThread state + let value1, state = IlMachineState.popEvalStack currentThread state + + let isLessEq = + match value1, value2 with + | EvalStackValue.Int32 v1, EvalStackValue.Int32 v2 -> + if v1 < 0 || v2 < 0 then + failwith "TODO" + + v1 <= v2 + | EvalStackValue.Int32 i, EvalStackValue.NativeInt nativeIntSource -> failwith "todo" + | EvalStackValue.Int32 i, _ -> failwith $"invalid comparison, {i} with {value2}" + | EvalStackValue.Int64 v1, EvalStackValue.Int64 v2 -> + if v1 < 0L || v2 < 0L then + failwith "TODO" + + v1 <= v2 + | EvalStackValue.Int64 i, _ -> failwith $"invalid comparison, {i} with {value2}" + | EvalStackValue.NativeInt nativeIntSource, _ -> failwith "todo" + | EvalStackValue.Float v1, EvalStackValue.Float v2 -> failwith "todo" + | EvalStackValue.Float f, _ -> failwith $"invalid comparison, {f} with {value2}" + | EvalStackValue.ManagedPointer v1, EvalStackValue.ManagedPointer v2 -> failwith "todo" + | EvalStackValue.ManagedPointer v1, _ -> failwith $"invalid comparison, {v1} with {value2}" + | EvalStackValue.ObjectRef _, _ -> failwith "todo" + | EvalStackValue.UserDefinedValueType _, _ -> + failwith "unexpectedly tried to compare user-defined value type" + + state + |> IlMachineState.advanceProgramCounter currentThread + |> if isLessEq then + IlMachineState.jumpProgramCounter currentThread (int b) + else + id + |> Tuple.withRight WhatWeDid.Executed + | Blt_un_s b -> + let value2, state = IlMachineState.popEvalStack currentThread state + let value1, state = IlMachineState.popEvalStack currentThread state + + let isLessThan = + match value1, value2 with + | EvalStackValue.Int32 v1, EvalStackValue.Int32 v2 -> + if v1 < 0 || v2 < 0 then + failwith "TODO" + + v1 < v2 + | EvalStackValue.Int32 i, EvalStackValue.NativeInt nativeIntSource -> failwith "todo" + | EvalStackValue.Int32 i, _ -> failwith $"invalid comparison, {i} with {value2}" + | EvalStackValue.Int64 v1, EvalStackValue.Int64 v2 -> + if v1 < 0L || v2 < 0L then + failwith "TODO" + + v1 < v2 + | EvalStackValue.Int64 i, _ -> failwith $"invalid comparison, {i} with {value2}" + | EvalStackValue.NativeInt nativeIntSource, _ -> failwith "todo" + | EvalStackValue.Float v1, EvalStackValue.Float v2 -> failwith "todo" + | EvalStackValue.Float f, _ -> failwith $"invalid comparison, {f} with {value2}" + | EvalStackValue.ManagedPointer v1, EvalStackValue.ManagedPointer v2 -> failwith "todo" + | EvalStackValue.ManagedPointer v1, _ -> failwith $"invalid comparison, {v1} with {value2}" + | EvalStackValue.ObjectRef _, _ -> failwith "todo" + | EvalStackValue.UserDefinedValueType _, _ -> + failwith "unexpectedly tried to compare user-defined value type" + + state + |> IlMachineState.advanceProgramCounter currentThread + |> if isLessThan then + IlMachineState.jumpProgramCounter currentThread (int b) + else + id + |> Tuple.withRight WhatWeDid.Executed | Bne_un i -> failwith "TODO: Bne_un unimplemented" | Bge_un i -> failwith "TODO: Bge_un unimplemented" | Bgt_un i -> failwith "TODO: Bgt_un unimplemented"