diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 15 | ||||
| -rw-r--r-- | gcc/ada/Makefile.rtl | 1 | ||||
| -rw-r--r-- | gcc/ada/g-sercom-linux.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/g-sercom-mingw.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/g-sercom.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/g-socket.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-mingw.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-vms.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-vms.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-vxworks.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-vxworks.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-socthi.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/g-socthi.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-stseme.adb | 64 | ||||
| -rw-r--r-- | gcc/ada/s-commun.adb | 53 | ||||
| -rw-r--r-- | gcc/ada/s-commun.ads | 51 |
16 files changed, 206 insertions, 94 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 298dda24736..ec4250c813f 100644 --- a/gcc/ada/ChangeLog +++ b/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 diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 4f26f1569b5..d03c67db4ca 100644 --- a/gcc/ada/Makefile.rtl +++ b/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) \ diff --git a/gcc/ada/g-sercom-linux.adb b/gcc/ada/g-sercom-linux.adb index 1be595a2f63..c25d5e8e44a 100644 --- a/gcc/ada/g-sercom-linux.adb +++ b/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; --------- diff --git a/gcc/ada/g-sercom-mingw.adb b/gcc/ada/g-sercom-mingw.adb index 03bd6aba191..e5034115995 100644 --- a/gcc/ada/g-sercom-mingw.adb +++ b/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; --------- diff --git a/gcc/ada/g-sercom.ads b/gcc/ada/g-sercom.ads index 8b4c5590684..5adeebe9b2d 100644 --- a/gcc/ada/g-sercom.ads +++ b/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; diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 7741dc0c76d..5cf623a1602 100644 --- a/gcc/ada/g-socket.adb +++ b/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 -- ------------------- diff --git a/gcc/ada/g-socthi-mingw.ads b/gcc/ada/g-socthi-mingw.ads index 8ec056148f1..6d851e17cb4 100644 --- a/gcc/ada/g-socthi-mingw.ads +++ b/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"); diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb index cb2b211d2aa..b9e23ecbfb5 100644 --- a/gcc/ada/g-socthi-vms.adb +++ b/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; diff --git a/gcc/ada/g-socthi-vms.ads b/gcc/ada/g-socthi-vms.ads index 3032b0ec72b..a1bb487e136 100644 --- a/gcc/ada/g-socthi-vms.ads +++ b/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"); diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb index 96d0cfca7a3..e6a8ee60644 100644 --- a/gcc/ada/g-socthi-vxworks.adb +++ b/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; diff --git a/gcc/ada/g-socthi-vxworks.ads b/gcc/ada/g-socthi-vxworks.ads index 08fac05d555..4f92b3a8143 100644 --- a/gcc/ada/g-socthi-vxworks.ads +++ b/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; diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb index b232378fab6..ca797631b08 100644 --- a/gcc/ada/g-socthi.adb +++ b/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; diff --git a/gcc/ada/g-socthi.ads b/gcc/ada/g-socthi.ads index eb690c5b4a8..1f103e89a74 100644 --- a/gcc/ada/g-socthi.ads +++ b/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"); diff --git a/gcc/ada/g-stseme.adb b/gcc/ada/g-stseme.adb new file mode 100644 index 00000000000..b09af1d6fb8 --- /dev/null +++ b/gcc/ada/g-stseme.adb @@ -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; diff --git a/gcc/ada/s-commun.adb b/gcc/ada/s-commun.adb new file mode 100644 index 00000000000..79d74ecad5a --- /dev/null +++ b/gcc/ada/s-commun.adb @@ -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; diff --git a/gcc/ada/s-commun.ads b/gcc/ada/s-commun.ads new file mode 100644 index 00000000000..84f6665d219 --- /dev/null +++ b/gcc/ada/s-commun.ads @@ -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; |