[multiple changes]

2010-01-26  Robert Dewar  <dewar@adacore.com>

	* s-commun.ads, s-osprim-mingw.adb, s-stchop-vxworks.adb, sem_aggr.adb,
	s-vxwext.adb, sem_ch10.adb, sem_eval.adb, sem_prag.adb: Minor
	reformatting.

2010-01-26  Vasiliy Fofanov  <fofanov@adacore.com>

	* g-regist.adb, g-regist.ads (For_Every_Key): New generic procedure
	that allows to iterate over all subkeys of a key.

2010-01-26  Ed Falis  <falis@adacore.com>

	* sysdep.c: enable NFS for VxWorks MILS
	* env.c: enable __gnat_environ for VxWorks MILS
	* gcc-interface/Makefile.in: Add VxWorks MILS target pairs.

From-SVN: r156233

gcc/ada/ChangeLog

+2010-01-26  Robert Dewar  <dewar@adacore.com>
+
+	* s-commun.ads, s-osprim-mingw.adb, s-stchop-vxworks.adb, sem_aggr.adb,
+	s-vxwext.adb, sem_ch10.adb, sem_eval.adb, sem_prag.adb: Minor
+	reformatting.
+
+2010-01-26  Vasiliy Fofanov  <fofanov@adacore.com>
+
+	* g-regist.adb, g-regist.ads (For_Every_Key): New generic procedure
+	that allows to iterate over all subkeys of a key.
+
+2010-01-26  Ed Falis  <falis@adacore.com>
+
+	* sysdep.c: enable NFS for VxWorks MILS
+	* env.c: enable __gnat_environ for VxWorks MILS
+	* gcc-interface/Makefile.in: Add VxWorks MILS target pairs.
+
 2010-01-25  Bob Duff  <duff@adacore.com>
 
 	* sem_aggr.adb (Resolve_Array_Aggregate): Check for the case where this

gcc/ada/env.c

@@ -52,7 +52,8 @@
 #include <stdlib.h>
 #endif
 
-#if defined (__vxworks) && ! (defined (__RTP__) || defined (__COREOS__))
+#if defined (__vxworks) \
+  && ! (defined (__RTP__) || defined (__COREOS__) || defined (__VXWORKSMILS__))
 #include "envLib.h"
 extern char** ppGlobalEnviron;
 #endif
@@ -198,7 +199,8 @@ __gnat_setenv (char *name, char *value)
 char **
 __gnat_environ (void)
 {
-#if defined (VMS) || defined (RTX) || defined (VTHREADS)
+#if defined (VMS) || defined (RTX) \
+   || (defined (VTHREADS) && ! defined (__VXWORKSMILS__))
   /* Not implemented */
   return NULL;
 #elif defined (__APPLE__)
@@ -210,9 +212,11 @@ __gnat_environ (void)
   extern char **_environ;
   return _environ;
 #else
-#if ! (defined (__vxworks) && ! (defined (__RTP__) || defined (__COREOS__)))
+#if ! (defined (__vxworks) \
+   && ! (defined (__RTP__) || defined (__COREOS__) \
+   || defined (__VXWORKSMILS__)))
   /* in VxWorks kernel mode environ is macro and not a variable */
-  /* same thing on 653 in the CoreOS */
+  /* same thing on 653 in the CoreOS and for VxWorks MILS vThreads */
   extern char **environ;
 #endif
   return environ;

gcc/ada/g-regist.adb

@@ -122,6 +122,13 @@ package body GNAT.Registry is
       cbData      : DWORD) return LONG;
    pragma Import (Stdcall, RegSetValueEx, "RegSetValueExA");
 
+   function RegEnumKey
+     (Key         : HKEY;
+      dwIndex     : DWORD;
+      lpName      : Address;
+      cchName     : DWORD) return LONG;
+   pragma Import (Stdcall, RegEnumKey, "RegEnumKeyA");
+
    ---------------------
    -- Local Constants --
    ---------------------
@@ -231,6 +238,75 @@ package body GNAT.Registry is
       Check_Result (Result, "Delete_Value " & Sub_Key);
    end Delete_Value;
 
