cstand.adb (Create_Standard): Change Import_Code component of Standard_Exception_Type to Foreign_Data.

2013-10-14  Tristan Gingold  <gingold@adacore.com>

	* cstand.adb (Create_Standard): Change Import_Code component
	of Standard_Exception_Type to Foreign_Data. Its type is now
	Standard_A_Char (access to character).
	* exp_prag.adb (Expand_Pragma_Import_Export_Exception): Adjust
	definition of Code to match the type of Foreign_Data.
	* s-stalib.ads (Exception_Data): Replace Import_Code by Foreign_Data
	Change the definition of standard predefined exceptions.
	(Exception_Code): Remove.
	* raise.h (Exception_Code): Remove (Exception_Data): Replace
	Import_Code field by Foreign_Data.
	* rtsfind.ads (RE_Exception_Code): Remove
	(RE_Import_Address): Add.
	* a-exexpr-gcc.adb (Import_Code_For): Replaced by Foreign_Data_For.
	* exp_ch11.adb (Expand_N_Exception_Declaration): Associate null
	to Foreign_Data component.
	* raise-gcc.c (Import_Code_For): Replaced by Foreign_Data_For.
	(is_handled_by): Add comments. Use replaced function. Change
	condition so that an Ada occurrence is never handled by
	Foreign_Exception.
	* s-exctab.adb (Internal_Exception): Associate Null_Address to
	Foreign_Data component.
	* s-vmexta.adb, s-vmexta.ads (Exception_Code): Declare Replace
	SSL.Exception_Code by Exception_Code.

From-SVN: r203538

12 files changed, 114 insertions, 103 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 16fe13c6..b12ce0a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+2013-10-14  Tristan Gingold  <gingold@adacore.com>
+
+	* cstand.adb (Create_Standard): Change Import_Code component
+	of Standard_Exception_Type to Foreign_Data. Its type is now
+	Standard_A_Char (access to character).
+	* exp_prag.adb (Expand_Pragma_Import_Export_Exception): Adjust
+	definition of Code to match the type of Foreign_Data.
+	* s-stalib.ads (Exception_Data): Replace Import_Code by Foreign_Data
+	Change the definition of standard predefined exceptions.
+	(Exception_Code): Remove.
+	* raise.h (Exception_Code): Remove (Exception_Data): Replace
+	Import_Code field by Foreign_Data.
+	* rtsfind.ads (RE_Exception_Code): Remove
+	(RE_Import_Address): Add.
+	* a-exexpr-gcc.adb (Import_Code_For): Replaced by Foreign_Data_For.
+	* exp_ch11.adb (Expand_N_Exception_Declaration): Associate null
+	to Foreign_Data component.
+	* raise-gcc.c (Import_Code_For): Replaced by Foreign_Data_For.
+	(is_handled_by): Add comments. Use replaced function. Change
+	condition so that an Ada occurrence is never handled by
+	Foreign_Exception.
+	* s-exctab.adb (Internal_Exception): Associate Null_Address to
+	Foreign_Data component.
+	* s-vmexta.adb, s-vmexta.ads (Exception_Code): Declare Replace
+	SSL.Exception_Code by Exception_Code.
+
 2013-10-14  Robert Dewar  <dewar@adacore.com>
 
 	* gnat_ugn.texi: Document -gnateu switch.
diff --git a/gcc/ada/a-exexpr-gcc.adb b/gcc/ada/a-exexpr-gcc.adb
index 178b7e3..0bf3198 100644
--- a/gcc/ada/a-exexpr-gcc.adb
+++ b/gcc/ada/a-exexpr-gcc.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -270,8 +270,8 @@ package body Exception_Propagation is
    function Language_For (E : Exception_Data_Ptr) return Character;
    pragma Export (C, Language_For, "__gnat_language_for");
 
-   function Import_Code_For (E : Exception_Data_Ptr) return Exception_Code;
-   pragma Export (C, Import_Code_For, "__gnat_import_code_for");
+   function Foreign_Data_For (E : Exception_Data_Ptr) return Address;
+   pragma Export (C, Foreign_Data_For, "__gnat_foreign_data_for");
 
    function EID_For (GNAT_Exception : not null GNAT_GCC_Exception_Access)
      return Exception_Id;
