Skip to content

R
riscv-gcc-1
Commit ac72c9c5 by Arnaud Charlet
Options

[multiple changes] 

2009-04-29  Gary Dismukes  <dismukes@adacore.com>

	* 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  <duff@adacore.com>

	* g-expect.adb (Expect_Internal): Fix check for overfull buffer.

	* g-expect.ads: Minor comment fixes.

2009-04-29  Ed Schonberg  <schonberg@adacore.com>

	* 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  <lee@adacore.com>

	* 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
parent de0b4ad5
Showing with 580 additions and 314 deletions
gcc/ada/ChangeLog
2009-04-29 Gary Dismukes <dismukes@adacore.com>
* 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 <duff@adacore.com>
* g-expect.adb (Expect_Internal): Fix check for overfull buffer.
* g-expect.ads: Minor comment fixes.
2009-04-29 Ed Schonberg <schonberg@adacore.com>
* 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 <lee@adacore.com>
* 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 <schonberg@adacore.com> 2009-04-29 Ed Schonberg <schonberg@adacore.com>
* sem_disp.adb (Check_Dispatching_Operation): if the dispatching * sem_disp.adb (Check_Dispatching_Operation): if the dispatching
......
gcc/ada/exp_ch3.adb
...@@ -8634,7 +8634,14 @@ package body Exp_Ch3 is ...@@ -8634,7 +8634,14 @@ package body Exp_Ch3 is
-- If the type is not limited, or else is limited but the attribute 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, -- explicitly specified or is predefined for the type, then return True,
-- unless other conditions prevail, such as restrictions prohibiting -- 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 -- We exclude the Input operation from being a predefined subprogram in
-- the case where the associated type is an abstract extension, because -- the case where the associated type is an abstract extension, because
...@@ -8648,6 +8655,7 @@ package body Exp_Ch3 is ...@@ -8648,6 +8655,7 @@ package body Exp_Ch3 is
-- exception. -- exception.
return (not Is_Limited_Type (Typ) return (not Is_Limited_Type (Typ)
or else Is_Interface (Typ)
or else Has_Predefined_Or_Specified_Stream_Attribute) or else Has_Predefined_Or_Specified_Stream_Attribute)
and then (Operation /= TSS_Stream_Input and then (Operation /= TSS_Stream_Input
or else not Is_Abstract_Type (Typ) or else not Is_Abstract_Type (Typ)
......
gcc/ada/freeze.adb
...@@ -36,7 +36,6 @@ with Exp_Pakd; use Exp_Pakd; ...@@ -36,7 +36,6 @@ with Exp_Pakd; use Exp_Pakd;
with Exp_Util; use Exp_Util; with Exp_Util; use Exp_Util;
with Exp_Tss; use Exp_Tss; with Exp_Tss; use Exp_Tss;
with Layout; use Layout; with Layout; use Layout;
with Lib.Xref; use Lib.Xref;
with Namet; use Namet; with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
...@@ -135,10 +134,6 @@ package body Freeze is ...@@ -135,10 +134,6 @@ package body Freeze is
-- the designated type. Otherwise freezing the access type does not freeze -- the designated type. Otherwise freezing the access type does not freeze
-- the designated type. -- 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 procedure Process_Default_Expressions
(E : Entity_Id; (E : Entity_Id;
After : in out Node_Id); After : in out Node_Id);
...@@ -2583,29 +2578,10 @@ package body Freeze is ...@@ -2583,29 +2578,10 @@ package body Freeze is
-- Here for other than a subprogram or type -- Here for other than a subprogram or type
else 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 -- If entity has a type, and it is not a generic unit, then
-- freeze it first (RM 13.14(10)). -- freeze it first (RM 13.14(10)).
elsif Present (Etype (E)) if Present (Etype (E))
and then Ekind (E) /= E_Generic_Function and then Ekind (E) /= E_Generic_Function
then then
Freeze_And_Append (Etype (E), Loc, Result); Freeze_And_Append (Etype (E), Loc, Result);
...@@ -3598,10 +3574,6 @@ package body Freeze is ...@@ -3598,10 +3574,6 @@ package body Freeze is
end if; end if;
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 -- 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 -- size is known at compile time, if it must be unsigned, or if
-- strict alignment is required -- strict alignment is required
...@@ -5145,72 +5117,6 @@ package body Freeze is ...@@ -5145,72 +5117,6 @@ package body Freeze is
end Is_Fully_Defined; 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 -- -- Process_Default_Expressions --
--------------------------------- ---------------------------------
......
gcc/ada/g-expect.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -660,7 +660,7 @@ package body GNAT.Expect is ...@@ -660,7 +660,7 @@ package body GNAT.Expect is
else else
-- Add what we read to the buffer -- Add what we read to the buffer
if Descriptors (J).Buffer_Index + N - 1 > if Descriptors (J).Buffer_Index + N >
Descriptors (J).Buffer_Size Descriptors (J).Buffer_Size
then then
-- If the user wants to know when we have -- If the user wants to know when we have
......
gcc/ada/g-expect.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -63,10 +63,10 @@ ...@@ -63,10 +63,10 @@
-- Close (Fd); -- Close (Fd);
-- You can also combine multiple regular expressions together, and get the -- You can also combine multiple regular expressions together, and get the
-- specific string matching a parenthesis pair by doing something like. If you -- specific string matching a parenthesis pair by doing something like this:
-- expect either "lang=optional ada" or "lang=ada" from the external process, -- If you expect either "lang=optional ada" or "lang=ada" from the external
-- you can group the two together, which is more efficient, and simply get the -- process, you can group the two together, which is more efficient, and
-- name of the language by doing: -- simply get the name of the language by doing:
-- declare -- declare
-- Matched : Match_Array (0 .. 2); -- Matched : Match_Array (0 .. 2);
...@@ -116,10 +116,10 @@ ...@@ -116,10 +116,10 @@
-- -- Task Safety -- -- -- Task Safety --
-- ----------------- -- -----------------
-- This package is not task-safe: there should be not concurrent calls to -- This package is not task-safe: there should not be concurrent calls to the
-- the functions defined in this package. In other words, separate tasks -- functions defined in this package. In other words, separate tasks must not
-- may not access the facilities of this package without synchronization -- access the facilities of this package without synchronization that
-- that serializes access. -- serializes access.
with System; with System;
with GNAT.OS_Lib; with GNAT.OS_Lib;
...@@ -132,21 +132,21 @@ package GNAT.Expect is ...@@ -132,21 +132,21 @@ package GNAT.Expect is
Null_Pid : constant Process_Id := 0; Null_Pid : constant Process_Id := 0;
type Filter_Type is (Output, Input, Died); type Filter_Type is (Output, Input, Died);
-- The signals that are emitted by the Process_Descriptor upon state -- The signals that are emitted by the Process_Descriptor upon state change
-- changed in the child. One can connect to any of this signal through -- in the child. One can connect to any of these signals through the
-- the Add_Filter subprograms. -- Add_Filter subprograms.
-- --
-- Output => Every time new characters are read from the process -- Output => Every time new characters are read from the process
-- associated with Descriptor, the filter is called with -- 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. -- blocked in a call to Expect.
-- --
-- Input => Every time new characters are written to the process -- Input => Every time new characters are written to the process
-- associated with Descriptor, the filter is called with -- associated with Descriptor, the filter is called with
-- these new characters in argument. -- these new characters in the argument.
-- Note that input is only generated by calls to Send. -- Note that input is generated only by calls to Send.
-- --
-- Died => The child process has died, or was explicitly killed -- Died => The child process has died, or was explicitly killed
...@@ -172,16 +172,16 @@ package GNAT.Expect is ...@@ -172,16 +172,16 @@ package GNAT.Expect is
-- the process and/or automatic parsing of the output. -- the process and/or automatic parsing of the output.
-- --
-- The expect buffer associated with that process can contain at most -- The expect buffer associated with that process can contain at most
-- Buffer_Size characters. Older characters are simply discarded when -- Buffer_Size characters. Older characters are simply discarded when this
-- this buffer is full. Beware that if the buffer is too big, this could -- buffer is full. Beware that if the buffer is too big, this could slow
-- slow down the Expect calls if not output is matched, since Expect has -- down the Expect calls if the output not is matched, since Expect has to
-- to match all the regexp against all the characters in the buffer. -- match all the regexp against all the characters in the buffer. If
-- If Buffer_Size is 0, there is no limit (i.e. all the characters are kept -- Buffer_Size is 0, there is no limit (i.e. all the characters are kept
-- till Expect matches), but this is slower. -- till Expect matches), but this is slower.
-- --
-- If Err_To_Out is True, then the standard error of the spawned process is -- 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 -- 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. -- Invalid_Process is raised if the process could not be spawned.
...@@ -252,9 +252,9 @@ package GNAT.Expect is ...@@ -252,9 +252,9 @@ package GNAT.Expect is
-- --
-- Str is a string of all these characters. -- Str is a string of all these characters.
-- --
-- User_Data, if specified, is a user specific data that will be passed to -- User_Data, if specified, is user specific data that will be passed to
-- the filter. Note that no checks are done on this parameter that should -- the filter. Note that no checks are done on this parameter, so it should
-- be used with cautiousness. -- be used with caution.
procedure Add_Filter procedure Add_Filter
(Descriptor : in out Process_Descriptor; (Descriptor : in out Process_Descriptor;
...@@ -262,10 +262,10 @@ package GNAT.Expect is ...@@ -262,10 +262,10 @@ package GNAT.Expect is
Filter_On : Filter_Type := Output; Filter_On : Filter_Type := Output;
User_Data : System.Address := System.Null_Address; User_Data : System.Address := System.Null_Address;
After : Boolean := False); After : Boolean := False);
-- Add a new filter for one of the filter type. This filter will be -- Add a new filter for one of the filter types. This filter will be run
-- run before all the existing filters, unless After is set True, -- before all the existing filters, unless After is set True, in which case
-- in which case it will be run after existing filters. User_Data -- it will be run after existing filters. User_Data is passed as is to the
-- is passed as is to the filter procedure. -- filter procedure.
procedure Remove_Filter procedure Remove_Filter
(Descriptor : in out Process_Descriptor; (Descriptor : in out Process_Descriptor;
...@@ -277,14 +277,14 @@ package GNAT.Expect is ...@@ -277,14 +277,14 @@ package GNAT.Expect is
(Descriptor : Process_Descriptor'Class; (Descriptor : Process_Descriptor'Class;
Str : String; Str : String;
User_Data : System.Address := System.Null_Address); 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. -- Standard_Output. This is mainly used for debugging purposes.
-- User_Data is ignored. -- User_Data is ignored.
procedure Lock_Filters (Descriptor : in out Process_Descriptor); procedure Lock_Filters (Descriptor : in out Process_Descriptor);
-- Temporarily disables all output and input filters. They will be -- Temporarily disables all output and input filters. They will be
-- reactivated only when Unlock_Filters has been called as many times as -- reactivated only when Unlock_Filters has been called as many times as
-- Lock_Filters; -- Lock_Filters.
procedure Unlock_Filters (Descriptor : in out Process_Descriptor); procedure Unlock_Filters (Descriptor : in out Process_Descriptor);
-- Unlocks the filters. They are reactivated only if Unlock_Filters -- Unlocks the filters. They are reactivated only if Unlock_Filters
...@@ -318,7 +318,7 @@ package GNAT.Expect is ...@@ -318,7 +318,7 @@ package GNAT.Expect is
-- If the buffer was full and some characters were discarded -- If the buffer was full and some characters were discarded
Expect_Timeout : constant Expect_Match := -2; 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; function "+" (S : String) return GNAT.OS_Lib.String_Access;
-- Allocate some memory for the string. This is merely a convenience -- Allocate some memory for the string. This is merely a convenience
......
gcc/ada/g-socket.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1657,6 +1657,41 @@ package body GNAT.Sockets is ...@@ -1657,6 +1657,41 @@ package body GNAT.Sockets is
From.Port := Port_Type (Network_To_Short (Sin.Sin_Port)); From.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
end Receive_Socket; 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 -- -- Resolve_Error --
------------------- -------------------
...@@ -1782,31 +1817,6 @@ package body GNAT.Sockets is ...@@ -1782,31 +1817,6 @@ package body GNAT.Sockets is
end if; end if;
end Resolve_Exception; 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 -- -- Send_Socket --
----------------- -----------------
...@@ -1891,11 +1901,15 @@ package body GNAT.Sockets is ...@@ -1891,11 +1901,15 @@ package body GNAT.Sockets is
procedure Send_Vector procedure Send_Vector
(Socket : Socket_Type; (Socket : Socket_Type;
Vector : Vector_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 is
Res : C.int; use type C.size_t;
Iov_Count : C.int;
This_Iov_Count : C.int; Res : ssize_t;
Iov_Count : C.size_t;
This_Iov_Count : C.size_t;
Msg : Msghdr;
begin begin
Count := 0; Count := 0;
...@@ -1913,13 +1927,23 @@ package body GNAT.Sockets is ...@@ -1913,13 +1927,23 @@ package body GNAT.Sockets is
pragma Warnings (On); 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 := Res :=
C_Writev C_Sendmsg
(C.int (Socket), (C.int (Socket),
Vector (Vector'First + Integer (Iov_Count))'Address, Msg'Address,
This_Iov_Count); Set_Forced_Flags (To_Int (Flags)));
if Res = Failure then if Res = ssize_t (Failure) then
Raise_Socket_Error (Socket_Errno); Raise_Socket_Error (Socket_Errno);
end if; end if;
......
gcc/ada/g-socket.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -913,9 +913,11 @@ package GNAT.Sockets is ...@@ -913,9 +913,11 @@ package GNAT.Sockets is
procedure Receive_Vector procedure Receive_Vector
(Socket : Socket_Type; (Socket : Socket_Type;
Vector : Vector_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 -- 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. -- elements Vector. Count is set to the count of received stream elements.
-- Flags allow control over reception.
function Resolve_Exception function Resolve_Exception
(Occurrence : Ada.Exceptions.Exception_Occurrence) return Error_Type; (Occurrence : Ada.Exceptions.Exception_Occurrence) return Error_Type;
...@@ -959,9 +961,11 @@ package GNAT.Sockets is ...@@ -959,9 +961,11 @@ package GNAT.Sockets is
procedure Send_Vector procedure Send_Vector
(Socket : Socket_Type; (Socket : Socket_Type;
Vector : Vector_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 -- Transmit data gathered from the set of vector elements Vector to a
-- socket. Count is set to the count of transmitted stream elements. -- socket. Count is set to the count of transmitted stream elements.
-- Flags allow control over transmission.
procedure Set_Socket_Option procedure Set_Socket_Option
(Socket : Socket_Type; (Socket : Socket_Type;
......
gcc/ada/g-socthi-mingw.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -247,38 +247,49 @@ package body GNAT.Sockets.Thin is ...@@ -247,38 +247,49 @@ package body GNAT.Sockets.Thin is
return Res; return Res;
end C_Connect; end C_Connect;
------------- ---------------
-- C_Readv -- -- C_Recvmsg --
------------- ---------------
function C_Readv function C_Recvmsg
(Fd : C.int; (S : C.int;
Iov : System.Address; Msg : System.Address;
Iovcnt : C.int) return C.int Flags : C.int) return ssize_t
is is
Res : C.int; Res : C.int;
Count : C.int := 0; Count : C.int := 0;
Iovec : array (0 .. Iovcnt - 1) of Vector_Element; MH : Msghdr;
for Iovec'Address use Iov; 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 Import (Ada, Iovec);
pragma Unreferenced (Flags);
begin 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 for J in Iovec'Range loop
Res := C_Recv Res := C_Recv
(Fd, (S,
Iovec (J).Base.all'Address, Iovec (J).Base.all'Address,
C.int (Iovec (J).Length), C.int (Iovec (J).Length),
0); 0);
if Res < 0 then if Res < 0 then
return Res; return ssize_t (Res);
else else
Count := Count + Res; Count := Count + Res;
end if; end if;
end loop; end loop;
return Count; return ssize_t (Count);
end C_Readv; end C_Recvmsg;
-------------- --------------
-- C_Select -- -- C_Select --
...@@ -372,26 +383,37 @@ package body GNAT.Sockets.Thin is ...@@ -372,26 +383,37 @@ package body GNAT.Sockets.Thin is
return Res; return Res;
end C_Select; end C_Select;
-------------- ---------------
-- C_Writev -- -- C_Sendmsg --
-------------- ---------------
function C_Writev function C_Sendmsg
(Fd : C.int; (S : C.int;
Iov : System.Address; Msg : System.Address;
Iovcnt : C.int) return C.int Flags : C.int) return ssize_t
is is
Res : C.int; Res : C.int;
Count : C.int := 0; Count : C.int := 0;
Iovec : array (0 .. Iovcnt - 1) of Vector_Element; MH : Msghdr;
for Iovec'Address use Iov; 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 Import (Ada, Iovec);
pragma Unreferenced (Flags);
begin 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 for J in Iovec'Range loop
Res := C_Sendto Res := C_Sendto
(Fd, (S,
Iovec (J).Base.all'Address, Iovec (J).Base.all'Address,
C.int (Iovec (J).Length), C.int (Iovec (J).Length),
Flags => 0, Flags => 0,
...@@ -399,13 +421,13 @@ package body GNAT.Sockets.Thin is ...@@ -399,13 +421,13 @@ package body GNAT.Sockets.Thin is
Tolen => 0); Tolen => 0);
if Res < 0 then if Res < 0 then
return Res; return ssize_t (Res);
else else
Count := Count + Res; Count := Count + Res;
end if; end if;
end loop; end loop;
return Count; return ssize_t (Count);
end C_Writev; end C_Sendmsg;
-------------- --------------
-- Finalize -- -- Finalize --
......
gcc/ada/g-socthi-mingw.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -49,6 +49,22 @@ package GNAT.Sockets.Thin is ...@@ -49,6 +49,22 @@ package GNAT.Sockets.Thin is
package C renames Interfaces.C; 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; function Socket_Errno return Integer;
-- Returns last socket error number -- Returns last socket error number
...@@ -124,11 +140,6 @@ package GNAT.Sockets.Thin is ...@@ -124,11 +140,6 @@ package GNAT.Sockets.Thin is
(S : C.int; (S : C.int;
Backlog : C.int) return 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 function C_Recv
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -143,6 +154,11 @@ package GNAT.Sockets.Thin is ...@@ -143,6 +154,11 @@ package GNAT.Sockets.Thin is
From : Sockaddr_In_Access; From : Sockaddr_In_Access;
Fromlen : not null access C.int) return C.int; 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 function C_Select
(Nfds : C.int; (Nfds : C.int;
Readfds : access Fd_Set; Readfds : access Fd_Set;
...@@ -150,6 +166,11 @@ package GNAT.Sockets.Thin is ...@@ -150,6 +166,11 @@ package GNAT.Sockets.Thin is
Exceptfds : access Fd_Set; Exceptfds : access Fd_Set;
Timeout : Timeval_Access) return C.int; Timeout : Timeval_Access) return C.int;
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
function C_Sendto function C_Sendto
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -180,11 +201,6 @@ package GNAT.Sockets.Thin is ...@@ -180,11 +201,6 @@ package GNAT.Sockets.Thin is
function C_System function C_System
(Command : System.Address) return C.int; (Command : System.Address) return C.int;
function C_Writev
(Fd : C.int;
Iov : System.Address;
Iovcnt : C.int) return C.int;
function WSAStartup function WSAStartup
(WS_Version : Interfaces.C.int; (WS_Version : Interfaces.C.int;
WSADataAddress : System.Address) return Interfaces.C.int; WSADataAddress : System.Address) return Interfaces.C.int;
......
gcc/ada/g-socthi-vms.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -91,6 +91,18 @@ package body GNAT.Sockets.Thin is ...@@ -91,6 +91,18 @@ package body GNAT.Sockets.Thin is
Fromlen : not null access C.int) return C.int; Fromlen : not null access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom"); 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 function Syscall_Sendto
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -277,6 +289,54 @@ package body GNAT.Sockets.Thin is ...@@ -277,6 +289,54 @@ package body GNAT.Sockets.Thin is
return Res; return Res;
end C_Recvfrom; 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 -- -- C_Sendto --
-------------- --------------
...@@ -416,72 +476,4 @@ package body GNAT.Sockets.Thin is ...@@ -416,72 +476,4 @@ package body GNAT.Sockets.Thin is
end if; end if;
end Socket_Error_Message; 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; end GNAT.Sockets.Thin;
gcc/ada/g-socthi-vms.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -52,6 +52,22 @@ package GNAT.Sockets.Thin is ...@@ -52,6 +52,22 @@ package GNAT.Sockets.Thin is
package C renames Interfaces.C; 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; function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number -- Returns last socket error number
...@@ -127,11 +143,6 @@ package GNAT.Sockets.Thin is ...@@ -127,11 +143,6 @@ package GNAT.Sockets.Thin is
(S : C.int; (S : C.int;
Backlog : C.int) return 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 function C_Recv
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -146,6 +157,11 @@ package GNAT.Sockets.Thin is ...@@ -146,6 +157,11 @@ package GNAT.Sockets.Thin is
From : Sockaddr_In_Access; From : Sockaddr_In_Access;
Fromlen : not null access C.int) return C.int; 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 function C_Select
(Nfds : C.int; (Nfds : C.int;
Readfds : access Fd_Set; Readfds : access Fd_Set;
...@@ -153,6 +169,11 @@ package GNAT.Sockets.Thin is ...@@ -153,6 +169,11 @@ package GNAT.Sockets.Thin is
Exceptfds : access Fd_Set; Exceptfds : access Fd_Set;
Timeout : Timeval_Access) return C.int; Timeout : Timeval_Access) return C.int;
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
function C_Sendto function C_Sendto
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -183,11 +204,6 @@ package GNAT.Sockets.Thin is ...@@ -183,11 +204,6 @@ package GNAT.Sockets.Thin is
function C_System function C_System
(Command : System.Address) return C.int; (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 -- -- Signalling file descriptors for selector abortion --
------------------------------------------------------- -------------------------------------------------------
......
gcc/ada/g-socthi-vxworks.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -102,6 +102,18 @@ package body GNAT.Sockets.Thin is ...@@ -102,6 +102,18 @@ package body GNAT.Sockets.Thin is
Fromlen : not null access C.int) return C.int; Fromlen : not null access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom"); 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 function Syscall_Sendto
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -291,6 +303,54 @@ package body GNAT.Sockets.Thin is ...@@ -291,6 +303,54 @@ package body GNAT.Sockets.Thin is
return Res; return Res;
end C_Recvfrom; 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 -- -- C_Sendto --
-------------- --------------
......
gcc/ada/g-socthi-vxworks.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -50,6 +50,22 @@ package GNAT.Sockets.Thin is ...@@ -50,6 +50,22 @@ package GNAT.Sockets.Thin is
package C renames Interfaces.C; 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; function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number -- Returns last socket error number
...@@ -125,11 +141,6 @@ package GNAT.Sockets.Thin is ...@@ -125,11 +141,6 @@ package GNAT.Sockets.Thin is
(S : C.int; (S : C.int;
Backlog : C.int) return 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 function C_Recv
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -144,6 +155,11 @@ package GNAT.Sockets.Thin is ...@@ -144,6 +155,11 @@ package GNAT.Sockets.Thin is
From : Sockaddr_In_Access; From : Sockaddr_In_Access;
Fromlen : not null access C.int) return C.int; 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 function C_Select
(Nfds : C.int; (Nfds : C.int;
Readfds : access Fd_Set; Readfds : access Fd_Set;
...@@ -151,6 +167,11 @@ package GNAT.Sockets.Thin is ...@@ -151,6 +167,11 @@ package GNAT.Sockets.Thin is
Exceptfds : access Fd_Set; Exceptfds : access Fd_Set;
Timeout : Timeval_Access) return C.int; Timeout : Timeval_Access) return C.int;
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
function C_Sendto function C_Sendto
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -181,11 +202,6 @@ package GNAT.Sockets.Thin is ...@@ -181,11 +202,6 @@ package GNAT.Sockets.Thin is
function C_System function C_System
(Command : System.Address) return C.int; (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 -- -- Signalling file descriptors for selector abortion --
------------------------------------------------------- -------------------------------------------------------
...@@ -224,11 +240,9 @@ private ...@@ -224,11 +240,9 @@ private
pragma Import (C, C_Getsockname, "getsockname"); pragma Import (C, C_Getsockname, "getsockname");
pragma Import (C, C_Getsockopt, "getsockopt"); pragma Import (C, C_Getsockopt, "getsockopt");
pragma Import (C, C_Listen, "listen"); pragma Import (C, C_Listen, "listen");
pragma Import (C, C_Readv, "readv");
pragma Import (C, C_Select, "select"); pragma Import (C, C_Select, "select");
pragma Import (C, C_Setsockopt, "setsockopt"); pragma Import (C, C_Setsockopt, "setsockopt");
pragma Import (C, C_Shutdown, "shutdown"); pragma Import (C, C_Shutdown, "shutdown");
pragma Import (C, C_Strerror, "strerror"); pragma Import (C, C_Strerror, "strerror");
pragma Import (C, C_System, "system"); pragma Import (C, C_System, "system");
pragma Import (C, C_Writev, "writev");
end GNAT.Sockets.Thin; end GNAT.Sockets.Thin;
gcc/ada/g-socthi.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -98,6 +98,18 @@ package body GNAT.Sockets.Thin is ...@@ -98,6 +98,18 @@ package body GNAT.Sockets.Thin is
Fromlen : not null access C.int) return C.int; Fromlen : not null access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom"); 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 function Syscall_Sendto
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -296,6 +308,54 @@ package body GNAT.Sockets.Thin is ...@@ -296,6 +308,54 @@ package body GNAT.Sockets.Thin is
return Res; return Res;
end C_Recvfrom; 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 -- -- C_Sendto --
-------------- --------------
......
gcc/ada/g-socthi.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -54,6 +54,22 @@ package GNAT.Sockets.Thin is ...@@ -54,6 +54,22 @@ package GNAT.Sockets.Thin is
package C renames Interfaces.C; 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; function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number -- Returns last socket error number
...@@ -126,11 +142,6 @@ package GNAT.Sockets.Thin is ...@@ -126,11 +142,6 @@ package GNAT.Sockets.Thin is
(S : C.int; (S : C.int;
Backlog : C.int) return 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 function C_Recv
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -145,6 +156,11 @@ package GNAT.Sockets.Thin is ...@@ -145,6 +156,11 @@ package GNAT.Sockets.Thin is
From : Sockaddr_In_Access; From : Sockaddr_In_Access;
Fromlen : not null access C.int) return C.int; 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 function C_Select
(Nfds : C.int; (Nfds : C.int;
Readfds : access Fd_Set; Readfds : access Fd_Set;
...@@ -152,6 +168,11 @@ package GNAT.Sockets.Thin is ...@@ -152,6 +168,11 @@ package GNAT.Sockets.Thin is
Exceptfds : access Fd_Set; Exceptfds : access Fd_Set;
Timeout : Timeval_Access) return C.int; Timeout : Timeval_Access) return C.int;
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
function C_Sendto function C_Sendto
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -182,11 +203,6 @@ package GNAT.Sockets.Thin is ...@@ -182,11 +203,6 @@ package GNAT.Sockets.Thin is
function C_System function C_System
(Command : System.Address) return C.int; (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 -- -- Signalling file descriptors for selector abortion --
------------------------------------------------------- -------------------------------------------------------
...@@ -249,13 +265,11 @@ private ...@@ -249,13 +265,11 @@ private
pragma Import (C, C_Getsockname, "getsockname"); pragma Import (C, C_Getsockname, "getsockname");
pragma Import (C, C_Getsockopt, "getsockopt"); pragma Import (C, C_Getsockopt, "getsockopt");
pragma Import (C, C_Listen, "listen"); pragma Import (C, C_Listen, "listen");
pragma Import (C, C_Readv, "readv");
pragma Import (C, C_Select, "select"); pragma Import (C, C_Select, "select");
pragma Import (C, C_Setsockopt, "setsockopt"); pragma Import (C, C_Setsockopt, "setsockopt");
pragma Import (C, C_Shutdown, "shutdown"); pragma Import (C, C_Shutdown, "shutdown");
pragma Import (C, C_Strerror, "strerror"); pragma Import (C, C_Strerror, "strerror");
pragma Import (C, C_System, "system"); pragma Import (C, C_System, "system");
pragma Import (C, C_Writev, "writev");
pragma Import (C, Nonreentrant_Gethostbyname, "gethostbyname"); pragma Import (C, Nonreentrant_Gethostbyname, "gethostbyname");
pragma Import (C, Nonreentrant_Gethostbyaddr, "gethostbyaddr"); pragma Import (C, Nonreentrant_Gethostbyaddr, "gethostbyaddr");
......
gcc/ada/lib-xref.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -93,6 +93,16 @@ package body Lib.Xref is ...@@ -93,6 +93,16 @@ package body Lib.Xref is
Table_Increment => Alloc.Xrefs_Increment, Table_Increment => Alloc.Xrefs_Increment,
Table_Name => "Xrefs"); 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 -- -- Generate_Definition --
------------------------- -------------------------
...@@ -196,6 +206,72 @@ package body Lib.Xref is ...@@ -196,6 +206,72 @@ package body Lib.Xref is
end if; end if;
end Generate_Operator_Reference; 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 -- -- Generate_Reference --
------------------------ ------------------------
...@@ -1083,6 +1159,26 @@ package body Lib.Xref is ...@@ -1083,6 +1159,26 @@ package body Lib.Xref is
return; return;
end if; 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 -- Before we go ahead and output the references we have a problem
-- that needs dealing with. So far we have captured things that are -- that needs dealing with. So far we have captured things that are
-- definitely referenced by the main unit, or defined in the main -- definitely referenced by the main unit, or defined in the main
...@@ -1198,9 +1294,11 @@ package body Lib.Xref is ...@@ -1198,9 +1294,11 @@ package body Lib.Xref is
function Parent_Op (E : Entity_Id) return Entity_Id is function Parent_Op (E : Entity_Id) return Entity_Id is
Orig_Op : constant Entity_Id := Alias (E); Orig_Op : constant Entity_Id := Alias (E);
begin begin
if No (Orig_Op) then if No (Orig_Op) then
return Empty; return Empty;
elsif not Comes_From_Source (E) elsif not Comes_From_Source (E)
and then not Has_Xref_Entry (Orig_Op) and then not Has_Xref_Entry (Orig_Op)
and then Comes_From_Source (Orig_Op) and then Comes_From_Source (Orig_Op)
......
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