+   -------------------
+   -- For_Every_Key --
+   -------------------
+
+   procedure For_Every_Key
+     (From_Key : HKEY;
+      Recursive : Boolean := False)
+   is
+      procedure Recursive_For_Every_Key
+        (From_Key  : HKEY;
+         Recursive : Boolean := False;
+         Quit      : in out Boolean);
+
+      procedure Recursive_For_Every_Key
+        (From_Key : HKEY;
+         Recursive : Boolean := False;
+         Quit      : in out Boolean)
+      is
+
+         use type LONG;
+         use type ULONG;
+
+         Index  : ULONG := 0;
+         Result : LONG;
+
+         Sub_Key : Interfaces.C.char_array (1 .. Max_Key_Size);
+         pragma Warnings (Off, Sub_Key);
+
+         Size_Sub_Key : aliased ULONG;
+         Sub_Hkey     : HKEY;
+
+         function Current_Name return String;
+
+         function Current_Name return String is
+         begin
+            return Interfaces.C.To_Ada (Sub_Key);
+         end Current_Name;
+
+      begin
+         loop
+            Size_Sub_Key := Sub_Key'Length;
+
+            Result :=
+              RegEnumKey
+                (From_Key, Index, Sub_Key (1)'Address, Size_Sub_Key);
+
+            exit when not (Result = ERROR_SUCCESS);
+
+            Action (Natural (Index) + 1, From_Key, Current_Name, Quit);
+
+            exit when Quit;
+
+            if Recursive then
+               Sub_Hkey := Open_Key (From_Key, Interfaces.C.To_Ada (Sub_Key));
+               Recursive_For_Every_Key (Sub_Hkey, True, Quit);
+               Close_Key (Sub_Hkey);
+            end if;
+
+            exit when Quit;
+
+            Index := Index + 1;
+         end loop;
+      end Recursive_For_Every_Key;
+
+      Quit : Boolean := False;
+   begin
+      Recursive_For_Every_Key (From_Key, Recursive, Quit);
+   end For_Every_Key;
+
    -------------------------
    -- For_Every_Key_Value --
    -------------------------
@@ -394,7 +470,8 @@ package body GNAT.Registry is
 
       if Type_Value = REG_EXPAND_SZ and then Expand then
          return Directory_Operations.Expand_Path
-           (Value (1 .. Integer (Size_Value - 1)), Directory_Operations.DOS);
+           (Value (1 .. Integer (Size_Value - 1)),
+            Directory_Operations.DOS);
       else
          return Value (1 .. Integer (Size_Value - 1));
       end if;

gcc/ada/g-regist.ads

@@ -111,6 +111,19 @@ package GNAT.Registry is
    generic
       with procedure Action
         (Index    : Positive;
+         Key      : HKEY;
+         Key_Name : String;
+         Quit     : in out Boolean);
+   procedure For_Every_Key (From_Key : HKEY; Recursive : Boolean := False);
+   --  Iterates over all the keys registered under From_Key, recursively if
+   --  Recursive is set to True. Index will be set to 1 for the first key and
+   --  will be incremented by one in each iteration. The current key of an
+   --  iteration is set in Key, and its name - in Key_Name. Quit can be set
+   --  to True to stop iteration; its initial value is False.
+
+   generic
+      with procedure Action
+        (Index   : Positive;
          Sub_Key : String;
          Value   : String;
          Quit    : in out Boolean);
@@ -126,6 +139,9 @@ package GNAT.Registry is
    --  with this case. Furthermore, if Expand is set to True and the Sub_Key
    --  is a REG_EXPAND_SZ the returned value will have the %name% variables
    --  replaced by the corresponding environment variable value.
+   --
+   --  This iterator can be used in conjunction with For_Every_Key in
+   --  order to analyze all subkeys and values of a given registry key.
 
 private
 

gcc/ada/gcc-interface/Makefile.in

@@ -536,7 +536,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
   EXTRA_LIBGNAT_OBJS+=vx_stack_info.o
 endif
 
-# vxworksae / vxworks 653
+# vxworks 653
 ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
   # target pairs for vthreads runtime
   LIBGNAT_TARGET_PAIRS = \
@@ -599,8 +599,59 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
   endif
 endif
 
-# vxworksae / vxworks 653 for x86 (vxsim)
-ifeq ($(strip $(filter-out %86 wrs vxworksae,$(targ))),)
+# vxworks MILS
+ifeq ($(strip $(filter-out powerpc% wrs vxworksmils,$(targ))),)
+  # target pairs for vthreads runtime
+  LIBGNAT_TARGET_PAIRS = \
+  a-intnam.ads<a-intnam-vxworks.ads \
+  a-numaux.ads<a-numaux-vxworks.ads \
+  g-io.adb<g-io-vxworks-ppc-cert.adb \
+  g-io.ads<g-io-vxworks-ppc-cert.ads \
+  s-inmaop.adb<s-inmaop-posix.adb \
+  s-interr.adb<s-interr-hwint.adb \
+  s-intman.ads<s-intman-vxworks.ads \
+  s-intman.adb<s-intman-vxworks.adb \
+  s-osinte.adb<s-osinte-vxworks.adb \
+  s-osinte.ads<s-osinte-vxworks.ads \
+  s-osprim.adb<s-osprim-vxworks.adb \
+  s-parame.ads<s-parame-ae653.ads \
+  s-parame.adb<s-parame-vxworks.adb \
+  s-stchop.adb<s-stchop-vxworks.adb \
+  s-stchop.ads<s-stchop-limit.ads \
+  s-taprop.adb<s-taprop-vxworks.adb \
+  s-tasinf.ads<s-tasinf-vxworks.ads \
+  s-taspri.ads<s-taspri-vxworks.ads \
+  s-thread.adb<s-thread-ae653.adb \
+  s-tpopsp.adb<s-tpopsp-vxworks.adb \
+  s-vxwork.ads<s-vxwork-ppc.ads \
+  g-trasym.ads<g-trasym-unimplemented.ads \
+  g-trasym.adb<g-trasym-unimplemented.adb \
+  system.ads<system-vxworks-ppc.ads \
+  $(DUMMY_SOCKETS_TARGET_PAIRS)
+
+  TOOLS_TARGET_PAIRS=\
+  mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
+  indepsw.adb<indepsw-gnu.adb
+
+  EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o s-vxwexc.o
+  EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
+
+  EXTRA_LIBGNAT_SRCS+=vx_stack_info.c
+  EXTRA_LIBGNAT_OBJS+=vx_stack_info.o
+  GNATRTL_SOCKETS_OBJS =
+
+  ifeq ($(strip $(filter-out yes,$(TRACE))),)
+    LIBGNAT_TARGET_PAIRS += \
+    s-traces.adb<s-traces-default.adb \
+    s-trafor.adb<s-trafor-default.adb \
+    s-trafor.ads<s-trafor-default.ads \
+    s-tratas.adb<s-tratas-default.adb \
+    s-tfsetr.adb<s-tfsetr-vxworks.adb
+  endif
+endif
+
+# vxworksae / vxworks 653 for x86 (vxsim) - ?? vxworksmils not implemented
+ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(targ))),)
   # target pairs for kernel + vthreads runtime
   LIBGNAT_TARGET_PAIRS = \
   a-elchha.adb<a-elchha-vxworks-ppc-full.adb \
