[multiple changes]

2009-04-17  Pascal Obry  <obry@adacore.com>

	* initialize.c: Set gnat_argv with UTF-8 encoded strings on Windows.

	* adaint.h, argv.c, bindgen.adb: Reverted to previous version.

2009-04-17  Robert Dewar  <dewar@adacore.com>

	* a-except.adb, a-except-2005.adb: Add PE_Address_Of_Intrinsic

	* sem_attr.adb (Analyze_Attribute, case Address): Use
	PE_Address_Of_Intrinsic.

	* types.ads: Add PE_Address_Of_Intrinsic

	* types.h: Add PE_Address_Of_Intrinsic

From-SVN: r146226

10 files changed, 157 insertions, 168 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7f2cc58..e9b46c6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,17 +1,24 @@
-2009-04-17  Nicolas Setton  <setton@adacore.com>
+2009-04-17  Pascal Obry  <obry@adacore.com>
 
-	* gcc-interface/Makefile.in: Under darwin, build shared libraries
-	with install_name starting with "@rpath/".
+	* initialize.c: Set gnat_argv with UTF-8 encoded strings on Windows.
 
-2009-04-17  Pascal Obry  <obry@adacore.com>
+	* init.c: Fix minor typo and style fix.
 
-	* adaint.h, argv.c (__gnat_init_args): New routine used to initialize
-	command line arguments.
+2009-04-17  Robert Dewar  <dewar@adacore.com>
 
-	* bindgen.adb: Call __gnat_init_args instead of simple assignments of
-	argc, argv and envp parameters.
+	* a-except.adb, a-except-2005.adb: Add PE_Address_Of_Intrinsic
 
-	* init.c: Fix minor typo and style fix.
+	* sem_attr.adb (Analyze_Attribute, case Address): Use
+	PE_Address_Of_Intrinsic.
+
+	* types.ads: Add PE_Address_Of_Intrinsic
+
+	* types.h: Add PE_Address_Of_Intrinsic
+
+2009-04-17  Nicolas Setton  <setton@adacore.com>
+
+	* gcc-interface/Makefile.in: Under darwin, build shared libraries
+	with install_name starting with "@rpath/".
 
 2009-04-17  Nicolas Setton  <setton@adacore.com>
 
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index 9db770c..ad43e21 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -457,6 +457,7 @@ package body Ada.Exceptions is
    procedure Rcheck_30 (File : System.Address; Line : Integer);
    procedure Rcheck_31 (File : System.Address; Line : Integer);
    procedure Rcheck_32 (File : System.Address; Line : Integer);
+   procedure Rcheck_33 (File : System.Address; Line : Integer);
 
    pragma Export (C, Rcheck_00, "__gnat_rcheck_00");
    pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
@@ -491,6 +492,7 @@ package body Ada.Exceptions is
    pragma Export (C, Rcheck_30, "__gnat_rcheck_30");
    pragma Export (C, Rcheck_31, "__gnat_rcheck_31");
    pragma Export (C, Rcheck_32, "__gnat_rcheck_32");
+   pragma Export (C, Rcheck_33, "__gnat_rcheck_33");
 
    --  None of these procedures ever returns (they raise an exception!). By
    --  using pragma No_Return, we ensure that any junk code after the call,
@@ -528,6 +530,7 @@ package body Ada.Exceptions is
    pragma No_Return (Rcheck_29);
    pragma No_Return (Rcheck_30);
    pragma No_Return (Rcheck_32);
+   pragma No_Return (Rcheck_33);
 
    ---------------------------------------------
    -- Reason Strings for Run-Time Check Calls --
@@ -554,25 +557,27 @@ package body Ada.Exceptions is
    Rmsg_13 : constant String := "tag check failed"                 & NUL;
    Rmsg_14 : constant String := "access before elaboration"        & NUL;
    Rmsg_15 : constant String := "accessibility check failed"       & NUL;
-   Rmsg_16 : constant String := "all guards closed"                & NUL;
-   Rmsg_17 : constant String := "Current_Task referenced in entry" &
+   Rmsg_16 : constant String := "attempt to take address of"       &
+                                " intrinsic subprogram"            & NUL;
+   Rmsg_17 : constant String := "all guards closed"                & NUL;
+   Rmsg_18 : constant String := "Current_Task referenced in entry" &
                                 " body"                            & NUL;