@@ -489,16 +489,16 @@ package body Exception_Propagation is
       return GNAT_Exception.Occurrence.Id;
    end EID_For;
 
-   ---------------------
-   -- Import_Code_For --
-   ---------------------
+   ----------------------
+   -- Foreign_Data_For --
+   ----------------------
 
-   function Import_Code_For
-     (E : SSL.Exception_Data_Ptr) return Exception_Code
+   function Foreign_Data_For
+     (E : SSL.Exception_Data_Ptr) return Address
    is
    begin
-      return E.all.Import_Code;
-   end Import_Code_For;
+      return E.Foreign_Data;
+   end Foreign_Data_For;
 
    --------------------------
    -- Is_Handled_By_Others --
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index 57355be..87555fd 100644
--- a/gcc/ada/cstand.adb
+++ b/gcc/ada/cstand.adb
@@ -1470,14 +1470,7 @@ package body CStand is
       end Build_Duration;
 
       --  Build standard exception type. Note that the type name here is
-      --  actually used in the generated code, so it must be set correctly
-
-      --  ??? Also note that the Import_Code component is now declared
-      --  as a System.Standard_Library.Exception_Code to enforce run-time
-      --  library implementation consistency. It's too early here to resort
-      --  to rtsfind to get the proper node for that type, so we use the
-      --  closest possible available type node at hand instead. We should
-      --  probably be fixing this up at some point.
+      --  actually used in the generated code, so it must be set correctly.
 
       Standard_Exception_Type := New_Standard_Entity;
       Set_Ekind       (Standard_Exception_Type, E_Record_Type);
@@ -1501,7 +1494,7 @@ package body CStand is
       Make_Component
         (Standard_Exception_Type, Standard_A_Char,    "HTable_Ptr");
       Make_Component
-        (Standard_Exception_Type, Standard_Unsigned,  "Import_Code");
+        (Standard_Exception_Type, Standard_A_Char,    "Foreign_Data");
       Make_Component
         (Standard_Exception_Type, Standard_A_Char,    "Raise_Hook");
 
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 90ca6da..d67a67f 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1172,7 +1172,7 @@ package body Exp_Ch11 is
    --                    Name_Length      => exceptE'Length,
    --                    Full_Name        => exceptE'Address,
    --                    HTable_Ptr       => null,
-   --                    Import_Code      => 0,
+   --                    Foreign_Data     => null,
    --                    Raise_Hook       => null,
    --                    );
 
@@ -1319,9 +1319,9 @@ package body Exp_Ch11 is
 
       Append_To (L, Make_Null (Loc));
 
-      --  Import_Code component: 0
+      --  Foreign_Data component: null
 
-      Append_To (L, Make_Integer_Literal (Loc, 0));
+      Append_To (L, Make_Null (Loc));
 
       --  Raise_Hook component: null
 
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 3576444..6f425d1 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -646,8 +646,9 @@ package body Exp_Prag is
                      --  alias to define the symbol.
 
                      Code :=
-                       Make_Integer_Literal (Loc,
-                         Intval => Exception_Code (Id));
+                       Unchecked_Convert_To (Standard_A_Char,
+                         Make_Integer_Literal (Loc,
+                           Intval => Exception_Code (Id)));
 
                      --  Declare a dummy object
 
@@ -655,7 +656,7 @@ package body Exp_Prag is
                        Make_Object_Declaration (Loc,
                          Defining_Identifier => Excep_Internal,
                          Object_Definition   =>
-                           New_Reference_To (RTE (RE_Exception_Code), Loc));
+                           New_Reference_To (RTE (RE_Address), Loc));
 
                      Insert_Action (N, Excep_Object);
                      Analyze (Excep_Object);
@@ -711,13 +712,12 @@ package body Exp_Prag is
 
                   else
                      Code :=
-                        Unchecked_Convert_To (RTE (RE_Exception_Code),
-                          Make_Function_Call (Loc,
-                            Name =>
-                              New_Reference_To (RTE (RE_Import_Value), Loc),
-                            Parameter_Associations => New_List
-                              (Make_String_Literal (Loc,
-                                Strval => Excep_Image))));
+                        Make_Function_Call (Loc,
+                          Name =>
+                            New_Reference_To (RTE (RE_Import_Address), Loc),
+                          Parameter_Associations => New_List
+                            (Make_String_Literal (Loc,
+                              Strval => Excep_Image)));
                   end if;
 
                   --  Generate the call to Register_VMS_Exception
