mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-10 07:30:27 +08:00
Code Issues Packages Projects Releases Wiki Activity

s-commun.adb, [...]: New internal support unit...

Browse Source 
2009-11-30  Thomas Quinot  <quinot@adacore.com>

	* s-commun.adb, s-commun.ads: New internal support unit,
	allowing code sharing between GNAT.Sockets and
	GNAT.Serial_Communication.
	* g-sercom.ads, g-sercom-mingw.adb, g-sercom-linux.adb,
	g-socket.adb (GNAT.Sockets.Last_Index): Move to System.Communication.
	(GNAT.Serial_Communication.Read): Handle correctly the case where no
	data was read, and Buffer'First = Stream_Element_Offset'First.
	* Makefile.rtl: Add entry for s-commun
	* g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
	g-socthi-vxworks.ads, g-stseme.adb, g-socthi-mingw.ads,
	g-socthi.adb, g-socthi.ads (GNAT.Sockets.Thin.Socket_Error_Message):
	Reimplement in terms of System.CRTL.strerror.

From-SVN: r154758
This commit is contained in:
Thomas Quinot 2009-11-30 09:31:28 +00:00 committed by Arnaud Charlet
parent 948bf10686
commit 5da0f2d96b
16 changed files with 206 additions and 94 deletions

15
gcc/ada/ChangeLog

@ -1,3 +1,18 @@
2009-11-30 Thomas Quinot <quinot@adacore.com>
* s-commun.adb, s-commun.ads: New internal support unit,
allowing code sharing between GNAT.Sockets and
GNAT.Serial_Communication.
* g-sercom.ads, g-sercom-mingw.adb, g-sercom-linux.adb,
g-socket.adb (GNAT.Sockets.Last_Index): Move to System.Communication.
(GNAT.Serial_Communication.Read): Handle correctly the case where no
data was read, and Buffer'First = Stream_Element_Offset'First.
* Makefile.rtl: Add entry for s-commun
* g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
g-socthi-vxworks.ads, g-stseme.adb, g-socthi-mingw.ads,
g-socthi.adb, g-socthi.ads (GNAT.Sockets.Thin.Socket_Error_Message):
Reimplement in terms of System.CRTL.strerror.
2009-11-26 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils.c (copy_type): Unshare the language-specific data

1
gcc/ada/Makefile.rtl

@ -421,6 +421,7 @@ GNATRTL_NONTASKING_OBJS= \
s-caun32$(objext) \
s-caun64$(objext) \
s-chepoo$(objext) \
s-commun$(objext) \
s-conca2$(objext) \
s-conca3$(objext) \
s-conca4$(objext) \

