[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

@@ -110,6 +110,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;
@@ -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_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