@@ -623,7 +674,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae,$(targ))),)
   s-taprop.adb<s-taprop-vxworks.adb \
   s-tasinf.ads<s-tasinf-vxworks.ads \
   s-taspri.ads<s-taspri-vxworks.ads \
-  s-thread.adb<s-thread-ae653.adb \
   s-tpopsp.adb<s-tpopsp-vxworks.adb \
   s-vxwext.adb<s-vxwext-noints.adb \
   s-vxwext.ads<s-vxwext-vthreads.ads \

gcc/ada/s-commun.ads

@@ -41,6 +41,7 @@ package System.Communication is
       Count : CRTL.size_t) return Ada.Streams.Stream_Element_Offset;
    --  Compute the Last OUT parameter for the various Read / Receive
    --  subprograms: returns First + Count - 1.
+   --
    --  When First = Stream_Element_Offset'First and Res = 0, Constraint_Error
    --  is raised. This is consistent with the semantics of stream operations
    --  as clarified in AI95-227.

gcc/ada/s-osprim-mingw.adb

@@ -199,12 +199,14 @@ package body System.OS_Primitives is
 
          loop
             GetSystemTimeAsFileTime (Loc_Time'Access);
+
             if QueryPerformanceCounter (Ctrl_Ticks'Access) = Win32.FALSE then
                pragma Assert
                  (Standard.False,
                   "Could not query high performance counter in Clock");
                null;
             end if;
+
             exit when Loc_Time /= Ctrl_Time;
             Loc_Ticks := Ctrl_Ticks;
          end loop;
@@ -218,7 +220,9 @@ package body System.OS_Primitives is
             Base_Time   := Loc_Time;
             Base_Ticks  := Loc_Ticks;
             Current_Max := Elapsed;
+
             --  Exit the loop when we have reached the expected precision
+
             exit when Elapsed <= Max_Elapsed;
          end if;
       end loop;

gcc/ada/s-stchop-vxworks.adb

@@ -29,9 +29,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is the VxWorks version of this package.
+--  This is the verson for VxWorks 5 and VxWorks MILS
+
 --  This file should be kept synchronized with the general implementation
---  provided by s-stchop.adb. This version is for VxWorks 5 and VxWorks MILS.
+--  provided by s-stchop.adb.
 
 pragma Restrictions (No_Elaboration_Code);
 --  We want to guarantee the absence of elaboration code because the

gcc/ada/s-vxwext.adb

@@ -28,9 +28,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package provides vxworks specific support functions needed
---  by System.OS_Interface.
-
 --  This is the VxWorks 5 and VxWorks MILS version of this package
 
 package body System.VxWorks.Ext is

gcc/ada/sem_aggr.adb

@@ -1936,9 +1936,8 @@ package body Sem_Aggr is
                     and then Compile_Time_Known_Value (Choices_Low)
                     and then Compile_Time_Known_Value (Choices_High)
                   then
-
                      --  If the bounds have semantic errors, do not attempt
-                     --  further resolution to prevent cascaded errors..
+                     --  further resolution to prevent cascaded errors.
 
                      if Error_Posted (Choices_Low)
                        or else Error_Posted (Choices_High)
@@ -1955,7 +1954,7 @@ package body Sem_Aggr is
                         Ent : Entity_Id;
 
                      begin
-                        --  Warning case one, missing values at start/end. Only
+                        --  Warning case 1, missing values at start/end. Only
                         --  do the check if the number of entries is too small.
 
                         if (Enumeration_Pos (CHi) - Enumeration_Pos (CLo))
@@ -2067,14 +2066,14 @@ package body Sem_Aggr is
                Check_Can_Never_Be_Null (Etype (N), Expression (Assoc));
             end if;
 
-            --  Ada 2005 (AI-287): In case of default initialized component
+            --  Ada 2005 (AI-287): In case of default initialized component,
             --  we delay the resolution to the expansion phase.
 
             if Box_Present (Assoc) then
 
-               --  Ada 2005 (AI-287): In case of default initialization
-               --  of a component the expander will generate calls to
-               --  the corresponding initialization subprogram.
+               --  Ada 2005 (AI-287): In case of default initialization of a
+               --  component the expander will generate calls to the
+               --  corresponding initialization subprogram.
 
                null;
 
@@ -2162,7 +2161,7 @@ package body Sem_Aggr is
 
       --  Do not duplicate Aggr_High if Aggr_High = Aggr_Low + Nb_Elements
       --  since the addition node returned by Add is not yet analyzed. Attach
-      --  to tree and analyze first. Reset analyzed flag to insure it will get
+      --  to tree and analyze first. Reset analyzed flag to ensure it will get
       --  analyzed when it is a literal bound whose type must be properly set.
 
       if Others_Present or else Nb_Discrete_Choices > 0 then
@@ -2208,20 +2207,20 @@ package body Sem_Aggr is
 
    --  There are two cases to consider:
 
-   --  a) If the ancestor part is a type mark, the components needed are
-   --  the difference between the components of the expected type and the
+   --  a) If the ancestor part is a type mark, the components needed are the
+   --  difference between the components of the expected type and the
    --  components of the given type mark.
 
