* [Ada] Runtime transition: System.Threads
@ 2021-10-11 13:39 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-10-11 13:39 UTC (permalink / raw)
To: gcc-patches; +Cc: Doug Rupp
[-- Attachment #1: Type: text/plain, Size: 875 bytes --]
Rewrite the former System.Threads implementation for AE653 to work on
the new Light runtime for VxWworks7r2Cert.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* libgnat/s-thread.ads: Fix comments. Remove unused package
imports.
(Thread_Body_Exception_Exit): Remove Exception_Occurrence
parameter.
(ATSD): Declare type locally.
* libgnat/s-thread__ae653.adb: Fix comments. Remove unused
package imports. Remove package references to Stack_Limit
checking.
(Install_Handler): Remove.
(Set_Sec_Stack): Likewise.
(Thread_Body_Enter): Remove calls to Install_Handler and
Stack_Limit checking.
(Thread_Body_Exception_Exit): Remove Exception_Occurrence
parameter.
(Init_RTS): Call local Get_Sec_Stack. Remove call to
Install_Handler. Remove references to accessors for
Get_Sec_Stack and Set_Sec_Stack. Remove OS check.
(Set_Sec_Stack): Remove.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 6060 bytes --]
diff --git a/gcc/ada/libgnat/s-thread.ads b/gcc/ada/libgnat/s-thread.ads
--- a/gcc/ada/libgnat/s-thread.ads
+++ b/gcc/ada/libgnat/s-thread.ads
@@ -34,16 +34,13 @@
-- This package is currently implemented for:
--- VxWorks AE653 rts-cert
--- VxWorks AE653 rts-full (not rts-kernel)
+-- VxWorks7r2Cert Light
-with Ada.Exceptions;
with Ada.Unchecked_Conversion;
with Interfaces.C;
with System.Secondary_Stack;
-with System.Soft_Links;
package System.Threads is
@@ -81,12 +78,15 @@ package System.Threads is
procedure Thread_Body_Leave;
-- Leave thread body (normally), see above for details
- procedure Thread_Body_Exceptional_Exit
- (EO : Ada.Exceptions.Exception_Occurrence);
+ procedure Thread_Body_Exceptional_Exit;
-- Leave thread body (abnormally on exception), see above for details
private
- type ATSD is new System.Soft_Links.TSD;
+ type ATSD is record
+ Sec_Stack_Ptr : SST.SS_Stack_Ptr;
+ -- Pointer of the allocated secondary stack
+
+ end record;
end System.Threads;
diff --git a/gcc/ada/libgnat/s-thread__ae653.adb b/gcc/ada/libgnat/s-thread__ae653.adb
--- a/gcc/ada/libgnat/s-thread__ae653.adb
+++ b/gcc/ada/libgnat/s-thread__ae653.adb
@@ -29,22 +29,19 @@
-- --
------------------------------------------------------------------------------
--- This is the VxWorks 653 version of this package
+-- This is the VxWorks7r2Cert Light version of this package
pragma Restrictions (No_Tasking);
--- The VxWorks 653 version of this package is intended only for programs
--- which do not use Ada tasking. This restriction ensures that this
--- will be checked by the binder.
+-- The VxWorks7r2Cert Light version of this package is intended only
+-- for programs which do not use Ada tasking. This restriction ensures
+-- that this will be checked by the binder.
with System.Storage_Elements; use System.Storage_Elements;
-with System.OS_Versions; use System.OS_Versions;
package body System.Threads is
use Interfaces.C;
- package SSL renames System.Soft_Links;
-
Main_ATSD : aliased ATSD;
-- TSD for environment task
@@ -52,21 +49,7 @@ package body System.Threads is
pragma Thread_Local_Storage (Current_ATSD);
-- pragma TLS needed since TaskVarAdd no longer available
- -- Assume guard pages for Helix APEX partitions, but leave
- -- checking mechanism in for now, in case of surprises. ???
- Stack_Limit : Address;
- pragma Import (C, Stack_Limit, "__gnat_stack_limit");
-
- type Set_Stack_Limit_Proc_Acc is access procedure;
- pragma Convention (C, Set_Stack_Limit_Proc_Acc);
-
- Set_Stack_Limit_Hook : Set_Stack_Limit_Proc_Acc;
- pragma Import (C, Set_Stack_Limit_Hook, "__gnat_set_stack_limit_hook");
- -- Procedure to be called when a task is created to set stack limit if
- -- limit checking is used.
-
-- VxWorks specific API
-
ERROR : constant STATUS := Interfaces.C.int (-1);
OK : constant STATUS := Interfaces.C.int (0);
@@ -85,13 +68,8 @@ package body System.Threads is
-- It installs System.Threads versions of certain operations of the
-- run-time lib.
- procedure Install_Handler;
- pragma Import (C, Install_Handler, "__gnat_install_handler");
-
function Get_Sec_Stack return SST.SS_Stack_Ptr;
- procedure Set_Sec_Stack (Stack : SST.SS_Stack_Ptr);
-
-----------------------
-- Thread_Body_Enter --
-----------------------
@@ -108,27 +86,14 @@ package body System.Threads is
ATSD.Sec_Stack_Ptr := Sec_Stack_Ptr;
SST.SS_Init (ATSD.Sec_Stack_Ptr);
Current_ATSD := Process_ATSD_Address;
- Install_Handler;
-
- -- Assume guard pages for Helix/Vx7, but leave in for now ???
- -- Initialize stack limit if needed.
- if Current_ATSD /= Main_ATSD'Address
- and then Set_Stack_Limit_Hook /= null
- then
- Set_Stack_Limit_Hook.all;
- end if;
end Thread_Body_Enter;
----------------------------------
-- Thread_Body_Exceptional_Exit --
----------------------------------
- procedure Thread_Body_Exceptional_Exit
- (EO : Ada.Exceptions.Exception_Occurrence)
- is
- pragma Unreferenced (EO);
-
+ procedure Thread_Body_Exceptional_Exit is
begin
-- No action for this target
@@ -156,11 +121,8 @@ package body System.Threads is
pragma Assert (Result /= ERROR);
begin
- Main_ATSD.Sec_Stack_Ptr := SSL.Get_Sec_Stack_NT;
+ Main_ATSD.Sec_Stack_Ptr := Get_Sec_Stack;
Current_ATSD := Main_ATSD'Address;
- Install_Handler;
- SSL.Get_Sec_Stack := Get_Sec_Stack'Access;
- SSL.Set_Sec_Stack := Set_Sec_Stack'Access;
end Init_RTS;
-------------------
@@ -190,38 +152,12 @@ package body System.Threads is
Current_ATSD := To_Address (Integer_Address (T));
- -- The same issue applies to the task variable that contains the stack
- -- limit when that overflow checking mechanism is used instead of
- -- probing. If stack checking is enabled and limit checking is used,
- -- allocate the limit for this task. The environment task has this
- -- initialized by the binder-generated main when
- -- System.Stack_Check_Limits = True.
-
- pragma Warnings (Off);
-
- -- OS is a constant
- if OS /= VxWorks_653 and then Set_Stack_Limit_Hook /= null then
- -- Check that this is correct if limit checking left in. ???
- Stack_Limit := To_Address (Integer_Address (T));
- end if;
- pragma Warnings (On);
-
return OK;
end Register;
- -------------------
- -- Set_Sec_Stack --
- -------------------
-
- procedure Set_Sec_Stack (Stack : SST.SS_Stack_Ptr) is
- CTSD : constant ATSD_Access := From_Address (Current_ATSD);
- begin
- pragma Assert (CTSD /= null);
- CTSD.Sec_Stack_Ptr := Stack;
- end Set_Sec_Stack;
-
begin
-- Initialize run-time library
Init_RTS;
+
end System.Threads;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-10-11 13:39 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-10-11 13:39 [Ada] Runtime transition: System.Threads Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).