[multiple changes]

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

	* prj-makr.adb (Source_Files): New hash table to keep track of source
	file names.
	(Finalize): Avoid putting several times the same source file name
	in the source list file.
	* prj-pp.adb (Print): Fix a bug in the placement of "at nn" for
	associative array indexes.

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

	* g-dyntab.ads: Add missing pragma Compiler_Unit

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

	* s-crtrun.ads, s-crtl.ads, g-stseme.adb, Makefile.rtl, s-fileio.adb
	(System.CRTL.Runtime): New unit, to contain parts of s-crtl that are
	used in the Ada runtime but can't be used in the compiler because of
	bootstrap issues.
	* socket.c, s-oscons-tmplt.c, g-sothco.ads
	(System.OS_Constants.SIZEOF_struct_servent): New constant.
	Use s-oscons constant instead of external variable to get size of
	struct hostent.

From-SVN: r154772
This commit is contained in:
Arnaud Charlet 2009-11-30 11:20:47 +01:00
parent 2fc5ecb5a8
commit ff149a358c
12 changed files with 136 additions and 43 deletions

View File

@ -1,3 +1,27 @@
2009-11-30 Vincent Celier <celier@adacore.com>
* prj-makr.adb (Source_Files): New hash table to keep track of source
file names.
(Finalize): Avoid putting several times the same source file name
in the source list file.
* prj-pp.adb (Print): Fix a bug in the placement of "at nn" for
associative array indexes.
2009-11-30 Robert Dewar <dewar@adacore.com>
* g-dyntab.ads: Add missing pragma Compiler_Unit
2009-11-30 Thomas Quinot <quinot@adacore.com>
* s-crtrun.ads, s-crtl.ads, g-stseme.adb, Makefile.rtl, s-fileio.adb
(System.CRTL.Runtime): New unit, to contain parts of s-crtl that are
used in the Ada runtime but can't be used in the compiler because of
bootstrap issues.
* socket.c, s-oscons-tmplt.c, g-sothco.ads
(System.OS_Constants.SIZEOF_struct_servent): New constant.
Use s-oscons constant instead of external variable to get size of
struct hostent.
2009-11-30 Thomas Quinot <quinot@adacore.com>
* s-crtl.ads, g-stseme.adb, s-fileio.adb (System.CRTL.strerror): Change

View File

@ -431,6 +431,7 @@ GNATRTL_NONTASKING_OBJS= \
s-conca8$(objext) \
s-conca9$(objext) \
s-crtl$(objext) \
s-crtrun$(objext) \
s-crc32$(objext) \
s-direio$(objext) \
s-dsaser$(objext) \

View File

@ -47,6 +47,8 @@
-- GNAT.Table and the GNAT compiler source unit Table to keep as much
-- coherency as possible between these three related units.
pragma Compiler_Unit;
generic
type Table_Component_Type is private;
type Table_Index_Type is range <>;

View File

@ -212,9 +212,8 @@ package GNAT.Sockets.Thin_Common is
C.Strings.Null_Ptr);
-- Arrays of C (char *)
sizeof_servent : constant C.size_t;
pragma Import (C, sizeof_servent, "__gnat_sizeof_servent");
type Servent is array (1 .. sizeof_servent) of C.char;
type Servent is new System.Storage_Elements.Storage_Array
(1 .. SOSC.SIZEOF_struct_servent);
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

View File

@ -34,7 +34,7 @@
-- 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 System.CRTL;
with System.CRTL.Runtime;
separate (GNAT.Sockets.Thin)
@ -46,7 +46,8 @@ function Socket_Error_Message
(Errno : Integer) return C.Strings.chars_ptr
is
use type Interfaces.C.Strings.chars_ptr;
C_Msg : constant C.Strings.chars_ptr := System.CRTL.strerror (Errno);
C_Msg : constant C.Strings.chars_ptr :=
System.CRTL.Runtime.strerror (Errno);
begin
if C_Msg = C.Strings.Null_Ptr then

View File

@ -41,6 +41,7 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with System.Case_Util; use System.Case_Util;
with System.CRTL;
with System.HTable;
package body Prj.Makr is
@ -170,6 +171,16 @@ package body Prj.Makr is
-- in the source attribute and package Naming of the project file, or in
-- the pragmas Source_File_Name in the configuration pragmas file.
package Source_Files is new System.HTable.Simple_HTable
(Header_Num => Prj.Header_Num,
Element => Boolean,
No_Element => False,
Key => Name_Id,
Hash => Prj.Hash,
Equal => "=");
-- Hash table to keep track of source file names, to avoid putting several
-- times the same file name in case of multi-unit files.
---------
-- Dup --
---------
@ -602,15 +613,19 @@ package body Prj.Makr is
In_Tree => Tree);
begin
-- Add source file name to the source list file
-- Add source file name to the source list file, if it is not
-- already there.
Get_Name_String (Current_Source.File_Name);
Add_Char_To_Name_Buffer (ASCII.LF);
if Write (Source_List_FD,
Name_Buffer (1)'Address,
Name_Len) /= Name_Len
then
Prj.Com.Fail ("disk full");
if not Source_Files.Get (Current_Source.File_Name) then
Source_Files.Set (Current_Source.File_Name, True);
Get_Name_String (Current_Source.File_Name);
Add_Char_To_Name_Buffer (ASCII.LF);
if Write (Source_List_FD,
Name_Buffer (1)'Address,
Name_Len) /= Name_Len
then
Prj.Com.Fail ("disk full");
end if;
end if;
-- For an Ada source, add entry in package Naming
@ -854,7 +869,7 @@ package body Prj.Makr is
-- Fail if parsing was not successful
if No (Project_Node) then
Fail ("parsing of existing project file failed");
Prj.Com.Fail ("parsing of existing project file failed");
else
-- If parsing was successful, remove the components that are