-   --  b) If the ancestor part is an expression, it must be unambiguous,
-   --  and once we have its type we can also compute the needed  components
-   --  as in the previous case. In both cases, if the ancestor type is not
-   --  the immediate ancestor, we have to build this ancestor recursively.
+   --  b) If the ancestor part is an expression, it must be unambiguous, and
+   --  once we have its type we can also compute the needed  components as in
+   --  the previous case. In both cases, if the ancestor type is not the
+   --  immediate ancestor, we have to build this ancestor recursively.
 
-   --  In both cases discriminants of the ancestor type do not play a
-   --  role in the resolution of the needed components, because inherited
-   --  discriminants cannot be used in a type extension. As a result we can
-   --  compute independently the list of components of the ancestor type and
-   --  of the expected type.
+   --  In both cases discriminants of the ancestor type do not play a role in
+   --  the resolution of the needed components, because inherited discriminants
+   --  cannot be used in a type extension. As a result we can compute
+   --  independently the list of components of the ancestor type and of the
+   --  expected type.
 
    procedure Resolve_Extension_Aggregate (N : Node_Id; Typ : Entity_Id) is
       A      : constant Node_Id := Ancestor_Part (N);
@@ -2231,8 +2230,8 @@ package body Sem_Aggr is
 
       function Valid_Limited_Ancestor (Anc : Node_Id) return Boolean;
       --  If the type is limited, verify that the ancestor part is a legal
