diff options
Diffstat (limited to 'gcc/ada/g-socket.adb')
| -rw-r--r-- | gcc/ada/g-socket.adb | 168 |
1 files changed, 70 insertions, 98 deletions
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 0906aec..0112ed8 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -454,110 +454,89 @@ package body GNAT.Sockets is TPtr : Timeval_Access; begin - begin - Status := Completed; - - -- No timeout or Forever is indicated by a null timeval pointer - - if Timeout = Forever then - TPtr := null; - else - TVal := To_Timeval (Timeout); - TPtr := TVal'Unchecked_Access; - end if; + Status := Completed; - -- Copy R_Socket_Set in RSet and add read signalling socket + -- No timeout or Forever is indicated by a null timeval pointer - RSet := (Set => New_Socket_Set (R_Socket_Set.Set), - Last => R_Socket_Set.Last); - Set (RSet, RSig); + if Timeout = Forever then + TPtr := null; + else + TVal := To_Timeval (Timeout); + TPtr := TVal'Unchecked_Access; + end if; - -- Copy W_Socket_Set in WSet + -- Copy R_Socket_Set in RSet and add read signalling socket - WSet := (Set => New_Socket_Set (W_Socket_Set.Set), - Last => W_Socket_Set.Last); + RSet := R_Socket_Set; + Set (RSet, RSig); - -- Copy E_Socket_Set in ESet + -- Copy W_Socket_Set in WSet - ESet := (Set => New_Socket_Set (E_Socket_Set.Set), - Last => E_Socket_Set.Last); + WSet := W_Socket_Set; - Last := C.int'Max (C.int'Max (C.int (RSet.Last), - C.int (WSet.Last)), - C.int (ESet.Last)); + -- Copy E_Socket_Set in ESet - Res := - C_Select - (Last + 1, - RSet.Set, - WSet.Set, - ESet.Set, - TPtr); + ESet := E_Socket_Set; - if Res = Failure then - Raise_Socket_Error (Socket_Errno); - end if; + Last := C.int'Max (C.int'Max (C.int (RSet.Last), + C.int (WSet.Last)), + C.int (ESet.Last)); - -- If Select was resumed because of read signalling socket, read this - -- data and remove socket from set. + Res := + C_Select + (Last + 1, + RSet.Set'Access, + WSet.Set'Access, + ESet.Set'Access, + TPtr); - if Is_Set (RSet, RSig) then - Clear (RSet, RSig); + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; - Res := Signalling_Fds.Read (C.int (RSig)); + -- If Select was resumed because of read signalling socket, read this + -- data and remove socket from set. - if Res = Failure then - Raise_Socket_Error (Socket_Errno); - end if; + if Is_Set (RSet, RSig) then + Clear (RSet, RSig); - Status := Aborted; + Res := Signalling_Fds.Read (C.int (RSig)); - elsif Res = 0 then - Status := Expired; + if Res = Failure then + Raise_Socket_Error (Socket_Errno); end if; - -- Update RSet, WSet and ESet in regard to their new socket sets + Status := Aborted; - Narrow (RSet); - Narrow (WSet); - Narrow (ESet); - - -- Reset RSet as it should be if R_Sig_Socket was not added - - if Is_Empty (RSet) then - Empty (RSet); - end if; - - if Is_Empty (WSet) then - Empty (WSet); - end if; + elsif Res = 0 then + Status := Expired; + end if; - if Is_Empty (ESet) then - Empty (ESet); - end if; + -- Update RSet, WSet and ESet in regard to their new socket sets - -- Deliver RSet, WSet and ESet + Narrow (RSet); + Narrow (WSet); + Narrow (ESet); - Empty (R_Socket_Set); - R_Socket_Set := RSet; + -- Reset RSet as it should be if R_Sig_Socket was not added - Empty (W_Socket_Set); - W_Socket_Set := WSet; + if Is_Empty (RSet) then + Empty (RSet); + end if; - Empty (E_Socket_Set); - E_Socket_Set := ESet; + if Is_Empty (WSet) then + Empty (WSet); + end if; - exception - when Socket_Error => + if Is_Empty (ESet) then + Empty (ESet); + end if; - -- The local socket sets must be emptied before propagating - -- Socket_Error so the associated storage is freed. + -- Deliver RSet, WSet and ESet - Empty (RSet); - Empty (WSet); - Empty (ESet); - raise; - end; + R_Socket_Set := RSet; + W_Socket_Set := WSet; + E_Socket_Set := ESet; end Check_Selector; ----------- @@ -571,8 +550,8 @@ package body GNAT.Sockets is Last : aliased C.int := C.int (Item.Last); begin if Item.Last /= No_Socket then - Remove_Socket_From_Set (Item.Set, C.int (Socket)); - Last_Socket_In_Set (Item.Set, Last'Unchecked_Access); + Remove_Socket_From_Set (Item.Set'Access, C.int (Socket)); + Last_Socket_In_Set (Item.Set'Access, Last'Unchecked_Access); Item.Last := Socket_Type (Last); end if; end Clear; @@ -737,11 +716,7 @@ package body GNAT.Sockets is Target : in out Socket_Set_Type) is begin - Empty (Target); - if Source.Last /= No_Socket then - Target.Set := New_Socket_Set (Source.Set); - Target.Last := Source.Last; - end if; + Target := Source; end Copy; --------------------- @@ -795,11 +770,7 @@ package body GNAT.Sockets is procedure Empty (Item : in out Socket_Set_Type) is begin - if Item.Set /= No_Fd_Set_Access then - Free_Socket_Set (Item.Set); - Item.Set := No_Fd_Set_Access; - end if; - + Reset_Socket_Set (Item.Set'Access); Item.Last := No_Socket; end Empty; @@ -842,7 +813,7 @@ package body GNAT.Sockets is begin if Item.Last /= No_Socket then Get_Socket_From_Set - (Item.Set, L'Unchecked_Access, S'Unchecked_Access); + (Item.Set'Access, L'Unchecked_Access, S'Unchecked_Access); Item.Last := Socket_Type (L); Socket := Socket_Type (S); else @@ -1340,7 +1311,7 @@ package body GNAT.Sockets is begin return Item.Last /= No_Socket and then Socket <= Item.Last - and then Is_Socket_In_Set (Item.Set, C.int (Socket)) /= 0; + and then Is_Socket_In_Set (Item.Set'Access, C.int (Socket)) /= 0; end Is_Set; ------------------- @@ -1365,8 +1336,8 @@ package body GNAT.Sockets is procedure Narrow (Item : in out Socket_Set_Type) is Last : aliased C.int := C.int (Item.Last); begin - if Item.Set /= No_Fd_Set_Access then - Last_Socket_In_Set (Item.Set, Last'Unchecked_Access); + if Item.Last /= No_Socket then + Last_Socket_In_Set (Item.Set'Access, Last'Unchecked_Access); Item.Last := Socket_Type (Last); end if; end Narrow; @@ -1858,15 +1829,16 @@ package body GNAT.Sockets is procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type) is begin - if Item.Set = No_Fd_Set_Access then - Item.Set := New_Socket_Set (No_Fd_Set_Access); + if Item.Last = No_Socket then + -- Uninitialized socket set, make sure it is properly zeroed out + + Reset_Socket_Set (Item.Set'Access); Item.Last := Socket; elsif Item.Last < Socket then Item.Last := Socket; end if; - - Insert_Socket_In_Set (Item.Set, C.int (Socket)); + Insert_Socket_In_Set (Item.Set'Access, C.int (Socket)); end Set; ---------------------- |