Test float comparisons (#73)

This commit is contained in:
Patrick Stevens
2025-06-27 15:06:01 +01:00
committed by GitHub
parent 7c636b61a7
commit 641040509f
8 changed files with 538 additions and 28 deletions

View File

@@ -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

View File

@@ -20,6 +20,7 @@
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="sourcesPure\BasicLock.cs" />
<EmbeddedResource Include="sourcesPure\Floats.cs" />
<EmbeddedResource Include="sourcesPure\NoOp.cs" />
<EmbeddedResource Include="sourcesPure\Ldelema.cs" />
<EmbeddedResource Include="sourcesPure\ExceptionWithNoOpCatch.cs" />

View File

@@ -0,0 +1,216 @@
// Thanks Gemini 2.5 Pro
using System;
public class Program
{
/// <summary>
/// Main entry point for the test harness. It runs test suites for float and double comparisons.
/// </summary>
/// <returns>0 if all tests pass, otherwise a non-zero error code indicating the first failed test.</returns>
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
}
}
/// <summary>
/// Contains a suite of tests for System.Single (float) comparisons.
/// Each test corresponds to a specific CIL comparison instruction.
/// </summary>
public class FloatCompareTests
{
private static int testCounter = 100; // Start error codes at 100 for this suite
/// <summary>
/// Checks a boolean condition. If the condition is false, it prints a failure message
/// and returns a unique error code.
/// </summary>
/// <param name="condition">The boolean result of the test.</param>
/// <param name="testName">A descriptive name for the test case.</param>
/// <returns>0 if the test passes, otherwise a unique non-zero error code.</returns>
private static int Check(bool condition, string testName)
{
testCounter++;
if (!condition)
{
return testCounter;
}
return 0;
}
/// <summary>
/// Runs all float comparison tests.
/// </summary>
/// <returns>0 if all tests pass, otherwise the error code of the first failing test.</returns>
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
}
}
/// <summary>
/// Contains a suite of tests for System.Double comparisons.
/// </summary>
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
}
}

View File

@@ -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 #)

View File

@@ -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

View File

@@ -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 =

View File

@@ -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 ->

View File

@@ -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"