11
gcc/ada/g-sercom-linux.adb

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-2008, AdaCore --
-- Copyright (C) 2007-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- --
@ -37,7 +37,9 @@ with Ada.Streams; use Ada.Streams;
with Ada; use Ada;
with Ada.Unchecked_Deallocation;
with System.CRTL; use System, System.CRTL;
with System; use System;
with System.Communication; use System.Communication;
with System.CRTL; use System.CRTL;
with GNAT.OS_Lib; use GNAT.OS_Lib;
@ -167,11 +169,10 @@ package body GNAT.Serial_Communications is
Res := read (Integer (Port.H.all), Buffer'Address, Len);
if Res = -1 then
Last := 0;
Raise_Error ("read failed");
else
Last := Buffer'First + Stream_Element_Offset (Res) - 1;
end if;
Last := Last_Index (Buffer'First, C.int (Res));
end Read;
---------

10
gcc/ada/g-sercom-mingw.adb

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-2008, AdaCore --
-- Copyright (C) 2007-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- --
@ -35,7 +35,11 @@
with Ada.Unchecked_Deallocation; use Ada;
with Ada.Streams; use Ada.Streams;
with System.Win32.Ext; use System, System.Win32, System.Win32.Ext;
with System; use System;
with System.Communication; use System.Communication;
with System.Win32; use System.Win32;
with System.Win32.Ext; use System.Win32.Ext;
package body GNAT.Serial_Communications is
@ -158,7 +162,7 @@ package body GNAT.Serial_Communications is
Raise_Error ("read error");
end if;
Last := Buffer'First - 1 + Stream_Element_Offset (Read_Last);
Last := Last_Index (Buffer'First, C.int (Read_Last));
end Read;
---------

6
gcc/ada/g-sercom.ads

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2007-2008, AdaCore --
-- Copyright (C) 2007-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,7 +91,9 @@ package GNAT.Serial_Communications is
Buffer : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-- Read a set of bytes, put result into Buffer and set Last accordingly.
-- Last is set to 0 if no byte has been read.
-- Last is set to Buffer'First - 1 if no byte has been read, unless
-- Buffer'First = Stream_Element_Offset'First, in which case Last is
-- set to Stream_Element_Offset'Last instead.
overriding procedure Write
(Port : in out Serial_Port;

27
gcc/ada/g-socket.adb

@ -46,7 +46,8 @@ with GNAT.Sockets.Linker_Options;
pragma Warnings (Off, GNAT.Sockets.Linker_Options);
-- Need to include pragma Linker_Options which is platform dependent
with System; use System;
with System; use System;
with System.Communication; use System.Communication;
package body GNAT.Sockets is
@ -249,14 +250,6 @@ package body GNAT.Sockets is
function Err_Code_Image (E : Integer) return String;
-- Return the value of E surrounded with brackets
function Last_Index
(First : Stream_Element_Offset;
Count : C.int) return Stream_Element_Offset;
-- Compute the Last OUT parameter for the various Receive_Socket
-- subprograms: returns First + Count - 1, except for the case
-- where First = Stream_Element_Offset'First and Res = 0, in which
-- case Stream_Element_Offset'Last is returned instead.
procedure Initialize (X : in out Sockets_Library_Controller);
procedure Finalize (X : in out Sockets_Library_Controller);
@ -1416,22 +1409,6 @@ package body GNAT.Sockets is
and then Is_Socket_In_Set (Item.Set'Access, C.int (Socket)) /= 0;
end Is_Set;
----------------
-- Last_Index --
----------------
function Last_Index
(First : Stream_Element_Offset;
Count : C.int) return Stream_Element_Offset
is
begin
if First = Stream_Element_Offset'First and then Count = 0 then
return Stream_Element_Offset'Last;
else
return First + Stream_Element_Offset (Count - 1);
end if;
end Last_Index;
-------------------
-- Listen_Socket --
-------------------

4
gcc/ada/g-socthi-mingw.ads

@ -184,9 +184,6 @@ package GNAT.Sockets.Thin is
Typ : C.int;
Protocol : C.int) return C.int;
function C_Strerror
(Errnum : C.int) return C.Strings.chars_ptr;
function C_System
(Command : System.Address) return C.int;
@ -241,7 +238,6 @@ private
pragma Import (Stdcall, C_Setsockopt, "setsockopt");
pragma Import (Stdcall, C_Shutdown, "shutdown");
pragma Import (Stdcall, C_Socket, "socket");
pragma Import (C, C_Strerror, "strerror");
pragma Import (C, C_System, "_system");
pragma Import (Stdcall, Socket_Errno, "WSAGetLastError");
pragma Import (Stdcall, Set_Socket_Errno, "WSASetLastError");

15
gcc/ada/g-socthi-vms.adb

@ -473,19 +473,6 @@ package body GNAT.Sockets.Thin is
function Socket_Error_Message
(Errno : Integer) return C.Strings.chars_ptr
is
use type Interfaces.C.Strings.chars_ptr;
C_Msg : C.Strings.chars_ptr;
begin
C_Msg := C_Strerror (C.int (Errno));
if C_Msg = C.Strings.Null_Ptr then
return Unknown_System_Error;
else
return C_Msg;
end if;
end Socket_Error_Message;
is separate;
end GNAT.Sockets.Thin;

4
gcc/ada/g-socthi-vms.ads

@ -187,9 +187,6 @@ package GNAT.Sockets.Thin is
Typ : C.int;
Protocol : C.int) return C.int;
function C_Strerror
(Errnum : C.int) return C.Strings.chars_ptr;
function C_System
(Command : System.Address) return C.int;
@ -255,7 +252,6 @@ private
pragma Import (C, C_Select, "DECC$SELECT");
pragma Import (C, C_Setsockopt, "DECC$SETSOCKOPT");
pragma Import (C, C_Shutdown, "DECC$SHUTDOWN");
pragma Import (C, C_Strerror, "DECC$STRERROR");
pragma Import (C, C_System, "DECC$SYSTEM");
pragma Import (C, Nonreentrant_Gethostbyname, "DECC$GETHOSTBYNAME");

16
gcc/ada/g-socthi-vxworks.adb

@ -489,20 +489,6 @@ package body GNAT.Sockets.Thin is
function Socket_Error_Message
(Errno : Integer) return C.Strings.chars_ptr
is
use type Interfaces.C.Strings.chars_ptr;
C_Msg : C.Strings.chars_ptr;
begin
C_Msg := C_Strerror (C.int (Errno));
if C_Msg = C.Strings.Null_Ptr then
return Unknown_System_Error;
else
return C_Msg;
end if;
end Socket_Error_Message;
is separate;
end GNAT.Sockets.Thin;

4
gcc/ada/g-socthi-vxworks.ads

@ -185,9 +185,6 @@ package GNAT.Sockets.Thin is
Typ : C.int;
Protocol : C.int) return C.int;
function C_Strerror
(Errnum : C.int) return C.Strings.chars_ptr;
function C_System
(Command : System.Address) return C.int;
@ -232,6 +229,5 @@ private
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");
end GNAT.Sockets.Thin;

15
gcc/ada/g-socthi.adb

@ -494,19 +494,6 @@ package body GNAT.Sockets.Thin is
function Socket_Error_Message
(Errno : Integer) return C.Strings.chars_ptr
is
use type Interfaces.C.Strings.chars_ptr;
C_Msg : C.Strings.chars_ptr;
begin
C_Msg := C_Strerror (C.int (Errno));
if C_Msg = C.Strings.Null_Ptr then
return Unknown_System_Error;
else
return C_Msg;
end if;
end Socket_Error_Message;
is separate;
end GNAT.Sockets.Thin;

4
gcc/ada/g-socthi.ads

@ -186,9 +186,6 @@ package GNAT.Sockets.Thin is
Typ : C.int;
Protocol : C.int) return C.int;
function C_Strerror
(Errnum : C.int) return C.Strings.chars_ptr;
function C_System
(Command : System.Address) return C.int;
@ -257,7 +254,6 @@ private
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, Nonreentrant_Gethostbyname, "gethostbyname");