@@ -733,7 +733,7 @@ package body Exp_Prag is
                             Prefix         => New_Occurrence_Of (Id, Loc),
                             Attribute_Name => Name_Unrestricted_Access)))));
 
-                  Analyze_And_Resolve (Code, RTE (RE_Exception_Code));
+                  Analyze_And_Resolve (Code, RTE (RE_Address));
                   Analyze (Call);
                end if;
 
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index d804564..897dca2 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -812,22 +812,32 @@ get_call_site_action_for (_Unwind_Ptr ip,
 
 #define Is_Handled_By_Others  __gnat_is_handled_by_others
 #define Language_For          __gnat_language_for
-#define Import_Code_For       __gnat_import_code_for
+#define Foreign_Data_For      __gnat_foreign_data_for
 #define EID_For               __gnat_eid_for
 
 extern bool Is_Handled_By_Others (_Unwind_Ptr eid);
 extern char Language_For (_Unwind_Ptr eid);
 
-extern Exception_Code Import_Code_For (_Unwind_Ptr eid);
+extern void *Foreign_Data_For (_Unwind_Ptr eid);
 
 extern Exception_Id EID_For (_GNAT_Exception * e);
 
+#define Foreign_Exception system__exceptions__foreign_exception
+extern struct Exception_Data Foreign_Exception;
+
+#ifdef VMS
+#define Non_Ada_Error system__aux_dec__non_ada_error
+extern struct Exception_Data Non_Ada_Error;
+#endif
+
 static enum action_kind
 is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
 {
+  /* All others choice match everything.  */
   if (choice == GNAT_ALL_OTHERS)
     return handler;
 
+  /* GNAT exception occurrence.  */
   if (propagated_exception->common.exception_class == GNAT_EXCEPTION_CLASS)
     {
       /* Pointer to the GNAT exception data corresponding to the propagated
@@ -845,6 +855,7 @@ is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
       if (choice == E || (choice == GNAT_OTHERS && Is_Handled_By_Others (E)))
 	return handler;
 
+#ifdef VMS
       /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
          may have different exception data pointers that should match for the
          same condition code, if both an export and an import have been
@@ -852,29 +863,25 @@ is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
          occurrence are expected to have been masked off regarding severity
          bits already (at registration time for the former and from within the
          low level exception vector for the latter).  */
-#ifdef VMS
-#     define Non_Ada_Error system__aux_dec__non_ada_error
-      extern struct Exception_Data Non_Ada_Error;
-
       if ((Language_For (E) == 'V'
 	   && choice != GNAT_OTHERS
 	   && ((Language_For (choice) == 'V'
-		&& Import_Code_For (choice) != 0
-		&& Import_Code_For (choice) == Import_Code_For (E))
+		&& Foreign_Data_For (choice) != 0
+		&& Foreign_Data_For (choice) == Foreign_Data_For (E))
 	       || choice == (_Unwind_Ptr)&Non_Ada_Error)))
 	return handler;
 #endif
-    }
-  else
-    {
-#     define Foreign_Exception system__exceptions__foreign_exception
-      extern struct Exception_Data Foreign_Exception;
 
-      if (choice == GNAT_ALL_OTHERS
-	  || choice == GNAT_OTHERS
-	  || choice == (_Unwind_Ptr) &Foreign_Exception)
-	return handler;
+      /* Otherwise, it doesn't match an Ada choice.  */
+      return nothing;
     }
+
+  /* All others and others choice match any foreign exception.  */
+  if (choice == GNAT_ALL_OTHERS
+      || choice == GNAT_OTHERS
+      || choice == (_Unwind_Ptr) &Foreign_Exception)
+    return handler;
+
   return nothing;
 }
 