-      --  expression (aggregate or function call, including 'Input)) that
-      --  does not require a copy, as specified in 7.5 (2).
+      --  expression (aggregate or function call, including 'Input)) that does
+      --  not require a copy, as specified in 7.5(2).
 
       function Valid_Ancestor_Type return Boolean;
       --  Verify that the type of the ancestor part is a non-private ancestor
@@ -2257,9 +2256,7 @@ package body Sem_Aggr is
          then
             return True;
 
-         elsif
-           Nkind (Anc) = N_Qualified_Expression
-         then
+         elsif Nkind (Anc) = N_Qualified_Expression then
             return Valid_Limited_Ancestor (Expression (Anc));
 
          else
@@ -2281,9 +2278,9 @@ package body Sem_Aggr is
                return True;
 
             --  The base type of the parent type may appear as  a private
-            --  extension if it is declared as such in a parent unit of
-            --  the current one. For consistency of the subsequent analysis
-            --  use the partial view for the ancestor part.
+            --  extension if it is declared as such in a parent unit of the
+            --  current one. For consistency of the subsequent analysis use
+            --  the partial view for the ancestor part.
 
             elsif Is_Private_Type (Etype (Imm_Type))
               and then Present (Full_View (Etype (Imm_Type)))
@@ -2305,8 +2302,8 @@ package body Sem_Aggr is
    --  Start of processing for Resolve_Extension_Aggregate
 
    begin
-      --  Analyze the ancestor part and account for the case where it's
-      --  a parameterless function call.
+      --  Analyze the ancestor part and account for the case where it is a
+      --  parameterless function call.
 
       Analyze (A);
       Check_Parameterless_Call (A);
@@ -2410,14 +2407,14 @@ package body Sem_Aggr is
               and then Nkind (Original_Node (A)) = N_Function_Call
             then
                --  If the ancestor part is a dispatching call, it appears
-               --  statically to be a legal ancestor, but it yields any
-               --  member of the class, and it is not possible to determine
-               --  whether it is an ancestor of the extension aggregate (much
-               --  less which ancestor). It is not possible to determine the
-               --  required components of the extension part.
+               --  statically to be a legal ancestor, but it yields any member
+               --  of the class, and it is not possible to determine whether
+               --  it is an ancestor of the extension aggregate (much less
+               --  which ancestor). It is not possible to determine the
+               --  components of the extension part.
 
-               --  This check implements AI-306, which in fact was motivated
-               --  by an ACT query to the ARG after this test was added.
+               --  This check implements AI-306, which in fact was motivated by
+               --  an AdaCore query to the ARG after this test was added.
 
                Error_Msg_N ("ancestor part must be statically tagged", A);
             else
@@ -2444,16 +2441,16 @@ package body Sem_Aggr is
       Component_Elmt  : Elmt_Id;
 
       Components : constant Elist_Id := New_Elmt_List;
-      --  Components is the list of the record components whose value must
-      --  be provided in the aggregate. This list does include discriminants.
+      --  Components is the list of the record components whose value must be
+      --  provided in the aggregate. This list does include discriminants.
 
       New_Assoc_List : constant List_Id := New_List;
       New_Assoc      : Node_Id;
       --  New_Assoc_List is the newly built list of N_Component_Association
       --  nodes. New_Assoc is one such N_Component_Association node in it.
-      --  Please note that while Assoc and New_Assoc contain the same
-      --  kind of nodes, they are used to iterate over two different
-      --  N_Component_Association lists.
+      --  Note that while Assoc and New_Assoc contain the same kind of nodes,
+      --  they are used to iterate over two different N_Component_Association
+      --  lists.
 
       Others_Etype : Entity_Id := Empty;
       --  This variable is used to save the Etype of the last record component
@@ -2464,7 +2461,7 @@ package body Sem_Aggr is
       --    (b) make sure the type of all the components whose value is
       --        subsumed by the others choice are the same.
       --
-      --  This variable is updated as a side effect of function Get_Value
+      --  This variable is updated as a side effect of function Get_Value.
 
       Is_Box_Present : Boolean := False;
       Others_Box     : Boolean := False;
@@ -2480,40 +2477,43 @@ package body Sem_Aggr is
          Expr           : Node_Id;
          Assoc_List     : List_Id;
          Is_Box_Present : Boolean := False);
-      --  Builds a new N_Component_Association node which associates
-      --  Component to expression Expr and adds it to the association
-      --  list being built, either New_Assoc_List, or the association
-      --  being built for an inner aggregate.
+      --  Builds a new N_Component_Association node which associates Component
+      --  to expression Expr and adds it to the association list being built,
+      --  either New_Assoc_List, or the association being built for an inner
+      --  aggregate.
 
       function Discr_Present (Discr : Entity_Id) return Boolean;
       --  If aggregate N is a regular aggregate this routine will return True.
       --  Otherwise, if N is an extension aggregate, Discr is a discriminant
-      --  whose value may already have been specified by N's ancestor part,
-      --  this routine checks whether this is indeed the case and if so
-      --  returns False, signaling that no value for Discr should appear in the
-      --  N's aggregate part. Also, in this case, the routine appends to
+      --  whose value may already have been specified by N's ancestor part.
+      --  This routine checks whether this is indeed the case and if so returns
+      --  False, signaling that no value for Discr should appear in N's
+      --  aggregate part. Also, in this case, the routine appends
       --  New_Assoc_List Discr the discriminant value specified in the ancestor
       --  part.
+      --  Can't parse previous sentence, appends what where???
 
       function Get_Value
         (Compon                 : Node_Id;
          From                   : List_Id;
          Consider_Others_Choice : Boolean := False)
          return                   Node_Id;
-      --  Given a record component stored in parameter Compon, the
-      --  following function returns its value as it appears in the list
-      --  From, which is a list of N_Component_Association nodes. If no
-      --  component association has a choice for the searched component,
-      --  the value provided by the others choice is returned, if there
-      --  is  one and Consider_Others_Choice is set to true. Otherwise
-      --  Empty is returned. If there is more than one component association
-      --  giving a value for the searched record component, an error message
-      --  is emitted and the first found value is returned.
+      --  Given a record component stored in parameter Compon, the following
+      --  function returns its value as it appears in the list From, which is
+      --  a list of N_Component_Association nodes.
+      --  What is this referring to??? There is no "following function" in
+      --  sight???
+      --  If no component association has a choice for the searched component,
+      --  the value provided by the others choice is returned, if there is one,
+      --  and Consider_Others_Choice is set to true. Otherwise Empty is
+      --  returned. If there is more than one component association giving a
+      --  value for the searched record component, an error message is emitted
+      --  and the first found value is returned.
       --
       --  If Consider_Others_Choice is set and the returned expression comes
       --  from the others choice, then Others_Etype is set as a side effect.
-      --  An error message is emitted if the components taking their value
-      --  from the others choice do not have same type.
+      --  An error message is emitted if the components taking their value from
+      --  the others choice do not have same type.
 
       procedure Resolve_Aggr_Expr (Expr : Node_Id; Component : Node_Id);
       --  Analyzes and resolves expression Expr against the Etype of the
@@ -2613,7 +2613,7 @@ package body Sem_Aggr is
          D := First_Discriminant (Ancestor_Typ);
          while Present (D) loop
 
-            --  If Ancestor has already specified Disc value than insert its
+            --  If Ancestor has already specified Disc value then insert its
             --  value in the final aggregate.
 
             if Original_Record_Component (D) = Orig_Discr then

gcc/ada/sem_ch10.adb

@@ -4015,6 +4015,10 @@ package body Sem_Ch10 is
                   --  a with_clause on the same unit as a private with-clause
                   --  on a parent, in which case child unit is visible.
 
+                  ----------------
+                  -- In_Context --
+                  ----------------
+
                   function In_Context return Boolean is
                   begin
                      Clause :=

gcc/ada/sem_eval.adb

@@ -1915,9 +1915,7 @@ package body Sem_Eval is
             --  are error cases where this is not the case), then see if we
             --  can do a constant evaluation of the array reference.
 