-   Rmsg_18 : constant String := "duplicated entry address"         & NUL;
-   Rmsg_19 : constant String := "explicit raise"                   & NUL;
-   Rmsg_20 : constant String := "finalize/adjust raised exception" & NUL;
-   Rmsg_21 : constant String := "implicit return with No_Return"   & NUL;
-   Rmsg_22 : constant String := "misaligned address value"         & NUL;
-   Rmsg_23 : constant String := "missing return"                   & NUL;
-   Rmsg_24 : constant String := "overlaid controlled object"       & NUL;
-   Rmsg_25 : constant String := "potentially blocking operation"   & NUL;
-   Rmsg_26 : constant String := "stubbed subprogram called"        & NUL;
-   Rmsg_27 : constant String := "unchecked union restriction"      & NUL;
-   Rmsg_28 : constant String := "actual/returned class-wide value "
-                                & "not transportable"              & NUL;
-   Rmsg_29 : constant String := "empty storage pool"               & NUL;
-   Rmsg_30 : constant String := "explicit raise"                   & NUL;
-   Rmsg_31 : constant String := "infinite recursion"               & NUL;
-   Rmsg_32 : constant String := "object too large"                 & NUL;
+   Rmsg_19 : constant String := "duplicated entry address"         & NUL;
+   Rmsg_20 : constant String := "explicit raise"                   & NUL;
+   Rmsg_21 : constant String := "finalize/adjust raised exception" & NUL;
+   Rmsg_22 : constant String := "implicit return with No_Return"   & NUL;
+   Rmsg_23 : constant String := "misaligned address value"         & NUL;
+   Rmsg_24 : constant String := "missing return"                   & NUL;
+   Rmsg_25 : constant String := "overlaid controlled object"       & NUL;
+   Rmsg_26 : constant String := "potentially blocking operation"   & NUL;
+   Rmsg_27 : constant String := "stubbed subprogram called"        & NUL;
+   Rmsg_28 : constant String := "unchecked union restriction"      & NUL;
+   Rmsg_29 : constant String := "actual/returned class-wide"       &
+                                " value not transportable"         & NUL;
+   Rmsg_30 : constant String := "empty storage pool"               & NUL;
+   Rmsg_31 : constant String := "explicit raise"                   & NUL;
+   Rmsg_32 : constant String := "infinite recursion"               & NUL;
+   Rmsg_33 : constant String := "object too large"                 & NUL;
 
    -----------------------
    -- Polling Interface --
@@ -1161,7 +1166,7 @@ package body Ada.Exceptions is
 
    procedure Rcheck_29 (File : System.Address; Line : Integer) is
    begin