diff --git a/gcc/ada/raise.h b/gcc/ada/raise.h
index 5761154..8f699bc 100644
--- a/gcc/ada/raise.h
+++ b/gcc/ada/raise.h
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2012, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2013, 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- *
@@ -35,15 +35,14 @@ extern "C" {
 
 /* C counterparts of what System.Standard_Library defines.  */
 
-typedef unsigned Exception_Code;
-
 struct Exception_Data
 {
   char Not_Handled_By_Others;
   char Lang;
   int Name_Length;
-  char *Full_Name, *Htable_Ptr;
-  Exception_Code Import_Code;
+  char *Full_Name;
+  char *Htable_Ptr;
+  void *Foreign_Data;
   void (*Raise_Hook)(void);
 };
 
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 88cd740..d863e1c 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -748,6 +748,7 @@ package Rtsfind is
      RE_Uint64,                          -- System.Atomic_Primitives
 
      RE_AST_Handler,                     -- System.Aux_DEC
+     RE_Import_Address,                  -- System.Aux_DEC
      RE_Import_Value,                    -- System.Aux_DEC
      RE_No_AST_Handler,                  -- System.Aux_DEC
      RE_Type_Class,                      -- System.Aux_DEC
@@ -1413,7 +1414,6 @@ package Rtsfind is
      RE_Shared_Var_Procs,                -- System.Shared_Storage
 
      RE_Abort_Undefer_Direct,            -- System.Standard_Library
-     RE_Exception_Code,                  -- System.Standard_Library
      RE_Exception_Data_Ptr,              -- System.Standard_Library
 
      RE_Integer_Address,                 -- System.Storage_Elements
@@ -2001,6 +2001,7 @@ package Rtsfind is
      RE_Uint64                           => System_Atomic_Primitives,
 
      RE_AST_Handler                      => System_Aux_DEC,
+     RE_Import_Address                   => System_Aux_DEC,
      RE_Import_Value                     => System_Aux_DEC,
      RE_No_AST_Handler                   => System_Aux_DEC,
      RE_Type_Class                       => System_Aux_DEC,
@@ -2670,7 +2671,6 @@ package Rtsfind is
      RE_Shared_Var_Procs                 => System_Shared_Storage,
 
      RE_Abort_Undefer_Direct             => System_Standard_Library,
-     RE_Exception_Code                   => System_Standard_Library,
      RE_Exception_Data_Ptr               => System_Standard_Library,
 
      RE_Integer_Address                  => System_Storage_Elements,
diff --git a/gcc/ada/s-exctab.adb b/gcc/ada/s-exctab.adb
index 5f2228c..42d4e95 100644
--- a/gcc/ada/s-exctab.adb
+++ b/gcc/ada/s-exctab.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2013, 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- --
@@ -180,7 +180,7 @@ package body System.Exception_Table is
               Name_Length           => Copy'Length,
               Full_Name             => Dyn_Copy.all'Address,
               HTable_Ptr            => null,
-              Import_Code           => 0,
+              Foreign_Data          => Null_Address,
               Raise_Hook            => null);
 
          Register_Exception (Res);
diff --git a/gcc/ada/s-stalib.ads b/gcc/ada/s-stalib.ads
index 2cb6cd1..6658afb 100644
--- a/gcc/ada/s-stalib.ads
+++ b/gcc/ada/s-stalib.ads
@@ -85,20 +85,6 @@ package System.Standard_Library is
    type Exception_Data_Ptr is access all Exception_Data;
    --  An equivalent of Exception_Id that is public
 
-   type Exception_Code is mod 2 ** Integer'Size;
-   --  A scalar value bound to some exception data. Typically used for
-   --  imported or exported exceptions on VMS. Having a separate type for this
-   --  is useful to enforce consistency throughout the various run-time units
-   --  handling such codes, and having it unsigned is the most appropriate
-   --  choice for it's currently single use on VMS.
-
-   --  ??? The construction in Cstand has no way to access the proper type
-   --  node for Exception_Code, and currently uses Standard_Unsigned as a
-   --  fallback. The representations shall match, and the size clause below
-   --  is aimed at ensuring that.
-
-   for Exception_Code'Size use Integer'Size;
-
    --  The following record defines the underlying representation of exceptions
 
    --  WARNING! Any changes to this may need to be reflected in the following
@@ -121,6 +107,7 @@ package System.Standard_Library is
       --  A character indicating the language raising the exception.
       --  Set to "A" for exceptions defined by an Ada program.
       --  Set to "V" for imported VMS exceptions.
+      --  Set to "C" for imported C++ exceptions.
 
       Name_Length : Natural;
       --  Length of fully expanded name of exception
@@ -134,11 +121,10 @@ package System.Standard_Library is
       --  built (by Register_Exception in s-exctab.adb) for converting between
       --  identities and names.
 