64
gcc/ada/g-stseme.adb Normal file

@ -0,0 +1,64 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- GNAT.SOCKETS.THIN.SOCKET_ERROR_MESSAGE --
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is the default implementation of this unit, using the standard C
-- library's strerror(3) function. It is used on all platforms except Windows,
-- since on that platform socket errno values are distinct from the system
-- ones: there is a specific variant of this function in g-socthi-mingw.adb.
with Ada.Unchecked_Conversion;
with System.CRTL;
separate (GNAT.Sockets.Thin)
function Socket_Error_Message
(Errno : Integer) return C.Strings.chars_ptr
is
use type Interfaces.C.Strings.chars_ptr;
pragma Warnings (Off);
function To_Chars_Ptr is
new Ada.Unchecked_Conversion
(System.Address, Interfaces.C.Strings.chars_ptr);
-- On VMS, the compiler warns because System.Address is 64 bits, but
-- chars_ptr is 32 bits. It should be safe, though, because strerror
-- will return a 32-bit pointer.
pragma Warnings (On);
C_Msg : C.Strings.chars_ptr;
begin
C_Msg := To_Chars_Ptr (System.CRTL.strerror (Errno));
if C_Msg = C.Strings.Null_Ptr then
return Unknown_System_Error;
else
return C_Msg;
end if;
end Socket_Error_Message;

53
gcc/ada/s-commun.adb Normal file

@ -0,0 +1,53 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . C O M M U N I C A T I O N --
-- --
-- B o d y --
-- --
-- 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package body System.Communication is
subtype SEO is Ada.Streams.Stream_Element_Offset;
----------------
-- Last_Index --
----------------
function Last_Index
(First : Ada.Streams.Stream_Element_Offset;
Count : C.int) return Ada.Streams.Stream_Element_Offset
is
use type Ada.Streams.Stream_Element_Offset;
begin
if First = SEO'First and then Count = 0 then
return SEO'Last;
else
return First + SEO (Count - 1);
end if;
end Last_Index;
end System.Communication;

51
gcc/ada/s-commun.ads Normal file

@ -0,0 +1,51 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . C O M M U N I C A T I O N --
-- --
-- S p e c --
-- --
-- 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Common support unit for GNAT.Sockets and GNAT.Serial_Communication
with Ada.Streams;
with Interfaces.C;
package System.Communication is
package C renames Interfaces.C;
use type C.int;
function Last_Index
(First : Ada.Streams.Stream_Element_Offset;
Count : C.int) return Ada.Streams.Stream_Element_Offset;
-- Compute the Last OUT parameter for the various Read / Receive
-- subprograms: returns First + Count - 1, except for the case
-- where First = Stream_Element_Offset'First and Res = 0, in which
-- case Stream_Element_Offset'Last is returned instead.
end System.Communication;