procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2012-10-29  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Document that pragma Optimize_Alignment (Space) is
	ignored with a warning for packed variable length records.

2012-10-29  Thomas Quinot  <quinot@adacore.com>

	* socket.c, g-socthi-dummy.adb, g-socthi-dummy.ads, g-socthi-vms.adb,
	g-socthi-vms.ads, g-socthi-vxworks.adb, g-socthi-vxworks.ads,
	s-oscons-tmplt.c, g-socthi-mingw.adb, g-socthi-mingw.ads, g-socthi.adb,
	g-socthi.ads, xoscons.adb, g-socket.adb, g-sothco.ads: Introduce an
	appropriate subtype for IOCTL requests, since these may be signed or
	unsigned.

From-SVN: r192939
This commit is contained in:
Arnaud Charlet 2012-10-29 12:41:01 +01:00
parent 43254605cb
commit 6db566c308
17 changed files with 147 additions and 87 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
gcc/ada/ChangeLog
View file

@ -1,3 +1,17 @@
2012-10-29 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Document that pragma Optimize_Alignment (Space) is
ignored with a warning for packed variable length records.
2012-10-29 Thomas Quinot <quinot@adacore.com>
* socket.c, g-socthi-dummy.adb, g-socthi-dummy.ads, g-socthi-vms.adb,
g-socthi-vms.ads, g-socthi-vxworks.adb, g-socthi-vxworks.ads,
s-oscons-tmplt.c, g-socthi-mingw.adb, g-socthi-mingw.ads, g-socthi.adb,
g-socthi.ads, xoscons.adb, g-socket.adb, g-sothco.ads: Introduce an
appropriate subtype for IOCTL requests, since these may be signed or
unsigned.
2012-10-29 Gary Dismukes <dismukes@adacore.com>
* exp_alfa.adb: Minor reformatting.

2
gcc/ada/g-socket.adb
View file

@ -80,7 +80,7 @@ package body GNAT.Sockets is
Shut_Write => SOSC.SHUT_WR,
Shut_Read_Write => SOSC.SHUT_RDWR);
Requests : constant array (Request_Name) of C.int :=
Requests : constant array (Request_Name) of SOSC.IOCTL_Req_T :=
(Non_Blocking_IO => SOSC.FIONBIO,
N_Bytes_To_Read => SOSC.FIONREAD);

2
gcc/ada/g-socthi-dummy.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2010, AdaCore --
-- Copyright (C) 2001-2012, 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- --

2
gcc/ada/g-socthi-dummy.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2010, AdaCore --
-- Copyright (C) 2001-2012, 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- --