View File

@ -532,6 +532,12 @@ package body Prj.PP is
Write_String (" (");
Output_String
(Associative_Array_Index_Of (Node, In_Tree));
if Source_Index_Of (Node, In_Tree) /= 0 then
Write_String (" at");
Write_String (Source_Index_Of (Node, In_Tree)'Img);
end if;
Write_String (")");
end if;
@ -574,11 +580,6 @@ package body Prj.PP is
Output_Attribute_Name (Name_Of (Node, In_Tree));
end if;
if Source_Index_Of (Node, In_Tree) /= 0 then
Write_String (" at");
Write_String (Source_Index_Of (Node, In_Tree)'Img);
end if;
Write_String (";");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node, In_Tree), Indent);

View File

@ -31,18 +31,18 @@
-- This package provides the low level interface to the C runtime library
with Interfaces.C.Strings;
pragma Compiler_Unit;
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???
-- Should use Interfaces.C.Strings types instead, but this causes bootstrap
-- issues as i-c contains Ada 2005 specific features, not compatible with
-- older, Ada 95-only base compilers???
subtype DIRs is System.Address;
-- Corresponds to the C type DIR*
@ -116,8 +116,7 @@ package System.CRTL is
function fseek
(stream : FILEs;
offset : long;
origin : int)
return int;
origin : int) return int;
pragma Import (C, fseek, "fseek");
function ftell (stream : FILEs) return long;
@ -167,8 +166,7 @@ package System.CRTL is
(stream : FILEs;
buffer : chars;
mode : int;
size : size_t)
return int;
size : size_t) return int;
pragma Import (C, setvbuf, "setvbuf");
procedure tmpnam (string : chars);
@ -195,7 +193,4 @@ 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_ptr;
pragma Import (C, strerror, "strerror");
end System.CRTL;

46
gcc/ada/s-crtrun.ads Normal file
View File

@ -0,0 +1,46 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . C R T L . R U N T I M E --
-- --
-- S p e c --
-- --
-- Copyright (C) 2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- 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 package provides the low level interface to the C runtime library
-- (additional declarations for use in the Ada runtime only, not in the
-- compiler itself).
with Interfaces.C.Strings;
package System.CRTL.Runtime is
pragma Preelaborate;
subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
function strerror (errno : int) return chars_ptr;
pragma Import (C, strerror, "strerror");
end System.CRTL.Runtime;

View File

@ -36,7 +36,7 @@ with Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System.CRTL;
with System.CRTL.Runtime;
with System.Case_Util; use System.Case_Util;
with System.OS_Lib;
with System.Soft_Links;
@ -374,7 +374,7 @@ package body System.File_IO is
-------------------
function Errno_Message (Errno : Integer := OS_Lib.Errno) return String is
Message : constant chars_ptr := CRTL.strerror (Errno);
Message : constant chars_ptr := CRTL.Runtime.strerror (Errno);
begin
if Message = Null_Ptr then

View File

@ -1198,7 +1198,7 @@ CND(SIZEOF_tv_usec, "tv_usec")
}
/*
-- Sizes of protocol specific address types (for sockaddr.sa_len)
-- Sizes of various data types
*/
#define SIZEOF_sockaddr_in (sizeof (struct sockaddr_in))
@ -1210,12 +1210,11 @@ CND(SIZEOF_sockaddr_in, "struct sockaddr_in")
#endif
CND(SIZEOF_sockaddr_in6, "struct sockaddr_in6")
/*
-- Size of file descriptor sets
*/
#define SIZEOF_fd_set (sizeof (fd_set))
CND(SIZEOF_fd_set, "fd_set");
#define SIZEOF_struct_servent (sizeof (struct servent))
CND(SIZEOF_struct_servent, "struct servent");
/*
-- Fields of struct hostent

View File

@ -35,11 +35,24 @@
#ifdef VMS
/*
* For VMS, gsocket.h can't include sockets-related DEC C header files
* when building the runtime (because these files are in DEC C archives,
* not accessable to GCC). So, we generate a separate header file along
* with s-oscons.ads and include it here.
* when building the runtime (because these files are in a DEC C text library
* (DECC$RTLDEF.TLB) not accessable to GCC). So, we generate a separate header
* file along with s-oscons.ads and include it here.
*/
# include "s-oscons.h"
/*
* We also need the declaration of struct servent, which s-oscons can't
* provide, so we copy it manually here. This needs to be kept in synch
* with the definition of that structure in the DEC C headers, which
* hopefully won't change frequently.
*/
struct servent {
char *s_name; /* official service name */
char **s_aliases; /* alias list */
int s_port; /* port # */
char *s_proto; /* protocol to use */
};
#endif
#if defined(HAVE_SOCKETS)
@ -59,9 +72,6 @@
#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);