Skip to content

R
riscv-gcc-1
Commit dc97c7a8 by Arnaud Charlet
Options

s-taprop-irix.adb, [...] (Create_Task): Do not attempt to set task priority or… 

s-taprop-irix.adb, [...] (Create_Task): Do not attempt to set task priority or task info if the thread could not be created.

2008-03-26  Arnaud Charlet  <charlet@adacore.com>

	* s-taprop-irix.adb, s-taprop-tru64.adb, s-taprop-lynxos.adb, 
	s-taprop-linux.adb, s-taprop-mingw.adb, s-taprop-vxworks.adb, 
	s-taprop-posix.adb (Create_Task): Do not attempt to set task priority
	or task info if the thread could not be created.

From-SVN: r133547
parent 366b8af7
Showing with 115 additions and 195 deletions
gcc/ada/s-taprop-irix.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -33,44 +33,30 @@
-- This is a IRIX (pthread library) version of this package
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
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.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Interfaces.C;
-- used for int
-- size_t
with System.Task_Info;
with System.Tasking.Debug;
-- used for Known_Tasks
with System.Interrupt_Management;
-- used for Keep_Unmasked
-- Abort_Task_Interrupt
-- Interrupt_ID
with System.OS_Primitives;
-- used for Delay_Modes
with System.IO;
-- used for Put_Line
with System.Soft_Links;
-- used for Abort_Defer/Undefer
-- We use System.Soft_Links instead of System.Tasking.Initialization
-- because the later 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 Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
......@@ -920,13 +906,16 @@ package body System.Task_Primitives.Operations is
Succeeded := Result = 0;
-- The following needs significant commenting ???
if Succeeded then
if T.Common.Task_Info /= null then
T.Common.Base_Priority := T.Common.Task_Info.Priority;
Set_Priority (T, T.Common.Task_Info.Priority);
else
Set_Priority (T, Priority);
-- The following needs significant commenting ???
if T.Common.Task_Info /= null then
T.Common.Base_Priority := T.Common.Task_Info.Priority;
Set_Priority (T, T.Common.Task_Info.Priority);
else
Set_Priority (T, Priority);
end if;
end if;
Result := pthread_attr_destroy (Attributes'Access);
......
gcc/ada/s-taprop-linux.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -33,51 +33,31 @@
-- This is a GNU/Linux (GNU/LinuxThreads) version of this package
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
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.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Interfaces.C;
-- used for int
-- size_t
with System.Task_Info;
-- used for Unspecified_Task_Info
with System.Tasking.Debug;
-- used for Known_Tasks
with System.Interrupt_Management;
-- used for Keep_Unmasked
-- Abort_Task_Interrupt
-- Interrupt_ID
with System.OS_Primitives;
-- used for Delay_Modes
with System.Storage_Elements;
with System.Stack_Checking.Operations;
with System.Soft_Links;
-- used for Abort_Defer/Undefer
-- We use System.Soft_Links instead of System.Tasking.Initialization
-- because the later 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.Storage_Elements;
with System.Stack_Checking.Operations;
-- Used for Invalidate_Stack_Cache and Notify_Stack_Attributes;
with Ada.Exceptions;
-- used for Raise_Exception
-- Raise_From_Signal_Handler
-- Exception_Id
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
......@@ -273,12 +253,11 @@ package body System.Task_Primitives.Operations is
-- Initialize_Lock --
---------------------
-- Note: mutexes and cond_variables needed per-task basis are
-- initialized in Initialize_TCB and the Storage_Error is
-- handled. Other mutexes (such as RTS_Lock, Memory_Lock...)
-- used in RTS is initialized before any status change of RTS.
-- Therefore rasing Storage_Error in the following routines
-- should be able to be handled safely.
-- Note: mutexes and cond_variables needed per-task basis are initialized
-- in Initialize_TCB and the Storage_Error is handled. Other mutexes (such
-- as RTS_Lock, Memory_Lock...) used in RTS is initialized before any
-- status change of RTS. Therefore rasing Storage_Error in the following
-- routines should be able to be handled safely.
procedure Initialize_Lock
(Prio : System.Any_Priority;
......@@ -294,8 +273,7 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0 or else Result = ENOMEM);
if Result = ENOMEM then
Ada.Exceptions.Raise_Exception (Storage_Error'Identity,
"Failed to allocate a lock");
raise Storage_Error with "Failed to allocate a lock";
end if;
end Initialize_Lock;
......@@ -920,7 +898,14 @@ package body System.Task_Primitives.Operations is
To_Address (T));
pragma Assert (Result = 0 or else Result = EAGAIN);
Succeeded := Result = 0;
if Result /= 0 then
Succeeded := False;
Result := pthread_attr_destroy (Attributes'Access);
pragma Assert (Result = 0);
return;
end if;
Succeeded := True;
-- Handle Task_Info
......
gcc/ada/s-taprop-lynxos.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,44 +31,31 @@
-- --
------------------------------------------------------------------------------
-- This is a LynxOS version of this file, adapted to make
-- SCHED_FIFO and ceiling locking (Annex D compliance) work properly
-- This is a LynxOS version of this file, adapted to make SCHED_FIFO and
-- ceiling locking (Annex D compliance) work properly.
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
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.
-- 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 Ada.Unchecked_Deallocation;
with System.Interrupt_Management;
-- used for Keep_Unmasked
-- Abort_Task_Interrupt
-- Interrupt_ID
with Interfaces.C;
with System.Tasking.Debug;
with System.Interrupt_Management;
with System.OS_Primitives;
-- used for Delay_Modes
with System.Task_Info;
-- used for Task_Info_Type
with Interfaces.C;
-- used for int
-- size_t
with System.Soft_Links;
-- used for Abort_Defer/Undefer
-- We use System.Soft_Links instead of System.Tasking.Initialization
-- because the later 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 Ada.Unchecked_Deallocation;
package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
......@@ -996,7 +983,9 @@ package body System.Task_Primitives.Operations is
Result := pthread_attr_destroy (Attributes'Access);
pragma Assert (Result = 0);
Set_Priority (T, Priority);
if Succeeded then
Set_Priority (T, Priority);
end if;
end Create_Task;
------------------
......
gcc/ada/s-taprop-mingw.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -33,42 +33,29 @@
-- This is a NT (native) version of this package
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
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.
-- 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 System.OS_Primitives;
-- used for Delay_Modes
with Ada.Unchecked_Deallocation;
with Interfaces.C;
-- used for int
-- size_t
with Interfaces.C.Strings;
-- used for Null_Ptr
with System.Tasking.Debug;
with System.OS_Primitives;
with System.Task_Info;
-- used for Unspecified_Task_Info
with System.Interrupt_Management;
-- used for Initialize
with System.Soft_Links;
-- used for Abort_Defer/Undefer
-- We use System.Soft_Links instead of System.Tasking.Initialization because
-- the later 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 Ada.Unchecked_Deallocation;
package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
......@@ -913,7 +900,8 @@ package body System.Task_Primitives.Operations is
-- Step 1: Create the thread in blocked mode
if hTask = 0 then
raise Storage_Error;
Succeeded := False;
return;
end if;
-- Step 2: set its TCB
......
gcc/ada/s-taprop-posix.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -33,48 +33,35 @@
-- This is a POSIX-like version of this package
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
-- Note: this file can only be used for POSIX compliant systems that
-- implement SCHED_FIFO and Ceiling Locking correctly.
-- Note: this file can only be used for POSIX compliant systems that implement
-- SCHED_FIFO and Ceiling Locking correctly.
-- For configurations where SCHED_FIFO and priority ceiling are not a
-- requirement, this file can also be used (e.g AiX threads)
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.
-- 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 Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with System.Interrupt_Management;
-- used for Keep_Unmasked
-- Abort_Task_Interrupt
-- Interrupt_ID
with Interfaces.C;
with System.Tasking.Debug;
with System.Interrupt_Management;
with System.OS_Primitives;
-- used for Delay_Modes
with System.Task_Info;
-- used for Task_Info_Type
with Interfaces.C;
-- used for int
-- size_t
with System.Soft_Links;
-- used for Abort_Defer/Undefer
-- We use System.Soft_Links instead of System.Tasking.Initialization
-- because the later 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 Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
......@@ -1013,7 +1000,9 @@ package body System.Task_Primitives.Operations is
Result := pthread_attr_destroy (Attributes'Access);
pragma Assert (Result = 0);
Set_Priority (T, Priority);
if Succeeded then
Set_Priority (T, Priority);
end if;
end Create_Task;
------------------
......
gcc/ada/s-taprop-tru64.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,46 +31,31 @@
-- --
------------------------------------------------------------------------------
-- This is a DEC Unix 4.0d version of this package
-- This is a Tru64 version of this package
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
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.
-- 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 Ada.Unchecked_Deallocation;
with System.Interrupt_Management;
-- used for Keep_Unmasked
-- Abort_Task_Interrupt
-- Interrupt_ID
with Interfaces;
with Interfaces.C;
with System.Tasking.Debug;
with System.Interrupt_Management;
with System.OS_Primitives;
-- used for Delay_Modes
with System.Task_Info;
-- used for Task_Info_Type
with Interfaces;
-- used for Shift_Left
with Interfaces.C;
-- used for int
-- size_t
with System.Soft_Links;
-- used for Abort_Defer/Undefer
-- We use System.Soft_Links instead of System.Tasking.Initialization
-- because the later 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 Ada.Unchecked_Deallocation;
package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
......@@ -948,7 +933,7 @@ package body System.Task_Primitives.Operations is
Result := pthread_attr_destroy (Attributes'Access);
pragma Assert (Result = 0);
if T.Common.Task_Info /= null then
if Succeeded and then T.Common.Task_Info /= null then
-- ??? We're using a process-wide function to implement a task
-- specific characteristic.
......
gcc/ada/s-taprop-vxworks.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -33,35 +33,27 @@
-- This is the VxWorks version of this package
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
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.
-- 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 System.Interrupt_Management;
-- used for Keep_Unmasked
-- Abort_Task_Interrupt
-- Signal_ID
-- Initialize_Interrupts
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Interfaces.C;
with System.Soft_Links;
-- used for Abort_Defer/Undefer
with System.Tasking.Debug;
with System.Interrupt_Management;
with System.Soft_Links;
-- We use System.Soft_Links instead of System.Tasking.Initialization
-- because the later is a higher level package that we shouldn't depend on.
-- For example when using the restricted run time, it is replaced by
-- because the later 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 Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
......@@ -754,9 +746,9 @@ package body System.Task_Primitives.Operations is
pragma Atomic_Components (Prio_Array_Type);
Prio_Array : Prio_Array_Type;
-- Global array containing the id of the currently running task for
-- each priority. Note that we assume that we are on a single processor
-- with run-till-blocked scheduling.
-- Global array containing the id of the currently running task for each
-- priority. Note that we assume that we are on a single processor with
-- run-till-blocked scheduling.
procedure Set_Priority
(T : Task_Id;
......@@ -776,7 +768,7 @@ package body System.Task_Primitives.Operations is
and then Loss_Of_Inheritance
and then Prio < T.Common.Current_Priority
then
-- Annex D requirement (RM D.2.2(9))
-- Annex D requirement (RM D.2.2(9)):
-- If the task drops its priority due to the loss of inherited
-- priority, it is added at the head of the ready queue for its
......@@ -852,7 +844,8 @@ package body System.Task_Primitives.Operations is
Unlock_RTS;
-- If stack checking is enabled set the stack limit for this task.
-- If stack checking is enabled, set the stack limit for this task
if Set_Stack_Limit_Hook /= null then
Set_Stack_Limit_Hook.all;
end if;
......@@ -985,10 +978,9 @@ package body System.Task_Primitives.Operations is
Succeeded := False;
else
Succeeded := True;
Task_Creation_Hook (T.Common.LL.Thread);
Set_Priority (T, Priority);
end if;
Task_Creation_Hook (T.Common.LL.Thread);
Set_Priority (T, Priority);
end Create_Task;
------------------
......@@ -1077,6 +1069,9 @@ package body System.Task_Primitives.Operations is
--------------
procedure Finalize (S : in out Suspension_Object) is
pragma Unmodified (S);
-- S may be modified on other targets, but not on VxWorks
Result : STATUS;
begin
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment