-- External Configuration Values --
-----------------------------------
- Time_Slice_Val : Interfaces.C.long;
+ Time_Slice_Val : Integer;
pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
Locking_Policy : Character;
pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
Foreign_Task_Elaborated : aliased Boolean := True;
- -- Used to identified fake tasks (i.e., non-Ada Threads).
+ -- Used to identified fake tasks (i.e., non-Ada Threads)
-----------------------
-- Local Subprograms --
procedure Initialize (Environment_Task : Task_Id);
pragma Inline (Initialize);
- -- Initialize various data needed by this package.
+ -- Initialize various data needed by this package
function Is_Valid_Task return Boolean;
pragma Inline (Is_Valid_Task);
procedure Set (Self_Id : Task_Id);
pragma Inline (Set);
- -- Set the self id for the current task.
+ -- Set the self id for the current task
function Self return Task_Id;
pragma Inline (Self);
- -- Return a pointer to the Ada Task Control Block of the calling task.
+ -- Return a pointer to the Ada Task Control Block of the calling task
end Specific;
package body Specific is separate;
- -- The body of this package is target specific.
+ -- The body of this package is target specific
---------------------------------
-- Support for foreign threads --
---------------------------------
function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
- -- Allocate and Initialize a new ATCB for the current Thread.
+ -- Allocate and Initialize a new ATCB for the current Thread
function Register_Foreign_Thread
(Thread : Thread_Id) return Task_Id is separate;
begin
if Proc_Acc.all'Length /= 0 then
+
-- Environment variable is defined
Last_Proc := Num_Procs - 1;
-- If a pragma Time_Slice is specified, takes the value in account
if Time_Slice_Val > 0 then
+
-- Convert Time_Slice_Val (microseconds) into seconds and
-- nanoseconds
- Secs := Time_Slice_Val / 1_000_000;
- Nsecs := (Time_Slice_Val rem 1_000_000) * 1_000;
+ Secs := Interfaces.C.long (Time_Slice_Val / 1_000_000);
+ Nsecs :=
+ Interfaces.C.long ((Time_Slice_Val rem 1_000_000) * 1_000);
-- Otherwise, default to no time slicing (i.e run until blocked)
Nsecs := RT_TQINF;
end if;
- -- Get the real time class id.
+ -- Get the real time class id
Class_Info.pc_clname (1) := 'R';
Class_Info.pc_clname (2) := 'T';
Specific.Set (Environment_Task);
- -- Initialize the lock used to synchronize chain of all ATCBs.
+ -- Initialize the lock used to synchronize chain of all ATCBs
Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
Result : Interfaces.C.int;
-
begin
if not Single_Lock or else Global_Lock then
pragma Assert (Check_Unlock (To_Lock_Ptr (RTS_Lock_Ptr (L))));
procedure Unlock (T : Task_Id) is
Result : Interfaces.C.int;
-
begin
if not Single_Lock then
pragma Assert (Check_Unlock (To_Lock_Ptr (T.Common.LL.L'Access)));
thr_setprio (T.Common.LL.Thread, Interfaces.C.int (Prio));
else
-
-- The task is bound to a LWP, use priocntl
-- ??? TBD
Result : Interfaces.C.int := 0;
begin
- -- Give the task a unique serial number.
+ -- Give the task a unique serial number
Self_ID.Serial_Number := Next_Serial_Number;
Next_Serial_Number := Next_Serial_Number + 1;
pragma Assert (Result = 0 or else Result = EINTR);
end Sleep;
- -- Note that we are relying heaviliy here on the GNAT feature
- -- that Calendar.Time, System.Real_Time.Time, Duration, and
- -- System.Real_Time.Time_Span are all represented in the same
+ -- Note that we are relying heaviliy here on GNAT represting Calendar.Time,
+ -- System.Real_Time.Time, Duration, System.Real_Time.Time_Span in the same
-- way, i.e., as a 64-bit count of nanoseconds.
- -- This allows us to always pass the timeout value as a Duration.
+ -- This allows us to always pass the timeout value as a Duration
-- ???
- -- We are taking liberties here with the semantics of the delays.
- -- That is, we make no distinction between delays on the Calendar clock
- -- and delays on the Real_Time clock. That is technically incorrect, if
- -- the Calendar clock happens to be reset or adjusted.
- -- To solve this defect will require modification to the compiler
- -- interface, so that it can pass through more information, to tell
- -- us here which clock to use!
+ -- We are taking liberties here with the semantics of the delays. That is,
+ -- we make no distinction between delays on the Calendar clock and delays
+ -- on the Real_Time clock. That is technically incorrect, if the Calendar
+ -- clock happens to be reset or adjusted. To solve this defect will require
+ -- modification to the compiler interface, so that it can pass through more
+ -- information, to tell us here which clock to use!
-- cond_timedwait will return if any of the following happens:
-- 1) some other task did cond_signal on this condition variable
-- UNIX calls this an "interrupted" system call.
-- In this case, the return value is EINTR
- -- If the cond_timedwait returns 0 or EINTR, it is still
- -- possible that the time has actually expired, and by chance
- -- a signal or cond_signal occurred at around the same time.
-
- -- We have also observed that on some OS's the value ETIME
- -- will be returned, but the clock will show that the full delay
- -- has not yet expired.
-
- -- For these reasons, we need to check the clock after return
- -- from cond_timedwait. If the time has expired, we will set
- -- Timedout = True.
-
- -- This check might be omitted for systems on which the
- -- cond_timedwait() never returns early or wakes up spuriously.
-
- -- Annex D requires that completion of a delay cause the task
- -- to go to the end of its priority queue, regardless of whether
- -- the task actually was suspended by the delay. Since
- -- cond_timedwait does not do this on Solaris, we add a call
- -- to thr_yield at the end. We might do this at the beginning,
- -- instead, but then the round-robin effect would not be the
- -- same; the delayed task would be ahead of other tasks of the
- -- same priority that awoke while it was sleeping.
-
- -- For Timed_Sleep, we are expecting possible cond_signals
- -- to indicate other events (e.g., completion of a RV or
- -- completion of the abortable part of an async. select),
- -- we want to always return if interrupted. The caller will
- -- be responsible for checking the task state to see whether
- -- the wakeup was spurious, and to go back to sleep again
- -- in that case. We don't need to check for pending abort
- -- or priority change on the way in our out; that is the
- -- caller's responsibility.
-
- -- For Timed_Delay, we are not expecting any cond_signals or
- -- other interruptions, except for priority changes and aborts.
- -- Therefore, we don't want to return unless the delay has
- -- actually expired, or the call has been aborted. In this
- -- case, since we want to implement the entire delay statement
- -- semantics, we do need to check for pending abort and priority
- -- changes. We can quietly handle priority changes inside the
+ -- If the cond_timedwait returns 0 or EINTR, it is still possible that the
+ -- time has actually expired, and by chance a signal or cond_signal
+ -- occurred at around the same time.
+
+ -- We have also observed that on some OS's the value ETIME will be
+ -- returned, but the clock will show that the full delay has not yet
+ -- expired.
+
+ -- For these reasons, we need to check the clock after return from
+ -- cond_timedwait. If the time has expired, we will set Timedout = True.
+
+ -- This check might be omitted for systems on which the cond_timedwait()
+ -- never returns early or wakes up spuriously.
+
+ -- Annex D requires that completion of a delay cause the task to go to the
+ -- end of its priority queue, regardless of whether the task actually was
+ -- suspended by the delay. Since cond_timedwait does not do this on
+ -- Solaris, we add a call to thr_yield at the end. We might do this at the
+ -- beginning, instead, but then the round-robin effect would not be the
+ -- same; the delayed task would be ahead of other tasks of the same
+ -- priority that awoke while it was sleeping.
+
+ -- For Timed_Sleep, we are expecting possible cond_signals to indicate
+ -- other events (e.g., completion of a RV or completion of the abortable
+ -- part of an async. select), we want to always return if interrupted. The
+ -- caller will be responsible for checking the task state to see whether
+ -- the wakeup was spurious, and to go back to sleep again in that case. We
+ -- don't need to check for pending abort or priority change on the way in
+ -- our out; that is the caller's responsibility.
+
+ -- For Timed_Delay, we are not expecting any cond_signals or other
+ -- interruptions, except for priority changes and aborts. Therefore, we
+ -- don't want to return unless the delay has actually expired, or the call
+ -- has been aborted. In this case, since we want to implement the entire
+ -- delay statement semantics, we do need to check for pending abort and
+ -- priority changes. We can quietly handle priority changes inside the
-- procedure, since there is no entry-queue reordering involved.
-----------------
-----------------
procedure Timed_Delay
- (Self_ID : Task_Id;
- Time : Duration;
- Mode : ST.Delay_Modes)
+ (Self_ID : Task_Id;
+ Time : Duration;
+ Mode : ST.Delay_Modes)
is
Check_Time : constant Duration := Monotonic_Clock;
Abs_Time : Duration;
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
if Single_Lock then
- Result := cond_timedwait (Self_ID.Common.LL.CV'Access,
- Single_RTS_Lock.L'Access, Request'Access);
+ Result := cond_timedwait
+ (Self_ID.Common.LL.CV'Access,
+ Single_RTS_Lock.L'Access,
+ Request'Access);
else
- Result := cond_timedwait (Self_ID.Common.LL.CV'Access,
- Self_ID.Common.LL.L.L'Access, Request'Access);
+ Result := cond_timedwait
+ (Self_ID.Common.LL.CV'Access,
+ Self_ID.Common.LL.L.L'Access,
+ Request'Access);
end if;
Yielded := True;
function Check_Exit (Self_ID : Task_Id) return Boolean is
begin
- -- Check that caller is just holding Global_Task_Lock
- -- and no other locks
+ -- Check that caller is just holding Global_Task_Lock and no other locks
if Self_ID.Common.LL.Locks = null then
return False;
projects / thirdparty / gcc.git / commitdiff