-      Import_Code : Exception_Code;
-      --  Value for imported exceptions. Needed only for the handling of
-      --  Import/Export_Exception for the VMS case, but present in all
-      --  implementations (we might well extend this mechanism for other
-      --  systems in the future).
+      Foreign_Data : Address;
+      --  Data for imported exceptions. This represents the exception code
+      --  for the handling of Import/Export_Exception for the VMS case.
+      --  This represents the address of the RTTI for the C++ case.
 
       Raise_Hook : Raise_Action;
       --  This field can be used to place a "hook" on an exception. If the
@@ -169,7 +155,7 @@ package System.Standard_Library is
       Name_Length           => Constraint_Error_Name'Length,
       Full_Name             => Constraint_Error_Name'Address,
       HTable_Ptr            => null,
-      Import_Code           => 0,
+      Foreign_Data          => Null_Address,
       Raise_Hook            => null);
 
    Numeric_Error_Def : aliased Exception_Data :=
@@ -178,7 +164,7 @@ package System.Standard_Library is
       Name_Length           => Numeric_Error_Name'Length,
       Full_Name             => Numeric_Error_Name'Address,
       HTable_Ptr            => null,
-      Import_Code           => 0,
+      Foreign_Data          => Null_Address,
       Raise_Hook            => null);
 
    Program_Error_Def : aliased Exception_Data :=
@@ -187,7 +173,7 @@ package System.Standard_Library is
       Name_Length           => Program_Error_Name'Length,
       Full_Name             => Program_Error_Name'Address,
       HTable_Ptr            => null,
-      Import_Code           => 0,
+      Foreign_Data          => Null_Address,
       Raise_Hook            => null);
 
    Storage_Error_Def : aliased Exception_Data :=
@@ -196,7 +182,7 @@ package System.Standard_Library is
       Name_Length           => Storage_Error_Name'Length,
       Full_Name             => Storage_Error_Name'Address,
       HTable_Ptr            => null,
-      Import_Code           => 0,
+      Foreign_Data          => Null_Address,
       Raise_Hook            => null);
 
    Tasking_Error_Def : aliased Exception_Data :=
@@ -205,7 +191,7 @@ package System.Standard_Library is
       Name_Length           => Tasking_Error_Name'Length,
       Full_Name             => Tasking_Error_Name'Address,
       HTable_Ptr            => null,
-      Import_Code           => 0,
+      Foreign_Data          => Null_Address,
       Raise_Hook            => null);
 
    Abort_Signal_Def : aliased Exception_Data :=
@@ -214,7 +200,7 @@ package System.Standard_Library is
       Name_Length           => Abort_Signal_Name'Length,
       Full_Name             => Abort_Signal_Name'Address,
       HTable_Ptr            => null,
-      Import_Code           => 0,
+      Foreign_Data          => Null_Address,
       Raise_Hook            => null);
 
    pragma Export (C, Constraint_Error_Def, "constraint_error");
diff --git a/gcc/ada/s-vmexta.adb b/gcc/ada/s-vmexta.adb
index b19e274..fb454cf 100644
--- a/gcc/ada/s-vmexta.adb
+++ b/gcc/ada/s-vmexta.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2013, 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- --
@@ -36,8 +36,6 @@ pragma Elaborate_All (System.HTable);
 
 package body System.VMS_Exception_Table is
 
-   use type SSL.Exception_Code;
-
    type HTable_Headers is range 1 .. 37;
 
    type Exception_Code_Data;
@@ -47,7 +45,7 @@ package body System.VMS_Exception_Table is
    --  Ada exception.
 
    type Exception_Code_Data is record
-      Code       : SSL.Exception_Code;
+      Code       : Exception_Code;
       Except     : SSL.Exception_Data_Ptr;
       HTable_Ptr : Exception_Code_Data_Ptr;
    end record;
@@ -59,8 +57,8 @@ package body System.VMS_Exception_Table is
    function Get_HT_Link (T : Exception_Code_Data_Ptr)
      return Exception_Code_Data_Ptr;
 