-            if Is_Array_Type (Atyp)
-              and then Atyp /= Any_Composite
-            then
+            if Is_Array_Type (Atyp) and then Atyp /= Any_Composite then
                if Ekind (Atyp) = E_String_Literal_Subtype then
                   Lbd := String_Literal_Low_Bound (Atyp);
                else

gcc/ada/sem_prag.adb

@@ -5265,16 +5265,15 @@ package body Sem_Prag is
                      if Is_Entity_Name (Exp) then
                         null;
 
-                     --  Determine the string type from the presence
-                     --  Wide (_Wide) characters.
+                     --  For string literals, we assume Standard_String as the
+                     --  type, unless the string contains wide or wide_wide
+                     --  characters.
 
                      elsif Nkind (Exp) = N_String_Literal then
                         if Has_Wide_Wide_Character (Exp) then
                            Resolve (Exp, Standard_Wide_Wide_String);
-
                         elsif Has_Wide_Character (Exp) then
                            Resolve (Exp, Standard_Wide_String);
-
                         else
                            Resolve (Exp, Standard_String);
                         end if;

gcc/ada/sysdep.c

@@ -37,7 +37,7 @@
 #if ! defined (__VXWORKSMILS__)
 #include "dosFsLib.h"
 #endif
-#if ! defined (__RTP__) && ! defined (VTHREADS)
+#if ! defined (__RTP__) && (! defined (VTHREADS) || defined (__VXWORKSMILS__))
 # include "nfsLib.h"
 #endif
 #include "selectLib.h"
@@ -990,7 +990,7 @@ __gnat_is_file_not_found_error (int errno_val) {
 #if ! defined (__VXWORKSMILS__)
       case S_dosFsLib_FILE_NOT_FOUND:
 #endif
-#if ! defined (__RTP__) && ! defined (VTHREADS)
+#if ! defined (__RTP__) && (! defined (VTHREADS) || defined (__VXWORKSMILS__))
       case S_nfsLib_NFSERR_NOENT:
 #endif
 #endif