diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8542c7d8bf5..1154f3f6d16 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2012-10-29 Robert Dewar + + * gnat_rm.texi: Document that pragma Optimize_Alignment (Space) is + ignored with a warning for packed variable length records. + +2012-10-29 Thomas Quinot + + * 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 * exp_alfa.adb: Minor reformatting. diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 731919be3ba..c7b71208ff0 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -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); diff --git a/gcc/ada/g-socthi-dummy.adb b/gcc/ada/g-socthi-dummy.adb index b247c12e02b..b5ed8e26e15 100644 --- a/gcc/ada/g-socthi-dummy.adb +++ b/gcc/ada/g-socthi-dummy.adb @@ -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- -- diff --git a/gcc/ada/g-socthi-dummy.ads b/gcc/ada/g-socthi-dummy.ads index 36780a0ee0f..d7fc9824fc2 100644 --- a/gcc/ada/g-socthi-dummy.ads +++ b/gcc/ada/g-socthi-dummy.ads @@ -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- -- diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb index 972940221ff..ad82c167d67 100644 --- a/gcc/ada/g-socthi-mingw.adb +++ b/gcc/ada/g-socthi-mingw.adb @@ -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 diff --git a/gcc/ada/g-socthi-mingw.ads b/gcc/ada/g-socthi-mingw.ads index 03688f63946..b1493a7cfed 100644 --- a/gcc/ada/g-socthi-mingw.ads +++ b/gcc/ada/g-socthi-mingw.ads @@ -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 diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb index 51c28fb601a..8a49dc5b0d5 100644 --- a/gcc/ada/g-socthi-vms.adb +++ b/gcc/ada/g-socthi-vms.adb @@ -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 diff --git a/gcc/ada/g-socthi-vms.ads b/gcc/ada/g-socthi-vms.ads index 7b9f9173197..3aea7d22778 100644 --- a/gcc/ada/g-socthi-vms.ads +++ b/gcc/ada/g-socthi-vms.ads @@ -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 diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb index 33c5d0ca85c..87549edb6c6 100644 --- a/gcc/ada/g-socthi-vxworks.adb +++ b/gcc/ada/g-socthi-vxworks.adb @@ -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 diff --git a/gcc/ada/g-socthi-vxworks.ads b/gcc/ada/g-socthi-vxworks.ads index e019303bea0..793258baa96 100644 --- a/gcc/ada/g-socthi-vxworks.ads +++ b/gcc/ada/g-socthi-vxworks.ads @@ -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 diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb index 77551eec3c5..801936f9ba5 100644 --- a/gcc/ada/g-socthi.adb +++ b/gcc/ada/g-socthi.adb @@ -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 diff --git a/gcc/ada/g-socthi.ads b/gcc/ada/g-socthi.ads index 15747cf14a2..b034e258538 100644 --- a/gcc/ada/g-socthi.ads +++ b/gcc/ada/g-socthi.ads @@ -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 diff --git a/gcc/ada/g-sothco.ads b/gcc/ada/g-sothco.ads index f5f8e185aa9..b957f225e80 100644 --- a/gcc/ada/g-sothco.ads +++ b/gcc/ada/g-sothco.ads @@ -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 diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 2afdb676687..ef57af5217f 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -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: diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index 25299e8218f..c386a1f0b0b 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/gcc/ada/s-oscons-tmplt.c @@ -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) /* diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c index ee1f760daab..18999b394ea 100644 --- a/gcc/ada/socket.c +++ b/gcc/ada/socket.c @@ -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__) diff --git a/gcc/ada/xoscons.adb b/gcc/ada/xoscons.adb index 90d1b2d4de7..4c58ebaedd2 100644 --- a/gcc/ada/xoscons.adb +++ b/gcc/ada/xoscons.adb @@ -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;