diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-09-05 07:46:06 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-09-05 07:46:06 +0000 |
commit | 51e69f04c0161130375d97979e76cbfd0bd2d45e (patch) | |
tree | a6cb1c584d1988e1b5e855ab100aea15d2e374d2 /gcc/ada/s-taprop-linux.adb | |
parent | 69e0f3d4a84e6e6226f05799ea4789427e996d42 (diff) | |
download | gcc-51e69f04c0161130375d97979e76cbfd0bd2d45e.tar.gz |
* a-calend-mingw.adb: Add call to OS_Primitives.Initialize;
* s-taprop-mingw.adb, s-taprop-vms.adb, s-taprop-solaris.adb,
s-taprop-os2.adb, s-taprop-irix-athread.adb, s-taprop-linux.adb,
s-taprop-hpux-dce.adb, s-taprop-irix.adb, s-taprop-tru64.adb,
s-taprop-lynxos.adb: Move with clauses outside Warnings Off now that
dependent units are Preelaborate.
(Initialize): Call Interrupt_Managemeent.Initialize and
OS_Primitives.Initialize to ensure proper initialization of this unit.
Remove use of System.Soft_Links
Make this unit Preelaborate.
* s-stache.ads, s-taspri-vxworks.ads, s-taspri-mingw.ads,
s-taspri-vms.ads, s-tasinf-solaris.ads, s-taspri-os2.ads,
s-taspri-lynxos.ads, s-taspri-hpux-dce.ads, s-taspri-tru64.ads,
s-tasinf-tru64.ads, s-tasinf-irix.ads, s-tasinf-irix-athread.ads,
s-proinf-irix-athread.adb, s-proinf-irix-athread.ads,
s-tratas.ads, s-tasinf.ads: Minor reformatting.
Add pragma Preelaborate, since these packages are suitable for this
categorization.
Update comments.
* s-traent-vms.ads, s-intman-dummy.adb,
s-taprop-dummy.adb: Make this unit Preelaborate.
* s-osprim-vxworks.adb, s-osprim-vms.adb, s-osprim-vms.ads,
s-osprim-mingw.adb, s-intman-vxworks.ads, s-intman-vxworks.adb,
s-intman-vms.adb, s-intman-mingw.adb, s-intman-vms.ads,
s-osprim-unix.adb, s-osprim-os2.adb, s-osprim-solaris.adb,
s-intman-solaris.adb, s-intman-irix-athread.adb,
s-intman-irix.adb: Mark this unit Preelaborate.
(Initialize): New procedure.
Update comments.
* s-taspri-linux.ads: Removed.
* s-tpopsp-solaris.adb (Initialize): Create the key in this procedure,
as done by other implementations (e.g. posix).
* s-taprop.ads (Timed_Delay): Update spec since the caller now is
responsible for deferring abort.
Mark this unit Preelaborate.
* s-taprob.adb, s-tarest.adb: Call System.Tasking.Initialize to ensure
proper initialization of the tasking run-time.
* s-tasdeb.ads: Mark this unit Preelaborate.
(Known_Tasks): Add explicit default value to avoid elaboration code.
* s-inmaop-vms.adb (Elaboration code): Add call to
Interrupt_Management.Initialize since the elaboration code depends on
proper initialization of this package.
* s-intman.ads, s-inmaop-posix.adb, s-intman-posix.adb,
s-osprim.ads, s-taprop-posix.adb, s-taspri-posix.ads,
s-osprim-posix.adb: Make this unit Preelaborate.
* a-calend.adb: Add call to OS_Primitives.Initialize
* a-elchha.adb: Update use of Except.Id.Full_Name.
Minor reformatting.
Remove use of Ada.Exceptions.Traceback when possible, cleaner.
* a-dynpri.adb, a-sytaco.adb, a-sytaco.ads:
Move with clauses outside Warnings Off now that dependent units are
Preelaborate.
Use raise xxx with "..."; Ada 2005 form.
* a-taside.ads, a-taside.adb:
Remove some dependencies, to make it easier to make this unit truly
Preelaborate.
Rewrite some code to be conformant with Preelaborate rules.
* g-os_lib.adb: Remove non-preelaborate code so that this unit can be
marked Preelaborate in the future.
* s-proinf.ads, g-string.ads, s-auxdec.ads, s-auxdec-vms_64.ads: Make
these units Preelaborate.
* s-exctab.adb: Update use of Except.Id.Full_Name.
* s-soflin.ads, s-soflin.adb: Mark this unit Preelaborate_05.
(Set_Exc_Stack_Addr_Soft, Get_Exc_Stack_Addr_NT, Set_Exc_Stack_Addr_NT,
Set_Exc_Stack_Addr): Removed, no longer used.
Remove reference to *Machine_State_Addr*, no longer needed.
* s-stalib.ads: Mark this unit as Preelaborate[_05].
(Exception_Data): Full_Name is now a System.Address so that this unit
can be made Preelaborate.
Clean up/simplify code thanks to Full_Name being a System.Address.
Remove obsolete pragma Suppress (All_Checks), no longer needed.
* s-taskin.ads, s-taskin.adb:
Move with clauses outside Warnings Off now that dependent units are
Preelaborate.
Make this unit Preelaborate.
(Initialize): New proceduure, replace elaboration code and makes the
set up of the tasking run-time cleaner.
(Detect_Blocking): Now a function instead of a deferred boolean, to
obey Preelaborate rules.
* s-tassta.adb (Finalize_Global_Tasks): Remove Get/Set_Exc_Stack_Addr
soft links, no longer used.
* s-traces.ads, s-traent.ads: Add pragma Preelaborate, since these
packages are suitable for this categorization.
* s-solita.adb: Replace use of Ada.Exception by raise xxx with "..."
since we compile run-time sources in Ada 2005 mode.
(Timed_Delay_T): Call Abort_Defer/Undefer around Timed_Delay, to
avoid having s-taprop*.adb depend on s-soflin and to avoid code
duplication.
Remove reference to *Machine_State_Addr*, no longer needed.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103847 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/s-taprop-linux.adb')
-rw-r--r-- | gcc/ada/s-taprop-linux.adb | 163 |
1 files changed, 43 insertions, 120 deletions
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index d255d7cebea..6cb7eb7e5cb 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -40,44 +40,32 @@ pragma Polling (Off); -- Turn off polling, we do not want ATC polling to take place during -- tasking operations. It causes infinite loops and other problems. -with System.Tasking.Debug; --- used for Known_Tasks - with Interfaces.C; -- used for int -- size_t +with System.Parameters; +-- used for Size_Type + +with System.Tasking.Debug; +-- used for Known_Tasks + with System.Interrupt_Management; -- used for Keep_Unmasked -- Abort_Task_Interrupt -- Interrupt_ID -with System.Parameters; --- used for Size_Type +with System.OS_Primitives; +-- used for Delay_Modes -with System.Tasking; --- used for Ada_Task_Control_Block --- Task_Id +with System.Soft_Links; +-- used for Abort_Defer/Undefer with Ada.Exceptions; -- used for Raise_Exception -- Raise_From_Signal_Handler -- Exception_Id -with System.Soft_Links; --- used for Defer/Undefer_Abort - --- Note that we do not use System.Tasking.Initialization directly since --- this is a higher level package that we shouldn't depend on. For example --- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Stages. - -with System.OS_Primitives; --- used for Delay_Modes - -with System.Soft_Links; --- used for Abort_Defer/Undefer - with Unchecked_Conversion; with Unchecked_Deallocation; @@ -90,8 +78,6 @@ package body System.Task_Primitives.Operations is use System.Parameters; use System.OS_Primitives; - package SSL renames System.Soft_Links; - ---------------- -- Local Data -- ---------------- @@ -111,12 +97,10 @@ package body System.Task_Primitives.Operations is -- A variable to hold Task_Id for the environment task Unblocked_Signal_Mask : aliased sigset_t; - -- The set of signals that should unblocked in all tasks + -- The set of signals that should be unblocked in all tasks -- The followings are internal configuration constants needed - Priority_Ceiling_Emulation : constant Boolean := True; - Next_Serial_Number : Task_Serial_Number := 100; -- We start at 100, to reserve some special values for -- using in error checking. @@ -127,9 +111,6 @@ package body System.Task_Primitives.Operations is Dispatching_Policy : Character; pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy"); - FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F'; - -- Indicates whether FIFO_Within_Priorities is set - -- The following are effectively constants, but they need to -- be initialized by calling a pthread_ function. @@ -280,14 +261,11 @@ package body System.Task_Primitives.Operations is (Prio : System.Any_Priority; L : access Lock) is - Result : Interfaces.C.int; + pragma Unreferenced (Prio); + Result : Interfaces.C.int; begin - if Priority_Ceiling_Emulation then - L.Ceiling := Prio; - end if; - - Result := pthread_mutex_init (L.L'Access, Mutex_Attr'Access); + Result := pthread_mutex_init (L, Mutex_Attr'Access); pragma Assert (Result = 0 or else Result = ENOMEM); @@ -319,7 +297,7 @@ package body System.Task_Primitives.Operations is procedure Finalize_Lock (L : access Lock) is Result : Interfaces.C.int; begin - Result := pthread_mutex_destroy (L.L'Access); + Result := pthread_mutex_destroy (L); pragma Assert (Result = 0); end Finalize_Lock; @@ -336,37 +314,13 @@ package body System.Task_Primitives.Operations is procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is Result : Interfaces.C.int; - begin - if Priority_Ceiling_Emulation then - declare - Self_ID : constant Task_Id := Self; - - begin - if Self_ID.Common.LL.Active_Priority > L.Ceiling then - Ceiling_Violation := True; - return; - end if; - - L.Saved_Priority := Self_ID.Common.LL.Active_Priority; + Result := pthread_mutex_lock (L); + Ceiling_Violation := Result = EINVAL; - if Self_ID.Common.LL.Active_Priority < L.Ceiling then - Self_ID.Common.LL.Active_Priority := L.Ceiling; - end if; - - Result := pthread_mutex_lock (L.L'Access); - pragma Assert (Result = 0); - Ceiling_Violation := False; - end; - - else - Result := pthread_mutex_lock (L.L'Access); - Ceiling_Violation := Result = EINVAL; - - -- Assume the cause of EINVAL is a priority ceiling violation + -- Assume the cause of EINVAL is a priority ceiling violation - pragma Assert (Result = 0 or else Result = EINVAL); - end if; + pragma Assert (Result = 0 or else Result = EINVAL); end Write_Lock; procedure Write_Lock @@ -405,25 +359,9 @@ package body System.Task_Primitives.Operations is procedure Unlock (L : access Lock) is Result : Interfaces.C.int; - begin - if Priority_Ceiling_Emulation then - declare - Self_ID : constant Task_Id := Self; - - begin - Result := pthread_mutex_unlock (L.L'Access); - pragma Assert (Result = 0); - - if Self_ID.Common.LL.Active_Priority > L.Saved_Priority then - Self_ID.Common.LL.Active_Priority := L.Saved_Priority; - end if; - end; - - else - Result := pthread_mutex_unlock (L.L'Access); - pragma Assert (Result = 0); - end if; + Result := pthread_mutex_unlock (L); + pragma Assert (Result = 0); end Unlock; procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is @@ -553,14 +491,8 @@ package body System.Task_Primitives.Operations is Abs_Time : Duration; Request : aliased timespec; Result : Interfaces.C.int; - begin - - -- Only the little window between deferring abort and - -- locking Self_ID is the reason we need to - -- check for pending abort and priority change below! :( - - SSL.Abort_Defer.all; + begin if Single_Lock then Lock_RTS; end if; @@ -611,7 +543,6 @@ package body System.Task_Primitives.Operations is end if; Result := sched_yield; - SSL.Abort_Undefer.all; end Timed_Delay; --------------------- @@ -678,12 +609,6 @@ package body System.Task_Primitives.Operations is begin T.Common.Current_Priority := Prio; - if Priority_Ceiling_Emulation then - if T.Common.LL.Active_Priority < Prio then - T.Common.LL.Active_Priority := Prio; - end if; - end if; - -- Priorities are in range 1 .. 99 on GNU/Linux, so we map -- map 0 .. 31 to 1 .. 32 @@ -693,7 +618,7 @@ package body System.Task_Primitives.Operations is Result := pthread_setschedparam (T.Common.LL.Thread, SCHED_RR, Param'Access); - elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then + elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then Result := pthread_setschedparam (T.Common.LL.Thread, SCHED_FIFO, Param'Access); @@ -1167,6 +1092,26 @@ package body System.Task_Primitives.Operations is begin Environment_Task_Id := Environment_Task; + Interrupt_Management.Initialize; + + -- Prepare the set of signals that should be unblocked in all tasks + + Result := sigemptyset (Unblocked_Signal_Mask'Access); + pragma Assert (Result = 0); + + for J in Interrupt_Management.Interrupt_ID loop + if System.Interrupt_Management.Keep_Unmasked (J) then + Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J)); + pragma Assert (Result = 0); + end if; + end loop; + + Result := pthread_mutexattr_init (Mutex_Attr'Access); + pragma Assert (Result = 0); + + Result := pthread_condattr_init (Cond_Attr'Access); + pragma Assert (Result = 0); + Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); -- Initialize the global RTS lock @@ -1196,26 +1141,4 @@ package body System.Task_Primitives.Operations is end if; end Initialize; -begin - declare - Result : Interfaces.C.int; - begin - -- Prepare the set of signals that should unblocked in all tasks - - Result := sigemptyset (Unblocked_Signal_Mask'Access); - pragma Assert (Result = 0); - - for J in Interrupt_Management.Interrupt_ID loop - if System.Interrupt_Management.Keep_Unmasked (J) then - Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J)); - pragma Assert (Result = 0); - end if; - end loop; - - Result := pthread_mutexattr_init (Mutex_Attr'Access); - pragma Assert (Result = 0); - - Result := pthread_condattr_init (Cond_Attr'Access); - pragma Assert (Result = 0); - end; end System.Task_Primitives.Operations; |