-      Raise_Storage_Error_Msg (File, Line, Rmsg_29'Address);
+      Raise_Program_Error_Msg (File, Line, Rmsg_29'Address);
    end Rcheck_29;
 
    procedure Rcheck_30 (File : System.Address; Line : Integer) is
@@ -1179,6 +1184,11 @@ package body Ada.Exceptions is
       Raise_Storage_Error_Msg (File, Line, Rmsg_32'Address);
    end Rcheck_32;
 
+   procedure Rcheck_33 (File : System.Address; Line : Integer) is
+   begin
+      Raise_Storage_Error_Msg (File, Line, Rmsg_33'Address);
+   end Rcheck_33;
+
    -------------
    -- Reraise --
    -------------
diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb
index 9a07b2f..229645a 100644
--- a/gcc/ada/a-except.adb
+++ b/gcc/ada/a-except.adb
@@ -414,6 +414,7 @@ package body Ada.Exceptions is
    procedure Rcheck_30 (File : System.Address; Line : Integer);
    procedure Rcheck_31 (File : System.Address; Line : Integer);
    procedure Rcheck_32 (File : System.Address; Line : Integer);
+   procedure Rcheck_33 (File : System.Address; Line : Integer);
 
    pragma Export (C, Rcheck_00, "__gnat_rcheck_00");
    pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
@@ -448,6 +449,7 @@ package body Ada.Exceptions is
    pragma Export (C, Rcheck_30, "__gnat_rcheck_30");
    pragma Export (C, Rcheck_31, "__gnat_rcheck_31");
    pragma Export (C, Rcheck_32, "__gnat_rcheck_32");
+   pragma Export (C, Rcheck_33, "__gnat_rcheck_33");
 
    --  None of these procedures ever returns (they raise an exception!). By
    --  using pragma No_Return, we ensure that any junk code after the call,
@@ -485,6 +487,7 @@ package body Ada.Exceptions is
    pragma No_Return (Rcheck_29);
    pragma No_Return (Rcheck_30);
    pragma No_Return (Rcheck_32);
+   pragma No_Return (Rcheck_33);
 
    ---------------------------------------------
    -- Reason Strings for Run-Time Check Calls --
@@ -511,25 +514,27 @@ package body Ada.Exceptions is
    Rmsg_13 : constant String := "tag check failed"                 & NUL;
    Rmsg_14 : constant String := "access before elaboration"        & NUL;
    Rmsg_15 : constant String := "accessibility check failed"       & NUL;
-   Rmsg_16 : constant String := "all guards closed"                & NUL;
-   Rmsg_17 : constant String := "Current_Task referenced in entry" &
+   Rmsg_16 : constant String := "attempt to take address of"       &
+                                " intrinsic subprogram"            & NUL;
+   Rmsg_17 : constant String := "all guards closed"                & NUL;
+   Rmsg_18 : constant String := "Current_Task referenced in entry" &
                                 " body"                            & NUL;
-   Rmsg_18 : constant String := "duplicated entry address"         & NUL;
-   Rmsg_19 : constant String := "explicit raise"                   & NUL;
-   Rmsg_20 : constant String := "finalize/adjust raised exception" & NUL;
-   Rmsg_21 : constant String := "implicit return with No_Return"   & NUL;
-   Rmsg_22 : constant String := "misaligned address value"         & NUL;
-   Rmsg_23 : constant String := "missing return"                   & NUL;
-   Rmsg_24 : constant String := "overlaid controlled object"       & NUL;
-   Rmsg_25 : constant String := "potentially blocking operation"   & NUL;
-   Rmsg_26 : constant String := "stubbed subprogram called"        & NUL;
-   Rmsg_27 : constant String := "unchecked union restriction"      & NUL;
-   Rmsg_28 : constant String := "actual/returned class-wide value "
-                                & "not transportable"              & NUL;
-   Rmsg_29 : constant String := "empty storage pool"               & NUL;
-   Rmsg_30 : constant String := "explicit raise"                   & NUL;
-   Rmsg_31 : constant String := "infinite recursion"               & NUL;
-   Rmsg_32 : constant String := "object too large"                 & NUL;
+   Rmsg_19 : constant String := "duplicated entry address"         & NUL;
+   Rmsg_20 : constant String := "explicit raise"                   & NUL;
+   Rmsg_21 : constant String := "finalize/adjust raised exception" & NUL;
+   Rmsg_22 : constant String := "implicit return with No_Return"   & NUL;
+   Rmsg_23 : constant String := "misaligned address value"         & NUL;
+   Rmsg_24 : constant String := "missing return"                   & NUL;
+   Rmsg_25 : constant String := "overlaid controlled object"       & NUL;
+   Rmsg_26 : constant String := "potentially blocking operation"   & NUL;
+   Rmsg_27 : constant String := "stubbed subprogram called"        & NUL;
+   Rmsg_28 : constant String := "unchecked union restriction"      & NUL;
+   Rmsg_29 : constant String := "actual/returned class-wide"       &
+                                " value not transportable"         & NUL;
+   Rmsg_30 : constant String := "empty storage pool"               & NUL;
+   Rmsg_31 : constant String := "explicit raise"                   & NUL;
+   Rmsg_32 : constant String := "infinite recursion"               & NUL;
+   Rmsg_33 : constant String := "object too large"                 & NUL;
 
    -----------------------
    -- Polling Interface --
@@ -1127,7 +1132,7 @@ package body Ada.Exceptions is
 
    procedure Rcheck_29 (File : System.Address; Line : Integer) is
    begin
-      Raise_Storage_Error_Msg (File, Line, Rmsg_29'Address);
+      Raise_Program_Error_Msg (File, Line, Rmsg_29'Address);
    end Rcheck_29;
 
    procedure Rcheck_30 (File : System.Address; Line : Integer) is
@@ -1145,6 +1150,11 @@ package body Ada.Exceptions is
       Raise_Storage_Error_Msg (File, Line, Rmsg_32'Address);
    end Rcheck_32;
 
+   procedure Rcheck_33 (File : System.Address; Line : Integer) is
+   begin
+      Raise_Storage_Error_Msg (File, Line, Rmsg_33'Address);
+   end Rcheck_33;
+
    -------------
    -- Reraise --
    -------------
diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index 1501e99..5ed4d76 100644
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -142,7 +142,6 @@ extern FILE  *__gnat_constant_stdin	  	   (void);
 extern FILE  *__gnat_constant_stdout	  	   (void);
 extern char  *__gnat_full_name		  	   (char *, char *);
 
-extern void   __gnat_init_args                     (int, char **, char **);
 extern int    __gnat_arg_count			   (void);
 extern int    __gnat_len_arg			   (int);
 extern void   __gnat_fill_arg			   (char *, int);
diff --git a/gcc/ada/argv.c b/gcc/ada/argv.c
index 6420967..b827b03 100644
--- a/gcc/ada/argv.c
+++ b/gcc/ada/argv.c
@@ -46,73 +46,29 @@
 #include "tconfig.h"
 #include "tsystem.h"
 #include <sys/stat.h>
-/* We don't have libiberty, so use malloc.  */
-#define xmalloc(S) malloc (S)
 #else
 #include "config.h"
 #include "system.h"
 #endif
 
+#include "adaint.h"
+
 /* argc and argv of the main program are saved under gnat_argc and gnat_argv,
    envp of the main program is saved under gnat_envp.  */
 
 int gnat_argc = 0;
-char **gnat_argv = (char **) 0;
+const char **gnat_argv = (const char **) 0;
 const char **gnat_envp = (const char **) 0;
 
 #if defined (_WIN32) && !defined (RTX)
 /* Note that on Windows environment the environ point to a buffer that could
    be reallocated if needed. It means that gnat_envp needs to be updated
-   before using gnat_envp to point to the right environment space. */
-#include "mingw32.h"
-#include <windows.h>
+   before using gnat_envp to point to the right environment space */
 #include <stdlib.h>
 /* for the environ variable definition */
 #define gnat_envp (environ)
 #endif
 
-#include "adaint.h"
-
-void
-__gnat_init_args (int argc, char **argv ATTRIBUTE_UNUSED, char **envp)
-{
-#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_COMPILE)
-  char arg_utf8[MAX_PATH];
-  LPWSTR *wargv;
-  int wargc;
-  int k;
-
-  wargv = CommandLineToArgvW (GetCommandLineW(), &wargc);
-
-  if (wargv == NULL)
-    {
-      /* CommandLineToArgvW was not successful, use standard argc/argv. */
-      gnat_argv = argv;
-      gnat_argc = argc;
-    }
-  else
-    {
-      /* Set gnat_argv with arguments encoded in UTF-8. */
-      gnat_argv = (char **) xmalloc ((wargc + 1) * sizeof (char *));
-
-      for (k=0; k<wargc; k++)
-	{
-	  WS2SU (arg_utf8, wargv[k], MAX_PATH);
-	  gnat_argv[k] = (char *) xmalloc (strlen (arg_utf8) + 1);
-	  strcpy (gnat_argv[k], arg_utf8);
-	}
-
-      LocalFree (wargv);
-      gnat_argc = wargc;
-    }
-#else
-  gnat_argv = argv;
-  gnat_argc = argc;
-#endif
-
-  gnat_envp = envp;
-}
-
 int
 __gnat_arg_count (void)
 {
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index ef90c6c..ce81c7a 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -1456,17 +1456,6 @@ package body Bindgen is
 
          WBI ("   is");
 
-         --  ??? the following code needs commenting
-
-         if not Configurable_Run_Time_Mode then
-            WBI ("      procedure Init_Args");
-            WBI ("        (argc : Integer;");
-            WBI ("         argv : System.Address;");
-            WBI ("         envp : System.Address);");
-            WBI ("      pragma Import (C, Init_Args, ""__gnat_init_args"");");
-            WBI ("");
-         end if;
-
       else
          if Exit_Status_Supported_On_Target then
             Set_String (" return Integer is");
@@ -1580,16 +1569,9 @@ package body Bindgen is
       --  Acquire command line arguments if present on target
 
       if Command_Line_Args_On_Target then
-         if Configurable_Run_Time_Mode then
-            WBI ("      gnat_argc := argc;");
-            WBI ("      gnat_argv := argv;");
-            WBI ("      gnat_envp := envp;");
-
-         --  ??? this else needs a comment
-         else
-            WBI ("      Init_Args (argc, argv, envp);");
-         end if;
-
+         WBI ("      gnat_argc := argc;");
+         WBI ("      gnat_argv := argv;");
+         WBI ("      gnat_envp := envp;");
          WBI ("");
 
       --  If configurable run time and no command line args, then nothing
@@ -1750,16 +1732,9 @@ package body Bindgen is
       --  arguments are present on target
 
       if Command_Line_Args_On_Target then
-         if Configurable_Run_Time_Mode then
-            WBI ("   gnat_argc = argc;");
-            WBI ("   gnat_argv = argv;");
-            WBI ("   gnat_envp = envp;");
-
-         --  ??? this call must be commented
-         else
-            WBI ("   __gnat_init_args (argc, argv, envp);");
-         end if;
-
+         WBI ("   gnat_argc = argc;");
+         WBI ("   gnat_argv = argv;");
+         WBI ("   gnat_envp = envp;");
          WBI (" ");
 
       --  If configurable run-time, then nothing to do, since in this case
diff --git a/gcc/ada/initialize.c b/gcc/ada/initialize.c
index dbaf80f..5e7b2ff 100644
--- a/gcc/ada/initialize.c
+++ b/gcc/ada/initialize.c
@@ -43,6 +43,8 @@
 #ifdef IN_RTS
 #include "tconfig.h"
 #include "tsystem.h"
+/* We don't have libiberty, so use malloc.  */
+#define xmalloc(S) malloc (S)
 #else
 #include "config.h"
 #include "system.h"
@@ -55,11 +57,15 @@
 /******************************************/
 
 #if defined (__MINGW32__)
+#include "mingw32.h"
 #include <windows.h>
 
 extern void __gnat_init_float (void);
 extern void __gnat_install_SEH_handler (void *);
 
+extern int gnat_argc;
+extern char **gnat_argv;
+
 #ifndef RTX
 /* Do not define for RTX since it is only used for creating child processes
    which is not supported in RTX. */
@@ -75,6 +81,32 @@ __gnat_initialize (void *eh)
       given that we have set Max_Digits etc with this in mind */
    __gnat_init_float ();
 
+   /* Adjust gnat_argv to support Unicode characters. */
+   {
+     char arg_utf8[MAX_PATH];
+     LPWSTR *wargv;
+     int wargc;
+     int k;
+
+     wargv = CommandLineToArgvW (GetCommandLineW(), &wargc);
+
+     if (wargv != NULL)
+       {
+	 /* Set gnat_argv with arguments encoded in UTF-8. */
+	 gnat_argv = (char **) xmalloc ((wargc + 1) * sizeof (char *));
+
+	 for (k=0; k<wargc; k++)
+	   {
+	     WS2SU (arg_utf8, wargv[k], MAX_PATH);
+	     gnat_argv[k] = (char *) xmalloc (strlen (arg_utf8) + 1);
+	     strcpy (gnat_argv[k], arg_utf8);
+	   }
+
+	 LocalFree (wargv);
+	 gnat_argc = wargc;
+       }
+    }
+
    /* Note that we do not activate this for the compiler itself to avoid a
       bootstrap path problem.  Older version of gnatbind will generate a call
       to __gnat_initialize() without argument. Therefore we cannot use eh in
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index e2fe5c3..c043c4f 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2060,9 +2060,7 @@ package body Sem_Attr is
                      if In_Instance then
                         Rewrite (N,
                           Make_Raise_Program_Error (Loc,
-                            Reason => PE_Misaligned_Address_Value));
-                        --   ??? why Misaligned_Address_Value, seems wrong
-
+                            Reason => PE_Address_Of_Intrinsic));
                      else
                         Error_Msg_N
                          ("cannot take Address of intrinsic subprogram", N);
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 94b037e..3b89ab2 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -787,24 +787,25 @@ package Types is
 
       PE_Access_Before_Elaboration,      -- 14
       PE_Accessibility_Check_Failed,     -- 15
-      PE_All_Guards_Closed,              -- 16
-      PE_Current_Task_In_Entry_Body,     -- 17
-      PE_Duplicated_Entry_Address,       -- 18
-      PE_Explicit_Raise,                 -- 19
-      PE_Finalize_Raised_Exception,      -- 20
-      PE_Implicit_Return,                -- 21
-      PE_Misaligned_Address_Value,       -- 22
-      PE_Missing_Return,                 -- 23
-      PE_Overlaid_Controlled_Object,     -- 24
-      PE_Potentially_Blocking_Operation, -- 25
-      PE_Stubbed_Subprogram_Called,      -- 26
-      PE_Unchecked_Union_Restriction,    -- 27
-      PE_Non_Transportable_Actual,       -- 28
-
-      SE_Empty_Storage_Pool,             -- 29
-      SE_Explicit_Raise,                 -- 30
-      SE_Infinite_Recursion,             -- 31
-      SE_Object_Too_Large);              -- 32
+      PE_Address_Of_Intrinsic,           -- 16
+      PE_All_Guards_Closed,              -- 17
+      PE_Current_Task_In_Entry_Body,     -- 18
+      PE_Duplicated_Entry_Address,       -- 19
+      PE_Explicit_Raise,                 -- 20
+      PE_Finalize_Raised_Exception,      -- 21
+      PE_Implicit_Return,                -- 22
+      PE_Misaligned_Address_Value,       -- 23
+      PE_Missing_Return,                 -- 24
+      PE_Overlaid_Controlled_Object,     -- 25
+      PE_Potentially_Blocking_Operation, -- 26
+      PE_Stubbed_Subprogram_Called,      -- 27
+      PE_Unchecked_Union_Restriction,    -- 28
+      PE_Non_Transportable_Actual,       -- 29
+
+      SE_Empty_Storage_Pool,             -- 30
+      SE_Explicit_Raise,                 -- 31
+      SE_Infinite_Recursion,             -- 32
+      SE_Object_Too_Large);              -- 33
 
    subtype RT_CE_Exceptions is RT_Exception_Code range
      CE_Access_Check_Failed ..
diff --git a/gcc/ada/types.h b/gcc/ada/types.h
index 1d4fd67..9b2cc90 100644
--- a/gcc/ada/types.h
+++ b/gcc/ada/types.h
@@ -359,23 +359,24 @@ typedef Int Mechanism_Type;
 
 #define PE_Access_Before_Elaboration       14
 #define PE_Accessibility_Check_Failed      15
-#define PE_All_Guards_Closed               16
-#define PE_Current_Task_In_Entry_Body      17
-#define PE_Duplicated_Entry_Address        18
-#define PE_Explicit_Raise                  19
-#define PE_Finalize_Raised_Exception       20
-#define PE_Implicit_Return                 21
-#define PE_Misaligned_Address_Value        22
-#define PE_Missing_Return                  23
-#define PE_Overlaid_Controlled_Object      24
-#define PE_Potentially_Blocking_Operation  25
-#define PE_Stubbed_Subprogram_Called       26
-#define PE_Unchecked_Union_Restriction     27
-#define PE_Non_Transportable_Actual        28
-
-#define SE_Empty_Storage_Pool              29
-#define SE_Explicit_Raise                  30
-#define SE_Infinite_Recursion              31
-#define SE_Object_Too_Large                32
-
-#define LAST_REASON_CODE                   32
+#define PE_Address_Of_Intrinsic            16
+#define PE_All_Guards_Closed               17
+#define PE_Current_Task_In_Entry_Body      18
+#define PE_Duplicated_Entry_Address        19
+#define PE_Explicit_Raise                  20
+#define PE_Finalize_Raised_Exception       21
+#define PE_Implicit_Return                 22
+#define PE_Misaligned_Address_Value        23
+#define PE_Missing_Return                  24
+#define PE_Overlaid_Controlled_Object      25
+#define PE_Potentially_Blocking_Operation  26
+#define PE_Stubbed_Subprogram_Called       27
+#define PE_Unchecked_Union_Restriction     28
+#define PE_Non_Transportable_Actual        29
+
+#define SE_Empty_Storage_Pool              30
+#define SE_Explicit_Raise                  31
+#define SE_Infinite_Recursion              32
+#define SE_Object_Too_Large                33
+
+#define LAST_REASON_CODE                   33