-- --
-- 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- --
-- 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;
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);
-- --
-- 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- --
-- 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;
-- 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;
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;
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
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
------------------
-- --
-- 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- --
-- 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;
-- 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
-- --
-- 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- --
-- 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;
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;
------------------
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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.
-- --
-- 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- --
-- 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;
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;
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
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;
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;
------------------
--------------
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
OSDN Git Service
