diff --git a/repos/libports/lib/mk/ada.mk b/repos/libports/lib/mk/ada.mk
index 87c94d7e4a..b11cf89abb 100644
--- a/repos/libports/lib/mk/ada.mk
+++ b/repos/libports/lib/mk/ada.mk
@@ -3,21 +3,32 @@ include $(REP_DIR)/lib/import/import-ada.mk
ADALIB = $(ADA_RTS)/adalib
ADAINCLUDE = $(ADA_RTS)/adainclude
-PACKAGES = system
+PACKAGES = system s-stoele s-secsta
-body_exists := $(filter $1.adb,$(shell if [ -e $(ADA_RTS_SOURCE)/$1.adb ]; then echo $1.adb; fi))
+body_exists := $(filter $1.adb,$(shell if [ -e $2/$1.adb ]; then echo $1.adb; fi))
ADA_RTS_SOURCE = $(call select_from_ports,gcc)/src/noux-pkg/gcc/gcc/ada
SRC_ADS += $(foreach package, $(PACKAGES), $(package).ads)
-SRC_ADB += $(foreach package, $(PACKAGES), $(body_exists, $(package)))
+SRC_ADB += $(foreach package, $(PACKAGES), $(body_exists, $(package), $(ADA_RTS_SOURCE)))
+SRC_ADB += $(foreach package, $(PACKAGES), $(body_exists, $(package), $(REP_DIR)/src/lib/ada/runtime))
CUSTOM_ADA_MAKE = $(CC)
CUSTOM_ADA_FLAGS = -c -gnatg -gnatp -gnatpg -gnatn2
CUSTOM_ADA_OPT = $(CC_ADA_OPT)
-CUSTOM_ADA_INCLUDE = -I- -I$(ADA_RTS_SOURCE)
+CUSTOM_ADA_INCLUDE = -I- -I$(REP_DIR)/src/lib/ada/runtime -I$(ADA_RTS_SOURCE) -I$(REP_DIR)/src/lib/ada/runtimelib
-vpath %.adb $(ADA_RTS_SOURCE)
-vpath %.ads $(ADA_RTS_SOURCE)
+# pure C runtime implementations
+SRC_CC += a-except_c.cc s-soflin_c.cc
+
+# C runtime glue code
+SRC_CC += s-secsta_c.cc gnat_except.cc
+
+# Ada packages that implement runtime functionality
+SRC_ADB += ss_utils.adb
+
+vpath %.cc $(REP_DIR)/src/lib/ada/runtimelib
+vpath %.adb $(REP_DIR)/src/lib/ada/runtime $(ADA_RTS_SOURCE) $(REP_DIR)/src/lib/ada/runtimelib
+vpath %.ads $(REP_DIR)/src/lib/ada/runtime $(ADA_RTS_SOURCE)
SHARED_LIB = yes
diff --git a/repos/libports/src/lib/ada/runtime/s-secsta.adb b/repos/libports/src/lib/ada/runtime/s-secsta.adb
new file mode 100644
index 0000000000..504834395e
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtime/s-secsta.adb
@@ -0,0 +1,52 @@
+package body System.Secondary_Stack is
+
+ procedure SS_Allocate (
+ Address : out System.Address;
+ Storage_Size : SSE.Storage_Count
+ )
+ is
+ T : constant Ss_Utils.Thread := Ss_Utils.C_Get_Thread;
+ begin
+ if T /= Ss_Utils.Invalid_Thread then
+ Ss_Utils.S_Allocate (Address,
+ Storage_Size,
+ Thread_Registry,
+ T);
+ else
+ raise Program_Error;
+ end if;
+ end SS_Allocate;
+
+ function SS_Mark return Mark_Id
+ is
+ M : Mark_Id;
+ T : constant Ss_Utils.Thread := Ss_Utils.C_Get_Thread;
+ begin
+ if T /= Ss_Utils.Invalid_Thread then
+ Ss_Utils.S_Mark (M.Sstk,
+ SSE.Storage_Count (M.Sptr),
+ Thread_Registry,
+ T);
+ else
+ raise Program_Error;
+ end if;
+ return M;
+ end SS_Mark;
+
+ procedure SS_Release (
+ M : Mark_Id
+ )
+ is
+ T : constant Ss_Utils.Thread := Ss_Utils.C_Get_Thread;
+ begin
+ if T /= Ss_Utils.Invalid_Thread then
+ Ss_Utils.S_Release (M.Sstk,
+ SSE.Storage_Count (M.Sptr),
+ Thread_Registry,
+ T);
+ else
+ raise Program_Error;
+ end if;
+ end SS_Release;
+
+end System.Secondary_Stack;
diff --git a/repos/libports/src/lib/ada/runtime/s-secsta.ads b/repos/libports/src/lib/ada/runtime/s-secsta.ads
new file mode 100644
index 0000000000..49e36d2dd1
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtime/s-secsta.ads
@@ -0,0 +1,31 @@
+with System.Storage_Elements;
+with Ss_Utils;
+use all type Ss_Utils.Thread;
+
+package System.Secondary_Stack is
+
+ package SSE renames System.Storage_Elements;
+
+ type Mark_Id is private;
+
+ procedure SS_Allocate (
+ Address : out System.Address;
+ Storage_Size : SSE.Storage_Count
+ );
+
+ function SS_Mark return Mark_Id;
+
+ procedure SS_Release (
+ M : Mark_Id
+ );
+
+private
+
+ type Mark_Id is record
+ Sstk : System.Address;
+ Sptr : SSE.Integer_Address;
+ end record;
+
+ Thread_Registry : Ss_Utils.Registry := Ss_Utils.Null_Registry;
+
+end System.Secondary_Stack;
diff --git a/repos/libports/src/lib/ada/runtimelib/a-except.h b/repos/libports/src/lib/ada/runtimelib/a-except.h
new file mode 100644
index 0000000000..09802235f2
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/a-except.h
@@ -0,0 +1,7 @@
+
+extern "C" {
+
+ void ada__exceptions__reraise_occurrence_no_defer();
+ void ada__exceptions__save_occurrence();
+
+}
diff --git a/repos/libports/src/lib/ada/runtimelib/a-except_c.cc b/repos/libports/src/lib/ada/runtimelib/a-except_c.cc
new file mode 100644
index 0000000000..a7eaf0daee
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/a-except_c.cc
@@ -0,0 +1,16 @@
+
+#include
+
+extern "C" {
+
+ void ada__exceptions__reraise_occurrence_no_defer()
+ {
+ Genode::warning(__func__, " not implemented");
+ }
+
+ void ada__exceptions__save_occurrence()
+ {
+ Genode::warning(__func__, " not implemented");
+ }
+
+}
diff --git a/repos/libports/src/lib/ada/runtimelib/genode_rts.gpr b/repos/libports/src/lib/ada/runtimelib/genode_rts.gpr
new file mode 100644
index 0000000000..8add0adbd0
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/genode_rts.gpr
@@ -0,0 +1,5 @@
+project genode_rts is
+
+ for Source_Dirs use (".");
+
+end genode_rts;
diff --git a/repos/libports/src/lib/ada/runtimelib/gnat_except.cc b/repos/libports/src/lib/ada/runtimelib/gnat_except.cc
new file mode 100644
index 0000000000..14a9fac826
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/gnat_except.cc
@@ -0,0 +1,21 @@
+
+#include
+
+extern "C" {
+
+ void __gnat_rcheck_CE_Explicit_Raise()
+ {
+ Genode::warning("Unhandled Ada exception: Constraint_Error");
+ }
+
+ void __gnat_rcheck_SE_Explicit_Raise()
+ {
+ Genode::warning("Unhandled Ada exception: Storage_Error");
+ }
+
+ void __gnat_rcheck_PE_Explicit_Raise()
+ {
+ Genode::warning("Unhandled Ada exception: Program_Error");
+ }
+
+}
diff --git a/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data-tests.adb b/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data-tests.adb
new file mode 100644
index 0000000000..904715bb3a
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data-tests.adb
@@ -0,0 +1,490 @@
+-- This package has been generated automatically by GNATtest.
+-- You are allowed to add your code to the bodies of test routines.
+-- Such changes will be kept during further regeneration of this file.
+-- All code placed outside of test routine bodies will be lost. The
+-- code intended to set up and tear down the test environment should be
+-- placed into Ss_Utils.Test_Data.
+
+with AUnit.Assertions; use AUnit.Assertions;
+with System.Assertions;
+
+-- begin read only
+-- id:2.2/00/
+--
+-- This section can be used to add with clauses if necessary.
+--
+-- end read only
+with System.Memory;
+-- begin read only
+-- end read only
+package body Ss_Utils.Test_Data.Tests is
+
+ -- begin read only
+ -- id:2.2/01/
+ --
+ -- This section can be used to add global variables and other elements.
+ --
+ -- end read only
+
+ package SSE renames System.Storage_Elements;
+ Alloc_Success : Boolean := False;
+ Valid_Thread : Thread := Thread (SSE.To_Address (16#1000#));
+
+ function C_Alloc (T : Thread; Size : SSE.Storage_Count) return System.Address
+ with
+ Export,
+ Convention => C,
+ External_Name => "allocate_secondary_stack";
+
+ function C_Alloc (T : Thread; Size : SSE.Storage_Count) return System.Address
+ is
+ begin
+ if Alloc_Success then
+ return System.Memory.Alloc (System.Memory.size_t (Size));
+ else
+ return System.Null_Address;
+ end if;
+ end C_Alloc;
+
+ procedure Get_Mark_Full_Registry
+ is
+ E : Mark;
+ R : Registry := Null_Registry;
+ T : constant Thread := Thread (System.Storage_Elements.To_Address (42));
+ begin
+ for I in R'Range loop
+ R (I).Id := Valid_Thread;
+ end loop;
+ Get_Mark (T, R, E);
+ end Get_Mark_Full_Registry;
+
+ procedure Get_Mark_Invalid_Thread
+ is
+ E : Mark;
+ R : Registry := Null_Registry;
+ begin
+ Get_Mark (Invalid_Thread, R, E);
+ end Get_Mark_Invalid_Thread;
+
+ procedure Set_Mark_Unknown_Thread
+ is
+ T : Thread := Valid_Thread;
+ R : Registry := Null_Registry;
+ M : Mark := (Base => System.Storage_Elements.To_Address (42),
+ Top => 8);
+ begin
+ Set_Mark (T, M, R);
+ end Set_Mark_Unknown_Thread;
+
+ procedure Set_Mark_Invalid_Thread
+ is
+ T : Thread := Invalid_Thread;
+ R : Registry := Null_Registry;
+ M : Mark := (Base => System.Storage_Elements.To_Address (42),
+ Top => 8);
+ begin
+ Set_Mark (T, M, R);
+ end Set_Mark_Invalid_Thread;
+
+ procedure Set_Mark_Invalid_Stack
+ is
+ T : Thread := Valid_Thread;
+ R : Registry := Null_Registry;
+ M : Mark := (Base => System.Null_Address,
+ Top => 0);
+ begin
+ R (0).Id := T;
+ R (0).Data := M;
+ R (0).Data.Base := System.Storage_Elements.To_Address (42);
+ Set_Mark (T, M, R);
+ end Set_Mark_Invalid_Stack;
+
+ procedure Alloc_Stack_With_Null_Ptr
+ is
+ Ptr : System.Address;
+ begin
+ Alloc_Success := False;
+ Ptr := Allocate_Stack (Valid_Thread, 0);
+ end Alloc_Stack_With_Null_Ptr;
+
+ procedure Alloc_Stack_With_Invalid_Thread
+ is
+ Ptr : System.Address;
+ begin
+ Alloc_Success := True;
+ Ptr := Allocate_Stack (Invalid_Thread, 0);
+ end Alloc_Stack_With_Invalid_Thread;
+
+ procedure S_Allocate_Stack_Overflow_1
+ is
+ T : Thread := Valid_Thread;
+ Reg : Registry := Null_Registry;
+ Stack_Ptr : System.Address;
+ begin
+ S_Allocate (Stack_Ptr, Secondary_Stack_Size * 2, Reg, T);
+ end S_Allocate_Stack_Overflow_1;
+
+ procedure S_Allocate_Stack_Overflow_2
+ is
+ T : Thread := Valid_Thread;
+ Reg : Registry := Null_Registry;
+ Stack_Ptr : System.Address;
+ begin
+ for I in 0 .. 1024 loop
+ S_Allocate (Stack_Ptr, SSE.Storage_Offset (1024), Reg, T);
+ end loop;
+ end S_Allocate_Stack_Overflow_2;
+
+ procedure S_Release_High_Mark
+ is
+ T : Thread := Valid_Thread;
+ Reg : Registry := Null_Registry;
+ Mark_Id : SSE.Storage_Count;
+ Mark_Base : System.Address;
+ Stack_Ptr : System.Address;
+ begin
+ S_Allocate (Stack_Ptr, 8, Reg, T);
+ S_Mark (Mark_Base, Mark_Id, Reg, T);
+ S_Release (Mark_Base, Mark_Id + 1, Reg, T);
+ end S_Release_High_Mark;
+
+ -- begin read only
+ -- end read only
+
+ -- begin read only
+ procedure Test_Get_Mark (Gnattest_T : in out Test);
+ procedure Test_Get_Mark_205a8b (Gnattest_T : in out Test) renames Test_Get_Mark;
+ -- id:2.2/205a8b09655a71fc/Get_Mark/1/0/
+ procedure Test_Get_Mark (Gnattest_T : in out Test) is
+ -- ss_utils.ads:36:4:Get_Mark
+ -- end read only
+
+ pragma Unreferenced (Gnattest_T);
+ T1 : Thread := Thread (System.Storage_Elements.To_Address (1));
+ T2 : Thread := Thread (System.Storage_Elements.To_Address (2));
+ Reg : Registry := Null_Registry;
+ Test_Mark : Mark;
+ T1_Mark : Mark := (Base => System.Null_Address,
+ Top => 0);
+ T2_Mark : Mark := (Base => System.Storage_Elements.To_Address (42),
+ Top => 4);
+ begin
+
+ Alloc_Success := True;
+ AUnit.Assertions.Assert_Exception (Get_Mark_Invalid_Thread'Access,
+ "Get mark with invalid thread failed");
+ AUnit.Assertions.Assert_Exception (Get_Mark_Full_Registry'Access,
+ "Get mark with full registry failed");
+
+ Get_Mark (T1, Reg, Test_Mark);
+ AUnit.Assertions.Assert (Test_Mark.Base /= System.Null_Address,
+ "Stack not initialized");
+ AUnit.Assertions.Assert (Test_Mark.Top = 0,
+ "Top not null after initialization");
+
+ Get_Mark (T1, Reg, T1_Mark);
+ AUnit.Assertions.Assert (Test_Mark = T1_Mark,
+ "Failed to get T1 mark");
+
+ Reg (2).Id := T2;
+ Reg (2).Data := T2_Mark;
+
+ Get_Mark (T2, Reg, Test_Mark);
+ AUnit.Assertions.Assert (Test_Mark = T2_Mark,
+ "Failed to get T2 mark");
+
+ -- begin read only
+ end Test_Get_Mark;
+ -- end read only
+
+ -- begin read only
+ procedure Test_Set_Mark (Gnattest_T : in out Test);
+ procedure Test_Set_Mark_75973c (Gnattest_T : in out Test) renames Test_Set_Mark;
+ -- id:2.2/75973c43cd4409b1/Set_Mark/1/0/
+ procedure Test_Set_Mark (Gnattest_T : in out Test) is
+ -- ss_utils.ads:44:4:Set_Mark
+ -- end read only
+
+ pragma Unreferenced (Gnattest_T);
+ Reg : Registry := Null_Registry;
+ E1 : Mark;
+ E2 : Mark;
+ T : Thread := Valid_Thread;
+ begin
+
+ AUnit.Assertions.Assert_Exception (Set_Mark_Unknown_Thread'Access,
+ "Set mark on unknown thread failed");
+ AUnit.Assertions.Assert_Exception (Set_Mark_Invalid_Thread'Access,
+ "Set mark on invalid thread failed");
+ AUnit.Assertions.Assert_Exception (Set_Mark_Invalid_Stack'Access,
+ "Set mark on invalid stack failed");
+
+ Get_Mark (T, Reg, E1);
+ E1.Top := 42;
+ Set_Mark (T, E1, Reg);
+ Get_Mark (T, Reg, E2);
+ AUnit.Assertions.Assert (E1 = E2,
+ "Storing mark failed");
+ -- begin read only
+ end Test_Set_Mark;
+ -- end read only
+
+
+ -- begin read only
+ procedure Test_Allocate_Stack (Gnattest_T : in out Test);
+ procedure Test_Allocate_Stack_247b78 (Gnattest_T : in out Test) renames Test_Allocate_Stack;
+ -- id:2.2/247b786dfb10deba/Allocate_Stack/1/0/
+ procedure Test_Allocate_Stack (Gnattest_T : in out Test) is
+ -- ss_utils.ads:53:4:Allocate_Stack
+ -- end read only
+
+ pragma Unreferenced (Gnattest_T);
+ begin
+
+ Alloc_Success := True;
+ AUnit.Assertions.Assert (Allocate_Stack (Valid_Thread, 0) /= System.Null_Address,
+ "Allocate stack failed");
+ AUnit.Assertions.Assert_Exception (Alloc_Stack_With_Null_Ptr'Access,
+ "Allocate stack with null failed");
+ AUnit.Assertions.Assert_Exception (Alloc_Stack_With_Invalid_Thread'Access,
+ "Allocate stack with invalid thread failed");
+
+ -- begin read only
+ end Test_Allocate_Stack;
+ -- end read only
+
+
+ -- begin read only
+ procedure Test_S_Allocate (Gnattest_T : in out Test);
+ procedure Test_S_Allocate_70b783 (Gnattest_T : in out Test) renames Test_S_Allocate;
+ -- id:2.2/70b783c9ffa2dd5e/S_Allocate/1/0/
+ procedure Test_S_Allocate (Gnattest_T : in out Test) is
+ -- ss_utils.ads:61:4:S_Allocate
+ -- end read only
+
+ pragma Unreferenced (Gnattest_T);
+ Reg : Registry := Null_Registry;
+ M : Mark;
+ T : Thread := Valid_Thread;
+ Stack_Base : System.Address;
+ Stack_Ptr : System.Address;
+ begin
+
+ Alloc_Success := True;
+
+ Get_Mark (T, Reg, M);
+ AUnit.Assertions.Assert (M.Base /= System.Null_Address,
+ "Base allocation failed");
+ AUnit.Assertions.Assert (M.Top = 0,
+ "Top not initialized with 0");
+
+ Stack_Base := M.Base;
+ S_Allocate (Stack_Ptr, 8, Reg, T);
+ AUnit.Assertions.Assert (Stack_Base - 8 = Stack_Ptr,
+ "Invalid base move");
+ Get_Mark (T, Reg, M);
+ AUnit.Assertions.Assert (M.Top = 8,
+ "Unmodified top");
+
+ S_Allocate (Stack_Ptr, 8, Reg, T);
+ AUnit.Assertions.Assert (Stack_Base - 16 = Stack_Ptr,
+ "Invalid stack ptr");
+ Get_Mark (T, Reg, M);
+ AUnit.Assertions.Assert (M.Top = 16,
+ "Invalid top");
+
+ Reg := Null_Registry;
+ S_Allocate (Stack_Ptr, 8, Reg, T);
+ Get_Mark (T, Reg, M);
+
+ AUnit.Assertions.Assert (Stack_Ptr /= System.Null_Address,
+ "Initial Base allocation failed");
+ AUnit.Assertions.Assert (M.Base - 8 = Stack_Ptr,
+ "Invalid Stack initialization");
+ AUnit.Assertions.Assert (M.Top = 8,
+ "Top not set correctly");
+
+ AUnit.Assertions.Assert_Exception (S_Allocate_Stack_Overflow_1'Access,
+ "Failed to detect stack overflow 1");
+ AUnit.Assertions.Assert_Exception (S_Allocate_Stack_Overflow_2'Access,
+ "Failed to detect stack overflow 2");
+
+ -- begin read only
+ end Test_S_Allocate;
+ -- end read only
+
+
+ -- begin read only
+ procedure Test_S_Mark (Gnattest_T : in out Test);
+ procedure Test_S_Mark_a8299f (Gnattest_T : in out Test) renames Test_S_Mark;
+ -- id:2.2/a8299fa36da74b68/S_Mark/1/0/
+ procedure Test_S_Mark (Gnattest_T : in out Test) is
+ -- ss_utils.ads:68:4:S_Mark
+ -- end read only
+
+ pragma Unreferenced (Gnattest_T);
+ Reg : Registry := Null_Registry;
+ M : Mark;
+ S_Addr : System.Address;
+ S_Pos : SSE.Storage_Count;
+ T : Thread := Valid_Thread;
+ Stack_Ptr : System.Address;
+ begin
+
+ S_Allocate (Stack_Ptr, 8, Reg, T);
+ S_Mark (S_Addr, S_Pos, Reg, T);
+ Get_Mark (T, Reg, M);
+ AUnit.Assertions.Assert (S_Pos = M.Top and S_Pos = 8 and S_Addr = M.Base,
+ "Invalid mark location");
+
+ Reg := Null_Registry;
+ S_Mark (S_Addr, S_Pos, Reg, T);
+ Get_Mark (T, Reg, M);
+ AUnit.Assertions.Assert (S_Addr = M.Base,
+ "Mark did not initialize stack");
+ AUnit.Assertions.Assert (M.Top = 0 and S_Pos = 0,
+ "Mark did not initialize top");
+
+ -- begin read only
+ end Test_S_Mark;
+ -- end read only
+
+
+ -- begin read only
+ procedure Test_S_Release (Gnattest_T : in out Test);
+ procedure Test_S_Release_666a46 (Gnattest_T : in out Test) renames Test_S_Release;
+ -- id:2.2/666a463f3bb6be9f/S_Release/1/0/
+ procedure Test_S_Release (Gnattest_T : in out Test) is
+ -- ss_utils.ads:74:4:S_Release
+ -- end read only
+
+ pragma Unreferenced (Gnattest_T);
+ Reg : Registry := Null_Registry;
+ M : Mark;
+ Stack_Ptr : System.Address;
+ Mark_Id : System.Address;
+ Mark_Pos : SSE.Storage_Count;
+ T : Thread := Valid_Thread;
+ begin
+
+ AUnit.Assertions.Assert_Exception (S_Release_High_Mark'Access,
+ "Invalid stack release");
+
+ S_Allocate (Stack_Ptr, 8, Reg, T);
+ S_Mark (Mark_Id, Mark_Pos, Reg, T);
+ S_Allocate (Stack_Ptr, 4, Reg, T);
+ S_Allocate (Stack_Ptr, 4, Reg, T);
+ Get_Mark (T, Reg, M);
+
+ AUnit.Assertions.Assert (M.Top = 16,
+ "Top not initialized correctly");
+ AUnit.Assertions.Assert (Stack_Ptr /= Mark_Id - Mark_Pos,
+ "Mark not set correctly");
+
+ S_Release (Mark_Id, Mark_Pos, Reg, T);
+ Get_Mark (T, Reg, M);
+ AUnit.Assertions.Assert (M.Top = 8,
+ "Top not reset correctly");
+ AUnit.Assertions.Assert (M.Top = Mark_Pos,
+ "Invalid mark id");
+ S_Allocate (Stack_Ptr, 8, Reg, T);
+ AUnit.Assertions.Assert (Mark_Id - Mark_Pos = Stack_Ptr + 8,
+ "Invalid stack ptr location");
+
+ -- begin read only
+ end Test_S_Release;
+ -- end read only
+
+
+ -- begin read only
+ procedure Test_C_Alloc (Gnattest_T : in out Test);
+ procedure Test_C_Alloc_08db82 (Gnattest_T : in out Test) renames Test_C_Alloc;
+ -- id:2.2/08db82b0ee8ae041/C_Alloc/1/0/
+ procedure Test_C_Alloc (Gnattest_T : in out Test) is
+ -- ss_utils.ads:80:4:C_Alloc
+ -- end read only
+
+ pragma Unreferenced (Gnattest_T);
+
+ begin
+
+ Alloc_Success := True;
+ AUnit.Assertions.Assert (C_Alloc (Invalid_Thread, 0) /= System.Null_Address,
+ "Alloc test failed");
+ Alloc_Success := False;
+ AUnit.Assertions.Assert (C_Alloc (Invalid_Thread, 0) = System.Null_Address,
+ "Null Address test failed");
+
+ -- begin read only
+ end Test_C_Alloc;
+ -- end read only
+
+
+ -- begin read only
+ procedure Test_C_Free (Gnattest_T : in out Test);
+ procedure Test_C_Free_6747d0 (Gnattest_T : in out Test) renames Test_C_Free;
+ -- id:2.2/6747d08d1141dd9a/C_Free/1/0/
+ procedure Test_C_Free (Gnattest_T : in out Test) is
+ -- ss_utils.ads:88:4:C_Free
+ -- end read only
+
+ pragma Unreferenced (Gnattest_T);
+
+ begin
+
+ AUnit.Assertions.Assert (True, "C_Free");
+
+ -- begin read only
+ end Test_C_Free;
+ -- end read only
+
+
+ -- begin read only
+ procedure Test_C_Get_Thread (Gnattest_T : in out Test);
+ procedure Test_C_Get_Thread_97edc5 (Gnattest_T : in out Test) renames Test_C_Get_Thread;
+ -- id:2.2/97edc547916ca499/C_Get_Thread/1/0/
+ procedure Test_C_Get_Thread (Gnattest_T : in out Test) is
+ -- ss_utils.ads:94:4:C_Get_Thread
+ -- end read only
+
+ pragma Unreferenced (Gnattest_T);
+
+ begin
+
+ AUnit.Assertions.Assert (True, "C_Get_Thread");
+
+ -- begin read only
+ end Test_C_Get_Thread;
+ -- end read only
+
+
+ -- begin read only
+ -- procedure Test_Read_Mark (Gnattest_T : in out Test_);
+ -- procedure Test_Read_Mark_8404db (Gnattest_T : in out Test_) renames Test_Read_Mark;
+ -- id:2.2/8404db30c2a22d7a/Read_Mark/1/1/
+ -- procedure Test_Read_Mark (Gnattest_T : in out Test_) is
+ -- end read only
+-- begin read only
+ -- end Test_Read_Mark;
+ -- end read only
+-- begin read only
+ -- procedure Test_Write_Mark (Gnattest_T : in out Test_);
+ -- procedure Test_Write_Mark_99a74f (Gnattest_T : in out Test_) renames Test_Write_Mark;
+ -- id:2.2/99a74ffb3f48c3b7/Write_Mark/1/1/
+ -- procedure Test_Write_Mark (Gnattest_T : in out Test_) is
+ -- end read only
+-- begin read only
+ -- end Test_Write_Mark;
+ -- end read only
+
+ -- begin read only
+ -- id:2.2/02/
+ --
+ -- This section can be used to add elaboration code for the global state.
+ --
+begin
+ -- end read only
+ null;
+ -- begin read only
+ -- end read only
+end Ss_Utils.Test_Data.Tests;
diff --git a/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data-tests.ads b/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data-tests.ads
new file mode 100644
index 0000000000..cdff90fd79
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data-tests.ads
@@ -0,0 +1,40 @@
+-- This package has been generated automatically by GNATtest.
+-- Do not edit any part of it, see GNATtest documentation for more details.
+
+-- begin read only
+with Gnattest_Generated;
+
+package Ss_Utils.Test_Data.Tests is
+
+ type Test is new GNATtest_Generated.GNATtest_Standard.Ss_Utils.Test_Data.Test
+ with null record;
+
+ procedure Test_Get_Mark_205a8b (Gnattest_T : in out Test);
+ -- ss_utils.ads:36:4:Get_Mark
+
+ procedure Test_Set_Mark_75973c (Gnattest_T : in out Test);
+ -- ss_utils.ads:44:4:Set_Mark
+
+ procedure Test_Allocate_Stack_247b78 (Gnattest_T : in out Test);
+ -- ss_utils.ads:53:4:Allocate_Stack
+
+ procedure Test_S_Allocate_70b783 (Gnattest_T : in out Test);
+ -- ss_utils.ads:61:4:S_Allocate
+
+ procedure Test_S_Mark_a8299f (Gnattest_T : in out Test);
+ -- ss_utils.ads:68:4:S_Mark
+
+ procedure Test_S_Release_666a46 (Gnattest_T : in out Test);
+ -- ss_utils.ads:74:4:S_Release
+
+ procedure Test_C_Alloc_08db82 (Gnattest_T : in out Test);
+ -- ss_utils.ads:80:4:C_Alloc
+
+ procedure Test_C_Free_6747d0 (Gnattest_T : in out Test);
+ -- ss_utils.ads:88:4:C_Free
+
+ procedure Test_C_Get_Thread_97edc5 (Gnattest_T : in out Test);
+ -- ss_utils.ads:94:4:C_Get_Thread
+
+end Ss_Utils.Test_Data.Tests;
+-- end read only
diff --git a/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data.adb b/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data.adb
new file mode 100644
index 0000000000..9c5a71d9fb
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data.adb
@@ -0,0 +1,20 @@
+-- This package is intended to set up and tear down the test environment.
+-- Once created by GNATtest, this package will never be overwritten
+-- automatically. Contents of this package can be modified in any way
+-- except for sections surrounded by a 'read only' marker.
+
+package body Ss_Utils.Test_Data is
+
+ procedure Set_Up (Gnattest_T : in out Test) is
+ pragma Unreferenced (Gnattest_T);
+ begin
+ null;
+ end Set_Up;
+
+ procedure Tear_Down (Gnattest_T : in out Test) is
+ pragma Unreferenced (Gnattest_T);
+ begin
+ null;
+ end Tear_Down;
+
+end Ss_Utils.Test_Data;
diff --git a/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data.ads b/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data.ads
new file mode 100644
index 0000000000..b825f46048
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/gnattest/tests/ss_utils-test_data.ads
@@ -0,0 +1,18 @@
+-- This package is intended to set up and tear down the test environment.
+-- Once created by GNATtest, this package will never be overwritten
+-- automatically. Contents of this package can be modified in any way
+-- except for sections surrounded by a 'read only' marker.
+
+with AUnit.Test_Fixtures;
+
+package Ss_Utils.Test_Data is
+
+-- begin read only
+ type Test is new AUnit.Test_Fixtures.Test_Fixture
+-- end read only
+ with null record;
+
+ procedure Set_Up (Gnattest_T : in out Test);
+ procedure Tear_Down (Gnattest_T : in out Test);
+
+end Ss_Utils.Test_Data;
diff --git a/repos/libports/src/lib/ada/runtimelib/s-secsta_c.cc b/repos/libports/src/lib/ada/runtimelib/s-secsta_c.cc
new file mode 100644
index 0000000000..d9c7829f38
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/s-secsta_c.cc
@@ -0,0 +1,28 @@
+
+#include
+#include
+
+/*
+ * The Mark_Id type defined in libports/src/lib/ada/libsrc/s-secsta.ads
+ * equal to the type defined in GCCs own implementation of s-secsta.ads.
+ * If the implementation used by GCC changes it needs to be changed in
+ * this library as well.
+ */
+
+#if !(__GNUC__ == 6 && __GNUC_MINOR__ == 3)
+ #warning Unsupported compiler version, check s-secsta.ads
+#endif
+
+extern "C" {
+
+ void *get_thread()
+ {
+ return static_cast(Genode::Thread::myself());
+ }
+
+ void *allocate_secondary_stack(void *thread, Genode::size_t size)
+ {
+ return static_cast(thread)->alloc_secondary_stack("ada thread", size);
+ }
+
+}
diff --git a/repos/libports/src/lib/ada/runtimelib/s-soflin.h b/repos/libports/src/lib/ada/runtimelib/s-soflin.h
new file mode 100644
index 0000000000..fec085f916
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/s-soflin.h
@@ -0,0 +1,9 @@
+
+extern "C" {
+
+ void system__soft_links__get_current_excep();
+ void system__soft_links__get_gnat_exception();
+ void system__soft_links__get_jmpbuf_address_soft();
+ void system__soft_links__set_jmpbuf_address_soft();
+
+}
diff --git a/repos/libports/src/lib/ada/runtimelib/s-soflin_c.cc b/repos/libports/src/lib/ada/runtimelib/s-soflin_c.cc
new file mode 100644
index 0000000000..998f008345
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/s-soflin_c.cc
@@ -0,0 +1,26 @@
+
+#include
+
+extern "C" {
+
+ void system__soft_links__get_current_excep()
+ {
+ Genode::warning(__func__, " not implemented");
+ }
+
+ void system__soft_links__get_gnat_exception()
+ {
+ Genode::warning(__func__, " not implemented");
+ }
+
+ void system__soft_links__get_jmpbuf_address_soft()
+ {
+ Genode::warning(__func__, " not implemented");
+ }
+
+ void system__soft_links__set_jmpbuf_address_soft()
+ {
+ Genode::warning(__func__, " not implemented");
+ }
+
+}
diff --git a/repos/libports/src/lib/ada/runtimelib/ss_utils.adb b/repos/libports/src/lib/ada/runtimelib/ss_utils.adb
new file mode 100644
index 0000000000..4f316c070f
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/ss_utils.adb
@@ -0,0 +1,158 @@
+package body Ss_Utils
+ with SPARK_Mode
+is
+
+ procedure Get_Mark (
+ T : Thread;
+ Thread_Registry : in out Registry;
+ E : out Mark
+ )
+ is
+ Thread_Entry : Long_Integer := -1;
+ First_Free_Entry : Long_Integer := -1;
+ begin
+ Search :
+ for E in Thread_Registry'Range loop
+ pragma Loop_Invariant (First_Free_Entry < 128);
+ pragma Loop_Invariant (Thread_Entry < 128);
+ if First_Free_Entry = -1 and then
+ Thread_Registry (E).Id = Invalid_Thread
+ then
+ First_Free_Entry := E;
+ end if;
+
+ if T = Thread_Registry (E).Id then
+ Thread_Entry := E;
+ exit Search;
+ end if;
+ end loop Search;
+
+ if Thread_Entry < 0 then
+ if First_Free_Entry >= 0 then
+ Thread_Registry (First_Free_Entry).Id := T;
+ Thread_Registry (First_Free_Entry).Data :=
+ (Base => System.Null_Address,
+ Top => 0);
+ Thread_Entry := First_Free_Entry;
+ else
+ raise Constraint_Error;
+ end if;
+ end if;
+
+ if Thread_Registry (Thread_Entry).Data.Base = System.Null_Address then
+ Thread_Registry (Thread_Entry).Data :=
+ (Base => Allocate_Stack (T, Secondary_Stack_Size),
+ Top => 0);
+ end if;
+
+ E := Thread_Registry (Thread_Entry).Data;
+ end Get_Mark;
+
+ procedure Set_Mark (
+ T : Thread;
+ M : Mark;
+ Thread_Registry : in out Registry
+ )
+ is
+ Thread_Entry : Long_Integer := -1;
+ begin
+ if T = Invalid_Thread then
+ raise Constraint_Error;
+ end if;
+ if M.Base = System.Null_Address then
+ raise Constraint_Error;
+ end if;
+
+ Search :
+ for E in Thread_Registry'Range loop
+ pragma Loop_Invariant (Thread_Entry < 128);
+ if T = Thread_Registry (E).Id then
+ Thread_Entry := E;
+ exit Search;
+ end if;
+ end loop Search;
+
+ if Thread_Entry < 0 then
+ raise Constraint_Error;
+ end if;
+
+ Thread_Registry (Thread_Entry).Data := M;
+ end Set_Mark;
+
+ function Allocate_Stack (
+ T : Thread;
+ Size : SSE.Storage_Count
+ ) return System.Address
+ is
+ Stack : System.Address;
+ begin
+ if T = Invalid_Thread then
+ raise Constraint_Error;
+ end if;
+ Stack := C_Alloc (T, Size);
+ if Stack = System.Null_Address then
+ raise Storage_Error;
+ end if;
+ return Stack;
+ end Allocate_Stack;
+
+ procedure S_Allocate (
+ Address : out System.Address;
+ Storage_Size : SSE.Storage_Count;
+ Reg : in out Registry;
+ T : Thread
+ )
+ is
+ M : Mark;
+ begin
+ Get_Mark (T, Reg, M);
+ if M.Top < Secondary_Stack_Size and then
+ Storage_Size < Secondary_Stack_Size and then
+ Storage_Size + M.Top < Secondary_Stack_Size
+ then
+ M.Top := M.Top + Storage_Size;
+ Address := M.Base - M.Top;
+ else
+ raise Storage_Error;
+ end if;
+
+ Set_Mark (T, M, Reg);
+ end S_Allocate;
+
+ procedure S_Mark (
+ Stack_Base : out System.Address;
+ Stack_Ptr : out SSE.Storage_Count;
+ Reg : in out Registry;
+ T : Thread
+ )
+ is
+ M : Mark;
+ begin
+ Get_Mark (T, Reg, M);
+
+ Stack_Base := M.Base;
+ Stack_Ptr := M.Top;
+ end S_Mark;
+
+ procedure S_Release (
+ Stack_Base : System.Address;
+ Stack_Ptr : SSE.Storage_Count;
+ Reg : in out Registry;
+ T : Thread
+ )
+ is
+ LM : Mark;
+ begin
+ Get_Mark (T, Reg, LM);
+
+ if Stack_Ptr > LM.Top or Stack_Base /= LM.Base
+ then
+ raise Program_Error;
+ end if;
+
+ LM.Top := Stack_Ptr;
+
+ Set_Mark (T, LM, Reg);
+ end S_Release;
+
+end Ss_Utils;
diff --git a/repos/libports/src/lib/ada/runtimelib/ss_utils.ads b/repos/libports/src/lib/ada/runtimelib/ss_utils.ads
new file mode 100644
index 0000000000..dc8867dc2c
--- /dev/null
+++ b/repos/libports/src/lib/ada/runtimelib/ss_utils.ads
@@ -0,0 +1,107 @@
+with System;
+with System.Storage_Elements;
+use all type System.Address;
+use all type System.Storage_Elements.Storage_Offset;
+
+package Ss_Utils
+ with SPARK_Mode
+is
+
+ package SSE renames System.Storage_Elements;
+
+ type Thread is new System.Address;
+ Invalid_Thread : constant Thread := Thread (System.Null_Address);
+
+ type Mark is
+ record
+ Base : System.Address;
+ Top : SSE.Storage_Count;
+ end record;
+
+ type Registry_Entry is
+ record
+ Id : Thread;
+ Data : Mark;
+ end record;
+
+ type Registry is array (Long_Integer range 0 .. 127) of Registry_Entry;
+
+ Null_Registry : constant Registry := (others =>
+ (Id => Invalid_Thread,
+ Data => (Base => System.Null_Address,
+ Top => 0)));
+
+ Secondary_Stack_Size : constant SSE.Storage_Count := 768 * 1024;
+
+ procedure Get_Mark (
+ T : Thread;
+ Thread_Registry : in out Registry;
+ E : out Mark
+ )
+ with
+ Pre => T /= Invalid_Thread,
+ Post => (E.Base /= System.Null_Address);
+
+ procedure Set_Mark (
+ T : Thread;
+ M : Mark;
+ Thread_Registry : in out Registry
+ )
+ with
+ Pre => (M.Base /= System.Null_Address and
+ T /= Invalid_Thread);
+
+ function Allocate_Stack (
+ T : Thread;
+ Size : SSE.Storage_Count
+ ) return System.Address
+ with
+ Pre => T /= Invalid_Thread,
+ Post => Allocate_Stack'Result /= System.Null_Address;
+
+ procedure S_Allocate (
+ Address : out System.Address;
+ Storage_Size : SSE.Storage_Count;
+ Reg : in out Registry;
+ T : Thread
+ )
+ with
+ Pre => T /= Invalid_Thread;
+
+ procedure S_Mark (
+ Stack_Base : out System.Address;
+ Stack_Ptr : out SSE.Storage_Count;
+ Reg : in out Registry;
+ T : Thread
+ )
+ with
+ Pre => T /= Invalid_Thread;
+
+ procedure S_Release (
+ Stack_Base : System.Address;
+ Stack_Ptr : SSE.Storage_Count;
+ Reg : in out Registry;
+ T : Thread
+ )
+ with
+ Pre => T /= Invalid_Thread;
+
+ function C_Alloc (
+ T : Thread;
+ Size : SSE.Storage_Count
+ ) return System.Address
+ with
+ Import,
+ Convention => C,
+ External_Name => "allocate_secondary_stack",
+ Pre => T /= Invalid_Thread,
+ Post => C_Alloc'Result /= System.Null_Address,
+ Global => null;
+
+ function C_Get_Thread return Thread
+ with
+ Import,
+ Convention => C,
+ External_Name => "get_thread";
+
+end Ss_Utils;