From: Arnaud Charlet Date: Wed, 29 Apr 2009 10:49:15 +0000 (+0200) Subject: [multiple changes] X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=ac72c9c53779907040fa8dfb0caf199cd890ac32;p=platform%2Fupstream%2Fgcc.git [multiple changes] 2009-04-29 Gary Dismukes * exp_ch3.adb (Stream_Operation_OK): Return True for limited interfaces (other conditions permitting), so that abstract stream subprograms will be declared for them. 2009-04-29 Bob Duff * g-expect.adb (Expect_Internal): Fix check for overfull buffer. * g-expect.ads: Minor comment fixes. 2009-04-29 Ed Schonberg * freeze.adb, lib-xref.adb (Check_Dispatching_Operation): if the dispatching operation is a body without previous spec, update the list of primitive operations to ensure that cross-reference information is up-to-date. 2009-04-29 Albert Lee * g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb, g-socthi-vxworks.ads, g-socthi-mingw.adb, g-socthi-mingw.ads, g-socthi.adb, g-socthi.ads, g-socket.adb, g-socket.ads (GNAT.Sockets.Thin.C_Readv, GNAT.Sockets.Thin.C_Writev): Remove unused subprograms. (GNAT.Sockets.Thin.C_Recvmsg, GNAT.Sockets.Thin.C_Sendmsg): New bindings to call recvmsg(2) and sendmsg(2). (GNAT.Sockets.Receive_Vector, GNAT.Sockets.Send_Vector): Use C_Recvmsg/C_Sendmsg rather than Readv/C_Writev. From-SVN: r146949 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c8767f1..aacaa58 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2009-04-29 Gary Dismukes + + * exp_ch3.adb (Stream_Operation_OK): Return True for limited interfaces + (other conditions permitting), so that abstract stream subprograms will + be declared for them. + +2009-04-29 Bob Duff + + * g-expect.adb (Expect_Internal): Fix check for overfull buffer. + + * g-expect.ads: Minor comment fixes. + +2009-04-29 Ed Schonberg + + * freeze.adb, lib-xref.adb (Check_Dispatching_Operation): if the + dispatching operation is a body without previous spec, update the list + of primitive operations to ensure that cross-reference information is + up-to-date. + +2009-04-29 Albert Lee + + * g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb, + g-socthi-vxworks.ads, g-socthi-mingw.adb, g-socthi-mingw.ads, + g-socthi.adb, g-socthi.ads, g-socket.adb, g-socket.ads + (GNAT.Sockets.Thin.C_Readv, + GNAT.Sockets.Thin.C_Writev): Remove unused subprograms. + (GNAT.Sockets.Thin.C_Recvmsg, + GNAT.Sockets.Thin.C_Sendmsg): New bindings to call recvmsg(2) and + sendmsg(2). + (GNAT.Sockets.Receive_Vector, GNAT.Sockets.Send_Vector): Use + C_Recvmsg/C_Sendmsg rather than Readv/C_Writev. + 2009-04-29 Ed Schonberg * sem_disp.adb (Check_Dispatching_Operation): if the dispatching diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 8ffb6e0..d05cdbb 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -8634,7 +8634,14 @@ package body Exp_Ch3 is -- If the type is not limited, or else is limited but the attribute is -- explicitly specified or is predefined for the type, then return True, -- unless other conditions prevail, such as restrictions prohibiting - -- streams or dispatching operations. + -- streams or dispatching operations. We also return True for limited + -- interfaces, because they may be extended by nonlimited types and + -- permit inheritance in this case (addresses cases where an abstract + -- extension doesn't get 'Input declared, as per comments below, but + -- 'Class'Input must still be allowed). Note that attempts to apply + -- stream attributes to a limited interface or its class-wide type + -- (or limited extensions thereof) will still get properly rejected + -- by Check_Stream_Attribute. -- We exclude the Input operation from being a predefined subprogram in -- the case where the associated type is an abstract extension, because @@ -8648,6 +8655,7 @@ package body Exp_Ch3 is -- exception. return (not Is_Limited_Type (Typ) + or else Is_Interface (Typ) or else Has_Predefined_Or_Specified_Stream_Attribute) and then (Operation /= TSS_Stream_Input or else not Is_Abstract_Type (Typ) diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 7866432..fdacb09 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -36,7 +36,6 @@ with Exp_Pakd; use Exp_Pakd; with Exp_Util; use Exp_Util; with Exp_Tss; use Exp_Tss; with Layout; use Layout; -with Lib.Xref; use Lib.Xref; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; @@ -135,10 +134,6 @@ package body Freeze is -- the designated type. Otherwise freezing the access type does not freeze -- the designated type. - procedure Generate_Prim_Op_References (Typ : Entity_Id); - -- For a tagged type, generate implicit references to its primitive - -- operations, for source navigation. - procedure Process_Default_Expressions (E : Entity_Id; After : in out Node_Id); @@ -2583,29 +2578,10 @@ package body Freeze is -- Here for other than a subprogram or type else - -- For a generic package, freeze types within, so that proper - -- cross-reference information is generated for tagged types. - -- This is the only freeze processing needed for generic packages. - - if Ekind (E) = E_Generic_Package then - declare - T : Entity_Id; - - begin - T := First_Entity (E); - while Present (T) loop - if Is_Type (T) then - Generate_Prim_Op_References (T); - end if; - - Next_Entity (T); - end loop; - end; - -- If entity has a type, and it is not a generic unit, then -- freeze it first (RM 13.14(10)). - elsif Present (Etype (E)) + if Present (Etype (E)) and then Ekind (E) /= E_Generic_Function then Freeze_And_Append (Etype (E), Loc, Result); @@ -3598,10 +3574,6 @@ package body Freeze is end if; end if; - -- Generate references to primitive operations for a tagged type - - Generate_Prim_Op_References (E); - -- Now that all types from which E may depend are frozen, see if the -- size is known at compile time, if it must be unsigned, or if -- strict alignment is required @@ -5145,72 +5117,6 @@ package body Freeze is end Is_Fully_Defined; --------------------------------- - -- Generate_Prim_Op_References -- - --------------------------------- - - procedure Generate_Prim_Op_References (Typ : Entity_Id) is - Base_T : Entity_Id; - Prim : Elmt_Id; - Prim_List : Elist_Id; - Ent : Entity_Id; - - begin - -- Handle subtypes of synchronized types - - if Ekind (Typ) = E_Protected_Subtype - or else Ekind (Typ) = E_Task_Subtype - then - Base_T := Etype (Typ); - else - Base_T := Typ; - end if; - - -- References to primitive operations are only relevant for tagged types - - if not Is_Tagged_Type (Base_T) - or else Is_Class_Wide_Type (Base_T) - then - return; - end if; - - -- Ada 2005 (AI-345): For synchronized types generate reference - -- to the wrapper that allow us to dispatch calls through their - -- implemented abstract interface types. - - -- The check for Present here is to protect against previously - -- reported critical errors. - - if Is_Concurrent_Type (Base_T) - and then Present (Corresponding_Record_Type (Base_T)) - then - Prim_List := Primitive_Operations - (Corresponding_Record_Type (Base_T)); - else - Prim_List := Primitive_Operations (Base_T); - end if; - - if No (Prim_List) then - return; - end if; - - Prim := First_Elmt (Prim_List); - while Present (Prim) loop - - -- If the operation is derived, get the original for cross-reference - -- reference purposes (it is the original for which we want the xref - -- and for which the comes_from_source test must be performed). - - Ent := Node (Prim); - while Present (Alias (Ent)) loop - Ent := Alias (Ent); - end loop; - - Generate_Reference (Typ, Ent, 'p', Set_Ref => False); - Next_Elmt (Prim); - end loop; - end Generate_Prim_Op_References; - - --------------------------------- -- Process_Default_Expressions -- --------------------------------- diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb index 124d439..256f256 100644 --- a/gcc/ada/g-expect.adb +++ b/gcc/ada/g-expect.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2008, AdaCore -- +-- Copyright (C) 2000-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -660,7 +660,7 @@ package body GNAT.Expect is else -- Add what we read to the buffer - if Descriptors (J).Buffer_Index + N - 1 > + if Descriptors (J).Buffer_Index + N > Descriptors (J).Buffer_Size then -- If the user wants to know when we have diff --git a/gcc/ada/g-expect.ads b/gcc/ada/g-expect.ads index 168a255..31dda41 100644 --- a/gcc/ada/g-expect.ads +++ b/gcc/ada/g-expect.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2008, AdaCore -- +-- Copyright (C) 2000-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -63,10 +63,10 @@ -- Close (Fd); -- You can also combine multiple regular expressions together, and get the --- specific string matching a parenthesis pair by doing something like. If you --- expect either "lang=optional ada" or "lang=ada" from the external process, --- you can group the two together, which is more efficient, and simply get the --- name of the language by doing: +-- specific string matching a parenthesis pair by doing something like this: +-- If you expect either "lang=optional ada" or "lang=ada" from the external +-- process, you can group the two together, which is more efficient, and +-- simply get the name of the language by doing: -- declare -- Matched : Match_Array (0 .. 2); @@ -116,10 +116,10 @@ -- -- Task Safety -- -- ----------------- --- This package is not task-safe: there should be not concurrent calls to --- the functions defined in this package. In other words, separate tasks --- may not access the facilities of this package without synchronization --- that serializes access. +-- This package is not task-safe: there should not be concurrent calls to the +-- functions defined in this package. In other words, separate tasks must not +-- access the facilities of this package without synchronization that +-- serializes access. with System; with GNAT.OS_Lib; @@ -132,21 +132,21 @@ package GNAT.Expect is Null_Pid : constant Process_Id := 0; type Filter_Type is (Output, Input, Died); - -- The signals that are emitted by the Process_Descriptor upon state - -- changed in the child. One can connect to any of this signal through - -- the Add_Filter subprograms. + -- The signals that are emitted by the Process_Descriptor upon state change + -- in the child. One can connect to any of these signals through the + -- Add_Filter subprograms. -- -- Output => Every time new characters are read from the process -- associated with Descriptor, the filter is called with - -- these new characters in argument. + -- these new characters in the argument. -- - -- Note that output is only generated when the program is + -- Note that output is generated only when the program is -- blocked in a call to Expect. -- -- Input => Every time new characters are written to the process -- associated with Descriptor, the filter is called with - -- these new characters in argument. - -- Note that input is only generated by calls to Send. + -- these new characters in the argument. + -- Note that input is generated only by calls to Send. -- -- Died => The child process has died, or was explicitly killed @@ -172,16 +172,16 @@ package GNAT.Expect is -- the process and/or automatic parsing of the output. -- -- The expect buffer associated with that process can contain at most - -- Buffer_Size characters. Older characters are simply discarded when - -- this buffer is full. Beware that if the buffer is too big, this could - -- slow down the Expect calls if not output is matched, since Expect has - -- to match all the regexp against all the characters in the buffer. - -- If Buffer_Size is 0, there is no limit (i.e. all the characters are kept + -- Buffer_Size characters. Older characters are simply discarded when this + -- buffer is full. Beware that if the buffer is too big, this could slow + -- down the Expect calls if the output not is matched, since Expect has to + -- match all the regexp against all the characters in the buffer. If + -- Buffer_Size is 0, there is no limit (i.e. all the characters are kept -- till Expect matches), but this is slower. -- -- If Err_To_Out is True, then the standard error of the spawned process is -- connected to the standard output. This is the only way to get the - -- Except subprograms also match on output on standard error. + -- Except subprograms to also match on output on standard error. -- -- Invalid_Process is raised if the process could not be spawned. @@ -252,9 +252,9 @@ package GNAT.Expect is -- -- Str is a string of all these characters. -- - -- User_Data, if specified, is a user specific data that will be passed to - -- the filter. Note that no checks are done on this parameter that should - -- be used with cautiousness. + -- User_Data, if specified, is user specific data that will be passed to + -- the filter. Note that no checks are done on this parameter, so it should + -- be used with caution. procedure Add_Filter (Descriptor : in out Process_Descriptor; @@ -262,10 +262,10 @@ package GNAT.Expect is Filter_On : Filter_Type := Output; User_Data : System.Address := System.Null_Address; After : Boolean := False); - -- Add a new filter for one of the filter type. This filter will be - -- run before all the existing filters, unless After is set True, - -- in which case it will be run after existing filters. User_Data - -- is passed as is to the filter procedure. + -- Add a new filter for one of the filter types. This filter will be run + -- before all the existing filters, unless After is set True, in which case + -- it will be run after existing filters. User_Data is passed as is to the + -- filter procedure. procedure Remove_Filter (Descriptor : in out Process_Descriptor; @@ -277,14 +277,14 @@ package GNAT.Expect is (Descriptor : Process_Descriptor'Class; Str : String; User_Data : System.Address := System.Null_Address); - -- Function that can be used a filter and that simply outputs Str on + -- Function that can be used as a filter and that simply outputs Str on -- Standard_Output. This is mainly used for debugging purposes. -- User_Data is ignored. procedure Lock_Filters (Descriptor : in out Process_Descriptor); -- Temporarily disables all output and input filters. They will be -- reactivated only when Unlock_Filters has been called as many times as - -- Lock_Filters; + -- Lock_Filters. procedure Unlock_Filters (Descriptor : in out Process_Descriptor); -- Unlocks the filters. They are reactivated only if Unlock_Filters @@ -318,7 +318,7 @@ package GNAT.Expect is -- If the buffer was full and some characters were discarded Expect_Timeout : constant Expect_Match := -2; - -- If not output matching the regexps was found before the timeout + -- If no output matching the regexps was found before the timeout function "+" (S : String) return GNAT.OS_Lib.String_Access; -- Allocate some memory for the string. This is merely a convenience diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index cc31d14..7096405 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2008, AdaCore -- +-- Copyright (C) 2001-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -1657,6 +1657,41 @@ package body GNAT.Sockets is From.Port := Port_Type (Network_To_Short (Sin.Sin_Port)); end Receive_Socket; + -------------------- + -- Receive_Vector -- + -------------------- + + procedure Receive_Vector + (Socket : Socket_Type; + Vector : Vector_Type; + Count : out Ada.Streams.Stream_Element_Count; + Flags : Request_Flag_Type := No_Request_Flag) + is + Res : ssize_t; + + Msg : Msghdr := + (Msg_Name => System.Null_Address, + Msg_Namelen => 0, + Msg_Iov => Vector'Address, + Msg_Iovlen => Vector'Length, + Msg_Control => System.Null_Address, + Msg_Controllen => 0, + Msg_Flags => 0); + + begin + Res := + C_Recvmsg + (C.int (Socket), + Msg'Address, + To_Int (Flags)); + + if Res = ssize_t (Failure) then + Raise_Socket_Error (Socket_Errno); + end if; + + Count := Ada.Streams.Stream_Element_Count (Res); + end Receive_Vector; + ------------------- -- Resolve_Error -- ------------------- @@ -1782,31 +1817,6 @@ package body GNAT.Sockets is end if; end Resolve_Exception; - -------------------- - -- Receive_Vector -- - -------------------- - - procedure Receive_Vector - (Socket : Socket_Type; - Vector : Vector_Type; - Count : out Ada.Streams.Stream_Element_Count) - is - Res : C.int; - - begin - Res := - C_Readv - (C.int (Socket), - Vector'Address, - Vector'Length); - - if Res = Failure then - Raise_Socket_Error (Socket_Errno); - end if; - - Count := Ada.Streams.Stream_Element_Count (Res); - end Receive_Vector; - ----------------- -- Send_Socket -- ----------------- @@ -1891,11 +1901,15 @@ package body GNAT.Sockets is procedure Send_Vector (Socket : Socket_Type; Vector : Vector_Type; - Count : out Ada.Streams.Stream_Element_Count) + Count : out Ada.Streams.Stream_Element_Count; + Flags : Request_Flag_Type := No_Request_Flag) is - Res : C.int; - Iov_Count : C.int; - This_Iov_Count : C.int; + use type C.size_t; + + Res : ssize_t; + Iov_Count : C.size_t; + This_Iov_Count : C.size_t; + Msg : Msghdr; begin Count := 0; @@ -1913,13 +1927,23 @@ package body GNAT.Sockets is pragma Warnings (On); + Msg := + (Msg_Name => System.Null_Address, + Msg_Namelen => 0, + Msg_Iov => Vector + (Vector'First + Integer (Iov_Count))'Address, + Msg_Iovlen => This_Iov_Count, + Msg_Control => System.Null_Address, + Msg_Controllen => 0, + Msg_Flags => 0); + Res := - C_Writev + C_Sendmsg (C.int (Socket), - Vector (Vector'First + Integer (Iov_Count))'Address, - This_Iov_Count); + Msg'Address, + Set_Forced_Flags (To_Int (Flags))); - if Res = Failure then + if Res = ssize_t (Failure) then Raise_Socket_Error (Socket_Errno); end if; diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads index 3680d75..e84bd0f 100644 --- a/gcc/ada/g-socket.ads +++ b/gcc/ada/g-socket.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2008, AdaCore -- +-- Copyright (C) 2001-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -913,9 +913,11 @@ package GNAT.Sockets is procedure Receive_Vector (Socket : Socket_Type; Vector : Vector_Type; - Count : out Ada.Streams.Stream_Element_Count); + Count : out Ada.Streams.Stream_Element_Count; + Flags : Request_Flag_Type := No_Request_Flag); -- Receive data from a socket and scatter it into the set of vector -- elements Vector. Count is set to the count of received stream elements. + -- Flags allow control over reception. function Resolve_Exception (Occurrence : Ada.Exceptions.Exception_Occurrence) return Error_Type; @@ -959,9 +961,11 @@ package GNAT.Sockets is procedure Send_Vector (Socket : Socket_Type; Vector : Vector_Type; - Count : out Ada.Streams.Stream_Element_Count); + Count : out Ada.Streams.Stream_Element_Count; + Flags : Request_Flag_Type := No_Request_Flag); -- Transmit data gathered from the set of vector elements Vector to a -- socket. Count is set to the count of transmitted stream elements. + -- Flags allow control over transmission. procedure Set_Socket_Option (Socket : Socket_Type; diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb index c3a120f..c770486 100644 --- a/gcc/ada/g-socthi-mingw.adb +++ b/gcc/ada/g-socthi-mingw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2008, AdaCore -- +-- Copyright (C) 2001-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -247,38 +247,49 @@ package body GNAT.Sockets.Thin is return Res; end C_Connect; - ------------- - -- C_Readv -- - ------------- + --------------- + -- C_Recvmsg -- + --------------- - function C_Readv - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int + function C_Recvmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t is Res : C.int; Count : C.int := 0; - Iovec : array (0 .. Iovcnt - 1) of Vector_Element; - for Iovec'Address use Iov; + MH : Msghdr; + for MH'Address use Msg; + + Iovec : array (0 .. MH.Msg_Iovlen - 1) of Vector_Element; + for Iovec'Address use MH.Msg_Iov'Address; pragma Import (Ada, Iovec); + pragma Unreferenced (Flags); + begin + -- Windows does not provide an implementation of recvmsg(). The + -- spec for WSARecvMsg() is incompatible with the data types we + -- define, and is not available in all versions of Windows. So, + -- we'll use C_Recv instead. Note that this means the Flags + -- argument is ignored. + for J in Iovec'Range loop Res := C_Recv - (Fd, + (S, Iovec (J).Base.all'Address, C.int (Iovec (J).Length), 0); if Res < 0 then - return Res; + return ssize_t (Res); else Count := Count + Res; end if; end loop; - return Count; - end C_Readv; + return ssize_t (Count); + end C_Recvmsg; -------------- -- C_Select -- @@ -372,26 +383,37 @@ package body GNAT.Sockets.Thin is return Res; end C_Select; - -------------- - -- C_Writev -- - -------------- + --------------- + -- C_Sendmsg -- + --------------- - function C_Writev - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int + function C_Sendmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t is Res : C.int; Count : C.int := 0; - Iovec : array (0 .. Iovcnt - 1) of Vector_Element; - for Iovec'Address use Iov; + MH : Msghdr; + for MH'Address use Msg; + + Iovec : array (0 .. MH.Msg_Iovlen - 1) of Vector_Element; + for Iovec'Address use MH.Msg_Iov'Address; pragma Import (Ada, Iovec); + pragma Unreferenced (Flags); + begin + -- Windows does not provide an implementation of sendmsg(). The + -- spec for WSASendMsg() is incompatible with the data types we + -- define, and is not available in all versions of Windows. So, + -- we'll use C_Sendto instead. Note that this means the Flags + -- argument is ignored. + for J in Iovec'Range loop Res := C_Sendto - (Fd, + (S, Iovec (J).Base.all'Address, C.int (Iovec (J).Length), Flags => 0, @@ -399,13 +421,13 @@ package body GNAT.Sockets.Thin is Tolen => 0); if Res < 0 then - return Res; + return ssize_t (Res); else Count := Count + Res; end if; end loop; - return Count; - end C_Writev; + return ssize_t (Count); + end C_Sendmsg; -------------- -- Finalize -- diff --git a/gcc/ada/g-socthi-mingw.ads b/gcc/ada/g-socthi-mingw.ads index e93b3f7..f06f7a8 100644 --- a/gcc/ada/g-socthi-mingw.ads +++ b/gcc/ada/g-socthi-mingw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2008, AdaCore -- +-- Copyright (C) 2001-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -49,6 +49,22 @@ package GNAT.Sockets.Thin is package C renames Interfaces.C; + use type C.size_t; + type ssize_t is range -(2 ** (C.size_t'Size - 1)) + .. +(2 ** (C.size_t'Size - 1) - 1); + -- Signed type of the same size as size_t + + type Msghdr is record + Msg_Name : System.Address; + Msg_Namelen : C.unsigned; + Msg_Iov : System.Address; + Msg_Iovlen : C.size_t; + Msg_Control : System.Address; + Msg_Controllen : C.size_t; + Msg_Flags : C.int; + end record; + pragma Convention (C, Msghdr); + function Socket_Errno return Integer; -- Returns last socket error number @@ -124,11 +140,6 @@ package GNAT.Sockets.Thin is (S : C.int; Backlog : C.int) return C.int; - function C_Readv - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int; - function C_Recv (S : C.int; Msg : System.Address; @@ -143,6 +154,11 @@ package GNAT.Sockets.Thin is From : Sockaddr_In_Access; Fromlen : not null access C.int) return C.int; + function C_Recvmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t; + function C_Select (Nfds : C.int; Readfds : access Fd_Set; @@ -150,6 +166,11 @@ package GNAT.Sockets.Thin is Exceptfds : access Fd_Set; Timeout : Timeval_Access) return C.int; + function C_Sendmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t; + function C_Sendto (S : C.int; Msg : System.Address; @@ -180,11 +201,6 @@ package GNAT.Sockets.Thin is function C_System (Command : System.Address) return C.int; - function C_Writev - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int; - function WSAStartup (WS_Version : Interfaces.C.int; WSADataAddress : System.Address) return Interfaces.C.int; diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb index afadbb2..1457680 100644 --- a/gcc/ada/g-socthi-vms.adb +++ b/gcc/ada/g-socthi-vms.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2008, AdaCore -- +-- Copyright (C) 2001-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -91,6 +91,18 @@ package body GNAT.Sockets.Thin is Fromlen : not null access C.int) return C.int; pragma Import (C, Syscall_Recvfrom, "recvfrom"); + function Syscall_Recvmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return C.int; + pragma Import (C, Syscall_Recvmsg, "recvmsg"); + + function Syscall_Sendmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return C.int; + pragma Import (C, Syscall_Sendmsg, "sendmsg"); + function Syscall_Sendto (S : C.int; Msg : System.Address; @@ -277,6 +289,54 @@ package body GNAT.Sockets.Thin is return Res; end C_Recvfrom; + --------------- + -- C_Recvmsg -- + --------------- + + function C_Recvmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t + is + Res : C.int; + + begin + loop + Res := Syscall_Recvmsg (S, Msg, Flags); + exit when SOSC.Thread_Blocking_IO + or else Res /= Failure + or else Non_Blocking_Socket (S) + or else Errno /= SOSC.EWOULDBLOCK; + delay Quantum; + end loop; + + return ssize_t (Res); + end C_Recvmsg; + + --------------- + -- C_Sendmsg -- + --------------- + + function C_Sendmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t + is + Res : C.int; + + begin + loop + Res := Syscall_Sendmsg (S, Msg, Flags); + exit when SOSC.Thread_Blocking_IO + or else Res /= Failure + or else Non_Blocking_Socket (S) + or else Errno /= SOSC.EWOULDBLOCK; + delay Quantum; + end loop; + + return ssize_t (Res); + end C_Sendmsg; + -------------- -- C_Sendto -- -------------- @@ -416,72 +476,4 @@ package body GNAT.Sockets.Thin is end if; end Socket_Error_Message; - ------------- - -- C_Readv -- - ------------- - - function C_Readv - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int - is - Res : C.int; - Count : C.int := 0; - - Iovec : array (0 .. Iovcnt - 1) of Vector_Element; - for Iovec'Address use Iov; - pragma Import (Ada, Iovec); - - begin - for J in Iovec'Range loop - Res := C_Recv - (Fd, - Iovec (J).Base.all'Address, - Interfaces.C.int (Iovec (J).Length), - 0); - - if Res < 0 then - return Res; - else - Count := Count + Res; - end if; - end loop; - return Count; - end C_Readv; - - -------------- - -- C_Writev -- - -------------- - - function C_Writev - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int - is - Res : C.int; - Count : C.int := 0; - - Iovec : array (0 .. Iovcnt - 1) of Vector_Element; - for Iovec'Address use Iov; - pragma Import (Ada, Iovec); - - begin - for J in Iovec'Range loop - Res := C_Sendto - (Fd, - Iovec (J).Base.all'Address, - Interfaces.C.int (Iovec (J).Length), - SOSC.MSG_Forced_Flags, - To => null, - Tolen => 0); - - if Res < 0 then - return Res; - else - Count := Count + Res; - end if; - end loop; - return Count; - end C_Writev; - end GNAT.Sockets.Thin; diff --git a/gcc/ada/g-socthi-vms.ads b/gcc/ada/g-socthi-vms.ads index 6a67e21..9725d91 100644 --- a/gcc/ada/g-socthi-vms.ads +++ b/gcc/ada/g-socthi-vms.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2008, AdaCore -- +-- Copyright (C) 2002-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -52,6 +52,22 @@ package GNAT.Sockets.Thin is package C renames Interfaces.C; + use type C.size_t; + type ssize_t is range -(2 ** (C.size_t'Size - 1)) + .. +(2 ** (C.size_t'Size - 1) - 1); + -- Signed type of the same size as size_t + + type Msghdr is record + Msg_Name : System.Address; + Msg_Namelen : C.int; + Msg_Iov : System.Address; + Msg_Iovlen : C.int; + Msg_Control : System.Address; + Msg_Controllen : C.int; + Msg_Flags : C.int; + end record; + pragma Convention (C, Msghdr); + function Socket_Errno return Integer renames GNAT.OS_Lib.Errno; -- Returns last socket error number @@ -127,11 +143,6 @@ package GNAT.Sockets.Thin is (S : C.int; Backlog : C.int) return C.int; - function C_Readv - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int; - function C_Recv (S : C.int; Msg : System.Address; @@ -146,6 +157,11 @@ package GNAT.Sockets.Thin is From : Sockaddr_In_Access; Fromlen : not null access C.int) return C.int; + function C_Recvmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t; + function C_Select (Nfds : C.int; Readfds : access Fd_Set; @@ -153,6 +169,11 @@ package GNAT.Sockets.Thin is Exceptfds : access Fd_Set; Timeout : Timeval_Access) return C.int; + function C_Sendmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t; + function C_Sendto (S : C.int; Msg : System.Address; @@ -183,11 +204,6 @@ package GNAT.Sockets.Thin is function C_System (Command : System.Address) return C.int; - function C_Writev - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int; - ------------------------------------------------------- -- Signalling file descriptors for selector abortion -- ------------------------------------------------------- diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb index d035b61..0f682f4 100644 --- a/gcc/ada/g-socthi-vxworks.adb +++ b/gcc/ada/g-socthi-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2008, AdaCore -- +-- Copyright (C) 2002-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -102,6 +102,18 @@ package body GNAT.Sockets.Thin is Fromlen : not null access C.int) return C.int; pragma Import (C, Syscall_Recvfrom, "recvfrom"); + function Syscall_Recvmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return C.int; + pragma Import (C, Syscall_Recvmsg, "recvmsg"); + + function Syscall_Sendmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return C.int; + pragma Import (C, Syscall_Sendmsg, "sendmsg"); + function Syscall_Sendto (S : C.int; Msg : System.Address; @@ -291,6 +303,54 @@ package body GNAT.Sockets.Thin is return Res; end C_Recvfrom; + --------------- + -- C_Recvmsg -- + --------------- + + function C_Recvmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t + is + Res : C.int; + + begin + loop + Res := Syscall_Recvmsg (S, Msg, Flags); + exit when SOSC.Thread_Blocking_IO + or else Res /= Failure + or else Non_Blocking_Socket (S) + or else Errno /= SOSC.EWOULDBLOCK; + delay Quantum; + end loop; + + return ssize_t (Res); + end C_Recvmsg; + + --------------- + -- C_Sendmsg -- + --------------- + + function C_Sendmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t + is + Res : C.int; + + begin + loop + Res := Syscall_Sendmsg (S, Msg, Flags); + exit when SOSC.Thread_Blocking_IO + or else Res /= Failure + or else Non_Blocking_Socket (S) + or else Errno /= SOSC.EWOULDBLOCK; + delay Quantum; + end loop; + + return ssize_t (Res); + end C_Sendmsg; + -------------- -- C_Sendto -- -------------- diff --git a/gcc/ada/g-socthi-vxworks.ads b/gcc/ada/g-socthi-vxworks.ads index 04e1278..9164155 100644 --- a/gcc/ada/g-socthi-vxworks.ads +++ b/gcc/ada/g-socthi-vxworks.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2008, AdaCore -- +-- Copyright (C) 2002-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -50,6 +50,22 @@ package GNAT.Sockets.Thin is package C renames Interfaces.C; + use type C.size_t; + type ssize_t is range -(2 ** (C.size_t'Size - 1)) + .. +(2 ** (C.size_t'Size - 1) - 1); + -- Signed type of the same size as size_t + + type Msghdr is record + Msg_Name : System.Address; + Msg_Namelen : C.unsigned; + Msg_Iov : System.Address; + Msg_Iovlen : C.int; + Msg_Control : System.Address; + Msg_Controllen : C.unsigned; + Msg_Flags : C.int; + end record; + pragma Convention (C, Msghdr); + function Socket_Errno return Integer renames GNAT.OS_Lib.Errno; -- Returns last socket error number @@ -125,11 +141,6 @@ package GNAT.Sockets.Thin is (S : C.int; Backlog : C.int) return C.int; - function C_Readv - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int; - function C_Recv (S : C.int; Msg : System.Address; @@ -144,6 +155,11 @@ package GNAT.Sockets.Thin is From : Sockaddr_In_Access; Fromlen : not null access C.int) return C.int; + function C_Recvmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t; + function C_Select (Nfds : C.int; Readfds : access Fd_Set; @@ -151,6 +167,11 @@ package GNAT.Sockets.Thin is Exceptfds : access Fd_Set; Timeout : Timeval_Access) return C.int; + function C_Sendmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t; + function C_Sendto (S : C.int; Msg : System.Address; @@ -181,11 +202,6 @@ package GNAT.Sockets.Thin is function C_System (Command : System.Address) return C.int; - function C_Writev - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int; - ------------------------------------------------------- -- Signalling file descriptors for selector abortion -- ------------------------------------------------------- @@ -224,11 +240,9 @@ private pragma Import (C, C_Getsockname, "getsockname"); pragma Import (C, C_Getsockopt, "getsockopt"); pragma Import (C, C_Listen, "listen"); - pragma Import (C, C_Readv, "readv"); pragma Import (C, C_Select, "select"); pragma Import (C, C_Setsockopt, "setsockopt"); pragma Import (C, C_Shutdown, "shutdown"); pragma Import (C, C_Strerror, "strerror"); pragma Import (C, C_System, "system"); - pragma Import (C, C_Writev, "writev"); end GNAT.Sockets.Thin; diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb index fab5fb3..daf6914 100644 --- a/gcc/ada/g-socthi.adb +++ b/gcc/ada/g-socthi.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2008, AdaCore -- +-- Copyright (C) 2001-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -98,6 +98,18 @@ package body GNAT.Sockets.Thin is Fromlen : not null access C.int) return C.int; pragma Import (C, Syscall_Recvfrom, "recvfrom"); + function Syscall_Recvmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t; + pragma Import (C, Syscall_Recvmsg, "recvmsg"); + + function Syscall_Sendmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t; + pragma Import (C, Syscall_Sendmsg, "sendmsg"); + function Syscall_Sendto (S : C.int; Msg : System.Address; @@ -296,6 +308,54 @@ package body GNAT.Sockets.Thin is return Res; end C_Recvfrom; + --------------- + -- C_Recvmsg -- + --------------- + + function C_Recvmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t + is + Res : ssize_t; + + begin + loop + Res := Syscall_Recvmsg (S, Msg, Flags); + exit when SOSC.Thread_Blocking_IO + or else Res /= ssize_t (Failure) + or else Non_Blocking_Socket (S) + or else Errno /= SOSC.EWOULDBLOCK; + delay Quantum; + end loop; + + return Res; + end C_Recvmsg; + + --------------- + -- C_Sendmsg -- + --------------- + + function C_Sendmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t + is + Res : ssize_t; + + begin + loop + Res := Syscall_Sendmsg (S, Msg, Flags); + exit when SOSC.Thread_Blocking_IO + or else Res /= ssize_t (Failure) + or else Non_Blocking_Socket (S) + or else Errno /= SOSC.EWOULDBLOCK; + delay Quantum; + end loop; + + return Res; + end C_Sendmsg; + -------------- -- C_Sendto -- -------------- diff --git a/gcc/ada/g-socthi.ads b/gcc/ada/g-socthi.ads index 303a942..31cbce8 100644 --- a/gcc/ada/g-socthi.ads +++ b/gcc/ada/g-socthi.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2008, AdaCore -- +-- Copyright (C) 2001-2009, AdaCore -- -- -- -- GNAT 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- -- @@ -54,6 +54,22 @@ package GNAT.Sockets.Thin is package C renames Interfaces.C; + use type C.size_t; + type ssize_t is range -(2 ** (C.size_t'Size - 1)) + .. +(2 ** (C.size_t'Size - 1) - 1); + -- Signed type of the same size as size_t + + type Msghdr is record + Msg_Name : System.Address; + Msg_Namelen : C.unsigned; + Msg_Iov : System.Address; + Msg_Iovlen : C.size_t; + Msg_Control : System.Address; + Msg_Controllen : C.size_t; + Msg_Flags : C.int; + end record; + pragma Convention (C, Msghdr); + function Socket_Errno return Integer renames GNAT.OS_Lib.Errno; -- Returns last socket error number @@ -126,11 +142,6 @@ package GNAT.Sockets.Thin is (S : C.int; Backlog : C.int) return C.int; - function C_Readv - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int; - function C_Recv (S : C.int; Msg : System.Address; @@ -145,6 +156,11 @@ package GNAT.Sockets.Thin is From : Sockaddr_In_Access; Fromlen : not null access C.int) return C.int; + function C_Recvmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t; + function C_Select (Nfds : C.int; Readfds : access Fd_Set; @@ -152,6 +168,11 @@ package GNAT.Sockets.Thin is Exceptfds : access Fd_Set; Timeout : Timeval_Access) return C.int; + function C_Sendmsg + (S : C.int; + Msg : System.Address; + Flags : C.int) return ssize_t; + function C_Sendto (S : C.int; Msg : System.Address; @@ -182,11 +203,6 @@ package GNAT.Sockets.Thin is function C_System (Command : System.Address) return C.int; - function C_Writev - (Fd : C.int; - Iov : System.Address; - Iovcnt : C.int) return C.int; - ------------------------------------------------------- -- Signalling file descriptors for selector abortion -- ------------------------------------------------------- @@ -249,13 +265,11 @@ private pragma Import (C, C_Getsockname, "getsockname"); pragma Import (C, C_Getsockopt, "getsockopt"); pragma Import (C, C_Listen, "listen"); - pragma Import (C, C_Readv, "readv"); pragma Import (C, C_Select, "select"); pragma Import (C, C_Setsockopt, "setsockopt"); pragma Import (C, C_Shutdown, "shutdown"); pragma Import (C, C_Strerror, "strerror"); pragma Import (C, C_System, "system"); - pragma Import (C, C_Writev, "writev"); pragma Import (C, Nonreentrant_Gethostbyname, "gethostbyname"); pragma Import (C, Nonreentrant_Gethostbyaddr, "gethostbyaddr"); diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index fac4864..c2e1c59 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2009, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -93,6 +93,16 @@ package body Lib.Xref is Table_Increment => Alloc.Xrefs_Increment, Table_Name => "Xrefs"); + ------------------------ + -- Local Subprograms -- + ------------------------ + + procedure Generate_Prim_Op_References (Typ : Entity_Id); + -- For a tagged type, generate implicit references to its primitive + -- operations, for source navigation. This is done right before emitting + -- cross-reference information rather than at the freeze point of the type + -- in order to handle late bodies that are primitive operations. + ------------------------- -- Generate_Definition -- ------------------------- @@ -196,6 +206,72 @@ package body Lib.Xref is end if; end Generate_Operator_Reference; + --------------------------------- + -- Generate_Prim_Op_References -- + --------------------------------- + + procedure Generate_Prim_Op_References (Typ : Entity_Id) is + Base_T : Entity_Id; + Prim : Elmt_Id; + Prim_List : Elist_Id; + Ent : Entity_Id; + + begin + -- Handle subtypes of synchronized types + + if Ekind (Typ) = E_Protected_Subtype + or else Ekind (Typ) = E_Task_Subtype + then + Base_T := Etype (Typ); + else + Base_T := Typ; + end if; + + -- References to primitive operations are only relevant for tagged types + + if not Is_Tagged_Type (Base_T) + or else Is_Class_Wide_Type (Base_T) + then + return; + end if; + + -- Ada 2005 (AI-345): For synchronized types generate reference + -- to the wrapper that allow us to dispatch calls through their + -- implemented abstract interface types. + + -- The check for Present here is to protect against previously + -- reported critical errors. + + if Is_Concurrent_Type (Base_T) + and then Present (Corresponding_Record_Type (Base_T)) + then + Prim_List := Primitive_Operations + (Corresponding_Record_Type (Base_T)); + else + Prim_List := Primitive_Operations (Base_T); + end if; + + if No (Prim_List) then + return; + end if; + + Prim := First_Elmt (Prim_List); + while Present (Prim) loop + + -- If the operation is derived, get the original for cross-reference + -- reference purposes (it is the original for which we want the xref + -- and for which the comes_from_source test must be performed). + + Ent := Node (Prim); + while Present (Alias (Ent)) loop + Ent := Alias (Ent); + end loop; + + Generate_Reference (Typ, Ent, 'p', Set_Ref => False); + Next_Elmt (Prim); + end loop; + end Generate_Prim_Op_References; + ------------------------ -- Generate_Reference -- ------------------------ @@ -1083,6 +1159,26 @@ package body Lib.Xref is return; end if; + -- First we add references to the primitive operations of tagged + -- types declared in the main unit. + + Handle_Prim_Ops : declare + Ent : Entity_Id; + + begin + for J in 1 .. Xrefs.Last loop + Ent := Xrefs.Table (J).Ent; + + if Is_Type (Ent) + and then Is_Tagged_Type (Ent) + and then Ent = Base_Type (Ent) + and then In_Extended_Main_Source_Unit (Ent) + then + Generate_Prim_Op_References (Ent); + end if; + end loop; + end Handle_Prim_Ops; + -- Before we go ahead and output the references we have a problem -- that needs dealing with. So far we have captured things that are -- definitely referenced by the main unit, or defined in the main @@ -1198,9 +1294,11 @@ package body Lib.Xref is function Parent_Op (E : Entity_Id) return Entity_Id is Orig_Op : constant Entity_Id := Alias (E); + begin if No (Orig_Op) then return Empty; + elsif not Comes_From_Source (E) and then not Has_Xref_Entry (Orig_Op) and then Comes_From_Source (Orig_Op)