diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 19 | ||||
| -rw-r--r-- | gcc/ada/adadecode.c | 3 | ||||
| -rw-r--r-- | gcc/ada/g-socket.adb | 47 | ||||
| -rw-r--r-- | gcc/ada/g-socket.ads | 17 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 57 | ||||
| -rw-r--r-- | gcc/ada/s-vxwext-kernel.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/s-vxwext-kernel.ads | 2 |
7 files changed, 109 insertions, 47 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 523ae77..2b98844 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2009-07-22 Ed Falis <falis@adacore.com> + + * s-vxwext-kernel.adb, s-vxwext-kernel.ads: Replace use of taskStop + with taskSuspend. + +2009-07-22 Arnaud Charlet <charlet@adacore.com> + + * adadecode.c: Make this file compilable outside of GCC. + +2009-07-22 Thomas Quinot <quinot@adacore.com> + + * g-socket.adb, g-socket.ads (Check_Selector): Make sure that + (partially) default-initialized socket sets are handled properly by + clearing their Set component. + +2009-07-22 Bob Duff <duff@adacore.com> + + * gnat_ugn.texi: Clarify the -gnatVx (validity checking) switches. + 2009-07-22 Robert Dewar <dewar@adacore.com> * gnat_ugn.texi: Minor reformatting diff --git a/gcc/ada/adadecode.c b/gcc/ada/adadecode.c index a6b528b..86216fc 100644 --- a/gcc/ada/adadecode.c +++ b/gcc/ada/adadecode.c @@ -33,6 +33,7 @@ #include "config.h" #include "system.h" #else +#include <string.h> #include <stdio.h> #include <ctype.h> #define ISDIGIT(c) isdigit(c) @@ -324,6 +325,7 @@ __gnat_decode (const char *coded_name, char *ada_name, int verbose) } } +#ifdef IN_GCC char * ada_demangle (const char *coded_name) { @@ -332,6 +334,7 @@ ada_demangle (const char *coded_name) __gnat_decode (coded_name, ada_name, 0); return xstrdup (ada_name); } +#endif void get_encoding (const char *coded_name, char *encoding) diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 5685cb5..c002054 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -56,10 +56,6 @@ package body GNAT.Sockets is ENOERROR : constant := 0; - Empty_Socket_Set : Socket_Set_Type; - -- Variable set in Initialize, and then used internally to provide an - -- initial value for Socket_Set_Type objects. - Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024; -- The network database functions gethostbyname, gethostbyaddr, -- getservbyname and getservbyport can either be guaranteed task safe by @@ -264,6 +260,11 @@ package body GNAT.Sockets is procedure Initialize (X : in out Sockets_Library_Controller); procedure Finalize (X : in out Sockets_Library_Controller); + procedure Normalize_Empty_Socket_Set (S : in out Socket_Set_Type); + -- If S is the empty set (detected by Last = No_Socket), make sure its + -- fd_set component is actually cleared. Note that the case where it is + -- not can occur for an uninitialized Socket_Set_Type object. + --------- -- "+" -- --------- @@ -452,7 +453,7 @@ package body GNAT.Sockets is Status : out Selector_Status; Timeout : Selector_Duration := Forever) is - E_Socket_Set : Socket_Set_Type := Empty_Socket_Set; + E_Socket_Set : Socket_Set_Type; begin Check_Selector (Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout); @@ -496,6 +497,12 @@ package body GNAT.Sockets is C.int (W_Socket_Set.Last)), C.int (E_Socket_Set.Last)); + -- Zero out fd_set for empty Socket_Set_Type objects + + Normalize_Empty_Socket_Set (R_Socket_Set); + Normalize_Empty_Socket_Set (W_Socket_Set); + Normalize_Empty_Socket_Set (E_Socket_Set); + Res := C_Select (Last + 1, @@ -705,7 +712,7 @@ package body GNAT.Sockets is procedure Copy (Source : Socket_Set_Type; - Target : in out Socket_Set_Type) + Target : out Socket_Set_Type) is begin Target := Source; @@ -760,7 +767,7 @@ package body GNAT.Sockets is -- Empty -- ----------- - procedure Empty (Item : in out Socket_Set_Type) is + procedure Empty (Item : out Socket_Set_Type) is begin Reset_Socket_Set (Item.Set'Access); Item.Last := No_Socket; @@ -1282,10 +1289,6 @@ package body GNAT.Sockets is pragma Unreferenced (X); begin - -- Initialization operation for the GNAT.Sockets package - - Empty_Socket_Set.Last := No_Socket; - Reset_Socket_Set (Empty_Socket_Set.Set'Access); Thin.Initialize; end Initialize; @@ -1408,6 +1411,17 @@ package body GNAT.Sockets is end if; end Narrow; + -------------------------------- + -- Normalize_Empty_Socket_Set -- + -------------------------------- + + procedure Normalize_Empty_Socket_Set (S : in out Socket_Set_Type) is + begin + if S.Last = No_Socket then + Reset_Socket_Set (S.Set'Access); + end if; + end Normalize_Empty_Socket_Set; + ------------------- -- Official_Name -- ------------------- @@ -1445,7 +1459,6 @@ package body GNAT.Sockets is R_Fd_Set : Socket_Set_Type; W_Fd_Set : Socket_Set_Type; - -- Socket sets, empty at elaboration begin -- Create selector if not provided by the user @@ -1470,14 +1483,6 @@ package body GNAT.Sockets is Check_Selector (S.all, R_Fd_Set, W_Fd_Set, Status, Timeout); - -- Cleanup actions (required in all cases to avoid memory leaks) - - if For_Read then - Empty (R_Fd_Set); - else - Empty (W_Fd_Set); - end if; - if Selector = null then Close_Selector (S.all); end if; @@ -1796,8 +1801,10 @@ package body GNAT.Sockets is if Id = Socket_Error_Id then return Resolve_Error (Val); + elsif Id = Host_Error_Id then return Resolve_Error (Val, False); + else return Cannot_Resolve_Error; end if; diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads index c5bf473..a260d90 100644 --- a/gcc/ada/g-socket.ads +++ b/gcc/ada/g-socket.ads @@ -1010,7 +1010,9 @@ package GNAT.Sockets is type Socket_Set_Type is limited private; -- This type allows to manipulate sets of sockets. It allows to wait for - -- events on multiple endpoints at one time. + -- events on multiple endpoints at one time. This type has default + -- initialization, and the default value is the empty set. + -- -- Note: This type used to contain a pointer to dynamically allocated -- storage, but this is not the case anymore, and no special precautions -- are required to avoid memory leaks. @@ -1018,10 +1020,10 @@ package GNAT.Sockets is procedure Clear (Item : in out Socket_Set_Type; Socket : Socket_Type); -- Remove Socket from Item - procedure Copy (Source : Socket_Set_Type; Target : in out Socket_Set_Type); + procedure Copy (Source : Socket_Set_Type; Target : out Socket_Set_Type); -- Copy Source into Target as Socket_Set_Type is limited private - procedure Empty (Item : in out Socket_Set_Type); + procedure Empty (Item : out Socket_Set_Type); -- Remove all Sockets from Item procedure Get (Item : in out Socket_Set_Type; Socket : out Socket_Type); @@ -1141,7 +1143,12 @@ private type Socket_Set_Type is record Last : Socket_Type := No_Socket; + -- Highest socket in set. Last = No_Socket denotes an empty set (which + -- is the default initial value). + Set : aliased Fd_Set; + -- Underlying socket set. Note that the contents of this component is + -- undefined if Last = No_Socket. end record; subtype Inet_Addr_Comp_Type is Natural range 0 .. 255; @@ -1188,9 +1195,7 @@ private subtype Name_Index is Natural range 1 .. Max_Name_Length; - type Name_Type - (Length : Name_Index := Max_Name_Length) - is record + type Name_Type (Length : Name_Index := Max_Name_Length) is record Name : String (1 .. Length); end record; -- We need fixed strings to avoid access types in host entry type diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 68bb855..f5e9ac3 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4084,7 +4084,8 @@ Generate brief messages to @file{stderr} even if verbose mode set. @item -gnatB @cindex @option{-gnatB} (@command{gcc}) -Assume no invalid (bad) values except for 'Valid attribute use. +Assume no invalid (bad) values except for 'Valid attribute use +(@pxref{Validity Checking}). @item -gnatc @cindex @option{-gnatc} (@command{gcc}) @@ -4327,8 +4328,7 @@ Verbose mode. Full error output with source lines to @file{stdout}. @item -gnatV @cindex @option{-gnatV} (@command{gcc}) -Control level of validity checking. See separate section describing -this feature. +Control level of validity checking (@pxref{Validity Checking}). @item ^-gnatw@var{xxx}^/WARNINGS=(@var{option}@r{[},@dots{}@r{]})^ @cindex @option{^-gnatw^/WARNINGS^} (@command{gcc}) @@ -4586,7 +4586,7 @@ as warning mode modifiers (see description of @option{-gnatw}). @item Once a ``V'' appears in the string (that is a use of the @option{-gnatV} switch), then all further characters in the switch are interpreted -as validity checking options (see description of @option{-gnatV}). +as validity checking options (@pxref{Validity Checking}). @end ifclear @end itemize @@ -5854,35 +5854,52 @@ file. Note that this doesn't include traceback information. @findex Validity Checking @noindent -The Ada Reference Manual has specific requirements for checking -for invalid values. In particular, RM 13.9.1 requires that the -evaluation of invalid values (for example from unchecked conversions), -not result in erroneous execution. In GNAT, the result of such an -evaluation in normal default mode is to either use the value -unmodified, or to raise Constraint_Error in those cases where use -of the unmodified value would cause erroneous execution. The cases -where unmodified values might lead to erroneous execution are case -statements (where a wild jump might result from an invalid value), -and subscripts on the left hand side (where memory corruption could -occur as a result of an invalid value). +The Ada Reference Manual defines the concept of invalid values (see +RM 13.9.1). The primary source of invalid values is uninitialized +variables. A scalar variable that is left uninitialized may contain +an invalid value; the concept of invalid does not apply to access or +composite types. + +It is an error to read an invalid value, but the RM does not require +run-time checks to detect such errors, except for some minimal +checking to prevent erroneous execution (i.e. unpredictable +behavior). This corresponds to the @option{-gnatVd} switch below, +which is the default. For example, by default, if the expression of a +case statement is invalid, it will raise Constraint_Error rather than +causing a wild jump, and if an array index on the left-hand side of an +assignment is invalid, it will raise Constraint_Error rather than +overwriting an arbitrary memory location. + +The @option{-gnatVa} may be used to enable additional validity checks, +which are not required by the RM. These checks are often very +expensive (which is why the RM does not require them). These checks +are useful in tracking down uninitialized variables, but they are +not usually recommended for production builds. + +The other @option{-gnatV^@var{x}^^} switches below allow finer-grained +control; you can enable whichever validity checks you desire. However, +for most debugging purposes, @option{-gnatVa} is sufficient, and the +default @option{-gnatVd} (i.e. standard Ada behavior) is usually +sufficient for non-debugging use. The @option{-gnatB} switch tells the compiler to assume that all values are valid (that is, within their declared subtype range) except in the context of a use of the Valid attribute. This means the compiler can generate more efficient code, since the range -of values is better known at compile time. +of values is better known at compile time. However, an uninitialized +variable can cause wild jumps and memory corruption in this mode. -The @option{-gnatV^@var{x}^^} switch allows more control over the validity -checking mode. +The @option{-gnatV^@var{x}^^} switch allows control over the validity +checking mode as described below. @ifclear vms The @code{x} argument is a string of letters that indicate validity checks that are performed or not performed in addition -to the default checks described above. +to the default checks required by Ada as described above. @end ifclear @ifset vms The options allowed for this qualifier indicate validity checks that are performed or not performed in addition -to the default checks described above. +to the default checks required by Ada as described above. @end ifset @table @option diff --git a/gcc/ada/s-vxwext-kernel.adb b/gcc/ada/s-vxwext-kernel.adb index a8455bb..d43edf1 100644 --- a/gcc/ada/s-vxwext-kernel.adb +++ b/gcc/ada/s-vxwext-kernel.adb @@ -75,4 +75,15 @@ package body System.VxWorks.Ext is return ERROR; end taskCpuAffinitySet; + -------------- + -- taskStop -- + -------------- + + function Task_Stop (tid : t_id) return int is + function taskStop (tid : t_id) return int; + pragma Import (C, taskStop, "taskStop"); + begin + return taskStop (tid); + end Task_Stop; + end System.VxWorks.Ext; diff --git a/gcc/ada/s-vxwext-kernel.ads b/gcc/ada/s-vxwext-kernel.ads index 83d4d67..e450285 100644 --- a/gcc/ada/s-vxwext-kernel.ads +++ b/gcc/ada/s-vxwext-kernel.ads @@ -70,7 +70,7 @@ package System.VxWorks.Ext is pragma Import (C, Task_Cont, "taskCont"); function Task_Stop (tid : t_id) return int; - pragma Import (C, Task_Stop, "taskStop"); + pragma Convention (C, Task_Stop); function kill (pid : t_id; sig : int) return int; pragma Import (C, kill, "kill"); |