mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-22 18:50:55 +08:00
s-taprop-solaris.adb: (Time_Slice_Val): Change type to Integer.
2006-10-31 Eric Botcazou <ebotcazou@adacore.com> * s-taprop-solaris.adb: (Time_Slice_Val): Change type to Integer. (Initialize): Add type conversions required by above change. From-SVN: r118238
This commit is contained in:
Eric Botcazou
Arnaud Charlet
parent
f95969eabc
commit
8dbb621ea2
@ -141,7 +141,7 @@ package body System.Task_Primitives.Operations is
|
||||
-- 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;
|
||||
@ -151,7 +151,7 @@ package body System.Task_Primitives.Operations is
|
||||
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 --
|
||||
@ -216,7 +216,7 @@ package body System.Task_Primitives.Operations is
|
||||
|
||||
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);
|
||||
@ -224,23 +224,23 @@ package body System.Task_Primitives.Operations is
|
||||
|
||||
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;
|
||||
@ -353,6 +353,7 @@ package body System.Task_Primitives.Operations is
|
||||
|
||||
begin
|
||||
if Proc_Acc.all'Length /= 0 then
|
||||
|
||||
-- Environment variable is defined
|
||||
|
||||
Last_Proc := Num_Procs - 1;
|
||||
@ -438,11 +439,13 @@ package body System.Task_Primitives.Operations is
|
||||
-- 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)
|
||||
|
||||
@ -451,7 +454,7 @@ package body System.Task_Primitives.Operations is
|
||||
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';
|
||||
@ -482,7 +485,7 @@ package body System.Task_Primitives.Operations is
|
||||
|
||||
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);
|
||||
|
||||
@ -699,7 +702,6 @@ package body System.Task_Primitives.Operations is
|
||||
|
||||
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))));
|
||||
@ -710,7 +712,6 @@ package body System.Task_Primitives.Operations is
|
||||
|
||||
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)));
|
||||
@ -820,7 +821,6 @@ package body System.Task_Primitives.Operations is
|
||||
thr_setprio (T.Common.LL.Thread, Interfaces.C.int (Prio));
|
||||
|
||||
else
|
||||
|
||||
-- The task is bound to a LWP, use priocntl
|
||||
-- ??? TBD
|
||||
|
||||
@ -942,7 +942,7 @@ package body System.Task_Primitives.Operations is
|
||||
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;
|
||||
@ -1132,21 +1132,19 @@ package body System.Task_Primitives.Operations is
|
||||
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
|
||||
@ -1161,47 +1159,42 @@ package body System.Task_Primitives.Operations is
|
||||
-- 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.
|
||||
-- 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.
|
||||
-- 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.
|
||||
-- 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.
|
||||
-- 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.
|
||||
-- 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_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
|
||||
-- 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.
|
||||
|
||||
-----------------
|
||||
@ -1273,9 +1266,9 @@ package body System.Task_Primitives.Operations is
|
||||
-----------------
|
||||
|
||||
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;
|
||||
@ -1313,11 +1306,15 @@ package body System.Task_Primitives.Operations is
|
||||
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;
|
||||
@ -1824,8 +1821,7 @@ package body System.Task_Primitives.Operations is
|
||||
|
||||
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;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user