[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
This commit is contained in:
parent
ffab1d071c
commit
196b199369
|
@ -1,3 +1,17 @@
|
|||
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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
|
Loading…
Reference in New Issue