Skip to content

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

[multiple changes] 

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

	* s-crtl.ads, g-stseme.adb, s-fileio.adb (System.CRTL.strerror): Change
	return type to Interfaces.C.Strings.chars_ptr to eliminate need for
	dubious unchecked conversion at call sites.
	* s-errrep.adb, s-errrep.ads, Makefile.rtl (System.Error_Reporting):
	Remove obsolete, unused runtime unit.
	* gcc-interface/Make-lang.in: Update dependencies.
	* gcc-interface/Makefile.in: Remove VMS specialization of s-crtl, not
	required anymore.

2009-11-30  Vincent Celier  <celier@adacore.com>

	* gnatlink.adb: Delete an eventual existing executable file, in case it
	is a symbolic link, to avoid modifying the target of the symbolic link.

2009-11-30  Bob Duff  <duff@adacore.com>

	* socket.c: Add accessor functions for struct servent.
	* g-sothco.ads (Servent): Declare interfaces to C accessor functions
	for struct servent.
	* g-socket.adb (To_Service_Entry): Use accessor functions for struct
	servent.

2009-11-30  Robert Dewar  <dewar@adacore.com>

	* g-arrspl.adb: Minor reformatting
	* g-dyntab.adb: Add missing pragma Compiler_Unit

From-SVN: r154769
parent 3a3173c9
Showing with 163 additions and 206 deletions
gcc/ada/ChangeLog
2009-11-30 Thomas Quinot <quinot@adacore.com>
* s-crtl.ads, g-stseme.adb, s-fileio.adb (System.CRTL.strerror): Change
return type to Interfaces.C.Strings.chars_ptr to eliminate need for
dubious unchecked conversion at call sites.
* s-errrep.adb, s-errrep.ads, Makefile.rtl (System.Error_Reporting):
Remove obsolete, unused runtime unit.
* gcc-interface/Make-lang.in: Update dependencies.
* gcc-interface/Makefile.in: Remove VMS specialization of s-crtl, not
required anymore.
2009-11-30 Vincent Celier <celier@adacore.com>
* gnatlink.adb: Delete an eventual existing executable file, in case it
is a symbolic link, to avoid modifying the target of the symbolic link.
2009-11-30 Bob Duff <duff@adacore.com>
* socket.c: Add accessor functions for struct servent.
* g-sothco.ads (Servent): Declare interfaces to C accessor functions
for struct servent.
* g-socket.adb (To_Service_Entry): Use accessor functions for struct
servent.
2009-11-30 Robert Dewar <dewar@adacore.com>
* g-arrspl.adb: Minor reformatting
* g-dyntab.adb: Add missing pragma Compiler_Unit
2009-11-30 Thomas Quinot <quinot@adacore.com>
* s-crtl.ads, s-oscons-tmplt.c: Fix support for VMS
* make.adb, g-comlin.ads, exp_ch6.adb: Minor reformatting
......
gcc/ada/Makefile.rtl
......@@ -434,7 +434,6 @@ GNATRTL_NONTASKING_OBJS= \
s-crc32$(objext) \
s-direio$(objext) \
s-dsaser$(objext) \
s-errrep$(objext) \
s-exctab$(objext) \
s-except$(objext) \
s-exnint$(objext) \
......
gcc/ada/g-arrspl.adb
......@@ -238,10 +238,10 @@ package body GNAT.Array_Split is
loop
if K > Count_Sep then
-- No more separators, last slice ends at the end of the source
-- string.
-- No more separators, last slice ends at end of source string
Stop := S.Source'Last;
else
Stop := S.Indexes (K) - 1;
end if;
......
gcc/ada/g-dyntab.adb
......@@ -31,6 +31,8 @@
-- --
------------------------------------------------------------------------------
pragma Compiler_Unit;
with GNAT.Heap_Sort_G;
with System; use System;
with System.Memory; use System.Memory;
......@@ -64,10 +66,7 @@ package body GNAT.Dynamic_Tables is
-- Allocate --
--------------
procedure Allocate
(T : in out Instance;
Num : Integer := 1)
is
procedure Allocate (T : in out Instance; Num : Integer := 1) is
begin
T.P.Last_Val := T.P.Last_Val + Num;
......
gcc/ada/g-socket.adb
......@@ -163,7 +163,7 @@ package body GNAT.Sockets is
function To_Host_Entry (E : Hostent) return Host_Entry_Type;
-- Conversion function
function To_Service_Entry (E : Servent) return Service_Entry_Type;
function To_Service_Entry (E : Servent_Access) return Service_Entry_Type;
-- Conversion function
function To_Timeval (Val : Timeval_Duration) return Timeval;
......@@ -970,7 +970,7 @@ package body GNAT.Sockets is
-- Translate from the C format to the API format
return To_Service_Entry (Res);
return To_Service_Entry (Res'Unchecked_Access);
end Get_Service_By_Name;
-------------------------
......@@ -996,7 +996,7 @@ package body GNAT.Sockets is
-- Translate from the C format to the API format
return To_Service_Entry (Res);
return To_Service_Entry (Res'Unchecked_Access);
end Get_Service_By_Port;
---------------------
......@@ -2352,17 +2352,17 @@ package body GNAT.Sockets is
-- To_Service_Entry --
----------------------
function To_Service_Entry (E : Servent) return Service_Entry_Type is
function To_Service_Entry (E : Servent_Access) return Service_Entry_Type is
use type C.size_t;
Official : constant String := C.Strings.Value (E.S_Name);
Official : constant String := C.Strings.Value (Servent_S_Name (E));
Aliases : constant Chars_Ptr_Array :=
Chars_Ptr_Pointers.Value (E.S_Aliases);
Chars_Ptr_Pointers.Value (Servent_S_Aliases (E));
-- S_Aliases points to a list of name aliases. The list is
-- terminated by a NULL pointer.
Protocol : constant String := C.Strings.Value (E.S_Proto);
Protocol : constant String := C.Strings.Value (Servent_S_Proto (E));
Result : Service_Entry_Type (Aliases_Length => Aliases'Length - 1);
-- The last element is a null pointer
......@@ -2383,7 +2383,7 @@ package body GNAT.Sockets is
end loop;
Result.Port :=
Port_Type (Network_To_Short (C.unsigned_short (E.S_Port)));
Port_Type (Network_To_Short (C.unsigned_short (Servent_S_Port (E))));
Result.Protocol := To_Name (Protocol);
return Result;
......
gcc/ada/g-sothco.ads
......@@ -212,19 +212,24 @@ package GNAT.Sockets.Thin_Common is
C.Strings.Null_Ptr);
-- Arrays of C (char *)
type Servent is record
S_Name : C.Strings.chars_ptr;
S_Aliases : Chars_Ptr_Pointers.Pointer;
S_Port : C.int;
S_Proto : C.Strings.chars_ptr;
end record;
pragma Convention (C, Servent);
-- Service entry
sizeof_servent : constant C.size_t;
pragma Import (C, sizeof_servent, "__gnat_sizeof_servent");
type Servent is array (1 .. sizeof_servent) of C.char;
for Servent'Alignment use 8;
-- Service entry. This is an opaque type used only via the following
-- accessor functions, because 'struct servent' has different layouts on
-- different platforms.
type Servent_Access is access all Servent;
pragma Convention (C, Servent_Access);
-- Access to service entry
function Servent_S_Name (E : Servent_Access) return C.Strings.chars_ptr;
function Servent_S_Aliases (E : Servent_Access)
return Chars_Ptr_Pointers.Pointer;
function Servent_S_Port (E : Servent_Access) return C.int;
function Servent_S_Proto (E : Servent_Access) return C.Strings.chars_ptr;
------------------
-- Host entries --
------------------
......@@ -335,4 +340,9 @@ private
pragma Import (C, Reset_Socket_Set, "__gnat_reset_socket_set");
pragma Import (C, C_Ioctl, "__gnat_socket_ioctl");
pragma Import (C, Inet_Pton, SOSC.Inet_Pton_Linkname);
pragma Import (C, Servent_S_Name, "__gnat_servent_s_name");
pragma Import (C, Servent_S_Aliases, "__gnat_servent_s_aliases");
pragma Import (C, Servent_S_Port, "__gnat_servent_s_port");
pragma Import (C, Servent_S_Proto, "__gnat_servent_s_proto");
end GNAT.Sockets.Thin_Common;
gcc/ada/g-stseme.adb
......@@ -34,8 +34,6 @@
-- 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)
......@@ -48,21 +46,9 @@ 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;
C_Msg : constant C.Strings.chars_ptr := System.CRTL.strerror (Errno);
begin
C_Msg := To_Chars_Ptr (System.CRTL.strerror (Errno));
if C_Msg = C.Strings.Null_Ptr then
return Unknown_System_Error;
else
......
gcc/ada/gcc-interface/Makefile.in
......@@ -1503,7 +1503,6 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
i-cstrea.adb<i-cstrea-vms.adb \
memtrack.adb<memtrack-vms_64.adb \
s-auxdec.ads<s-auxdec-vms_64.ads \
s-crtl.ads<s-crtl-vms_64.ads \
s-inmaop.adb<s-inmaop-vms.adb \
s-interr.adb<s-interr-vms.adb \
s-intman.adb<s-intman-vms.adb \
......
gcc/ada/gnatlink.adb
......@@ -439,34 +439,14 @@ procedure Gnatlink is
Compile_Bind_File := False;
when 'o' =>
if VM_Target = CLI_Target then
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
new String'("/QUIET");
else
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
new String'(Arg);
end if;
Next_Arg := Next_Arg + 1;
if Next_Arg > Argument_Count then
Exit_With_Error ("Missing argument for -o");
end if;
if VM_Target = CLI_Target then
Output_File_Name :=
new String'("/OUTPUT=" & Argument (Next_Arg));
else
Output_File_Name :=
new String'(Argument (Next_Arg));
end if;
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
Output_File_Name;
Output_File_Name :=
new String'(Executable_Name (Argument (Next_Arg)));
when 'R' =>
Opt.Run_Path_Option := False;
......@@ -1728,33 +1708,44 @@ begin
Output_File_Name :=
new String'(Base_Name (Ali_File_Name.all)
& Get_Target_Debuggable_Suffix.all);
end if;
if VM_Target = CLI_Target then
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) := new String'("/QUIET");
if VM_Target = CLI_Target then
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) := new String'("/QUIET");
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) := new String'("/DEBUG");
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) := new String'("/DEBUG");
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
new String'("/OUTPUT=" & Output_File_Name.all);
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
new String'("/OUTPUT=" & Output_File_Name.all);
elsif RTX_RTSS_Kernel_Module_On_Target then
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
new String'("/OUT:" & Output_File_Name.all);
elsif RTX_RTSS_Kernel_Module_On_Target then
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
new String'("/OUT:" & Output_File_Name.all);
else
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) := new String'("-o");
else
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) := new String'("-o");
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
new String'(Output_File_Name.all);
end if;
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
new String'(Output_File_Name.all);
end if;
-- Delete existing executable, in case it is a symbolic link, to avoid
-- modifying the target of the symbolic link.
declare
Dummy : Boolean;
pragma Unreferenced (Dummy);
begin
Delete_File (Output_File_Name.all, Dummy);
end;
-- Warn if main program is called "test", as that may be a built-in command
-- on Unix. On non-Unix systems executables have a suffix, so the warning
-- will not appear. However, do not warn in the case of a cross compiler.
......
gcc/ada/s-crtl.ads
......@@ -31,13 +31,18 @@
-- This package provides the low level interface to the C runtime library
with Interfaces.C.Strings;
with System.Parameters;
package System.CRTL is
pragma Preelaborate;
subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
subtype chars is System.Address;
-- Pointer to null-terminated array of characters
-- Should use Interfaces.C.Strings types instead???
subtype DIRs is System.Address;
-- Corresponds to the C type DIR*
......@@ -48,7 +53,7 @@ package System.CRTL is
subtype int is Integer;
type long is range -(2 ** (System.Parameters.long_bits - 1))
.. +(2 ** (System.Parameters.long_bits - 1)) - 1;
.. +(2 ** (System.Parameters.long_bits - 1)) - 1;
subtype off_t is Long_Integer;
......@@ -190,7 +195,7 @@ package System.CRTL is
function write (fd : int; buffer : chars; nbytes : int) return int;
pragma Import (C, write, "write");
function strerror (errno : int) return chars;
function strerror (errno : int) return chars_ptr;
pragma Import (C, strerror, "strerror");
end System.CRTL;
gcc/ada/s-errrep.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . E R R O R _ R E P O R T I N G --
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2006, AdaCore --
-- --
-- GNARL 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 2, or (at your option) any later ver- --
-- sion. GNARL 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNARL; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- This package must not depend on anything else, since it may be
-- called during elaboration of other packages.
package body System.Error_Reporting is
procedure Write (fildes : Integer; buf : System.Address; nbyte : Integer);
pragma Import (C, Write, "write");
procedure Prog_Exit (Status : Integer);
pragma No_Return (Prog_Exit);
pragma Import (C, Prog_Exit, "exit");
Shutdown_Message : String := "failed run-time assertion : ";
End_Of_Line : String := "" & ASCII.LF;
--------------
-- Shutdown --
--------------
function Shutdown (M : String) return Boolean is
begin
Write (2, Shutdown_Message'Address, Shutdown_Message'Length);
Write (2, M'Address, M'Length);
Write (2, End_Of_Line'Address, End_Of_Line'Length);
-- This call should never return
Prog_Exit (1);
-- Return is just to keep Ada happy (return required)
return False;
end Shutdown;
end System.Error_Reporting;
gcc/ada/s-errrep.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . E R R O R _ R E P O R T I N G --
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2006, AdaCore --
-- --
-- GNARL 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 2, or (at your option) any later ver- --
-- sion. GNARL 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNARL; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- This package must not depend on anything else, since it may be
-- called during elaboration of other packages.
package System.Error_Reporting is
pragma Preelaborate;
function Shutdown (M : String) return Boolean;
-- Perform emergency shutdown of the entire program. Msg is an error
-- message to be printed to the console. This is to be used only for
-- nonrecoverable errors.
end System.Error_Reporting;
gcc/ada/s-fileio.adb
......@@ -31,7 +31,6 @@
with Ada.Finalization; use Ada.Finalization;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Ada.Unchecked_Conversion;
with Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
......@@ -375,16 +374,7 @@ package body System.File_IO is
-------------------
function Errno_Message (Errno : Integer := OS_Lib.Errno) return String is
pragma Warnings (Off);
function To_Chars_Ptr is
new Ada.Unchecked_Conversion (System.Address, 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);
Message : constant chars_ptr :=
To_Chars_Ptr (CRTL.strerror (Errno));
Message : constant chars_ptr := CRTL.strerror (Errno);
begin
if Message = Null_Ptr then
......
gcc/ada/socket.c
......@@ -59,6 +59,9 @@
#include <string.h>
/* Required for memcpy() */
extern const size_t __gnat_sizeof_servent = sizeof(struct servent);
/* For passing the size of servent to Ada code. */
extern void __gnat_disable_sigpipe (int fd);
extern void __gnat_disable_all_sigpipes (void);
extern int __gnat_create_signalling_fds (int *fds);
......@@ -74,6 +77,10 @@ extern void __gnat_remove_socket_from_set (fd_set *, int);
extern void __gnat_reset_socket_set (fd_set *);
extern int __gnat_get_h_errno (void);
extern int __gnat_socket_ioctl (int, int, int *);
extern char * __gnat_servent_s_name (struct servent *);
extern char ** __gnat_servent_s_aliases (struct servent *);
extern int __gnat_servent_s_port (struct servent *);
extern char * __gnat_servent_s_proto (struct servent *);
#if defined (__vxworks) || defined (_WIN32)
extern int __gnat_inet_pton (int, const char *, void *);
#endif
......@@ -488,6 +495,61 @@ __gnat_inet_pton (int af, const char *src, void *dst) {
}
#endif
/*
* Accessor functions for struct servent.
*
* These are needed because servent has different representations on different
* platforms, and we don't want to deal with that on the Ada side. For example,
* on Linux, we have (see /usr/include netdb.h):
*
* struct servent
* {
* char *s_name;
* char **s_aliases;
* int s_port;
* char *s_proto;
* };
*
* and on Windows (see mingw's socket.h):
*
* struct servent {
* char *s_name;
* char **s_aliases;
* #ifdef _WIN64
* char *s_proto;
* short s_port;
* #else
* short s_port;
* char *s_proto;
* #endif
* };
*/
char *
__gnat_servent_s_name (struct servent * s)
{
return s->s_name;
}
char **
__gnat_servent_s_aliases (struct servent * s)
{
return s->s_aliases;
}
int
__gnat_servent_s_port (struct servent * s)
{
return s->s_port;
}
char *
__gnat_servent_s_proto (struct servent * s)
{
return s->s_proto;
}
#else
# warning Sockets are not supported on this platform
#endif /* defined(HAVE_SOCKETS) */
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