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