diff --git a/.gitignore b/.gitignore index 8dc44d7..9682304 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,33 @@ +# Ignore files and directories generated by VSCode .ai/ .vscode/ + +# Ignore directories we don't want to modify +.github/ +autom3te.cache/ +build-aux/ +docs/ +biggnat-hack/ +obj/ +/obj/gnatprove/ +rtsdir/ +scripts/ +/source/cryptography/ +/source/devices/ +/source/lib/ +/source//memory/ +/source/networking/ +/source/rts/ +/source/userland/ +/source/vfs/ + +# Ignore Build Files and Directories +/source/tests/obj/ +/source/tests/bin/ + +# Ignore GNATprove tarball +#gnatprove-x86_64-linux-14.1.0-1.tar.gz + +#ignore AUnit build directories +/source/tests/bin/ +/source/tests/obj/ diff --git a/GNUmakefile b/GNUmakefile index 9506b94..9c24e23 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -159,4 +159,4 @@ install-strip: install .PHONY: uninstall uninstall: rm '$(call SHESCAPE,$(DESTDIR)$(datarootdir))/$(PACKAGE_TARNAME)/$(OUTPUT)' - rm '$(call SHESCAPE,$(DESTDIR)$(infodir))/ironclad.info' + rm '$(call SHESCAPE,$(DESTDIR)$(infodir))/ironclad.info' \ No newline at end of file diff --git a/autom4te.cache/output.1 b/autom4te.cache/output.1 index 8887f93..7fe3457 100644 --- a/autom4te.cache/output.1 +++ b/autom4te.cache/output.1 @@ -3889,5 +3889,4 @@ fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} -fi - +fi \ No newline at end of file diff --git a/autom4te.cache/requests b/autom4te.cache/requests index e01013f..f2a7590 100644 --- a/autom4te.cache/requests +++ b/autom4te.cache/requests @@ -182,5 +182,4 @@ 'AM_AUTOMAKE_VERSION' => 1 } ], 'Autom4te::Request' ) - ); - + ); \ No newline at end of file diff --git a/build-aux/config.guess b/build-aux/config.guess index f50dcdb..984ffc8 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -1477,4 +1477,4 @@ exit 1 # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" -# End: +# End: \ No newline at end of file diff --git a/build-aux/config.sub b/build-aux/config.sub index 1d8e98b..c7eeda2 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -1798,4 +1798,4 @@ exit # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" -# End: +# End: \ No newline at end of file diff --git a/config.log b/config.log index 372a303..e984646 100644 --- a/config.log +++ b/config.log @@ -260,4 +260,4 @@ target_vendor='limine' #define PACKAGE_BUGREPORT "https://ironclad.nongnu.org/usersupport.html" #define PACKAGE_URL "" -configure: exit 0 +configure: exit 0 \ No newline at end of file diff --git a/config.status b/config.status index 5a1cf01..78fc4fd 100755 --- a/config.status +++ b/config.status @@ -926,4 +926,4 @@ which seems to be undefined. Please make sure it is defined" >&2;} done # for ac_tag -as_fn_exit 0 +as_fn_exit 0 \ No newline at end of file diff --git a/configure b/configure index 58ba0fa..aa063ba 100755 --- a/configure +++ b/configure @@ -3889,6 +3889,4 @@ fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} -fi - - +fi \ No newline at end of file diff --git a/configure~ b/configure~ index 58ba0fa..aa063ba 100755 --- a/configure~ +++ b/configure~ @@ -3889,6 +3889,4 @@ fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} -fi - - +fi \ No newline at end of file diff --git a/docs/fdl.texi b/docs/fdl.texi index eaf3da0..822b7e3 100644 --- a/docs/fdl.texi +++ b/docs/fdl.texi @@ -502,4 +502,4 @@ to permit their use in free software. @c Local Variables: @c ispell-local-pdict: "ispell-dict" -@c End: +@c End: \ No newline at end of file diff --git a/ironclad.gpr b/ironclad.gpr index ea2e72c..3f9f16a 100644 --- a/ironclad.gpr +++ b/ironclad.gpr @@ -96,4 +96,4 @@ project Ironclad is "-Wl,--undefined=multiboot2,-zmuldefs"); end case; end Linker; -end Ironclad; +end Ironclad; \ No newline at end of file diff --git a/rts.gpr b/rts.gpr index 82e3acb..b424e54 100644 --- a/rts.gpr +++ b/rts.gpr @@ -59,4 +59,4 @@ library project RTS is for Library_Kind use "static"; for Library_Name use "gnat"; for Runtime ("Ada") use "rtsdir"; -end RTS; +end RTS; \ No newline at end of file diff --git a/source/arch/riscv64-limine/arch-context.adb b/source/arch/riscv64-limine/arch-context.adb index 9274cad..094e737 100644 --- a/source/arch/riscv64-limine/arch-context.adb +++ b/source/arch/riscv64-limine/arch-context.adb @@ -1,5 +1,6 @@ --- arch-context.ads: Architecture-specific context switching. --- Copyright (C) 2024 streaksu +------------------------------------------------------------------ +-- arch-context.adb: Architecture-specific context switching. +-- (RISC-V 64-bit version) -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by @@ -13,56 +14,335 @@ -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . +------------------------------------------------------------------ +pragma SPARK_Mode (On); +pragma Warnings (Off, "SPARK_Mode is enabled"); + +with System; use System; +with Interfaces; use Interfaces; +with System.Machine_Code; +with Arch.CPU; use Arch.CPU; +with Arch.Interrupts; use Arch.Interrupts; package body Arch.Context is + + --Start Package Body Specific Variables, Constants, and Types + ------------------------------------------ + type GP_Context_Type is record + SP : Unsigned_64; + SEPC : Unsigned_64; + SSTATUS : Unsigned_64; + A0 : Unsigned_64; + end record; + + MISA_Value : constant Unsigned_64 := Get_CSR(16#301#); + + F_Extension_Bit : constant Unsigned_64 := 16#20#; -- F extension (bit 5) + D_Extension_Bit : constant Unsigned_64 := 16#40#; -- D extension (bit 6) + Q_Extension_Bit : constant Unsigned_64 := 16#80#; -- Q extension (bit 7, if implemented) + + type FP_Save_Routine_Type is access procedure (Ctx : in out FP_Context); + type FP_Load_Routine_Type is access procedure (Ctx : FP_Context); + + FP_Save_Routine : FP_Save_Routine_Type; + FP_Load_Routine : FP_Load_Routine_Type; + + ------------------------------------------ + --End Package Body Specific Variables, Constants, and Types + + -- Start Public Sectiom + ------------------------------------------ + + -- Start General-Purpose Section + ------------------------------------------ + + -- Initialize the general-purpose context. procedure Init_GP_Context (Ctx : out GP_Context; Stack : System.Address; - Start_Addr : System.Address) - is - pragma Unreferenced (Stack); - pragma Unreferenced (Start_Addr); + Start_Addr : System.Address) is + Ctx_Impl : GP_Context_Type; + Current_Hart : Unsigned_64 := Get_Hart_ID; + Stack_Int : Integer := To_Integer(Stack); + Start_Int : Integer := To_Integer(Start_Addr); begin - Ctx := (others => 0); + -- Verify that the stack and start addresses are valid. + pragma Assume(Stack /= System.Null_Address and Start_Addr /= System.Null_Address); + pragma Assert(Stack_Int mod 16 = 0, "Stack address must be 16-byte aligned"); + pragma Assert(Start_Int /= 0, "Start address must be nonzero"); + + -- Initialize context fields. + Ctx_Impl.SP := Unsigned_64(Stack_Int); + Ctx_Impl.SEPC := Unsigned_64(Start_Int); + Ctx_Impl.SSTATUS := Get_CSR(16#100#); + Ctx_Impl.A0 := 0; + + -- Convert internal context representation to external frame. + Ctx := To_Frame(Ctx_Impl); + + -- Validate that critical registers are properly set. + pragma Assert(Ctx.R2 = Unsigned_32(Stack_Int and 16#FFFFFFFF#), "Stack pointer correctly set"); + pragma Assert(Ctx.R10 = 0, "Initial fork return value must be zero"); end Init_GP_Context; - procedure Load_GP_Context (Ctx : GP_Context) is - pragma Unreferenced (Ctx); + -- Load the general-purpose context. + procedure Load_GP_Context(Ctx : GP_Context) with No_Return is + Ctx_Impl : GP_Context_Type := To_GP_Context_Type(Ctx); begin - loop - null; - end loop; + -- Validate that critical registers are properly set. + pragma Assert(Ctx_Impl.SP /= 0, "SP must not be zero"); + pragma Assert(Ctx_Impl.SEPC /= 0, "SEPC must not be zero"); + pragma Assert(Ctx_Impl.SSTATUS /= 0, "SSTATUS must not be zero"); + + -- Minimal inline assembly to restore context and jump to SEPC. + Asm("csrw sepc, %0; csrw sstatus, %1; mv sp, %2; sret", + Inputs => (Unsigned_64'Asm_Input("r", Ctx_Impl.SEPC), + Unsigned_64'Asm_Input("r", Ctx_Impl.SSTATUS), + Unsigned_64'Asm_Input("r", Ctx_Impl.SP)), + Clobber => "memory", + Volatile => True); + + -- sret shoud not return to this context; add an infinite loop safeguard to prevent undetermined state. + loop null; end loop; end Load_GP_Context; - procedure Save_Core_Context (Ctx : out Core_Context) is - begin - Ctx := 0; - end Save_Core_Context; + ------------------------------------------ + -- End General-Purpose Section - procedure Success_Fork_Result (Ctx : in out GP_Context) is + -- Start Core and Fork Section + ------------------------------------------ + + -- Show that the forked process has returned successfully + procedure Success_Fork_Result(Ctx : in out GP_Context) is + Ctx_Impl : GP_Context_Type := To_GP_Context_Type(Ctx); + Old_SEPC : Unsigned_64 := Ctx_Impl.SEPC; begin - Ctx := (others => 0); + -- Set the a0 return register and advance the SEPC for the forked process. + Ctx_Impl.A0 := 0; + Ctx_Impl.SEPC := Ctx_Impl.SEPC + 4; -- Advance by one instruction. + Ctx := To_Frame(Ctx_Impl); + + -- Validate that the forked process has the correct return value and SEPC. + pragma Assert(Ctx.R10 = 0, "Forked process must return zero"); + pragma Assert(Ctx_Impl.SEPC > Old_SEPC, "SEPC should have advanced"); end Success_Fork_Result; - procedure Init_FP_Context (Ctx : out FP_Context) is + -- Save the Core Context + procedure Save_Core_Context(Ctx : out Core_Context) is + Current_Hart : constant Unsigned_64 := Get_Hart_ID; + -- Map current hart ID to a 1-based index in Core_Locals. + Core_Index : constant Positive := Positive(Integer(Current_Hart) + 1); + begin + -- Validate that the core index is within bounds. + pragma Assert(Core_Index <= Core_Count, "Core index out of bounds"); + -- Save the entire per-core state from Core_Locals. + Ctx := Core_Locals(Core_Index); + + -- Validate that the saved core context has saved the correct core. + pragma Assert(Ctx.Hart_ID = Current_Hart, "Saved core context must have the current hart ID"); + pragma Assert(Ctx.Number = Core_Index, "Saved core context must have the correct core number"); + end Save_Core_Context; + + ------------------------------------------ + -- End Core and Fork Section + + -- Start Floating-Point Section + ------------------------------------------ + + -- Initialize the floating-point context + procedure Init_FP_Context(Ctx : out FP_Context) is begin Ctx := (others => 0); + -- Assert that the FP context is zeroed after initialization. + pragma Assert(for all I in FP_Context'Range => Ctx(I) = 0, + "FP context must be zeroed at init"); + Setup_FP_Routines; + FP_Save_Routine.all(Ctx); + -- Assert that the FP context is zeroed after the save routine. + pragma Assert(for all I in FP_Context'Range => Ctx(I) = 0, + "FP context should remain zero after Init_FP_Context"); end Init_FP_Context; - procedure Save_FP_Context (Ctx : in out FP_Context) is + -- Save the floating-point context + procedure Save_FP_Context(Ctx : in out FP_Context) is begin - Ctx := (others => 0); + FP_Save_Routine.all(Ctx); end Save_FP_Context; - procedure Load_FP_Context (Ctx : FP_Context) is - pragma Unreferenced (Ctx); + -- Load the floating-point context + procedure Load_FP_Context(Ctx : FP_Context) is begin - null; + FP_Load_Routine.all(Ctx); end Load_FP_Context; - procedure Destroy_FP_Context (Ctx : in out FP_Context) is - pragma Unreferenced (Ctx); + -- Destroy the floating-point context + procedure Destroy_FP_Context(Ctx : in out FP_Context) is begin - null; + Ctx := (others => 0); + -- Assert that the FP context is zeroed after destruction. + pragma Assert(for all I in FP_Context'Range => Ctx(I) = 0, "FP context successfully destroyed"); end Destroy_FP_Context; + + ------------------------------------------ + -- End Floating-Point Section + + ------------------------------------------ + -- End Public Section + + -- Start Internal Section + ------------------------------------------ + + -- Start Conversion Section + ------------------------------------------ + + -- Convert a GP_Context_Type record to a GP_Context record + function To_Frame(Ctx : GP_Context_Type) return GP_Context is + -- Tell compiler to inline this function. + pragma Inline; + begin + -- Assert that the register values are within bounds. + pragma Assert(Ctx.SP <= 16#FFFFFFFF#, "Internal SP exceeds 32 bits"); + pragma Assert(Ctx.A0 <= 16#FFFFFFFF#, "Internal A0 exceeds 32 bits"); + return ( + R2 => Unsigned_32(Ctx.SP and 16#FFFFFFFF#), + R10 => Unsigned_32(Ctx.A0 and 16#FFFFFFFF#), + others => 0 + ); + end To_Frame; + + -- Convert a GP_Context record to a GP_Context_Type record + function To_GP_Context_Type(Frame : GP_Context) return GP_Context_Type is + -- Tell compiler to inline this function. + pragma Inline; + begin + -- Assert that the register values are within bounds. + pragma Assert(Frame.R2 <= 16#FFFFFFFF#, "Frame.R2 invalid"); + pragma Assert(Frame.R10 <= 16#FFFFFFFF#, "Frame.R10 invalid"); + return ( + SP => Unsigned_64(Frame.R2), + SEPC => Get_CSR(16#141#), + SSTATUS => Get_CSR(16#100#), + A0 => Unsigned_64(Frame.R10) + ); + end To_GP_Context_Type; + + ------------------------------------------ + -- End Conversion Section + + -- Start Floating-Point Section + ------------------------------------------ + + -- No-op FP Section + ------------------------------------------ + + -- No-op save and load routines for when the F, D, and Q extensions are not present + procedure FP_Save_NoOp(Ctx : in out FP_Context) is + begin + null; + end FP_Save_NoOp; + + -- No-op save and load routines for when the F, D, and Q extensions are not present + procedure FP_Load_NoOp(Ctx : FP_Context) is + begin + null; + end FP_Load_NoOp; + + -- Single Precision FP Section + ------------------------------------------ + + -- Save the single-precision floating-point registers of the context + procedure Save_FP_Context_F(Ctx : in out FP_Context) is + FP_Ptr : System.Address := FP_Context'Address(Ctx); + begin + -- Assert that the FP context pointer is not null. + pragma Assert(FP_Ptr /= System.Null_Address, "FP context pointer must not be null"); + for Reg in 0 .. 31 loop + -- Save each single-precision FP register. + Asm("fsw f" & Reg'Image & ", " & (Reg * 4)'Image & "(%0)", + Inputs => System.Address'Asm_Input("r", FP_Ptr), + Volatile => True); + end loop; + -- Clear unused portion of the FP context. + for Offset in 128 .. FP_Context'Length - 1 loop + Ctx(Offset + 1) := 0; + end loop; + end Save_FP_Context_F; + + -- Load the single-precision floating-point registers to the context + procedure Load_FP_Context_F(Ctx : FP_Context) is + FP_Ptr : System.Address := FP_Context'Address(Ctx); + begin + -- Assert that the FP context pointer is not null. + pragma Assert(FP_Ptr /= System.Null_Address, "FP context pointer must not be null"); + for Reg in 0 .. 31 loop + -- Load each single-precision FP register. + Asm("flw f" & Reg'Image & ", " & (Reg * 4)'Image & "(%0)", + Inputs => System.Address'Asm_Input("r", FP_Ptr), + Volatile => True); + end loop; + end Load_FP_Context_F; + + -- Double Precision FP Section + ------------------------------------------ + + -- Save the double-precision floating-point registers of the context + procedure Save_FP_Context_D(Ctx : in out FP_Context) is + FP_Ptr : System.Address := FP_Context'Address(Ctx); + begin + -- Assert that the FP context pointer is not null. + pragma Assert(FP_Ptr /= System.Null_Address, "FP context pointer must not be null"); + for Reg in 0 .. 31 loop + -- Save each double-precision FP register. + Asm("fsd f" & Reg'Image & ", " & (Reg * 8)'Image & "(%0)", + Inputs => System.Address'Asm_Input("r", FP_Ptr), + Volatile => True); + end loop; + for Offset in 256 .. FP_Context'Length - 1 loop + Ctx(Offset + 1) := 0; + end loop; + end Save_FP_Context_D; + + -- Load the double-precision floating-point registers to the context + procedure Load_FP_Context_D(Ctx : FP_Context) is + FP_Ptr : System.Address := FP_Context'Address(Ctx); + begin + -- Assert that the FP context pointer is not null. + pragma Assert(FP_Ptr /= System.Null_Address, "FP context pointer must not be null"); + for Reg in 0 .. 31 loop + -- Load each double-precision FP register. + Asm("fld f" & Reg'Image & ", " & (Reg * 8)'Image & "(%0)", + Inputs => System.Address'Asm_Input("r", FP_Ptr), + Volatile => True); + end loop; + end Load_FP_Context_D; + + -- FP Routine Selection Section + ------------------------------------------ + + -- Set the FP save and load routines based on the MISA register + procedure Setup_FP_Routines is + begin + -- Set the FP save and load routines based on the MISA register. + if (MISA_Value and F_Extension_Bit) /= 0 then + if (MISA_Value and D_Extension_Bit) /= 0 then + FP_Save_Routine := FP_Save_Routine_Type'(Save_FP_Context_D'Access); + FP_Load_Routine := FP_Load_Routine_Type'(Load_FP_Context_D'Access); + else + FP_Save_Routine := FP_Save_Routine_Type'(Save_FP_Context_F'Access); + FP_Load_Routine := FP_Load_Routine_Type'(Load_FP_Context_F'Access); + end if; + else + FP_Save_Routine := FP_Save_Routine_Type'(FP_Save_NoOp'Access); + FP_Load_Routine := FP_Load_Routine_Type'(FP_Load_NoOp'Access); + end if; + -- Assert FP routines are properly set. + pragma Assert(FP_Save_Routine /= null and FP_Load_Routine /= null, "FP dispatch routines must be set"); + end Setup_FP_Routines; + + ------------------------------------------ + -- End Floating-Point Section + + ------------------------------------------ + -- End Internal Section + end Arch.Context; diff --git a/source/tests/riscv64/arch_rv64_test_suite.adb b/source/tests/riscv64/arch_rv64_test_suite.adb new file mode 100644 index 0000000..68079df --- /dev/null +++ b/source/tests/riscv64/arch_rv64_test_suite.adb @@ -0,0 +1,9 @@ +with AUnit.Test_Suites; +with Context_Test_Suite; + +package body Arch_RV64_Test_Suite is + function Suite return AUnit.Test_Suites.Access_Test_Suite is + begin + return Context_Test_Suite.Suite; + end Suite; +end Arch_RV64_Test_Suite; diff --git a/source/tests/riscv64/arch_rv64_test_suite.ads b/source/tests/riscv64/arch_rv64_test_suite.ads new file mode 100644 index 0000000..ac35682 --- /dev/null +++ b/source/tests/riscv64/arch_rv64_test_suite.ads @@ -0,0 +1,5 @@ +with AUnit.Test_Suites; + +package Arch_RV64_Test_Suite is + function Suite return AUnit.Test_Suites.Access_Test_Suite; +end Arch_RV64_Test_Suite; diff --git a/source/tests/riscv64/context_test_suite.adb b/source/tests/riscv64/context_test_suite.adb new file mode 100644 index 0000000..8d007a1 --- /dev/null +++ b/source/tests/riscv64/context_test_suite.adb @@ -0,0 +1,21 @@ +with AUnit.Test_Suites; +with GP_Context_Tests; +with CSR_Extension_Tests; +with FP_Context_Tests; +with Core_Context_Tests; +with Success_Fork_Result_Tests; +package body Context_Test_Suite is + + function Suite return AUnit.Test_Suites.Access_Test_Suite is + Result : AUnit.Test_Suites.Access_Test_Suite := AUnit.Test_Suites.New_Suite; + begin + -- Simply add the test cases without any extra conversion. + Result.Add_Test(GP_Context_Tests.Test_Case'Access); + Result.Add_Test(CSR_Extension_Tests.Test_Case'Access); + Result.Add_Test(FP_Context_Tests.Test_Case'Access); + Result.Add_Test(Core_Context_Tests.Test_Case'Access); + Result.Add_Test(Success_Fork_Result_Tests.Test_Case'Access); + return Result; + end Suite; + +end Context_Test_Suite; diff --git a/source/tests/riscv64/context_test_suite.ads b/source/tests/riscv64/context_test_suite.ads new file mode 100644 index 0000000..0621b5e --- /dev/null +++ b/source/tests/riscv64/context_test_suite.ads @@ -0,0 +1,5 @@ +with AUnit.Test_Suites; + +package Context_Test_Suite is + function Suite return AUnit.Test_Suites.Access_Test_Suite; +end Context_Test_Suite; diff --git a/source/tests/riscv64/core_context_tests.adb b/source/tests/riscv64/core_context_tests.adb new file mode 100644 index 0000000..6f533d5 --- /dev/null +++ b/source/tests/riscv64/core_context_tests.adb @@ -0,0 +1,41 @@ +with AUnit.Assertions; use AUnit.Assertions; +with AUnit.Test_Cases.Registration; use AUnit.Test_Cases.Registration; +with Arch.Context; use Arch.Context; +with Arch.CPU; use Arch.CPU; +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; + +package body Core_Context_Tests is + + procedure Test_Save_Core_Context (T : in out Test_Case'Class) is + Saved_Core : Core_Context; + Current_Hart : Unsigned_64; + Core_Index : Positive; + begin + Current_Hart := Get_Hart_ID; + Core_Index := Positive(Integer(Current_Hart) + 1); + pragma Assert(Core_Index <= Core_Count, "Test: Core index out of bounds"); + Save_Core_Context(Saved_Core); + Check_Equal(Core_Locals(Core_Index).User_Stack, + Saved_Core.User_Stack, + "Saved core context must have the correct User_Stack"); + Check_Equal(Core_Locals(Core_Index).Hart_ID, + Saved_Core.Hart_ID, + "Saved core context must have the correct Hart_ID"); + Check_Equal(Core_Locals(Core_Index).Number, + Saved_Core.Number, + "Saved core context must have the correct core number"); + end Test_Save_Core_Context; + + overriding procedure Register_Tests (T : in out Core_Context_Test) is + use AUnit.Test_Cases.Registration; + begin + Register_Routine(T, Test_Save_Core_Context'Access, "Test_Save_Core_Context"); + end Register_Tests; + + overriding function Name (T : Core_Context_Test) return Message_String is + begin + return "Core_Context_Tests"; + end Name; + +end Core_Context_Tests; diff --git a/source/tests/riscv64/core_context_tests.ads b/source/tests/riscv64/core_context_tests.ads new file mode 100644 index 0000000..da14587 --- /dev/null +++ b/source/tests/riscv64/core_context_tests.ads @@ -0,0 +1,9 @@ +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; + +package Core_Context_Tests is + type Core_Context_Test is new Test_Cases.Test_Case with null record; + overriding function Name (T : Core_Context_Test) return Test_String; + procedure Register_Tests (T : in out Core_Context_Test); + Test_Case : constant access Core_Context_Test := new Core_Context_Test'(Name => "Core_Context_Tests"); +end Core_Context_Tests; diff --git a/source/tests/riscv64/csr_extension_tests.adb b/source/tests/riscv64/csr_extension_tests.adb new file mode 100644 index 0000000..230bf5e --- /dev/null +++ b/source/tests/riscv64/csr_extension_tests.adb @@ -0,0 +1,41 @@ +with AUnit.Assertions; use AUnit.Assertions; +with AUnit.Test_Cases.Registration; use AUnit.Test_Cases.Registration; +with Arch.Context; use Arch.Context; +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; +with Test.Stubs; use Test.Stubs; +package body CSR_Extension_Tests is + + procedure Test_MISA_Value (T : in out Test_Case'Class) is + begin + Check_True(MISA_Value /= 0, "Cached MISA_Value must be nonzero"); + end Test_MISA_Value; + + procedure Test_FP_Extension_Bits (T : in out Test_Case'Class) is + begin + if (MISA_Value and F_Extension_Bit) /= 0 then + Check_True(Has_Extension(F_Extension_Bit), "F extension should be detected"); + else + Check_True(not Has_Extension(F_Extension_Bit), "F extension should not be detected"); + end if; + + if (MISA_Value and D_Extension_Bit) /= 0 then + Check_True(Has_Extension(D_Extension_Bit), "D extension should be detected"); + else + Check_True(not Has_Extension(D_Extension_Bit), "D extension should not be detected"); + end if; + end Test_FP_Extension_Bits; + + procedure Register_Tests (T : in out CSR_Extension_Test) is + use AUnit.Test_Cases.Registration; + begin + Register_Routine(T, Test_MISA_Value'Access, "Test_MISA_Value"); + Register_Routine(T, Test_FP_Extension_Bits'Access, "Test_FP_Extension_Bits"); + end Register_Tests; + + overriding function Name (T : CSR_Extension_Test) return Message_String is + begin + return "CSR_Extension_Tests"; + end Name; + +end CSR_Extension_Tests; diff --git a/source/tests/riscv64/csr_extension_tests.ads b/source/tests/riscv64/csr_extension_tests.ads new file mode 100644 index 0000000..63aee34 --- /dev/null +++ b/source/tests/riscv64/csr_extension_tests.ads @@ -0,0 +1,9 @@ +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; + +package CSR_Extension_Tests is + type CSR_Extension_Test is new Test_Cases.Test_Case with null record; + overriding function Name (T : CSR_Extension_Test) return Test_String; + procedure Register_Tests (T : in out CSR_Extension_Test); + Test_Case : constant access CSR_Extension_Test := new CSR_Extension_Test'(Name => "CSR_Extension_Tests"); +end CSR_Extension_Tests; diff --git a/source/tests/riscv64/fp_context_tests.adb b/source/tests/riscv64/fp_context_tests.adb new file mode 100644 index 0000000..b1abaea --- /dev/null +++ b/source/tests/riscv64/fp_context_tests.adb @@ -0,0 +1,53 @@ +with AUnit.Assertions; use AUnit.Assertions; +with AUnit.Test_Cases.Registration; use AUnit.Test_Cases.Registration; +with Arch.Context; use Arch.Context; +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; +with Interfaces; use Interfaces; + +package body FP_Context_Tests is + + Dummy_FP_Context : FP_Context; + + procedure Test_Init_FP_Context (T : in out Test_Case'Class) is + I : Integer; + begin + Init_FP_Context(Dummy_FP_Context); + for I in FP_Context'Range loop + Check_Equal(0, Dummy_FP_Context(I), + "FP context element " & I'Image & " should be zero after initialization"); + end loop; + end Test_Init_FP_Context; + + procedure Test_Destroy_FP_Context (T : in out Test_Case'Class) is + I : Integer; + begin + Init_FP_Context(Dummy_FP_Context); + Destroy_FP_Context(Dummy_FP_Context); + for I in FP_Context'Range loop + Check_Equal(0, Dummy_FP_Context(I), + "FP context element " & I'Image & " should be zero after destruction"); + end loop; + end Test_Destroy_FP_Context; + + procedure Test_FP_Dispatch (T : in out Test_Case'Class) is + begin + Setup_FP_Routines; + Check_True(FP_Save_Routine /= null, "FP_Save_Routine must not be null"); + Check_True(FP_Load_Routine /= null, "FP_Load_Routine must not be null"); + end Test_FP_Dispatch; + + procedure Register_Tests (T : in out FP_Context_Test) is + use AUnit.Test_Cases.Registration; + begin + Register_Routine(T, Test_Init_FP_Context'Access, "Test_Init_FP_Context"); + Register_Routine(T, Test_Destroy_FP_Context'Access, "Test_Destroy_FP_Context"); + Register_Routine(T, Test_FP_Dispatch'Access, "Test_FP_Dispatch"); + end Register_Tests; + + overriding function Name (T : FP_Context_Test) return Message_String is + begin + return "FP_Context_Tests"; + end Name; + +end FP_Context_Tests; diff --git a/source/tests/riscv64/fp_context_tests.ads b/source/tests/riscv64/fp_context_tests.ads new file mode 100644 index 0000000..5afe3e1 --- /dev/null +++ b/source/tests/riscv64/fp_context_tests.ads @@ -0,0 +1,9 @@ +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; + +package FP_Context_Tests is + type FP_Context_Test is new Test_Cases.Test_Case with null record; + overriding function Name (T : FP_Context_Test) return Test_String; + procedure Register_Tests (T : in out FP_Context_Test); + Test_Case : constant access FP_Context_Test := new FP_Context_Test'(Name => "FP_Context_Tests"); +end FP_Context_Tests; diff --git a/source/tests/riscv64/gp_context_tests.adb b/source/tests/riscv64/gp_context_tests.adb new file mode 100644 index 0000000..01081fe --- /dev/null +++ b/source/tests/riscv64/gp_context_tests.adb @@ -0,0 +1,98 @@ +with AUnit.Assertions; use AUnit.Assertions; +with AUnit.Test_Cases.Registration; use AUnit.Test_Cases.Registration; +with Arch.Context; +with Arch.Interrupts; use Arch.Interrupts; +with Interfaces; use Interfaces; +with Memory.Physical; +with System; +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; + +package body GP_Context_Tests is + + procedure Test_To_GP_Context_Type (T : in out Test_Case'Class) is + Internal : Arch.Context.GP_Context_Type; + Dummy_Frame : constant Frame := + (R0 => 0, + R1 => 1, + R2 => 16#1000#, -- Example stack pointer. + R3 => 3, + R4 => 4, + R5 => 5, + R6 => 6, + R7 => 7, + R8 => 8, + R9 => 9, + R10 => 10, -- Example return register. + R11 => 11, + R12 => 12, + R13 => 13, + R14 => 14, + R15 => 15); + begin + Internal := Arch.Context.To_GP_Context_Type(Dummy_Frame); + Check_Equal(16#1000#, Internal.SP, "SP from Frame.R2 should be 0x1000"); + Check_Equal(10, Internal.A0, "A0 from Frame.R10 should be 10"); + Check_True(Internal.SEPC /= 0, "SEPC must be nonzero"); + Check_True(Internal.SSTATUS /= 0, "SSTATUS must be nonzero"); + end Test_To_GP_Context_Type; + + procedure Test_To_Frame (T : in out Test_Case'Class) is + Internal : Arch.Context.GP_Context_Type := + (SP => 16#12345678#, + SEPC => 16#DEADBEEF#, + SSTATUS => 16#CAFEBABE#, + A0 => 16#ABCDEF00#); + External : Frame; + begin + External := Arch.Context.To_Frame(Internal); + Check_Equal(16#12345678#, External.R2, "External R2 must equal lower 32 bits of SP"); + Check_Equal(16#ABCDEF00#, External.R10, "External R10 must equal lower 32 bits of A0"); + Check_Equal(0, External.R0, "R0 should be zero"); + Check_Equal(0, External.R15, "R15 should be zero"); + end Test_To_Frame; + + procedure Test_Init_GP_Context (T : in out Test_Case'Class) is + Ctx : Arch.Context.GP_Context; + Stack : System.Address := Memory.Physical.Alloc(4096); + Dummy_Start : constant System.Address := System.Address'Value(16#4000#); + Internal : Arch.Context.GP_Context_Type; + begin + Arch.Context.Init_GP_Context(Ctx, Stack, Dummy_Start); + Internal := Arch.Context.To_GP_Context_Type(Ctx); + Check_True(Internal.SP /= 0, "SP must be set by Init_GP_Context"); + Check_True(Internal.SEPC /= 0, "SEPC must be nonzero after init"); + Check_Equal(0, Internal.A0, "A0 should be initialized to zero"); + end Test_Init_GP_Context; + + procedure Test_Success_Fork_Result (T : in out Test_Case'Class) is + Ctx : Arch.Context.GP_Context; + Stack : System.Address := Memory.Physical.Alloc(4096); + Dummy_Start : constant System.Address := System.Address'Value(16#5000#); + Internal : Arch.Context.GP_Context_Type; + Old_SEPC : Unsigned_64; + begin + Arch.Context.Init_GP_Context(Ctx, Stack, Dummy_Start); + Internal := Arch.Context.To_GP_Context_Type(Ctx); + Old_SEPC := Internal.SEPC; + Arch.Context.Success_Fork_Result(Ctx); + Internal := Arch.Context.To_GP_Context_Type(Ctx); + Check_Equal(0, Internal.A0, "A0 should be set to 0 by Success_Fork_Result"); + Check_True(Internal.SEPC > Old_SEPC, "SEPC should be advanced after Success_Fork_Result"); + end Test_Success_Fork_Result; + + procedure Register_Tests (T : in out GP_Context_Test) is + use AUnit.Test_Cases.Registration; + begin + Register_Routine(T, Test_To_GP_Context_Type'Access, "Test_To_GP_Context_Type"); + Register_Routine(T, Test_To_Frame'Access, "Test_To_Frame"); + Register_Routine(T, Test_Init_GP_Context'Access, "Test_Init_GP_Context"); + Register_Routine(T, Test_Success_Fork_Result'Access, "Test_Success_Fork_Result"); + end Register_Tests; + + overriding function Name (T : GP_Context_Test) return Message_String is + begin + return "GP_Context_Tests"; + end Name; + +end GP_Context_Tests; diff --git a/source/tests/riscv64/gp_context_tests.ads b/source/tests/riscv64/gp_context_tests.ads new file mode 100644 index 0000000..b93ac3f --- /dev/null +++ b/source/tests/riscv64/gp_context_tests.ads @@ -0,0 +1,10 @@ +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; + +package GP_Context_Tests is + type GP_Context_Test is new Test_Cases.Test_Case with null record; + overriding function Name (T : GP_Context_Test) return Test_String; + procedure Register_Tests (T : in out GP_Context_Test); + -- Changed from an aliased object to a constant access object. + Test_Case : constant access GP_Context_Test := new GP_Context_Test'(Name => "GP_Context_Tests"); +end GP_Context_Tests; diff --git a/source/tests/riscv64/stubs.adb b/source/tests/riscv64/stubs.adb new file mode 100644 index 0000000..bf78715 --- /dev/null +++ b/source/tests/riscv64/stubs.adb @@ -0,0 +1,36 @@ +with Interfaces; +with System; +with System.Storage_Elements; use System.Storage_Elements; + +package body Stubs is + + procedure Initialize_Core_Locals is + begin + for I in Core_Locals'Range loop + declare + A : Integer_Address := Integer_Address(16#1000# + I * 16#100#); + begin + Core_Locals(I).User_Stack := To_Address(A); + end; + Core_Locals(I).Hart_ID := Interfaces.Unsigned_64(I - 1); + Core_Locals(I).Number := I; + end loop; + end Initialize_Core_Locals; + + function Eq_U64(L, R : Interfaces.Unsigned_64) return Boolean is + begin + -- Compare via the 'Image attribute. + return L'Image = R'Image; + end Eq_U64; + + function Has_Extension(Bit : Interfaces.Unsigned_64) return Boolean is + begin + if Eq_U64(Bit, Interfaces.Unsigned_64(16#20#)) or else + Eq_U64(Bit, Interfaces.Unsigned_64(16#40#)) + then + return True; + else + return False; + end if; + end Has_Extension; +end Stubs; diff --git a/source/tests/riscv64/stubs.ads b/source/tests/riscv64/stubs.ads new file mode 100644 index 0000000..b2d4903 --- /dev/null +++ b/source/tests/riscv64/stubs.ads @@ -0,0 +1,19 @@ +with Interfaces; +with System; +package Stubs is + type Core_Context_Record is record + User_Stack : System.Address; + Hart_ID : Interfaces.Unsigned_64; + Number : Positive; + end record; + + Core_Count : constant Positive := 4; + -- Simulated per-core local storage. + Core_Locals : array (Positive range 1 .. Core_Count) of Core_Context_Record; + + -- For testing, initialize Core_Locals with dummy values. + procedure Initialize_Core_Locals; + + -- Stub for FP extension detection. + function Has_Extension(Bit : Interfaces.Unsigned_64) return Boolean; +end Stubs; diff --git a/source/tests/riscv64/success_fork_result_tests.adb b/source/tests/riscv64/success_fork_result_tests.adb new file mode 100644 index 0000000..fba3161 --- /dev/null +++ b/source/tests/riscv64/success_fork_result_tests.adb @@ -0,0 +1,38 @@ +with AUnit.Assertions; use AUnit.Assertions; +with AUnit.Test_Cases.Registration; use AUnit.Test_Cases.Registration; +with Arch.Context; use Arch.Context; +with Memory.Physical; +with System; +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; + +package body Success_Fork_Result_Tests is + + procedure Test_Success_Fork_Result (T : in out Test_Case'Class) is + Ctx : Arch.Context.GP_Context; + Stack : System.Address := Memory.Physical.Alloc(4096); + Dummy_Start : constant System.Address := System.Address'Value(16#6000#); + Internal : Arch.Context.GP_Context_Type; + Old_SEPC : Unsigned_64; + begin + Arch.Context.Init_GP_Context(Ctx, Stack, Dummy_Start); + Internal := Arch.Context.To_GP_Context_Type(Ctx); + Old_SEPC := Internal.SEPC; + Arch.Context.Success_Fork_Result(Ctx); + Internal := Arch.Context.To_GP_Context_Type(Ctx); + Check_Equal(0, Internal.A0, "A0 should be set to 0 by Success_Fork_Result"); + Check_True(Internal.SEPC > Old_SEPC, "SEPC should advance after Success_Fork_Result"); + end Test_Success_Fork_Result; + + overriding procedure Register_Tests (T : in out Success_Fork_Result_Test) is + use AUnit.Test_Cases.Registration; + begin + Register_Routine(T, Test_Success_Fork_Result'Access, "Test_Success_Fork_Result"); + end Register_Tests; + + overriding function Name (T : Success_Fork_Result_Test) return Test_String is + begin + return "Success_Fork_Result_Tests"; + end Name; + +end Success_Fork_Result_Tests; diff --git a/source/tests/riscv64/success_fork_result_tests.ads b/source/tests/riscv64/success_fork_result_tests.ads new file mode 100644 index 0000000..6d4d0d7 --- /dev/null +++ b/source/tests/riscv64/success_fork_result_tests.ads @@ -0,0 +1,8 @@ +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; + +package Success_Fork_Result_Tests is + type Success_Fork_Result_Test is new Test_Cases.Test_Case with null record; + Test_Case : Success_Fork_Result_Test := new Success_Fork_Result_Test; + procedure Register_Tests (T : in out Success_Fork_Result_Test); +end Success_Fork_Result_Tests; diff --git a/source/tests/riscv64/test_context.adb b/source/tests/riscv64/test_context.adb new file mode 100644 index 0000000..4726963 --- /dev/null +++ b/source/tests/riscv64/test_context.adb @@ -0,0 +1,118 @@ +with AUnit.Assertions; +with AUnit.Test_Cases.Registration; +with Arch.Context; +with System; +with Memory.Physical; +with Ada.Text_IO; +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; + +package body Test_Context is + + use AUnit.Assertions; + + -- Test General-Purpose Context Initialization + procedure Test_Init_GP_Context (T : in out AUnit.Test_Cases.Test_Case'Class) is + Ctx : GP_Context; + Stack : System.Address := Memory.Physical.Alloc (4096); + begin + Init_GP_Context (Ctx, Stack, System.Null_Address); + Assert (Ctx.SP /= 0, "Stack pointer should not be zero!"); + Assert (Ctx.SEPC = 0, "Program counter should start at zero!"); + end Test_Init_GP_Context; + + -- Test General-Purpose Context Loading + procedure Test_Load_GP_Context (T : in out AUnit.Test_Cases.Test_Case'Class) is + Ctx : GP_Context; + begin + Init_GP_Context (Ctx, Memory.Physical.Alloc (4096), System.Null_Address); + -- No direct way to verify `sret`, but we can check CSR manipulation indirectly. + Load_GP_Context (Ctx); + -- Ensure function does not return unexpectedly + end Test_Load_GP_Context; + + -- Test Multi-Core Core Context Saving + procedure Test_Save_Core_Context (T : in out AUnit.Test_Cases.Test_Case'Class) is + Ctx : Core_Context; + begin + Save_Core_Context (Ctx); + Assert (Ctx >= 0, "Saved core context should be valid!"); + end Test_Save_Core_Context; + + -- Test Success Fork Result + procedure Test_Success_Fork_Result (T : in out AUnit.Test_Cases.Test_Case'Class) is + Ctx : GP_Context; + begin + Init_GP_Context (Ctx, Memory.Physical.Alloc (4096), System.Null_Address); + Success_Fork_Result (Ctx); + Assert (Ctx.SEPC = 0, "SEPC should be 0 after fork!"); + Assert (Ctx.A0 = 0, "Child process should return 0 in A0!"); + end Test_Success_Fork_Result; + + -- Test Floating-Point Context Initialization + procedure Test_Init_FP_Context (T : in out AUnit.Test_Cases.Test_Case'Class) is + Ctx : FP_Context; + begin + Init_FP_Context (Ctx); + Assert (Ctx /= System.Null_Address, "Floating-point context should be allocated!"); + end Test_Init_FP_Context; + + -- Test Floating-Point Context Saving + procedure Test_Save_FP_Context (T : in out AUnit.Test_Cases.Test_Case'Class) is + Ctx : FP_Context; + begin + Init_FP_Context (Ctx); + Save_FP_Context (Ctx); + end Test_Save_FP_Context; + + -- Test Floating-Point Context Loading + procedure Test_Load_FP_Context (T : in out AUnit.Test_Cases.Test_Case'Class) is + Ctx : FP_Context; + begin + Init_FP_Context (Ctx); + Load_FP_Context (Ctx); + end Test_Load_FP_Context; + + -- Test Floating-Point Context Destruction + procedure Test_Destroy_FP_Context (T : in out AUnit.Test_Cases.Test_Case'Class) is + Ctx : FP_Context; + begin + Init_FP_Context (Ctx); + Destroy_FP_Context (Ctx); + Assert (Ctx = System.Null_Address, "FP Context should be NULL after destruction!"); + end Test_Destroy_FP_Context; + + -- Test Hart ID Retrieval + procedure Test_Get_Hart_ID (T : in out AUnit.Test_Cases.Test_Case'Class) is + Hart : Unsigned_64; + begin + Hart := Get_Hart_ID; + Assert (Hart < 64, "Hart ID should be valid (less than 64)!"); + end Test_Get_Hart_ID; + + -- Test CPU Extension Checking + procedure Test_Has_Extension (T : in out AUnit.Test_Cases.Test_Case'Class) is + begin + Assert (Has_Extension (16#1#) = (Get_CSR (16#F11#) and 16#1# /= 0), "Extension check failed!"); + end Test_Has_Extension; + + -- Register all test cases + overriding procedure Register_Tests (T : in out Test_Context) is + begin + Register_Routine (T, Test_Init_GP_Context'Access, "Test_Init_GP_Context"); + Register_Routine (T, Test_Load_GP_Context'Access, "Test_Load_GP_Context"); + Register_Routine (T, Test_Save_Core_Context'Access, "Test_Save_Core_Context"); + Register_Routine (T, Test_Success_Fork_Result'Access, "Test_Success_Fork_Result"); + Register_Routine (T, Test_Init_FP_Context'Access, "Test_Init_FP_Context"); + Register_Routine (T, Test_Save_FP_Context'Access, "Test_Save_FP_Context"); + Register_Routine (T, Test_Load_FP_Context'Access, "Test_Load_FP_Context"); + Register_Routine (T, Test_Destroy_FP_Context'Access, "Test_Destroy_FP_Context"); + Register_Routine (T, Test_Get_Hart_ID'Access, "Test_Get_Hart_ID"); + Register_Routine (T, Test_Has_Extension'Access, "Test_Has_Extension"); + end Register_Tests; + + overriding function Name (T : Test_Context) return Test_String is + begin + return Format ("Context Tests"); + end Name; +end Test_Context; \ No newline at end of file diff --git a/source/tests/riscv64/test_context.ads b/source/tests/riscv64/test_context.ads new file mode 100644 index 0000000..b592534 --- /dev/null +++ b/source/tests/riscv64/test_context.ads @@ -0,0 +1,21 @@ +with AUnit; use AUnit; +with AUnit.Test_Cases; use AUnit.Test_Cases; + +package Test_Context is + + overriding procedure Register_Tests (T: in out Test_Context); + overriding function Name (T: Test_Context) return Message_String; + + -- Test Routines: + procedure Test_Init_GP_Context (T : in out Test_Cases.Test_Case'Class); + procedure Test_Load_GP_Context (T : in out Test_Cases.Test_Case'Class); + procedure Test_Save_Core_Context (T : in out Test_Cases.Test_Case'Class); + procedure Test_Success_Fork_Result (T : in out Test_Cases.Test_Case'Class); + procedure Test_Init_FP_Context (T : in out Test_Cases.Test_Case'Class); + procedure Test_Save_FP_Context (T : in out Test_Cases.Test_Case'Class); + procedure Test_Load_FP_Context (T : in out Test_Cases.Test_Case'Class); + procedure Test_Destroy_FP_Context (T : in out Test_Cases.Test_Case'Class); + procedure Test_Get_Hart_ID (T : in out Test_Cases.Test_Case'Class); + procedure Test_Has_Extension (T : in out Test_Cases.Test_Case'Class); + +end Test_Context; \ No newline at end of file diff --git a/source/tests/riscv64/test_harness.adb b/source/tests/riscv64/test_harness.adb new file mode 100644 index 0000000..4ac1083 --- /dev/null +++ b/source/tests/riscv64/test_harness.adb @@ -0,0 +1,16 @@ +with AUnit.Reporter.Text; +with AUnit.Run; +with Arch_RV64_Test_Suite; +with Ada.Text_IO; +with Stubs; use Stubs; + +procedure Test_Harness is + procedure Run is new AUnit.Run.Test_Runner(Arch_RV64_Test_Suite.Suite); + Reporter : AUnit.Reporter.Text.Text_Reporter; +begin + -- Initialize test stubs. + Initialize_Core_Locals; + + Ada.Text_IO.Put_Line("Running RISC-V Context Switch Tests..."); + Run(Reporter); +end Test_Harness; diff --git a/source/tests/test_harness.gpr b/source/tests/test_harness.gpr new file mode 100644 index 0000000..2ec7fa0 --- /dev/null +++ b/source/tests/test_harness.gpr @@ -0,0 +1,34 @@ +project Test_Harness is + + for Source_Dirs use ("../tests/riscv64", + "/usr/share/ada/adainclude/aunit/", + "/home/sean/.alire/riscv64-elf/lib/gnat/", + "/home/sean/.alire/"); + for Object_Dir use "obj"; + for Exec_Dir use "bin"; + for Main use ("test_harness.adb"); + + package Compiler is + for Switches ("Ada") use ("-gnat2012"); + end Compiler; + + package Builder is + for Executable ("test_harness.adb") use "test-harness"; + end Builder; + + package Ide is + for Integrated_Tools use ("GNAT", "GPS"); + end Ide; + + for Languages use ("Ada"); + + package Linker is + for Default_Switches ("Ada") use ("-launit"); + end Linker; + + package Naming is + for Body_Suffix ("Ada") use ".adb"; + for Specification_Suffix ("Ada") use ".ads"; + end Naming; + +end Test_Harness;