+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.
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);
-- --
-- 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- --
-- --
-- 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- --
-- --
-- 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- --
function Socket_Ioctl
(S : C.int;
- Req : C.int;
+ Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int
is
begin
-- --
-- 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- --
function Socket_Ioctl
(S : C.int;
- Req : C.int;
+ Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int;
function C_Listen
-- --
-- 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- --
function Socket_Ioctl
(S : C.int;
- Req : C.int;
+ Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int
is
begin
-- --
-- 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- --
function Socket_Ioctl
(S : C.int;
- Req : C.int;
+ Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int;
function C_Listen
-- --
-- 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- --
function Socket_Ioctl
(S : C.int;
- Req : C.int;
+ Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int
is
begin
-- --
-- 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- --
function Socket_Ioctl
(S : C.int;
- Req : C.int;
+ Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int;
function C_Listen
-- --
-- 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- --
function Socket_Ioctl
(S : C.int;
- Req : C.int;
+ Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int
is
begin
-- --
-- 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- --
function Socket_Ioctl
(S : C.int;
- Req : C.int;
+ Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int;
function C_Listen
-- --
-- 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- --
function C_Ioctl
(Fd : C.int;
- Req : C.int;
+ Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int;
private
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:
#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__);
: : "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__));
#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
*/
+/* 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
*/
#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)
/*
* *
* 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- *
#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
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)
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);
/* 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__)
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.
-- 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 (" := ");
- end if;
+ null;
- when Lang_C =>
- Put ("#define " & Info.Constant_Name.all & " ");
- Put (Spaces (Max_Constant_Name_Len
- - Info.Constant_Name'Length));
- end case;
+ 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;
- if Info.Kind in Asm_Int_Kind then
- if not Info.Int_Value.Positive then
- Put ("-");
- end if;
+ when others =>
- Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left));
+ -- 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;
- else
- declare
- Is_String : constant Boolean :=
- Info.Kind = C
- and then Info.Constant_Type.all = "String";
-
- begin
- if Is_String then
- Put ("""");
+ 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;
- Put (Info.Text_Value.all);
+ Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left));
- if Is_String then
- Put ("""");
- end if;
- end;
- end if;
+ else
+ declare
+ Is_String : constant Boolean :=
+ Info.Kind = C
+ and then Info.Constant_Type.all = "String";
+
+ begin
+ if Is_String then
+ Put ("""");
+ end if;
- if Lang = Lang_Ada then
- Put (";");
+ Put (Info.Text_Value.all);
- if Info.Comment'Length > 0 then
- Put (Spaces (Max_Constant_Value_Len - Info.Value_Len));
- Put (" -- ");
+ if Is_String then
+ Put ("""");
+ end if;
+ end;
end if;
- end if;
- 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 case;
if Lang = Lang_Ada then
Put (Info.Comment.all);
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;
projects / thirdparty / gcc.git / commitdiff
