Commit 6db566c3 by Arnaud Charlet

[multiple changes]

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
parent 43254605
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> 2012-10-29 Gary Dismukes <dismukes@adacore.com>
* exp_alfa.adb: Minor reformatting. * exp_alfa.adb: Minor reformatting.
......
...@@ -80,7 +80,7 @@ package body GNAT.Sockets is ...@@ -80,7 +80,7 @@ package body GNAT.Sockets is
Shut_Write => SOSC.SHUT_WR, Shut_Write => SOSC.SHUT_WR,
Shut_Read_Write => SOSC.SHUT_RDWR); 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, (Non_Blocking_IO => SOSC.FIONBIO,
N_Bytes_To_Read => SOSC.FIONREAD); N_Bytes_To_Read => SOSC.FIONREAD);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -256,7 +256,7 @@ package body GNAT.Sockets.Thin is ...@@ -256,7 +256,7 @@ package body GNAT.Sockets.Thin is
function Socket_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int Arg : access C.int) return C.int
is is
begin begin
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -118,7 +118,7 @@ package GNAT.Sockets.Thin is ...@@ -118,7 +118,7 @@ package GNAT.Sockets.Thin is
function Socket_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int; Arg : access C.int) return C.int;
function C_Listen function C_Listen
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -227,7 +227,7 @@ package body GNAT.Sockets.Thin is ...@@ -227,7 +227,7 @@ package body GNAT.Sockets.Thin is
function Socket_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int Arg : access C.int) return C.int
is is
begin begin
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -121,7 +121,7 @@ package GNAT.Sockets.Thin is ...@@ -121,7 +121,7 @@ package GNAT.Sockets.Thin is
function Socket_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int; Arg : access C.int) return C.int;
function C_Listen function C_Listen
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -235,7 +235,7 @@ package body GNAT.Sockets.Thin is ...@@ -235,7 +235,7 @@ package body GNAT.Sockets.Thin is
function Socket_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int Arg : access C.int) return C.int
is is
begin begin
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -119,7 +119,7 @@ package GNAT.Sockets.Thin is ...@@ -119,7 +119,7 @@ package GNAT.Sockets.Thin is
function Socket_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int; Arg : access C.int) return C.int;
function C_Listen function C_Listen
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -233,7 +233,7 @@ package body GNAT.Sockets.Thin is ...@@ -233,7 +233,7 @@ package body GNAT.Sockets.Thin is
function Socket_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int Arg : access C.int) return C.int
is is
begin begin
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -120,7 +120,7 @@ package GNAT.Sockets.Thin is ...@@ -120,7 +120,7 @@ package GNAT.Sockets.Thin is
function Socket_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int; Arg : access C.int) return C.int;
function C_Listen function C_Listen
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -385,7 +385,7 @@ package GNAT.Sockets.Thin_Common is ...@@ -385,7 +385,7 @@ package GNAT.Sockets.Thin_Common is
function C_Ioctl function C_Ioctl
(Fd : C.int; (Fd : C.int;
Req : C.int; Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int; Arg : access C.int) return C.int;
private private
......
...@@ -4032,6 +4032,12 @@ allowed to be bigger than the size of the type, but it can waste space if for ...@@ -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 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. 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 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: small types with sizes that are not a power of 2. For example, consider:
......
...@@ -182,6 +182,9 @@ int counter = 0; ...@@ -182,6 +182,9 @@ int counter = 0;
#define C(sname,type,value,comment)\ #define C(sname,type,value,comment)\
printf ("\n->C:$%d:" sname ":" #type ":" value ":" comment, __LINE__); printf ("\n->C:$%d:" sname ":" #type ":" value ":" comment, __LINE__);
#define SUB(sname)\
printf ("\n->SUB:$%d:" #sname ":" sname, __LINE__);
#define TXT(text) \ #define TXT(text) \
printf ("\n->TXT:$%d:" text, __LINE__); printf ("\n->TXT:$%d:" text, __LINE__);
...@@ -209,6 +212,11 @@ int counter = 0; ...@@ -209,6 +212,11 @@ int counter = 0;
: : "i" (__LINE__)); : : "i" (__LINE__));
/* Typed constant */ /* Typed constant */
#define SUB(sname) \
asm volatile("\n->SUB:%0:" #sname ":" sname \
: : "i" (__LINE__));
/* Subtype */
#define TXT(text) \ #define TXT(text) \
asm volatile("\n->TXT:%0:" text \ asm volatile("\n->TXT:%0:" text \
: : "i" (__LINE__)); : : "i" (__LINE__));
...@@ -217,14 +225,7 @@ int counter = 0; ...@@ -217,14 +225,7 @@ int counter = 0;
#endif /* NATIVE */ #endif /* NATIVE */
#define CST(name,comment) C(#name,String,name,comment) #define CST(name,comment) C(#name,String,name,comment)
/* String constant */
/* ioctl(2) requests are "int" in UNIX, but "unsigned long" on FreeBSD */
#ifdef __FreeBSD__
# define CNI CNU
#else
# define CNI CND
#endif
#define STR(x) STR1(x) #define STR(x) STR1(x)
#define STR1(x) #x #define STR1(x) #x
...@@ -378,6 +379,18 @@ CND(FNDELAY, "Nonblocking") ...@@ -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 #ifndef FIONBIO
# define FIONBIO -1 # define FIONBIO -1
#endif #endif
...@@ -1333,12 +1346,12 @@ CND(SIZEOF_sigset, "sigset"); ...@@ -1333,12 +1346,12 @@ CND(SIZEOF_sigset, "sigset");
*/ */
#if defined (__sun__) || defined (__hpux__) #if defined (__sun__) || defined (__hpux__)
# define msg_iovlen_t "int" # define Msg_Iovlen_T "int"
#else #else
# define msg_iovlen_t "size_t" # define Msg_Iovlen_T "size_t"
#endif #endif
TXT(" subtype Msg_Iovlen_T is Interfaces.C." msg_iovlen_t ";") SUB(Msg_Iovlen_T)
/* /*
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * 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 * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -33,7 +33,7 @@ ...@@ -33,7 +33,7 @@
#include "gsocket.h" #include "gsocket.h"
#ifdef VMS #if defined(VMS)
/* /*
* For VMS, gsocket.h can't include sockets-related DEC C header files * 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 * when building the runtime (because these files are in a DEC C text library
...@@ -65,6 +65,10 @@ struct servent { ...@@ -65,6 +65,10 @@ struct servent {
int s_port; int s_port;
__netdb_char_ptr s_proto; __netdb_char_ptr s_proto;
}; };
#elif defined(__FreeBSD__)
typedef unsigned int IOCTL_Req_T;
#else
typedef int IOCTL_Req_T;
#endif #endif
#if defined(HAVE_SOCKETS) #if defined(HAVE_SOCKETS)
...@@ -98,7 +102,7 @@ extern fd_set *__gnat_new_socket_set (fd_set *); ...@@ -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_remove_socket_from_set (fd_set *, int);
extern void __gnat_reset_socket_set (fd_set *); extern void __gnat_reset_socket_set (fd_set *);
extern int __gnat_get_h_errno (void); 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_name (struct servent *);
extern char * __gnat_servent_s_alias (struct servent *, int index); extern char * __gnat_servent_s_alias (struct servent *, int index);
...@@ -526,7 +530,7 @@ __gnat_get_h_errno (void) { ...@@ -526,7 +530,7 @@ __gnat_get_h_errno (void) {
/* Wrapper for ioctl(2), which is a variadic function */ /* Wrapper for ioctl(2), which is a variadic function */
int int
__gnat_socket_ioctl (int fd, int req, int *arg) { __gnat_socket_ioctl (int fd, IOCTL_Req_T req, int *arg) {
#if defined (_WIN32) #if defined (_WIN32)
return ioctlsocket (fd, req, arg); return ioctlsocket (fd, req, arg);
#elif defined (__APPLE__) #elif defined (__APPLE__)
......
...@@ -76,6 +76,7 @@ procedure XOSCons is ...@@ -76,6 +76,7 @@ procedure XOSCons is
CNU, -- Named number (decimal, unsigned) CNU, -- Named number (decimal, unsigned)
CNS, -- Named number (freeform text) CNS, -- Named number (freeform text)
C, -- Constant object C, -- Constant object
SUB, -- Subtype
TXT); -- Literal text TXT); -- Literal text
-- Recognized markers found in assembly file. These markers are produced by -- Recognized markers found in assembly file. These markers are produced by
-- the same-named macros from the C template. -- the same-named macros from the C template.
...@@ -181,9 +182,28 @@ procedure XOSCons is ...@@ -181,9 +182,28 @@ procedure XOSCons is
-- Start of processing for Output_Info -- Start of processing for Output_Info
begin begin
-- Case of non-TXT case (TXT case handled by common code below) case Info.Kind is
when TXT =>
-- Handled in the common code for comments below
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
if Info.Kind /= TXT then
case Lang is case Lang is
when Lang_Ada => when Lang_Ada =>
Put (" " & Info.Constant_Name.all); Put (" " & Info.Constant_Name.all);
...@@ -239,7 +259,7 @@ procedure XOSCons is ...@@ -239,7 +259,7 @@ procedure XOSCons is
Put (" -- "); Put (" -- ");
end if; end if;
end if; end if;
end if; end case;
if Lang = Lang_Ada then if Lang = Lang_Ada then
Put (Info.Comment.all); Put (Info.Comment.all);
...@@ -349,13 +369,16 @@ procedure XOSCons is ...@@ -349,13 +369,16 @@ procedure XOSCons is
Integer (Parse_Int (Line (Index1 .. Index2 - 1), CNU).Abs_Value); Integer (Parse_Int (Line (Index1 .. Index2 - 1), CNU).Abs_Value);
case Info.Kind is case Info.Kind is
when CND | CNU | CNS | C => when CND | CNU | CNS | C | SUB =>
Index1 := Index2 + 1; Index1 := Index2 + 1;
Find_Colon (Index2); Find_Colon (Index2);
Info.Constant_Name := Field_Alloc; 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; Max_Constant_Name_Len := Info.Constant_Name'Length;
end if; end if;
......
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