4
gcc/ada/g-socthi-mingw.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2011, AdaCore --
-- Copyright (C) 2001-2012, 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- --
@ -256,7 +256,7 @@ package body GNAT.Sockets.Thin is
function Socket_Ioctl
(S : C.int;
Req : C.int;
Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int
is
begin

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2010, AdaCore --
-- Copyright (C) 2001-2012, 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- --
@ -118,7 +118,7 @@ package GNAT.Sockets.Thin is
function Socket_Ioctl
(S : C.int;
Req : C.int;
Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int;
function C_Listen

4
gcc/ada/g-socthi-vms.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2011, AdaCore --
-- Copyright (C) 2001-2012, 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- --
@ -227,7 +227,7 @@ package body GNAT.Sockets.Thin is
function Socket_Ioctl
(S : C.int;
Req : C.int;
Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int
is
begin

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2010, AdaCore --
-- Copyright (C) 2002-2012, 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- --
@ -121,7 +121,7 @@ package GNAT.Sockets.Thin is
function Socket_Ioctl
(S : C.int;
Req : C.int;
Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int;
function C_Listen

4
gcc/ada/g-socthi-vxworks.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2010, AdaCore --
-- Copyright (C) 2002-2012, 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- --
@ -235,7 +235,7 @@ package body GNAT.Sockets.Thin is
function Socket_Ioctl
(S : C.int;
Req : C.int;
Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int
is
begin

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2010, AdaCore --
-- Copyright (C) 2002-2012, 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- --
@ -119,7 +119,7 @@ package GNAT.Sockets.Thin is
function Socket_Ioctl
(S : C.int;
Req : C.int;
Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int;
function C_Listen

4
gcc/ada/g-socthi.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2010, AdaCore --
-- Copyright (C) 2001-2012, 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- --
@ -233,7 +233,7 @@ package body GNAT.Sockets.Thin is
function Socket_Ioctl
(S : C.int;
Req : C.int;
Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int
is
begin

4
gcc/ada/g-socthi.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2010, AdaCore --
-- Copyright (C) 2001-2012, 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- --
@ -120,7 +120,7 @@ package GNAT.Sockets.Thin is
function Socket_Ioctl
(S : C.int;
Req : C.int;
Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int;
function C_Listen

4
gcc/ada/g-sothco.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2008-2010, AdaCore --
-- Copyright (C) 2008-2012, 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- --
@ -385,7 +385,7 @@ package GNAT.Sockets.Thin_Common is
function C_Ioctl
(Fd : C.int;
Req : C.int;
Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int;
private

6
gcc/ada/gnat_rm.texi
View file

@ -4032,6 +4032,12 @@ allowed to be bigger than the size of the type, but it can waste space if for
example fields of type R appear in an enclosing record. If the above type is
compiled in @code{Optimize_Alignment (Space)} mode, the alignment is set to 1.
However, there is one case in which SPACE is ignored. If a variable length
record (that is a discriminated record with a component which is an array
whose length depends on a discriminant), has a pragam pack, then it is not
in general possible to set the alignment of such a record to one, so the
pragma is ignored in this case (with a warning).
Specifying TIME causes larger default alignments to be chosen in the case of
small types with sizes that are not a power of 2. For example, consider:

35
gcc/ada/s-oscons-tmplt.c
View file

@ -182,6 +182,9 @@ int counter = 0;
#define C(sname,type,value,comment)\
printf ("\n->C:$%d:" sname ":" #type ":" value ":" comment, __LINE__);
#define SUB(sname)\
printf ("\n->SUB:$%d:" #sname ":" sname, __LINE__);
#define TXT(text) \
printf ("\n->TXT:$%d:" text, __LINE__);
@ -209,6 +212,11 @@ int counter = 0;
: : "i" (__LINE__));
/* Typed constant */
#define SUB(sname) \
asm volatile("\n->SUB:%0:" #sname ":" sname \
: : "i" (__LINE__));
/* Subtype */
#define TXT(text) \
asm volatile("\n->TXT:%0:" text \
: : "i" (__LINE__));
@ -217,14 +225,7 @@ int counter = 0;
#endif /* NATIVE */
#define CST(name,comment) C(#name,String,name,comment)
/* ioctl(2) requests are "int" in UNIX, but "unsigned long" on FreeBSD */
#ifdef __FreeBSD__
# define CNI CNU
#else
# define CNI CND
#endif
/* String constant */
#define STR(x) STR1(x)
#define STR1(x) #x
@ -378,6 +379,18 @@ CND(FNDELAY, "Nonblocking")
*/
/* ioctl(2) requests are "int" in UNIX, but "unsigned long" on FreeBSD */
#ifdef __FreeBSD__
# define CNI CNU
# define IOCTL_Req_T "unsigned"
#else
# define CNI CND
# define IOCTL_Req_T "int"
#endif
SUB(IOCTL_Req_T)
#ifndef FIONBIO
# define FIONBIO -1
#endif
@ -1333,12 +1346,12 @@ CND(SIZEOF_sigset, "sigset");
*/
#if defined (__sun__) || defined (__hpux__)
# define msg_iovlen_t "int"
# define Msg_Iovlen_T "int"
#else
# define msg_iovlen_t "size_t"
# define Msg_Iovlen_T "size_t"
#endif
TXT(" subtype Msg_Iovlen_T is Interfaces.C." msg_iovlen_t ";")
SUB(Msg_Iovlen_T)
/*

12
gcc/ada/socket.c
View file

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 2003-2010, Free Software Foundation, Inc. *
* Copyright (C) 2003-2012, 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- *
@ -33,7 +33,7 @@
#include "gsocket.h"
#ifdef VMS
#if defined(VMS)
/*
* For VMS, gsocket.h can't include sockets-related DEC C header files
* when building the runtime (because these files are in a DEC C text library
@ -65,6 +65,10 @@ struct servent {
int s_port;
__netdb_char_ptr s_proto;
};
#elif defined(__FreeBSD__)
typedef unsigned int IOCTL_Req_T;
#else
typedef int IOCTL_Req_T;
#endif
#if defined(HAVE_SOCKETS)
@ -98,7 +102,7 @@ extern fd_set *__gnat_new_socket_set (fd_set *);
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 int __gnat_socket_ioctl (int, IOCTL_Req_T, int *);
extern char * __gnat_servent_s_name (struct servent *);
extern char * __gnat_servent_s_alias (struct servent *, int index);
@ -526,7 +530,7 @@ __gnat_get_h_errno (void) {
/* Wrapper for ioctl(2), which is a variadic function */
int
__gnat_socket_ioctl (int fd, int req, int *arg) {
__gnat_socket_ioctl (int fd, IOCTL_Req_T req, int *arg) {
#if defined (_WIN32)
return ioctlsocket (fd, req, arg);
#elif defined (__APPLE__)

125
gcc/ada/xoscons.adb
View file

@ -76,6 +76,7 @@ procedure XOSCons is
CNU, -- Named number (decimal, unsigned)
CNS, -- Named number (freeform text)
C, -- Constant object
SUB, -- Subtype
TXT); -- Literal text
-- Recognized markers found in assembly file. These markers are produced by
-- the same-named macros from the C template.
@ -181,65 +182,84 @@ procedure XOSCons is
-- Start of processing for Output_Info
begin
-- Case of non-TXT case (TXT case handled by common code below)
case Info.Kind is
when TXT =>
if Info.Kind /= TXT then
case Lang is
when Lang_Ada =>
Put (" " & Info.Constant_Name.all);
Put (Spaces (Max_Constant_Name_Len
- Info.Constant_Name'Length));
-- Handled in the common code for comments below
if Info.Kind in Named_Number then
Put (" : constant := ");
else
Put (" : constant " & Info.Constant_Type.all);
Put (Spaces (Max_Constant_Type_Len
- Info.Constant_Type'Length));
Put (" := ");
null;
when SUB =>
case Lang is
when Lang_Ada =>
Put (" subtype " & Info.Constant_Name.all
& " is Interfaces.C."
& Info.Text_Value.all & ";");
when Lang_C =>
Put ("#define " & Info.Constant_Name.all & " "
& Info.Text_Value.all);
end case;
when others =>
-- All named number cases
case Lang is
when Lang_Ada =>
Put (" " & Info.Constant_Name.all);
Put (Spaces (Max_Constant_Name_Len
- Info.Constant_Name'Length));
if Info.Kind in Named_Number then
Put (" : constant := ");
else
Put (" : constant " & Info.Constant_Type.all);
Put (Spaces (Max_Constant_Type_Len
- Info.Constant_Type'Length));
Put (" := ");
end if;
when Lang_C =>
Put ("#define " & Info.Constant_Name.all & " ");
Put (Spaces (Max_Constant_Name_Len
- Info.Constant_Name'Length));
end case;
if Info.Kind in Asm_Int_Kind then
if not Info.Int_Value.Positive then
Put ("-");
end if;
when Lang_C =>
Put ("#define " & Info.Constant_Name.all & " ");
Put (Spaces (Max_Constant_Name_Len
- Info.Constant_Name'Length));
end case;
Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left));
if Info.Kind in Asm_Int_Kind then
if not Info.Int_Value.Positive then
Put ("-");
else
declare
Is_String : constant Boolean :=
Info.Kind = C
and then Info.Constant_Type.all = "String";
begin
if Is_String then
Put ("""");
end if;
Put (Info.Text_Value.all);
if Is_String then
Put ("""");
end if;
end;
end if;
Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left));
if Lang = Lang_Ada then
Put (";");
else
declare
Is_String : constant Boolean :=
Info.Kind = C
and then Info.Constant_Type.all = "String";
begin
if Is_String then
Put ("""");
if Info.Comment'Length > 0 then
Put (Spaces (Max_Constant_Value_Len - Info.Value_Len));
Put (" -- ");
end if;
Put (Info.Text_Value.all);
if Is_String then
Put ("""");
end if;
end;
end if;
if Lang = Lang_Ada then
Put (";");
if Info.Comment'Length > 0 then
Put (Spaces (Max_Constant_Value_Len - Info.Value_Len));
Put (" -- ");
end if;
end if;
end if;
end case;
if Lang = Lang_Ada then
Put (Info.Comment.all);
@ -349,13 +369,16 @@ procedure XOSCons is
Integer (Parse_Int (Line (Index1 .. Index2 - 1), CNU).Abs_Value);
case Info.Kind is
when CND | CNU | CNS | C =>
when CND | CNU | CNS | C | SUB =>
Index1 := Index2 + 1;
Find_Colon (Index2);
Info.Constant_Name := Field_Alloc;
if Info.Constant_Name'Length > Max_Constant_Name_Len then
if Info.Kind /= SUB
and then
Info.Constant_Name'Length > Max_Constant_Name_Len
then
Max_Constant_Name_Len := Info.Constant_Name'Length;
end if;