From 04409526edd351b982136e99acaaa3189fc427ce Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 30 Nov 2009 10:45:39 +0000 Subject: [PATCH] 2009-11-30 Robert Dewar * 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 * g-sttsne-locking.adb (Copy_Service_Entry): Complete previous change. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154779 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 14 ++++++++ gcc/ada/g-sttsne-locking.adb | 24 +++++++------ gcc/ada/osint.ads | 7 ++-- gcc/ada/prj.adb | 8 +++-- gcc/ada/prj.ads | 5 +-- gcc/ada/s-osinte-hpux-dce.adb | 8 ++--- gcc/ada/s-osinte-tru64.adb | 9 +++-- gcc/ada/s-stausa.adb | 20 +++++------ gcc/ada/s-stchop.adb | 8 ++--- gcc/ada/s-strxdr.adb | 36 ++++++++------------ gcc/ada/s-taenca.adb | 9 ++--- gcc/ada/s-taprop-hpux-dce.adb | 75 ++++++++++++++++------------------------- gcc/ada/s-taprop-irix.adb | 70 ++++++++++++++++---------------------- gcc/ada/s-taprop-linux.adb | 76 +++++++++++++++++------------------------ gcc/ada/s-taprop-posix.adb | 76 +++++++++++++++-------------------------- gcc/ada/s-taprop-solaris.adb | 19 +++++------ gcc/ada/s-taprop-tru64.adb | 74 ++++++++++++++++------------------------ gcc/ada/s-taprop-vms.adb | 35 ++++++++----------- gcc/ada/s-taprop-vxworks.adb | 78 +++++++++++++++++++------------------------ 19 files changed, 270 insertions(+), 381 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ef5245bed8b..e07b4fa0b45 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2009-11-30 Robert Dewar + + * 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 + + * g-sttsne-locking.adb (Copy_Service_Entry): Complete previous change. + 2009-11-30 Bob Duff * socket.c: Add more accessor functions for struct servent (need diff --git a/gcc/ada/g-sttsne-locking.adb b/gcc/ada/g-sttsne-locking.adb index 543281d77fc..c5e39b734b9 100644 --- a/gcc/ada/g-sttsne-locking.adb +++ b/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); diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index 8353908afec..38ae79598e7 100644 --- a/gcc/ada/osint.ads +++ b/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; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index d097c1dbd6a..70a5737df2f 100644 --- a/gcc/ada/prj.adb +++ b/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; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index f161a8129e4..605c5bd12af 100644 --- a/gcc/ada/prj.ads +++ b/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; diff --git a/gcc/ada/s-osinte-hpux-dce.adb b/gcc/ada/s-osinte-hpux-dce.adb index 45a5ed1dc56..8844d17e0b2 100644 --- a/gcc/ada/s-osinte-hpux-dce.adb +++ b/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; diff --git a/gcc/ada/s-osinte-tru64.adb b/gcc/ada/s-osinte-tru64.adb index 8252107a313..6229ba0caec 100644 --- a/gcc/ada/s-osinte-tru64.adb +++ b/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; diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb index dfa8a1fc6bb..37dda6fad3c 100644 --- a/gcc/ada/s-stausa.adb +++ b/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, diff --git a/gcc/ada/s-stchop.adb b/gcc/ada/s-stchop.adb index 7c62aa5e550..d4aa675a857 100644 --- a/gcc/ada/s-stchop.adb +++ b/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 diff --git a/gcc/ada/s-strxdr.adb b/gcc/ada/s-strxdr.adb index 32ee8ee433d..4fca719e25d 100644 --- a/gcc/ada/s-strxdr.adb +++ b/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; diff --git a/gcc/ada/s-taenca.adb b/gcc/ada/s-taenca.adb index df8a5735333..fba7691e3a2 100644 --- a/gcc/ada/s-taenca.adb +++ b/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 diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb index e93b7af4dca..ebc2f9ddc0c 100644 --- a/gcc/ada/s-taprop-hpux-dce.adb +++ b/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; diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb index 83439214259..e73555fb304 100644 --- a/gcc/ada/s-taprop-irix.adb +++ b/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; diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index 0f0773cec5e..5680fa22c76 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/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); diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index db385c8c589..84c0eee4ffe 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/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; diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index 1e47b9486ed..5250e0e2c15 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/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); diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb index c5a68b7a4e2..cd23f16d9ca 100644 --- a/gcc/ada/s-taprop-tru64.adb +++ b/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; diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb index eb8c0f1867c..582f88bcbde 100644 --- a/gcc/ada/s-taprop-vms.adb +++ b/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; diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index 622e3b53230..4cde338bfd3 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/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); -- 2.11.0