-   function Hash (F : SSL.Exception_Code) return HTable_Headers;
-   function Get_Key (T : Exception_Code_Data_Ptr) return SSL.Exception_Code;
+   function Hash (F : Exception_Code) return HTable_Headers;
+   function Get_Key (T : Exception_Code_Data_Ptr) return Exception_Code;
 
    package Exception_Code_HTable is new System.HTable.Static_HTable (
      Header_Num => HTable_Headers,
@@ -69,7 +67,7 @@ package body System.VMS_Exception_Table is
      Null_Ptr   => null,
      Set_Next   => Set_HT_Link,
      Next       => Get_HT_Link,
-     Key        => SSL.Exception_Code,
+     Key        => Exception_Code,
      Get_Key    => Get_Key,
      Hash       => Hash,
      Equal      => "=");
@@ -79,7 +77,7 @@ package body System.VMS_Exception_Table is
    ------------------
 
    function Base_Code_In
-     (Code : SSL.Exception_Code) return SSL.Exception_Code
+     (Code : Exception_Code) return Exception_Code
    is
    begin
       return Code and not 2#0111#;
@@ -90,7 +88,7 @@ package body System.VMS_Exception_Table is
    ---------------------
 
    function Coded_Exception
-     (X : SSL.Exception_Code) return SSL.Exception_Data_Ptr
+     (X : Exception_Code) return SSL.Exception_Data_Ptr
    is
       Res : Exception_Code_Data_Ptr;
 
@@ -121,7 +119,7 @@ package body System.VMS_Exception_Table is
    -------------
 
    function Get_Key (T : Exception_Code_Data_Ptr)
-     return SSL.Exception_Code
+     return Exception_Code
    is
    begin
       return T.Code;
@@ -132,10 +130,10 @@ package body System.VMS_Exception_Table is
    ----------
 
    function Hash
-     (F : SSL.Exception_Code) return HTable_Headers
+     (F : Exception_Code) return HTable_Headers
    is
-      Headers_Magnitude : constant SSL.Exception_Code :=
-        SSL.Exception_Code (HTable_Headers'Last - HTable_Headers'First + 1);
+      Headers_Magnitude : constant Exception_Code :=
+        Exception_Code (HTable_Headers'Last - HTable_Headers'First + 1);
 
    begin
       return HTable_Headers (F mod Headers_Magnitude + 1);
@@ -146,13 +144,13 @@ package body System.VMS_Exception_Table is
    ----------------------------
 
    procedure Register_VMS_Exception
-     (Code : SSL.Exception_Code;
+     (Code : Exception_Code;
       E    : SSL.Exception_Data_Ptr)
    is
       --  We bind the exception data with the base code found in the
       --  input value, that is with the severity bits masked off.
 
-      Excode : constant SSL.Exception_Code := Base_Code_In (Code);
+      Excode : constant Exception_Code := Base_Code_In (Code);
 
    begin
       --  The exception data registered here is mostly filled prior to this
@@ -165,7 +163,7 @@ package body System.VMS_Exception_Table is
       --  routine attempts to match the import codes in this case.
 
       E.Lang := 'V';
-      E.Import_Code := Excode;
+      E.Foreign_Data := Excode;
 
       if Exception_Code_HTable.Get (Excode) = null then
          Exception_Code_HTable.Set (new Exception_Code_Data'(Excode, E, null));
diff --git a/gcc/ada/s-vmexta.ads b/gcc/ada/s-vmexta.ads
index b6ac23c..5ad3f3c 100644
--- a/gcc/ada/s-vmexta.ads
+++ b/gcc/ada/s-vmexta.ads
@@ -38,8 +38,10 @@ package System.VMS_Exception_Table is
 
    package SSL renames System.Standard_Library;
 
+   subtype Exception_Code is System.Address;
+
    procedure Register_VMS_Exception
-     (Code : SSL.Exception_Code;
+     (Code : Exception_Code;
       E    : SSL.Exception_Data_Ptr);
    --  Register an exception in hash table mapping with a VMS condition code.
    --
@@ -55,10 +57,10 @@ private
    --  The following functions are directly called (without import/export) in
    --  init.c by __gnat_handle_vms_condition.
 
-   function Base_Code_In (Code : SSL.Exception_Code) return SSL.Exception_Code;
+   function Base_Code_In (Code : Exception_Code) return Exception_Code;
    --  Value of Code with the severity bits masked off
 
-   function Coded_Exception (X : SSL.Exception_Code)
+   function Coded_Exception (X : Exception_Code)
      return SSL.Exception_Data_Ptr;
    --  Given a VMS condition, find and return its allocated Ada exception