Skip to content

R
riscv-gcc-1
Commit 196b1993 by Arnaud Charlet
Options

[multiple changes] 

2009-11-30  Robert Dewar  <dewar@adacore.com>

	* osint.ads, prj.adb, prj.ads: Minor reformatting
	* s-stchop.adb, s-taprop-vxworks.adb, s-taprop-tru64.adb,
	s-taprop-vms.adb, s-taprop-linux.adb, s-taprop-solaris.adb,
	s-strxdr.adb, s-taprop-irix.adb,
	s-osinte-hpux-dce.adb, s-osinte-tru64.adb, s-taenca.adb,
	s-taprop-hpux-dce.adb, s-stausa.adb, s-taprop-posix.adb: Minor code
	reorganization (use conditional expressions).

2009-11-30  Bob Duff  <duff@adacore.com>

	* g-sttsne-locking.adb (Copy_Service_Entry): Complete previous change.

From-SVN: r154779
parent ffab1d07
Showing with 270 additions and 381 deletions
gcc/ada/ChangeLog
2009-11-30 Robert Dewar <dewar@adacore.com>
* osint.ads, prj.adb, prj.ads: Minor reformatting
* s-stchop.adb, s-taprop-vxworks.adb, s-taprop-tru64.adb,
s-taprop-vms.adb, s-taprop-linux.adb, s-taprop-solaris.adb,
s-strxdr.adb, s-taprop-irix.adb, s-osinte-hpux-dce.adb,
s-osinte-tru64.adb, s-taenca.adb, s-taprop-hpux-dce.adb, s-stausa.adb,
s-taprop-posix.adb: Minor code reorganization (use conditional
expressions).
2009-11-30 Bob Duff <duff@adacore.com>
* g-sttsne-locking.adb (Copy_Service_Entry): Complete previous change.
2009-11-30 Bob Duff <duff@adacore.com>
* socket.c: Add more accessor functions for struct servent (need
......
gcc/ada/g-sttsne-locking.adb
......@@ -57,8 +57,8 @@ package body GNAT.Sockets.Thin.Task_Safe_NetDB is
-- is too small for the associated data).
procedure Copy_Service_Entry
(Source_Servent : Servent;
Target_Servent : out Servent;
(Source_Servent : Servent_Access;
Target_Servent : Servent_Access;
Target_Buffer : System.Address;
Target_Buffer_Length : C.int;
Result : out C.int);
......@@ -194,8 +194,8 @@ package body GNAT.Sockets.Thin.Task_Safe_NetDB is
------------------------
procedure Copy_Service_Entry
(Source_Servent : Servent;
Target_Servent : out Servent;
(Source_Servent : Servent_Access;
Target_Servent : Servent_Access;
Target_Buffer : System.Address;
Target_Buffer_Length : C.int;
Result : out C.int)
......@@ -383,11 +383,14 @@ package body GNAT.Sockets.Thin.Task_Safe_NetDB is
goto Unlock_Return;
end if;
-- Now copy the data to the user-provided buffer
-- Now copy the data to the user-provided buffer. We convert Ret to
-- type Servent_Access using the .all'Unchecked_Access trick to avoid
-- an accessibility check. Ret could be pointing to a nested variable,
-- and we don't want to raise an exception in that case.
Copy_Service_Entry
(Source_Servent => SE.all,
Target_Servent => Ret.all,
(Source_Servent => SE,
Target_Servent => Ret.all'Unchecked_Access,
Target_Buffer => Buf,
Target_Buffer_Length => Buflen,
Result => Result);
......@@ -420,11 +423,12 @@ package body GNAT.Sockets.Thin.Task_Safe_NetDB is
goto Unlock_Return;
end if;
-- Now copy the data to the user-provided buffer
-- Now copy the data to the user-provided buffer. See Safe_Getservbyname
-- for comment regarding .all'Unchecked_Access.
Copy_Service_Entry
(Source_Servent => SE.all,
Target_Servent => Ret.all,
(Source_Servent => SE,
Target_Servent => Ret.all'Unchecked_Access,
Target_Buffer => Buf,
Target_Buffer_Length => Buflen,
Result => Result);
......
gcc/ada/osint.ads
......@@ -207,10 +207,9 @@ package Osint is
function To_Host_Dir_Spec
(Canonical_Dir : String;
Prefix_Style : Boolean) return String_Access;
-- Convert a canonical syntax directory specification to host syntax.
-- The Prefix_Style flag is currently ignored but should be set to
-- False.
-- Caller must free result
-- Convert a canonical syntax directory specification to host syntax. The
-- Prefix_Style flag is currently ignored but should be set to False.
-- Note that the caller must free result.
function To_Host_File_Spec
(Canonical_File : String) return String_Access;
......
gcc/ada/prj.adb
......@@ -1215,15 +1215,19 @@ package body Prj is
------------
function Length
(Table : Name_List_Table.Instance; List : Name_List_Index) return Natural
(Table : Name_List_Table.Instance;
List : Name_List_Index) return Natural
is
Count : Natural := 0;
Tmp : Name_List_Index := List;
Tmp : Name_List_Index;
begin
Tmp := List;
while Tmp /= No_Name_List loop
Count := Count + 1;
Tmp := Table.Table (Tmp).Next;
end loop;
return Count;
end Length;
......
gcc/ada/prj.ads
......@@ -317,8 +317,9 @@ package Prj is
-- The table for lists of names
function Length
(Table : Name_List_Table.Instance; List : Name_List_Index) return Natural;
-- Return the number of elements in that list
(Table : Name_List_Table.Instance;
List : Name_List_Index) return Natural;
-- Return the number of elements in specified list
type Number_List_Index is new Nat;
No_Number_List : constant Number_List_Index := 0;
......
gcc/ada/s-osinte-hpux-dce.adb
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, AdaCore --
-- Copyright (C) 1995-2009, AdaCore --
-- --
-- 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- --
......@@ -314,11 +314,7 @@ package body System.OS_Interface is
begin
if pthread_cond_timedwait_base (cond, mutex, abstime) /= 0 then
if errno = EAGAIN then
return ETIMEDOUT;
else
return errno;
end if;
return (if errno = EAGAIN then ETIMEDOUT else errno);
else
return 0;
end if;
......
gcc/ada/s-osinte-tru64.adb
......@@ -99,11 +99,10 @@ package body System.OS_Interface is
-- Stick a guard page right above the Yellow Zone if it exists
if Teb.all.stack_yellow /= Teb.all.stack_guard then
if Hide then
Res := mprotect (Teb.all.stack_yellow, Get_Page_Size, PROT_ON);
else
Res := mprotect (Teb.all.stack_yellow, Get_Page_Size, PROT_OFF);
end if;
Res :=
mprotect
(Teb.all.stack_yellow, Get_Page_Size,
prot => (if Res then PROT_ON else PROT_OFF));
end if;
end Hide_Unhide_Yellow_Zone;
......
gcc/ada/s-stausa.adb
......@@ -609,20 +609,18 @@ package body System.Stack_Usage is
-- Take either the label size or the number image size for the
-- size of the column "Stack Size".
if Size_Str_Len > Stack_Size_Str'Length then
Max_Stack_Size_Len := Size_Str_Len;
else
Max_Stack_Size_Len := Stack_Size_Str'Length;
end if;
Max_Stack_Size_Len :=
(if Size_Str_Len > Stack_Size_Str'Length
then Size_Str_Len
else Stack_Size_Str'Length);
-- Take either the label size or the number image size for the
-- size of the column "Stack Usage"
-- size of the column "Stack Usage".
if Result_Str_Len > Actual_Size_Str'Length then
Max_Actual_Use_Len := Result_Str_Len;
else
Max_Actual_Use_Len := Actual_Size_Str'Length;
end if;
Max_Actual_Use_Len :=
(if Result_Str_Len > Actual_Size_Str'Length
then Result_Str_Len
else Actual_Size_Str'Length);
Output_Result
(Analyzer.Result_Id,
......
gcc/ada/s-stchop.adb
......@@ -149,11 +149,9 @@ package body System.Stack_Checking.Operations is
-- If a stack base address has been registered, honor it. Fallback to
-- the address of a local object otherwise.
if My_Stack.Limit /= System.Null_Address then
My_Stack.Base := My_Stack.Limit;
else
My_Stack.Base := Frame_Address;
end if;
My_Stack.Base :=
(if My_Stack.Limit /= System.Null_Address
then My_Stack.Limit else Frame_Address);
if Stack_Grows_Down then
......
gcc/ada/s-strxdr.adb
......@@ -1263,11 +1263,9 @@ package body System.Stream_Attributes is
else
-- Test sign and apply two complement notation
if Item < 0 then
U := XDR_U'Last xor XDR_U (-(Item + 1));
else
U := XDR_U (Item);
end if;
U := (if Item < 0
then XDR_U'Last xor XDR_U (-(Item + 1))
else XDR_U (Item));
for N in reverse S'Range loop
S (N) := SE (U mod BB);
......@@ -1386,8 +1384,7 @@ package body System.Stream_Attributes is
X := Long_Unsigned (Item);
end if;
-- Compute using machine unsigned
-- rather than long_unsigned.
-- Compute using machine unsigned rather than long_unsigned
for N in reverse S'Range loop
......@@ -1530,8 +1527,7 @@ package body System.Stream_Attributes is
X := Long_Long_Unsigned (Item);
end if;
-- Compute using machine unsigned
-- rather than long_long_unsigned.
-- Compute using machine unsigned rather than long_long_unsigned
for N in reverse S'Range loop
......@@ -1571,8 +1567,7 @@ package body System.Stream_Attributes is
S := Long_Long_Unsigned_To_XDR_S_LLU (Item);
else
-- Compute using machine unsigned
-- rather than long_long_unsigned.
-- Compute using machine unsigned rather than long_long_unsigned
for N in reverse S'Range loop
......@@ -1609,8 +1604,7 @@ package body System.Stream_Attributes is
S := Long_Long_Unsigned_To_XDR_S_LU (Long_Long_Unsigned (Item));
else
-- Compute using machine unsigned
-- rather than long_unsigned.
-- Compute using machine unsigned rather than long_unsigned
for N in reverse S'Range loop
......@@ -1729,11 +1723,9 @@ package body System.Stream_Attributes is
else
-- Test sign and apply two complement's notation
if Item < 0 then
U := XDR_SU'Last xor XDR_SU (-(Item + 1));
else
U := XDR_SU (Item);
end if;
U := (if Item < 0
then XDR_SU'Last xor XDR_SU (-(Item + 1))
else XDR_SU (Item));
for N in reverse S'Range loop
S (N) := SE (U mod BB);
......@@ -1766,11 +1758,9 @@ package body System.Stream_Attributes is
else
-- Test sign and apply two complement's notation
if Item < 0 then
U := XDR_SSU'Last xor XDR_SSU (-(Item + 1));
else
U := XDR_SSU (Item);
end if;
U := (if Item < 0
then XDR_SSU'Last xor XDR_SSU (-(Item + 1))
else XDR_SSU (Item));
S (1) := SE (U);
end if;
......
gcc/ada/s-taenca.adb
......@@ -165,13 +165,8 @@ package body System.Tasking.Entry_Calls is
and then Entry_Call.State = Now_Abortable
then
Queuing.Dequeue_Call (Entry_Call);
if Entry_Call.Cancellation_Attempted then
Entry_Call.State := Cancelled;
else
Entry_Call.State := Done;
end if;
Entry_Call.State :=
(if Entry_Call.Cancellation_Attempted then Cancelled else Done);
Unlock_And_Update_Server (Self_ID, Entry_Call);
else
......
gcc/ada/s-taprop-hpux-dce.adb
......@@ -411,16 +411,14 @@ package body System.Task_Primitives.Operations is
pragma Unreferenced (Reason);
Result : Interfaces.C.int;
begin
if Single_Lock then
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access);
else
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
end if;
Result :=
pthread_cond_wait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access));
-- EINTR is not considered a failure
......@@ -450,11 +448,10 @@ package body System.Task_Primitives.Operations is
Timedout := True;
Yielded := False;
if Mode = Relative then
Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
else
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
end if;
Abs_Time :=
(if Mode = Relative
then Duration'Min (Time, Max_Sensible_Delay) + Check_Time
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
......@@ -462,20 +459,13 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
if Single_Lock then
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Single_RTS_Lock'Access,
Request'Access);
else
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Self_ID.Common.LL.L'Access,
Request'Access);
end if;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
exit when Abs_Time <= Monotonic_Clock;
......@@ -515,11 +505,10 @@ package body System.Task_Primitives.Operations is
Write_Lock (Self_ID);
if Mode = Relative then
Abs_Time := Time + Check_Time;
else
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
end if;
Abs_Time :=
(if Mode = Relative
then Time + Check_Time
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
......@@ -528,19 +517,13 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
if Single_Lock then
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Single_RTS_Lock'Access,
Request'Access);
else
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Self_ID.Common.LL.L'Access,
Request'Access);
end if;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
exit when Abs_Time <= Monotonic_Clock;
......
gcc/ada/s-taprop-irix.adb
......@@ -430,15 +430,12 @@ package body System.Task_Primitives.Operations is
Result : Interfaces.C.int;
begin
if Single_Lock then
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access);
else
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
end if;
Result :=
pthread_cond_wait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access));
-- EINTR is not considered a failure
......@@ -469,11 +466,10 @@ package body System.Task_Primitives.Operations is
Timedout := True;
Yielded := False;
if Mode = Relative then
Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
else
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
end if;
Abs_Time :=
(if Mode = Relative
then Duration'Min (Time, Max_Sensible_Delay) + Check_Time
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
......@@ -481,18 +477,13 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
if Single_Lock then
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access,
Request'Access);
else
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access,
Request'Access);
end if;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
......@@ -530,11 +521,10 @@ package body System.Task_Primitives.Operations is
Write_Lock (Self_ID);
if Mode = Relative then
Abs_Time := Time + Check_Time;
else
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
end if;
Abs_Time :=
(if Mode = Relative
then Time + Check_Time
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
......@@ -543,17 +533,13 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
if Single_Lock then
Result := pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Single_RTS_Lock'Access,
Request'Access);
else
Result := pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Self_ID.Common.LL.L'Access,
Request'Access);
end if;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
......
gcc/ada/s-taprop-linux.adb
......@@ -426,15 +426,12 @@ package body System.Task_Primitives.Operations is
begin
pragma Assert (Self_ID = Self);
if Single_Lock then
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access);
else
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
end if;
Result :=
pthread_cond_wait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access));
-- EINTR is not considered a failure
......@@ -469,11 +466,10 @@ package body System.Task_Primitives.Operations is
Timedout := True;
Yielded := False;
if Mode = Relative then
Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
else
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
end if;
Abs_Time :=
(if Mode = Relative
then Duration'Min (Time, Max_Sensible_Delay) + Check_Time
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
......@@ -481,20 +477,13 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
if Single_Lock then
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Single_RTS_Lock'Access,
Request'Access);
else
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Self_ID.Common.LL.L'Access,
Request'Access);
end if;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
......@@ -539,11 +528,10 @@ package body System.Task_Primitives.Operations is
Write_Lock (Self_ID);
if Mode = Relative then
Abs_Time := Time + Check_Time;
else
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
end if;
Abs_Time :=
(if Mode = Relative
then Time + Check_Time
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
......@@ -552,17 +540,13 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
if Single_Lock then
Result := pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Single_RTS_Lock'Access,
Request'Access);
else
Result := pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Self_ID.Common.LL.L'Access,
Request'Access);
end if;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
......@@ -1104,6 +1088,7 @@ package body System.Task_Primitives.Operations is
SSL.Abort_Undefer.all;
raise Program_Error;
else
-- Suspend the task if the state is False. Otherwise, the task
-- continues its execution, and the state of the suspension object
......@@ -1118,8 +1103,7 @@ package body System.Task_Primitives.Operations is
-- Loop in case pthread_cond_wait returns earlier than expected
-- (e.g. in case of EINTR caused by a signal). This should not
-- happen with the current Linux implementation of pthread, but
-- POSIX does not guarantee it, so this may change in the
-- future.
-- POSIX does not guarantee it so this may change in future.
Result := pthread_cond_wait (S.CV'Access, S.L'Access);
pragma Assert (Result = 0 or else Result = EINTR);
......
gcc/ada/s-taprop-posix.adb
......@@ -244,12 +244,9 @@ package body System.Task_Primitives.Operations is
Guard_Page_Address :=
Stack_Base - (Stack_Base mod Get_Page_Size) + Get_Page_Size;
if On then
Res := mprotect (Guard_Page_Address, Get_Page_Size, PROT_ON);
else
Res := mprotect (Guard_Page_Address, Get_Page_Size, PROT_OFF);
end if;
Res :=
mprotect (Guard_Page_Address, Get_Page_Size,
prot => (if ON then PROT_ON else PROT_OFF));
pragma Assert (Res = 0);
end if;
end Stack_Guard;
......@@ -491,15 +488,12 @@ package body System.Task_Primitives.Operations is
Result : Interfaces.C.int;
begin
if Single_Lock then
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access);
else
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
end if;
Result :=
pthread_cond_wait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access));
-- EINTR is not considered a failure
......@@ -551,27 +545,19 @@ package body System.Task_Primitives.Operations is
end if;
if Abs_Time > Check_Time then
if Relative_Timed_Wait then
Request := To_Timespec (Rel_Time);
else
Request := To_Timespec (Abs_Time);
end if;
Request :=
To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
if Single_Lock then
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access,
Request'Access);
else
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access,
Request'Access);
end if;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
......@@ -633,28 +619,20 @@ package body System.Task_Primitives.Operations is
end if;
if Abs_Time > Check_Time then
if Relative_Timed_Wait then
Request := To_Timespec (Rel_Time);
else
Request := To_Timespec (Abs_Time);
end if;
Request :=
To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
Self_ID.Common.State := Delay_Sleep;
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
if Single_Lock then
Result := pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Single_RTS_Lock'Access,
Request'Access);
else
Result := pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Self_ID.Common.LL.L'Access,
Request'Access);
end if;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
......
gcc/ada/s-taprop-solaris.adb
......@@ -1226,15 +1226,13 @@ package body System.Task_Primitives.Operations is
Timedout := True;
Yielded := False;
if Mode = Relative then
Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
else
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
end if;
Abs_Time :=
(if Mode = Relative
then Duration'Min (Time, Max_Sensible_Delay) + Check_Time
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
......@@ -1294,11 +1292,10 @@ package body System.Task_Primitives.Operations is
Write_Lock (Self_ID);
if Mode = Relative then
Abs_Time := Time + Check_Time;
else
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
end if;
Abs_Time :=
(if Mode = Relative
then Time + Check_Time
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
......
gcc/ada/s-taprop-tru64.adb
......@@ -440,15 +440,12 @@ package body System.Task_Primitives.Operations is
Result : Interfaces.C.int;
begin
if Single_Lock then
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access);
else
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
end if;
Result :=
pthread_cond_wait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access));
-- EINTR is not considered a failure
......@@ -482,11 +479,10 @@ package body System.Task_Primitives.Operations is
Timedout := True;
Yielded := False;
if Mode = Relative then
Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
else
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
end if;
Abs_Time :=
(if Mode = Relative
then Duration'Min (Time, Max_Sensible_Delay) + Check_Time
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
......@@ -494,20 +490,13 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
if Single_Lock then
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Single_RTS_Lock'Access,
Request'Access);
else
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Self_ID.Common.LL.L'Access,
Request'Access);
end if;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
......@@ -550,11 +539,10 @@ package body System.Task_Primitives.Operations is
Write_Lock (Self_ID);
if Mode = Relative then
Abs_Time := Time + Check_Time;
else
Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
end if;
Abs_Time :=
(if Mode = Relative
then Time + Check_Time
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
......@@ -563,19 +551,13 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
if Single_Lock then
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Single_RTS_Lock'Access,
Request'Access);
else
Result :=
pthread_cond_timedwait
(Self_ID.Common.LL.CV'Access,
Self_ID.Common.LL.L'Access,
Request'Access);
end if;
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access),
abstime => Request'Access);
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
......
gcc/ada/s-taprop-vms.adb
......@@ -408,15 +408,12 @@ package body System.Task_Primitives.Operations is
Result : Interfaces.C.int;
begin
if Single_Lock then
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access);
else
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
end if;
Result :=
pthread_cond_wait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access));
-- EINTR is not considered a failure
......@@ -540,19 +537,13 @@ package body System.Task_Primitives.Operations is
exit;
end if;
if Single_Lock then
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access,
Single_RTS_Lock'Access);
pragma Assert (Result = 0);
else
Result :=
pthread_cond_wait
(Self_ID.Common.LL.CV'Access,
Self_ID.Common.LL.L'Access);
pragma Assert (Result = 0);
end if;
Result :=
pthread_cond_wait
(cond => Self_ID.Common.LL.CV'Access,
mutex => (if Single_Lock
then Single_RTS_Lock'Access
else Self_ID.Common.LL.L'Access));
pragma Assert (Result = 0);
Yielded := True;
......
gcc/ada/s-taprop-vxworks.adb
......@@ -430,12 +430,10 @@ package body System.Task_Primitives.Operations is
-- Release the mutex before sleeping
if Single_Lock then
Result := semGive (Single_RTS_Lock.Mutex);
else
Result := semGive (Self_ID.Common.LL.L.Mutex);
end if;
Result :=
semGive (if Single_Lock
then Single_RTS_Lock.Mutex
else Self_ID.Common.LL.L.Mutex);
pragma Assert (Result = 0);
-- Perform a blocking operation to take the CV semaphore. Note that a
......@@ -448,12 +446,10 @@ package body System.Task_Primitives.Operations is
-- Take the mutex back
if Single_Lock then
Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
else
Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
end if;
Result :=
semTake ((if Single_Lock
then Single_RTS_Lock.Mutex
else Self_ID.Common.LL.L.Mutex), WAIT_FOREVER);
pragma Assert (Result = 0);
end Sleep;
......@@ -506,12 +502,10 @@ package body System.Task_Primitives.Operations is
loop
-- Release the mutex before sleeping
if Single_Lock then
Result := semGive (Single_RTS_Lock.Mutex);
else
Result := semGive (Self_ID.Common.LL.L.Mutex);
end if;
Result :=
semGive (if Single_Lock
then Single_RTS_Lock.Mutex
else Self_ID.Common.LL.L.Mutex);
pragma Assert (Result = 0);
-- Perform a blocking operation to take the CV semaphore. Note
......@@ -551,12 +545,10 @@ package body System.Task_Primitives.Operations is
-- Take the mutex back
if Single_Lock then
Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
else
Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
end if;
Result :=
semTake ((if Single_Lock
then Single_RTS_Lock.Mutex
else Self_ID.Common.LL.L.Mutex), WAIT_FOREVER);
pragma Assert (Result = 0);
exit when Timedout or Wakeup;
......@@ -623,11 +615,10 @@ package body System.Task_Primitives.Operations is
-- Modifying State, locking the TCB
if Single_Lock then
Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
else
Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
end if;
Result :=
semTake ((if Single_Lock
then Single_RTS_Lock.Mutex
else Self_ID.Common.LL.L.Mutex), WAIT_FOREVER);
pragma Assert (Result = 0);
......@@ -639,11 +630,10 @@ package body System.Task_Primitives.Operations is
-- Release the TCB before sleeping
if Single_Lock then
Result := semGive (Single_RTS_Lock.Mutex);
else
Result := semGive (Self_ID.Common.LL.L.Mutex);
end if;
Result :=
semGive (if Single_Lock
then Single_RTS_Lock.Mutex
else Self_ID.Common.LL.L.Mutex);
pragma Assert (Result = 0);
exit when Aborted;
......@@ -670,11 +660,11 @@ package body System.Task_Primitives.Operations is
-- Take back the lock after having slept, to protect further
-- access to Self_ID.
if Single_Lock then
Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
else
Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
end if;
Result :=
semTake
((if Single_Lock
then Single_RTS_Lock.Mutex
else Self_ID.Common.LL.L.Mutex), WAIT_FOREVER);
pragma Assert (Result = 0);
......@@ -683,11 +673,11 @@ package body System.Task_Primitives.Operations is
Self_ID.Common.State := Runnable;
if Single_Lock then
Result := semGive (Single_RTS_Lock.Mutex);
else
Result := semGive (Self_ID.Common.LL.L.Mutex);
end if;
Result :=
semGive
(if Single_Lock
then Single_RTS_Lock.Mutex
else Self_ID.Common.LL.L.Mutex);
else
taskDelay (0);
......
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