re PR ada/23646 (Ada testsuite hangs -- many new failures)

PR ada/23646

	* s-mastop-tru64.adb, s-mastop-irix.adb, s-mastop-vms.adb
	(Enter_Handler, Set_Signal_Machine_State): Removed, no longer used.
	Remove reference to System.Exceptions.

	* s-mastop-x86.adb: Removed, no longer used.

	* s-traceb-mastop.adb: Adjust calls to Pop_Frame.

	* a-excach.adb: Minor reformatting.

	* a-except.ads, a-except.adb: Remove global Warnings (Off) pragma, and
	instead fix new warnings that were hidden by this change.
	(AAA, ZZZ): Removed, replaced by...
	(Code_Address_For_AAA, Code_Address_For_ZZZ): ... these functions, who
	are used instead of constants, to help make Ada.Exception truly
	preelaborate.
	(Rcheck_*, Raise_Constraint_Error, Raise_Program_Error,
	Raise_Storage_Error): File is now a System.Address, to simplify code.
	(Elab code): Removed, no longer used.
	(Null_Occurrence): Remove Warnings Off and make this construct
	preelaborate.
	Remove code related to front-end zero cost exception handling, since
	it is no longer used.
	Remove -gnatL/-gnatZ switches.

	* a-exexda.adb (Append_Info_Exception_Name, Set_Exception_C_Msg):
	Update use of Except.Msg.

	* gnat1drv.adb, inline.adb, bindgen.adb, debug.adb, exp_ch11.ads,
	freeze.adb, frontend.adb, lib.adb, exp_ch11.adb: Remove code related
	to front-end zero cost exception handling, since it is no longer used.
	Remove -gnatL/-gnatZ switches.

	* lib-writ.ads: Minor reformatting
	Remove doc of UX

	* Makefile.rtl: Remove references to s-except*, s-mastop-x86*

	* Make-lang.in: Remove references to s-except.ads

	* s-except.ads: Removed, no longer used.

	* s-mastop.ads, s-mastop.adb:
	(Enter_Handler, Set_Signal_Machine_State): Removed, no longer used.
	Remove reference to System.Exceptions.

	* raise.h, usage.adb, targparm.adb, targparm.ads, switch-m.adb,
	switch-b.adb: Remove code related to front-end zero cost exception
	handling, since it is no longer used.
	Remove -gnatL/-gnatZ switches.

From-SVN: r103848

gcc/ada/Make-lang.in

@@ -113,7 +113,7 @@ GNAT1_C_OBJS = ada/b_gnat1.o ada/adadecode.o ada/adaint.o ada/cstreams.o \
 GNAT_ADA_OBJS = ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
  ada/a-elchha.o ada/a-ioexce.o \
  ada/s-memory.o ada/s-carun8.o ada/s-casuti.o ada/s-strcom.o ada/s-purexc.o \
- ada/s-htable.o ada/s-traceb.o ada/s-mastop.o ada/s-except.o ada/ali.o \
+ ada/s-htable.o ada/s-traceb.o ada/s-mastop.o ada/ali.o \
  ada/alloc.o ada/atree.o ada/butil.o ada/casing.o ada/checks.o ada/comperr.o \
  ada/csets.o ada/cstand.o ada/debug.o ada/debug_a.o ada/einfo.o ada/elists.o \
  ada/errout.o ada/erroutc.o ada/err_vars.o ada/eval_fat.o ada/exp_attr.o \
@@ -215,7 +215,6 @@ GNATBIND_OBJS = \
  ada/s-casuti.o   \
  ada/s-crc32.o    \
  ada/s-crtl.o     \
- ada/s-except.o   \
  ada/s-exctab.o   \
  ada/s-htable.o   \
  ada/s-imgenu.o   \
@@ -1101,7 +1100,7 @@ ada/a-except.o : ada/ada.ads ada/a-except.ads ada/a-except.adb \
    ada/a-excach.adb ada/a-exexda.adb ada/a-exexpr.adb ada/a-exextr.adb \
    ada/a-elchha.ads ada/a-excpol.adb ada/a-exstat.adb ada/a-unccon.ads \
    ada/a-uncdea.ads ada/interfac.ads ada/system.ads ada/s-exctab.ads \
-   ada/s-except.ads ada/s-mastop.ads ada/s-secsta.ads ada/s-soflin.ads \
+   ada/s-mastop.ads ada/s-secsta.ads ada/s-soflin.ads \
    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
    ada/s-traceb.ads ada/s-traent.ads ada/s-traent.adb ada/s-unstyp.ads \
    ada/unchconv.ads 
@@ -2606,9 +2605,6 @@ ada/s-crc32.o : ada/interfac.ads ada/system.ads ada/s-crc32.ads \
 
 ada/s-crtl.o : ada/system.ads ada/s-crtl.ads ada/s-parame.ads 
 
-ada/s-except.o : ada/ada.ads ada/a-except.ads ada/system.ads \
-   ada/s-except.ads ada/s-stalib.ads ada/s-traent.ads ada/unchconv.ads 
-
 ada/s-exctab.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
    ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
    ada/s-htable.adb ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
@@ -2621,7 +2617,7 @@ ada/s-imgenu.o : ada/system.ads ada/s-imgenu.ads ada/s-imgenu.adb \
    ada/s-secsta.ads ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads 
 
 ada/s-mastop.o : ada/ada.ads ada/a-except.ads ada/system.ads \
-   ada/s-except.ads ada/s-mastop.ads ada/s-mastop.adb ada/s-stalib.ads \
+   ada/s-mastop.ads ada/s-mastop.adb ada/s-stalib.ads \
    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads 
 
 ada/s-memory.o : ada/ada.ads ada/a-except.ads ada/system.ads \
@@ -2639,7 +2635,7 @@ ada/s-secsta.o : ada/ada.ads ada/a-except.ads ada/system.ads \
    ada/s-traent.ads ada/unchconv.ads ada/unchdeal.ads 
 
 ada/s-soflin.o : ada/ada.ads ada/a-except.ads ada/system.ads \
-   ada/s-except.ads ada/s-mastop.ads ada/s-parame.ads ada/s-secsta.ads \
+   ada/s-mastop.ads ada/s-parame.ads ada/s-secsta.ads \
    ada/s-soflin.ads ada/s-soflin.adb ada/s-stache.ads ada/s-stalib.ads \
    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads 
 

gcc/ada/Makefile.rtl

@@ -375,7 +375,6 @@ GNATRTL_NONTASKING_OBJS= \
   s-crc32$(objext)  \
   s-direio$(objext) \
   s-errrep$(objext) \
-  s-except$(objext) \
   s-exctab$(objext) \
   s-exnint$(objext) \
   s-exnllf$(objext) \

gcc/ada/a-excach.adb

@@ -71,7 +71,6 @@ begin
          Exclude_Min => Code_Address_For_AAA,
          Exclude_Max => Code_Address_For_ZZZ,
          Skip_Frames => 3);
-
    end if;
 
 end Call_Chain;

gcc/ada/a-except.adb

@@ -35,14 +35,9 @@ pragma Polling (Off);
 --  We must turn polling off for this unit, because otherwise we get
 --  elaboration circularities with System.Exception_Tables.
 
-pragma Warnings (Off);
---  Since several constructs give warnings in 3.14a1, including unreferenced
---  variables and pragma Unreferenced itself.
-
 with System;                  use System;
 with System.Standard_Library; use System.Standard_Library;
 with System.Soft_Links;       use System.Soft_Links;
-with System.Machine_State_Operations; use System.Machine_State_Operations;
 
 package body Ada.Exceptions is
 
@@ -71,11 +66,11 @@ package body Ada.Exceptions is
    --  from C clients using the given external name, even though they are not
    --  technically visible in the Ada sense.
 
-   procedure AAA;
-   procedure ZZZ;
-   --  Mark start and end of procedures in this package
+   function Code_Address_For_AAA return System.Address;
+   function Code_Address_For_ZZZ return System.Address;
+   --  Return start and end of procedures in this package
    --
-   --  The AAA and ZZZ procedures are used to provide exclusion bounds in
+   --  These procedures are used to provide exclusion bounds in
    --  calls to Call_Chain at exception raise points from this unit. The
    --  purpose is to arrange for the exception tracebacks not to include
    --  frames from routines involved in the raise process, as these are
@@ -83,27 +78,18 @@ package body Ada.Exceptions is
    --
    --  For these bounds to be meaningful, we need to ensure that the object
    --  code for the routines involved in processing a raise is located after
-   --  the object code for AAA and before the object code for ZZZ. This will
-   --  indeed be the case as long as the following rules are respected:
+   --  the object code Code_Address_For_AAA and before the object code
+   --  Code_Address_For_ZZZ. This will indeed be the case as long as the
+   --  following rules are respected:
    --
    --  1) The bodies of the subprograms involved in processing a raise
-   --     are located after the body of AAA and before the body of ZZZ.
+   --     are located after the body of Code_Address_For_AAA and before the
+   --     body of Code_Address_For_ZZZ.
    --
    --  2) No pragma Inline applies to any of these subprograms, as this
    --     could delay the corresponding assembly output until the end of
    --     the unit.
 
-   Code_Address_For_AAA, Code_Address_For_ZZZ : System.Address;
-   --  Used to represent addresses really inside the code range for AAA and
-   --  ZZZ, initialized to the address of a label inside the corresponding
-   --  procedure. This is initialization takes place inside the procedures
-   --  themselves, which are called as part of the elaboration code.
-   --
-   --  We are doing this instead of merely using Proc'Address because on some
-   --  platforms the latter does not yield the address we want, but the
-   --  address of a stub or of a descriptor instead. This is the case at least
-   --  on Alpha-VMS and PA-HPUX.
-
    procedure Call_Chain (Excep : EOA);
    --  Store up to Max_Tracebacks in Excep, corresponding to the current
    --  call chain.
@@ -139,9 +125,9 @@ package body Ada.Exceptions is
 
       procedure Set_Exception_C_Msg
         (Id   : Exception_Id;
-         Msg1 : Big_String_Ptr;
+         Msg1 : System.Address;
          Line : Integer        := 0;
-         Msg2 : Big_String_Ptr := null);
+         Msg2 : System.Address := System.Null_Address);
       --  This routine is called to setup the exception referenced by the
       --  Current_Excep field in the TSD to contain the indicated Id value
       --  and message. Msg1 is a null terminated string which is generated
@@ -210,7 +196,7 @@ package body Ada.Exceptions is
       pragma Export
         (Ada, Tailored_Exception_Information,
            "__gnat_tailored_exception_information");
-      --  This is currently used by System.Tasking.Stages.
+      --  This is currently used by System.Tasking.Stages
 
    end Exception_Data;
 
@@ -329,9 +315,9 @@ package body Ada.Exceptions is
 
    procedure Raise_With_Location_And_Msg
      (E : Exception_Id;
-      F : Big_String_Ptr;
+      F : System.Address;
       L : Integer;
-      M : Big_String_Ptr := null);
+      M : System.Address := System.Null_Address);
    pragma No_Return (Raise_With_Location_And_Msg);
    --  Raise an exception with given exception id value. A filename and line
    --  number is associated with the raise and is stored in the exception
@@ -339,7 +325,7 @@ package body Ada.Exceptions is
    --  this (if M is not null).
 
    procedure Raise_Constraint_Error
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer);
    pragma No_Return (Raise_Constraint_Error);
    pragma Export
@@ -347,16 +333,16 @@ package body Ada.Exceptions is
    --  Raise constraint error with file:line information
 
    procedure Raise_Constraint_Error_Msg
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer;
-      Msg  : Big_String_Ptr);
+      Msg  : System.Address);
    pragma No_Return (Raise_Constraint_Error_Msg);
    pragma Export
      (C, Raise_Constraint_Error_Msg, "__gnat_raise_constraint_error_msg");
    --  Raise constraint error with file:line + msg information
 
    procedure Raise_Program_Error
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer);
    pragma No_Return (Raise_Program_Error);
    pragma Export
@@ -364,16 +350,16 @@ package body Ada.Exceptions is
    --  Raise program error with file:line information
 
    procedure Raise_Program_Error_Msg
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer;
-      Msg  : Big_String_Ptr);
+      Msg  : System.Address);
    pragma No_Return (Raise_Program_Error_Msg);
    pragma Export
      (C, Raise_Program_Error_Msg, "__gnat_raise_program_error_msg");
    --  Raise program error with file:line + msg information
 
    procedure Raise_Storage_Error
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer);
    pragma No_Return (Raise_Storage_Error);
    pragma Export
@@ -381,9 +367,9 @@ package body Ada.Exceptions is
    --  Raise storage error with file:line information
 
    procedure Raise_Storage_Error_Msg
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer;
-      Msg  : Big_String_Ptr);
+      Msg  : System.Address);
    pragma No_Return (Raise_Storage_Error_Msg);
    pragma Export
      (C, Raise_Storage_Error_Msg, "__gnat_raise_storage_error_msg");
@@ -454,37 +440,37 @@ package body Ada.Exceptions is
    --  to the codes defined in Types.ads and a-types.h (for example,
    --  the name Rcheck_05 refers to the Reason whose Pos code is 5).
 
-   procedure Rcheck_00 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_01 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_02 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_03 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_04 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_05 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_06 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_07 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_08 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_09 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_10 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_11 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_12 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_13 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_14 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_15 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_16 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_17 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_18 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_19 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_20 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_21 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_22 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_23 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_24 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_25 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_26 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_27 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_28 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_29 (File : Big_String_Ptr; Line : Integer);
-   procedure Rcheck_30 (File : Big_String_Ptr; Line : Integer);
+   procedure Rcheck_00 (File : System.Address; Line : Integer);
+   procedure Rcheck_01 (File : System.Address; Line : Integer);
+   procedure Rcheck_02 (File : System.Address; Line : Integer);
+   procedure Rcheck_03 (File : System.Address; Line : Integer);
+   procedure Rcheck_04 (File : System.Address; Line : Integer);
+   procedure Rcheck_05 (File : System.Address; Line : Integer);
+   procedure Rcheck_06 (File : System.Address; Line : Integer);
+   procedure Rcheck_07 (File : System.Address; Line : Integer);
+   procedure Rcheck_08 (File : System.Address; Line : Integer);
+   procedure Rcheck_09 (File : System.Address; Line : Integer);
+   procedure Rcheck_10 (File : System.Address; Line : Integer);
+   procedure Rcheck_11 (File : System.Address; Line : Integer);
+   procedure Rcheck_12 (File : System.Address; Line : Integer);
+   procedure Rcheck_13 (File : System.Address; Line : Integer);
+   procedure Rcheck_14 (File : System.Address; Line : Integer);
+   procedure Rcheck_15 (File : System.Address; Line : Integer);
+   procedure Rcheck_16 (File : System.Address; Line : Integer);
+   procedure Rcheck_17 (File : System.Address; Line : Integer);
+   procedure Rcheck_18 (File : System.Address; Line : Integer);
+   procedure Rcheck_19 (File : System.Address; Line : Integer);
+   procedure Rcheck_20 (File : System.Address; Line : Integer);
+   procedure Rcheck_21 (File : System.Address; Line : Integer);
+   procedure Rcheck_22 (File : System.Address; Line : Integer);
+   procedure Rcheck_23 (File : System.Address; Line : Integer);
+   procedure Rcheck_24 (File : System.Address; Line : Integer);
+   procedure Rcheck_25 (File : System.Address; Line : Integer);
+   procedure Rcheck_26 (File : System.Address; Line : Integer);
+   procedure Rcheck_27 (File : System.Address; Line : Integer);
+   procedure Rcheck_28 (File : System.Address; Line : Integer);
+   procedure Rcheck_29 (File : System.Address; Line : Integer);
+   procedure Rcheck_30 (File : System.Address; Line : Integer);
 
    pragma Export (C, Rcheck_00, "__gnat_rcheck_00");
    pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
@@ -611,19 +597,25 @@ package body Ada.Exceptions is
    --  The actual polling routine is separate, so that it can easily
    --  be replaced with a target dependent version.
 
-   ---------
-   -- AAA --
-   ---------
+   --------------------------
+   -- Code_Address_For_AAA --
+   --------------------------
 
-   --  This dummy procedure gives us the start of the PC range for addresses
+   --  This function gives us the start of the PC range for addresses
    --  within the exception unit itself. We hope that gigi/gcc keep all the
    --  procedures in their original order!
 
-   procedure AAA is
+   function Code_Address_For_AAA return System.Address is
    begin
+      --  We are using a label instead of merely using
+      --  Code_Address_For_AAA'Address because on some platforms the latter
+      --  does not yield the address we want, but the address of a stub or of
+      --  a descriptor instead. This is the case at least on Alpha-VMS and
+      --  PA-HPUX.
+
       <<Start_Of_AAA>>
-      Code_Address_For_AAA := Start_Of_AAA'Address;
-   end AAA;
+      return Start_Of_AAA'Address;
+   end Code_Address_For_AAA;
 
    ----------------
    -- Call_Chain --
@@ -714,7 +706,7 @@ package body Ada.Exceptions is
          raise Constraint_Error;
       end if;
 
-      return Id.Full_Name.all (1 .. Id.Name_Length - 1);
+      return To_Ptr (Id.Full_Name) (1 .. Id.Name_Length - 1);
    end Exception_Name;
 
    function Exception_Name (X : Exception_Occurrence) return String is
@@ -793,7 +785,7 @@ package body Ada.Exceptions is
       --  This is so the debugger can reliably inspect the parameter
 
       Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
-      Excep       : EOA := Get_Current_Excep.all;
+      Excep       : constant EOA := Get_Current_Excep.all;
 
    begin
       --  WARNING : There should be no exception handler for this body
@@ -803,43 +795,44 @@ package body Ada.Exceptions is
       --  we are handling, which would completely break the whole design
       --  of this procedure.
 
-      --  Processing varies between zero cost and setjmp/lonjmp processing.
+      --  Processing varies between zero cost and setjmp/lonjmp processing
 
       if Zero_Cost_Exceptions /= 0 then
 
-         --  Use the front-end tables to propagate if we have them, otherwise
-         --  resort to the GCC back-end alternative. Backtrace computation is
-         --  performed, if required, by the underlying routine. Notifications
-         --  for the debugger are also not performed here, because we do not
-         --  yet know if the exception is handled.
+         --  Use the GCC back-end to propagate the exception. Backtrace
+         --  computation is performed, if required, by the underlying routine.
+         --  Notifications for the debugger are also not performed here,
+         --  because we do not yet know if the exception is handled.
 
          Exception_Propagation.Propagate_Exception (From_Signal_Handler);
 
       else
-         --  Compute the backtrace for this occurrence if the corresponding
-         --  binder option has been set. Call_Chain takes care of the reraise
-         --  case.
+         --  Compute the backtrace for this occurrence if corresponding binder
+         --  option has been set. Call_Chain takes care of the reraise case.
 
          Call_Chain (Excep);
+
+         --  Note on above call to Call_Chain:
+
          --  We used to only do this if From_Signal_Handler was not set,
          --  based on the assumption that backtracing from a signal handler
          --  would not work due to stack layout oddities. However, since
-         --
+
          --   1. The flag is never set in tasking programs (Notify_Exception
          --      performs regular raise statements), and
-         --
+
          --   2. No problem has shown up in tasking programs around here so
          --      far, this turned out to be too strong an assumption.
-         --
+
          --  As, in addition, the test was
-         --
+
          --   1. preventing the production of backtraces in non-tasking
          --      programs, and
-         --
+
          --   2. introducing a behavior inconsistency between
          --      the tasking and non-tasking cases,
-         --
-         --  we have simply removed it.
+
+         --  we have simply removed it
 
          --  If the jump buffer pointer is non-null, transfer control using
          --  it. Otherwise announce an unhandled exception (note that this
@@ -872,7 +865,7 @@ package body Ada.Exceptions is
    ----------------------------
 
    procedure Raise_Constraint_Error
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer)
    is
    begin
@@ -885,9 +878,9 @@ package body Ada.Exceptions is
    --------------------------------
 
    procedure Raise_Constraint_Error_Msg
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer;
-      Msg  : Big_String_Ptr)
+      Msg  : System.Address)
    is
    begin
       Raise_With_Location_And_Msg
@@ -941,7 +934,7 @@ package body Ada.Exceptions is
 
    procedure Raise_From_Signal_Handler
      (E : Exception_Id;
-      M : Big_String_Ptr)
+      M : System.Address)
    is
    begin
       Exception_Data.Set_Exception_C_Msg (E, M);
@@ -954,7 +947,7 @@ package body Ada.Exceptions is
    -------------------------
 
    procedure Raise_Program_Error
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer)
    is
    begin
@@ -967,9 +960,9 @@ package body Ada.Exceptions is
    -----------------------------
 
    procedure Raise_Program_Error_Msg
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer;
-      Msg  : Big_String_Ptr)
+      Msg  : System.Address)
    is
    begin
       Raise_With_Location_And_Msg
@@ -981,7 +974,7 @@ package body Ada.Exceptions is
    -------------------------
 
    procedure Raise_Storage_Error
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer)
    is
    begin
@@ -994,9 +987,9 @@ package body Ada.Exceptions is
    -----------------------------
 
    procedure Raise_Storage_Error_Msg
-     (File : Big_String_Ptr;
+     (File : System.Address;
       Line : Integer;
-      Msg  : Big_String_Ptr)
+      Msg  : System.Address)
    is
    begin
       Raise_With_Location_And_Msg
@@ -1009,9 +1002,9 @@ package body Ada.Exceptions is
 
    procedure Raise_With_Location_And_Msg
      (E : Exception_Id;
-      F : Big_String_Ptr;
+      F : System.Address;
       L : Integer;
-      M : Big_String_Ptr := null)
+      M : System.Address := System.Null_Address)
    is
    begin
       Exception_Data.Set_Exception_C_Msg (E, F, L, M);
@@ -1042,159 +1035,159 @@ package body Ada.Exceptions is
    -- Calls to Run-Time Check Routines --
    --------------------------------------
 
-   procedure Rcheck_00 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_00 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_00'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_00'Address);
    end Rcheck_00;
 
-   procedure Rcheck_01 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_01 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_01'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_01'Address);
    end Rcheck_01;
 
-   procedure Rcheck_02 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_02 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_02'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_02'Address);
    end Rcheck_02;
 
-   procedure Rcheck_03 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_03 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_03'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_03'Address);
    end Rcheck_03;
 
-   procedure Rcheck_04 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_04 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_04'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_04'Address);
    end Rcheck_04;
 
-   procedure Rcheck_05 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_05 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_05'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_05'Address);
    end Rcheck_05;
 
-   procedure Rcheck_06 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_06 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_06'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_06'Address);
    end Rcheck_06;
 
-   procedure Rcheck_07 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_07 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_07'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_07'Address);
    end Rcheck_07;
 
-   procedure Rcheck_08 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_08 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_08'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_08'Address);
    end Rcheck_08;
 
-   procedure Rcheck_09 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_09 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_09'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_09'Address);
    end Rcheck_09;
 
-   procedure Rcheck_10 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_10 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_10'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_10'Address);
    end Rcheck_10;
 
-   procedure Rcheck_11 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_11 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_11'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_11'Address);
    end Rcheck_11;
 
-   procedure Rcheck_12 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_12 (File : System.Address; Line : Integer) is
    begin
-      Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_12'Address));
+      Raise_Constraint_Error_Msg (File, Line, Rmsg_12'Address);
    end Rcheck_12;
 
-   procedure Rcheck_13 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_13 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_13'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_13'Address);
    end Rcheck_13;
 
-   procedure Rcheck_14 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_14 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_14'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_14'Address);
    end Rcheck_14;
 
-   procedure Rcheck_15 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_15 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_15'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_15'Address);
    end Rcheck_15;
 
-   procedure Rcheck_16 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_16 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_16'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_16'Address);
    end Rcheck_16;
 
-   procedure Rcheck_17 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_17 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_17'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_17'Address);
    end Rcheck_17;
 
-   procedure Rcheck_18 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_18 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_18'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_18'Address);
    end Rcheck_18;
 
-   procedure Rcheck_19 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_19 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_19'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_19'Address);
    end Rcheck_19;
 
-   procedure Rcheck_20 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_20 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_20'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_20'Address);
    end Rcheck_20;
 
-   procedure Rcheck_21 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_21 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_21'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_21'Address);
    end Rcheck_21;
 
-   procedure Rcheck_22 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_22 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_22'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_22'Address);
    end Rcheck_22;
 
-   procedure Rcheck_23 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_23 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_23'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_23'Address);
    end Rcheck_23;
 
-   procedure Rcheck_24 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_24 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_24'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_24'Address);
    end Rcheck_24;
 
-   procedure Rcheck_25 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_25 (File : System.Address; Line : Integer) is
    begin
-      Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_25'Address));
+      Raise_Program_Error_Msg (File, Line, Rmsg_25'Address);
    end Rcheck_25;
 
-   procedure Rcheck_26 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_26 (File : System.Address; Line : Integer) is
    begin
-      Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_26'Address));
+      Raise_Storage_Error_Msg (File, Line, Rmsg_26'Address);
    end Rcheck_26;
 
-   procedure Rcheck_27 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_27 (File : System.Address; Line : Integer) is
    begin
-      Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_27'Address));
+      Raise_Storage_Error_Msg (File, Line, Rmsg_27'Address);
    end Rcheck_27;
 
-   procedure Rcheck_28 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_28 (File : System.Address; Line : Integer) is
    begin
-      Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_28'Address));
+      Raise_Storage_Error_Msg (File, Line, Rmsg_28'Address);
    end Rcheck_28;
 
-   procedure Rcheck_29 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_29 (File : System.Address; Line : Integer) is
    begin
-      Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_29'Address));
+      Raise_Storage_Error_Msg (File, Line, Rmsg_29'Address);
    end Rcheck_29;
 
-   procedure Rcheck_30 (File : Big_String_Ptr; Line : Integer) is
+   procedure Rcheck_30 (File : System.Address; Line : Integer) is
    begin
-      Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_30'Address));
+      Raise_Storage_Error_Msg (File, Line, Rmsg_30'Address);
    end Rcheck_30;
 
    -------------
@@ -1263,7 +1256,7 @@ package body Ada.Exceptions is
    end Save_Occurrence;
 
    function Save_Occurrence (Source : Exception_Occurrence) return EOA is
-      Target : EOA := new Exception_Occurrence;
+      Target : constant EOA := new Exception_Occurrence;
    begin
       Save_Occurrence (Target.all, Source);
       return Target;
@@ -1348,8 +1341,7 @@ package body Ada.Exceptions is
    begin
       Exception_Data.Set_Exception_Msg (E, Message);
 
-      --  DO NOT CALL Abort_Defer.all; !!!!
-      --  why not??? would be nice to have more comments here
+      --  Do not call Abort_Defer.all, as specified by the spec
 
       Raise_Current_Excep (E);
    end Raise_Exception_No_Defer;
@@ -1378,35 +1370,18 @@ package body Ada.Exceptions is
       end loop;
    end To_Stderr;
 
-   ---------
-   -- ZZZ --
-   ---------
+   --------------------------
+   -- Code_Address_For_ZZZ --
+   --------------------------
 
-   --  This dummy procedure gives us the end of the PC range for addresses
+   --  This function gives us the end of the PC range for addresses
    --  within the exception unit itself. We hope that gigi/gcc keeps all the
    --  procedures in their original order!
 
-   procedure ZZZ is
+   function Code_Address_For_ZZZ return System.Address is
    begin
       <<Start_Of_ZZZ>>
-      Code_Address_For_ZZZ := Start_Of_ZZZ'Address;
-   end ZZZ;
-
-begin
-   pragma Warnings (Off);
-   --  Allow calls to non-static subprograms in Ada 2005 mode where this
-   --  package will be implicitly categorized as Preelaborate. See AI-362 for
-   --  details. It is safe in the context of the run-time to violate the rules!
-
-   --  Allocate the Non-Tasking Machine_State
-
-   Set_Machine_State_Addr_NT (System.Address (Allocate_Machine_State));
-
-   --  Call the AAA/ZZZ routines to setup the code addresses for the
-   --  bounds of this unit.
-
-   AAA;
-   ZZZ;
+      return Start_Of_ZZZ'Address;
+   end Code_Address_For_ZZZ;
 
-   pragma Warnings (On);
 end Ada.Exceptions;

gcc/ada/a-except.ads

@@ -39,24 +39,18 @@ pragma Polling (Off);
 --  We must turn polling off for this unit, because otherwise we get
 --  elaboration circularities with ourself.
 
-pragma Warnings (Off);
---  Allow withing of non-Preelaborated units in Ada 2005 mode where this
---  package will be categorized as Preelaborate. See AI-362 for details.
---  It is safe in the context of the run-time to violate the rules!
-
 with System;
 with System.Parameters;
 with System.Standard_Library;
 with System.Traceback_Entries;
-pragma Warnings (On);
 
 package Ada.Exceptions is
-pragma Warnings (Off);
-pragma Preelaborate_05 (Exceptions);
-pragma Warnings (On);
---  In accordance with Ada 2005 AI-362. The warnings pragmas are so that we can
---  compile this using older compiler versions, which will ignore the pragma,
---  which is fine for the bootstrap.
+   pragma Warnings (Off);
+   pragma Preelaborate_05;
+   pragma Warnings (On);
+   --  In accordance with Ada 2005 AI-362. The warnings pragmas are so that we
+   --  can compile this using older compiler versions, which will ignore the
+   --  pragma, which is fine for the bootstrap.
 
    type Exception_Id is private;
    Null_Id : constant Exception_Id;
@@ -127,10 +121,9 @@ private
    ------------------
 
    subtype Code_Loc is System.Address;
-   --  Code location used in building exception tables and for call
-   --  addresses when propagating an exception.
-   --  Values of this type are created by using Label'Address or
-   --  extracted from machine states using Get_Code_Loc.
+   --  Code location used in building exception tables and for call addresses
+   --  when propagating an exception. Values of this type are created by using
+   --  Label'Address or extracted from machine states using Get_Code_Loc.
 
    Null_Loc : constant Code_Loc := System.Null_Address;
    --  Null code location, used to flag outer level frame
@@ -161,12 +154,12 @@ private
    --  to be in the visible part, since this is set by the reference manual).
 
    function Exception_Name_Simple (X : Exception_Occurrence) return String;
-   --  Like Exception_Name, but returns the simple non-qualified name of
-   --  the exception. This is used to implement the Exception_Name function
-   --  in Current_Exceptions (the DEC compatible unit). It is called from
-   --  the compiler generated code (using Rtsfind, which does not respect
-   --  the private barrier, so we can place this function in the private
-   --  part where the compiler can find it, but the spec is unchanged.)
+   --  Like Exception_Name, but returns the simple non-qualified name of the
+   --  exception. This is used to implement the Exception_Name function in
+   --  Current_Exceptions (the DEC compatible unit). It is called from the
+   --  compiler generated code (using Rtsfind, which does not respect the
+   --  private barrier, so we can place this function in the private part
+   --  where the compiler can find it, but the spec is unchanged.)
 
    procedure Raise_Exception_Always (E : Exception_Id; Message : String := "");
    pragma No_Return (Raise_Exception_Always);
@@ -179,22 +172,21 @@ private
 
    procedure Raise_From_Signal_Handler
      (E : Exception_Id;
-      M : SSL.Big_String_Ptr);
+      M : System.Address);
    pragma Export
      (Ada, Raise_From_Signal_Handler,
            "ada__exceptions__raise_from_signal_handler");
    pragma No_Return (Raise_From_Signal_Handler);
-   --  This routine is used to raise an exception from a signal handler.
-   --  The signal handler has already stored the machine state (i.e. the
-   --  state that corresponds to the location at which the signal was
-   --  raised). E is the Exception_Id specifying what exception is being
-   --  raised, and M is a pointer to a null-terminated string which is the
-   --  message to be raised. Note that this routine never returns, so it is
-   --  permissible to simply jump to this routine, rather than call it. This
-   --  may be appropriate for systems where the right way to get out of a
-   --  signal handler is to alter the PC value in the machine state or in
-   --  some other way ask the operating system to return here rather than
-   --  to the original location.
+   --  This routine is used to raise an exception from a signal handler. The
+   --  signal handler has already stored the machine state (i.e. the state that
+   --  corresponds to the location at which the signal was raised). E is the
+   --  Exception_Id specifying what exception is being raised, and M is a
+   --  pointer to a null-terminated string which is the message to be raised.
+   --  Note that this routine never returns, so it is permissible to simply
+   --  jump to this routine, rather than call it. This may be appropriate for
+   --  systems where the right way to get out of signal handler is to alter the
+   --  PC value in the machine state or in some other way ask the operating
+   --  system to return here rather than to the original location.
 
    procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
    pragma No_Return (Reraise_Occurrence_Always);
@@ -207,8 +199,8 @@ private
    pragma No_Return (Reraise_Occurrence_No_Defer);
    --  Exactly like Reraise_Occurrence, except that abort is not deferred
    --  before the call and the parameter X is known not to be the null
-   --  occurrence. This is used in generated code when it is known
-   --  that abort is already deferred.
+   --  occurrence. This is used in generated code when it is known that
+   --  abort is already deferred.
 
    -----------------------
    -- Polling Interface --
@@ -260,7 +252,7 @@ private
       Msg : String (1 .. Exception_Msg_Max_Length);
       --  Characters of message
 
-      Cleanup_Flag : Boolean;
+      Cleanup_Flag : Boolean := False;
       --  The cleanup flag is normally False, it is set True for an exception
       --  occurrence passed to a cleanup routine, and will still be set True
       --  when the cleanup routine does a Reraise_Occurrence call using this
@@ -276,7 +268,7 @@ private
       --  it is dealing with the reraise case (which is useful to distinguish
       --  for exception tracing purposes).
 
-      Pid : Natural;
+      Pid : Natural := 0;
       --  Partition_Id for partition raising exception
 
       Num_Tracebacks : Natural range 0 .. Max_Tracebacks := 0;
@@ -302,13 +294,8 @@ private
    pragma Stream_Convert (Exception_Occurrence, String_To_EO, EO_To_String);
    --  Functions for implementing Exception_Occurrence stream attributes
 
-   pragma Warnings (Off);
-   --  Allow non-static constants in Ada 2005 mode where this package will be
-   --  implicitly categorized as Preelaborate. See AI-362 for details. It is
-   --  safe in the context of the run-time to violate the rules!
-
    Null_Occurrence : constant Exception_Occurrence := (
-     Id               => Null_Id,
+     Id               => null,
      Msg_Length       => 0,
      Msg              => (others => ' '),
      Cleanup_Flag     => False,
@@ -318,6 +305,4 @@ private
      Tracebacks       => (others => TBE.Null_TB_Entry),
      Private_Data     => System.Null_Address);
 
-   pragma Warnings (On);
-
 end Ada.Exceptions;

gcc/ada/a-exexda.adb

@@ -476,7 +476,7 @@ package body Exception_Data is
 
       declare
          Len  : constant Natural := Exception_Name_Length (Id);
-         Name : constant String (1 .. Len) := Id.Full_Name (1 .. Len);
+         Name : constant String (1 .. Len) := To_Ptr (Id.Full_Name) (1 .. Len);
       begin
          Append_Info_String (Name, Info, Ptr);
       end;
@@ -556,9 +556,9 @@ package body Exception_Data is
 
    procedure Set_Exception_C_Msg
      (Id   : Exception_Id;
-      Msg1 : Big_String_Ptr;
+      Msg1 : System.Address;
       Line : Integer        := 0;
-      Msg2 : Big_String_Ptr := null)
+      Msg2 : System.Address := System.Null_Address)
    is
       Excep  : constant EOA := Get_Current_Excep.all;
       Val    : Integer := Line;
@@ -575,11 +575,11 @@ package body Exception_Data is
       Excep.Msg_Length       := 0;
       Excep.Cleanup_Flag     := False;
 
-      while Msg1 (Excep.Msg_Length + 1) /= ASCII.NUL
+      while To_Ptr (Msg1) (Excep.Msg_Length + 1) /= ASCII.NUL
         and then Excep.Msg_Length < Exception_Msg_Max_Length
       loop
          Excep.Msg_Length := Excep.Msg_Length + 1;
-         Excep.Msg (Excep.Msg_Length) := Msg1 (Excep.Msg_Length);
+         Excep.Msg (Excep.Msg_Length) := To_Ptr (Msg1) (Excep.Msg_Length);
       end loop;
 
       --  Append line number if present
@@ -613,18 +613,18 @@ package body Exception_Data is
 
       --  Append second message if present
 
-      if Msg2 /= null
+      if Msg2 /= System.Null_Address
         and then Excep.Msg_Length + 1 < Exception_Msg_Max_Length
       then
          Excep.Msg_Length := Excep.Msg_Length + 1;
          Excep.Msg (Excep.Msg_Length) := ' ';
 
          Ptr := 1;
-         while Msg2 (Ptr) /= ASCII.NUL
+         while To_Ptr (Msg2) (Ptr) /= ASCII.NUL
            and then Excep.Msg_Length < Exception_Msg_Max_Length
          loop
             Excep.Msg_Length := Excep.Msg_Length + 1;
-            Excep.Msg (Excep.Msg_Length) := Msg2 (Ptr);
+            Excep.Msg (Excep.Msg_Length) := To_Ptr (Msg2) (Ptr);
             Ptr := Ptr + 1;
          end loop;
       end if;

gcc/ada/bindgen.adb

@@ -201,16 +201,6 @@ package body Bindgen is
    procedure Gen_Elab_Defs_C;
    --  Generate sequence of definitions for elaboration routines (C code case)
 
-   procedure Gen_Exception_Table_Ada;
-   --  Generate binder exception table (Ada code case). This consists of
-   --  declarations followed by a begin followed by a call. If zero cost
-   --  exceptions are not active, then only the begin is generated.
-
-   procedure Gen_Exception_Table_C;
-   --  Generate binder exception table (C code case). This has no effect
-   --  if zero cost exceptions are not active, otherwise it generates a
-   --  set of declarations followed by a call.
-
    procedure Gen_Main_Ada;
    --  Generate procedure main (Ada code case)
 
@@ -279,9 +269,6 @@ package body Bindgen is
    --  Set given character in Statement_Buffer at the Last + 1 position
    --  and increment Last by one to reflect the stored character.
 
-   procedure Set_EA_Last;
-   --  Output the number of elements in array EA
-
    procedure Set_Int (N : Int);
    --  Set given value in decimal in Statement_Buffer with no spaces
    --  starting at the Last + 1 position, and updating Last past the value.
@@ -296,7 +283,7 @@ package body Bindgen is
    --  is generated starting at Last + 1, and Last is updated past it.
 
    procedure Set_Name_Buffer;
-   --  Set the value stored in positions 1 .. Name_Len of the Name_Buffer.
+   --  Set the value stored in positions 1 .. Name_Len of the Name_Buffer
 
    procedure Set_String (S : String);
    --  Sets characters of given string in Statement_Buffer, starting at the
@@ -550,10 +537,7 @@ package body Bindgen is
          WBI ("      Handler_Installed : Integer;");
          WBI ("      pragma Import (C, Handler_Installed, " &
               """__gnat_handler_installed"");");
-
-         --  Generate exception table
-
-         Gen_Exception_Table_Ada;
+         WBI ("   begin");
 
          --  Generate the call to Set_Globals
 
@@ -782,10 +766,8 @@ package body Bindgen is
 
          --  Code for normal case (standard library not suppressed)
 
-         Gen_Exception_Table_C;
-
          --  Generate call to set the runtime global variables defined in
-         --  a-init.c. We define the varables in a-init.c, rather than in
+         --  init.c. We define the varables in init.c, rather than in
          --  the binder generated file itself to avoid undefined externals
          --  when the runtime is linked as a shareable image library.
 
@@ -1228,324 +1210,6 @@ package body Bindgen is
       WBI ("   END ELABORATION ORDER */");
    end Gen_Elab_Order_C;
 
-   -----------------------------
-   -- Gen_Exception_Table_Ada --
-   -----------------------------
-
-   procedure Gen_Exception_Table_Ada is
-      Num  : Nat;
-      Last : ALI_Id := No_ALI_Id;
-
-   begin
-      if not Zero_Cost_Exceptions_Specified then
-         WBI ("   begin");
-         return;
-      end if;
-
-      --  The code we generate looks like
-
-      --        procedure SDP_Table_Build
-      --          (SDP_Addresses   : System.Address;
-      --           SDP_Count       : Natural;
-      --           Elab_Addresses  : System.Address;
-      --           Elab_Addr_Count : Natural);
-      --        pragma Import (C, SDP_Table_Build, "__gnat_SDP_Table_Build");
-      --
-      --        ST : aliased constant array (1 .. nnn) of System.Address := (
-      --               unit_name_1'UET_Address,
-      --               unit_name_2'UET_Address,
-      --               ...
-      --               unit_name_3'UET_Address,
-      --
-      --        EA : aliased constant array (1 .. eee) of System.Address := (
-      --               adainit'Code_Address,
-      --               adafinal'Code_Address,
-      --               unit_name'elab[spec|body]'Code_Address,
-      --               unit_name'elab[spec|body]'Code_Address,
-      --               unit_name'elab[spec|body]'Code_Address,
-      --               unit_name'elab[spec|body]'Code_Address);
-      --
-      --     begin
-      --        SDP_Table_Build (ST'Address, nnn, EA'Address, eee);
-
-      Num := 0;
-      for A in ALIs.First .. ALIs.Last loop
-         if not ALIs.Table (A).SAL_Interface
-           and then ALIs.Table (A).Unit_Exception_Table
-         then
-            Num := Num + 1;
-            Last := A;
-         end if;
-      end loop;
-
-      if Num = 0 then
-
-         --  Happens with "gnatmake -a -f -gnatL ..."
-
-         WBI (" ");
-         WBI ("   begin");
-         return;
-      end if;
-
-      WBI ("      procedure SDP_Table_Build");
-      WBI ("        (SDP_Addresses   : System.Address;");
-      WBI ("         SDP_Count       : Natural;");
-      WBI ("         Elab_Addresses  : System.Address;");
-      WBI ("         Elab_Addr_Count : Natural);");
-      WBI ("      " &
-           "pragma Import (C, SDP_Table_Build, ""__gnat_SDP_Table_Build"");");
-
-      WBI (" ");
-      Set_String ("      ST : aliased constant array (1 .. ");
-      Set_Int (Num);
-      Set_String (") of System.Address := (");
-
-      if Num = 1 then
-         Set_String ("1 => ");
-
-      else
-         Write_Statement_Buffer;
-      end if;
-
-      for A in ALIs.First .. ALIs.Last loop
-         if not ALIs.Table (A).SAL_Interface
-           and then ALIs.Table (A).Unit_Exception_Table
-         then
-            Get_Decoded_Name_String_With_Brackets
-              (Units.Table (ALIs.Table (A).First_Unit).Uname);
-            Set_Casing (Mixed_Case);
-
-            if Num /= 1 then
-               Set_String ("        ");
-            end if;
-
-            Set_String (Name_Buffer (1 .. Name_Len - 2));
-            Set_String ("'UET_Address");
-
-            if A = Last then
-               Set_String (");");
-            else
-               Set_Char (',');
-            end if;
-
-            Write_Statement_Buffer;
-         end if;
-      end loop;
-
-      WBI (" ");
-      Set_String ("      EA : aliased constant array (1 .. ");
-      Set_EA_Last;
-      Set_String (") of System.Address := (");
-      Write_Statement_Buffer;
-      Set_String ("        " & Ada_Init_Name.all & "'Code_Address");
-
-      --  If compiling for the JVM, we directly reference Adafinal because
-      --  we don't import it via Do_Finalize (see Gen_Output_File_Ada).
-
-      if not Cumulative_Restrictions.Set (No_Finalization) then
-         Set_Char (',');
-         Write_Statement_Buffer;
-
-         if Hostparm.Java_VM then
-            Set_String
-              ("        System.Standard_Library.Adafinal'Code_Address");
-         else
-            Set_String
-              ("        Do_Finalize'Code_Address");
-         end if;
-      end if;
-
-      for E in Elab_Order.First .. Elab_Order.Last loop
-         Get_Decoded_Name_String_With_Brackets
-           (Units.Table (Elab_Order.Table (E)).Uname);
-
-         if Units.Table (Elab_Order.Table (E)).No_Elab then
-            null;
-
-         else
-            Set_Char (',');
-            Write_Statement_Buffer;
-            Set_String ("        ");
-
-            if Name_Buffer (Name_Len) = 's' then
-               Name_Buffer (Name_Len - 1 .. Name_Len + 21) :=
-                                        "'elab_spec'code_address";
-            else
-               Name_Buffer (Name_Len - 1 .. Name_Len + 21) :=
-                                        "'elab_body'code_address";
-            end if;
-
-            Name_Len := Name_Len + 21;
-            Set_Casing (Units.Table (Elab_Order.Table (E)).Icasing);
-            Set_Name_Buffer;
-         end if;
-      end loop;
-
-      Set_String (");");
-      Write_Statement_Buffer;
-
-      WBI (" ");
-      WBI ("   begin");
-
-      Set_String ("      SDP_Table_Build (ST'Address, ");
-      Set_Int (Num);
-      Set_String (", EA'Address, ");
-      Set_EA_Last;
-      Set_String (");");
-      Write_Statement_Buffer;
-   end Gen_Exception_Table_Ada;
-
-   ---------------------------
-   -- Gen_Exception_Table_C --
-   ---------------------------
-
-   procedure Gen_Exception_Table_C is
-      Num  : Nat;
-      Num2 : Nat;
-
-   begin
-      if not Zero_Cost_Exceptions_Specified then
-         return;
-      end if;
-
-      --  The code we generate looks like
-
-      --     extern void *__gnat_unitname1__SDP;
-      --     extern void *__gnat_unitname2__SDP;
-      --     ...
-      --
-      --     void **st[nnn] = {
-      --       &__gnat_unitname1__SDP,
-      --       &__gnat_unitname2__SDP,
-      --       ...
-      --       &__gnat_unitnamen__SDP};
-      --
-      --     extern void unitname1__elabb ();
-      --     extern void unitname2__elabb ();
-      --     ...
-      --
-      --     void (*ea[eee]) () = {
-      --       adainit,
-      --       adafinal,
-      --       unitname1___elab[b,s],
-      --       unitname2___elab[b,s],
-      --       ...
-      --       unitnamen___elab[b,s]};
-      --
-      --     __gnat_SDP_Table_Build (&st, nnn, &ea, eee);
-
-      Num := 0;
-      for A in ALIs.First .. ALIs.Last loop
-         if not ALIs.Table (A).SAL_Interface
-           and then ALIs.Table (A).Unit_Exception_Table
-         then
-            Num := Num + 1;
-
-            Set_String ("   extern void *__gnat_");
-            Get_Name_String (Units.Table (ALIs.Table (A).First_Unit).Uname);
-            Set_Unit_Name;
-            Set_String ("__SDP");
-            Set_Char (';');
-            Write_Statement_Buffer;
-         end if;
-      end loop;
-
-      if Num = 0 then
-
-         --  Happens with "gnatmake -a -f -gnatL ..."
-
-         return;
-      end if;
-
-      WBI (" ");
-
-      Set_String ("   void **st[");
-      Set_Int (Num);
-      Set_String ("] = {");
-      Write_Statement_Buffer;
-
-      Num2 := 0;
-      for A in ALIs.First .. ALIs.Last loop
-         if not ALIs.Table (A).SAL_Interface
-           and then ALIs.Table (A).Unit_Exception_Table
-         then
-            Num2 := Num2 + 1;
-
-            Set_String ("     &__gnat_");
-            Get_Name_String (Units.Table (ALIs.Table (A).First_Unit).Uname);
-            Set_Unit_Name;
-            Set_String ("__SDP");
-
-            if Num = Num2 then
-               Set_String ("};");
-            else
-               Set_Char (',');
-            end if;
-
-            Write_Statement_Buffer;
-         end if;
-      end loop;
-
-      WBI ("");
-      for E in Elab_Order.First .. Elab_Order.Last loop
-         Get_Name_String (Units.Table (Elab_Order.Table (E)).Uname);
-
-         if Units.Table (Elab_Order.Table (E)).No_Elab then
-            null;
-
-         else
-            Set_String ("   extern void ");
-            Set_Unit_Name;
-            Set_String ("___elab");
-            Set_Char (Name_Buffer (Name_Len)); -- 's' or 'b' for spec/body
-            Set_String (" ();");
-            Write_Statement_Buffer;
-         end if;
-      end loop;
-
-      WBI ("");
-      Set_String ("   void (*ea[");
-      Set_EA_Last;
-      Set_String ("]) () = {");
-      Write_Statement_Buffer;
-
-      Set_String ("     " & Ada_Init_Name.all);
-
-      if not Cumulative_Restrictions.Set (No_Finalization) then
-         Set_Char (',');
-         Write_Statement_Buffer;
-         Set_String ("     system__standard_library__adafinal");
-      end if;
-
-      for E in Elab_Order.First .. Elab_Order.Last loop
-         Get_Name_String (Units.Table (Elab_Order.Table (E)).Uname);
-
-         if Units.Table (Elab_Order.Table (E)).No_Elab then
-            null;
-
-         else
-            Set_Char (',');
-            Write_Statement_Buffer;
-            Set_String ("     ");
-            Set_Unit_Name;
-            Set_String ("___elab");
-            Set_Char (Name_Buffer (Name_Len)); -- 's' or 'b' for spec/body
-         end if;
-      end loop;
-
-      Set_String ("};");
-      Write_Statement_Buffer;
-
-      WBI (" ");
-
-      Set_String ("   __gnat_SDP_Table_Build (&st, ");
-      Set_Int (Num);
-      Set_String (", ea, ");
-      Set_EA_Last;
-      Set_String (");");
-      Write_Statement_Buffer;
-   end Gen_Exception_Table_C;
-
    ------------------
    -- Gen_Main_Ada --
    ------------------
@@ -1943,7 +1607,7 @@ package body Bindgen is
       --  internal file appears.
 
       procedure Write_Linker_Option;
-      --  Write binder info linker option.
+      --  Write binder info linker option
 
       -------------------------
       -- Write_Linker_Option --
@@ -3132,24 +2796,6 @@ package body Bindgen is
       Statement_Buffer (Last) := C;
    end Set_Char;
 
-   -----------------
-   -- Set_EA_Last --
-   -----------------
-
-   procedure Set_EA_Last is
-   begin
-      --  When there is no finalization, only adainit is added
-
-      if Cumulative_Restrictions.Set (No_Finalization) then
-         Set_Int (Num_Elab_Calls + 1);
-
-      --  When there is finalization, both adainit and adafinal are added
-
-      else
-         Set_Int (Num_Elab_Calls + 2);
-      end if;
-   end Set_EA_Last;
-
    -------------
    -- Set_Int --
    -------------

gcc/ada/debug.adb

@@ -89,7 +89,7 @@ package body Debug is
    --  dU   Enable garbage collection of unreachable entities
    --  dV   Enable viewing of all symbols in debugger
    --  dW   Disable warnings on calls for IN OUT parameters
-   --  dX   Enable Frontend ZCX even when it is not supported
+   --  dX
    --  dY   Enable configurable run-time mode
    --  dZ   Generate listing showing the contents of the dispatch tables
 
@@ -457,13 +457,6 @@ package body Debug is
    --       task of transitioning incorrect legacy code, we provide this
    --       undocumented feature for suppressing these warnings.
 
-   --  dX   Enable frontend ZCX even when it is not supported. Equivalent to
-   --       -gnatZ but without verifying that System.Front_End_ZCX_Support
-   --       is set. This causes the front end to generate suitable tables
-   --       for ZCX handling even when the runtime cannot handle ZCX. This
-   --       is used for testing the front end for correct ZCX operation, and
-   --       in particular is useful for multi-target testing.
-
    --  dY   Enable configurable run-time mode, just as though the System file
    --       had Configurable_Run_Time_Mode set to True. This is useful in
    --       testing high integrity mode.

gcc/ada/exp_ch11.adb

@@ -32,8 +32,6 @@ with Errout;   use Errout;
 with Exp_Ch7;  use Exp_Ch7;
 with Exp_Util; use Exp_Util;
 with Hostparm; use Hostparm;
-with Inline;   use Inline;
-with Lib;      use Lib;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -42,7 +40,6 @@ with Rtsfind;  use Rtsfind;
 with Restrict; use Restrict;
 with Rident;   use Rident;
 with Sem;      use Sem;
-with Sem_Ch5;  use Sem_Ch5;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
@@ -54,38 +51,9 @@ with Stringt;  use Stringt;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
-with Uname;    use Uname;
 
 package body Exp_Ch11 is
 
-   SD_List : List_Id;
-   --  This list gathers the values SDn'Unrestricted_Access used to
-   --  construct the unit exception table. It is set to Empty_List if
-   --  there are no subprogram descriptors.
-
-   -----------------------
-   -- Local Subprograms --
-   -----------------------
-
-   procedure Expand_Exception_Handler_Tables (HSS : Node_Id);
-   --  Subsidiary procedure called by Expand_Exception_Handlers if zero
-   --  cost exception handling is installed for this target. Replaces the
-   --  exception handler structure with appropriate labeled code and tables
-   --  that allow the zero cost exception handling circuits to find the
-   --  correct handler (see unit Ada.Exceptions for details).
-
-   procedure Generate_Subprogram_Descriptor
-     (N     : Node_Id;
-      Loc   : Source_Ptr;
-      Spec  : Entity_Id;
-      Slist : List_Id);
-   --  Procedure called to generate a subprogram descriptor. N is the
-   --  subprogram body node or, in the case of an imported subprogram, is
-   --  Empty, and Spec is the entity of the sunprogram. For details of the
-   --  required structure, see package System.Exceptions. The generated
-   --  subprogram descriptor is appended to Slist. Loc provides the
-   --  source location to be used for the generated descriptor.
-
    ---------------------------
    -- Expand_At_End_Handler --
    ---------------------------
@@ -130,7 +98,7 @@ package body Exp_Ch11 is
 
       --  Don't expand if back end exception handling active
 
-      if Exception_Mechanism = Back_End_ZCX_Exceptions then
+      if Exception_Mechanism = Back_End_Exceptions then
          return;
       end if;
 
@@ -172,498 +140,6 @@ package body Exp_Ch11 is
       end if;
    end Expand_At_End_Handler;
 
-   -------------------------------------
-   -- Expand_Exception_Handler_Tables --
-   -------------------------------------
-
-   --  See Ada.Exceptions specification for full details of the data
-   --  structures that we need to construct here. As an example of the
-   --  transformation that is required, given the structure:
-
-   --     declare
-   --        {declarations}
-   --        ..
-   --     begin
-   --        {statements-1}
-   --        ...
-   --     exception
-   --        when a | b =>
-   --           {statements-2}
-   --           ...
-   --        when others =>
-   --           {statements-3}
-   --           ...
-   --     end;
-
-   --  We transform this into:
-
-   --     declare
-   --        {declarations}
-   --        ...
-   --        L1 : label;
-   --        L2 : label;
-   --        L3 : label;
-   --        L4 : Label;
-   --        L5 : label;
-
-   --     begin
-   --        <<L1>>
-   --           {statements-1}
-   --        <<L2>>
-
-   --     exception
-
-   --        when a | b =>
-   --           <<L3>>
-   --           {statements-2}
-
-   --           HR2 : constant Handler_Record := (
-   --                   Lo      => L1'Address,
-   --                   Hi      => L2'Address,
-   --                   Id      => a'Identity,
-   --                   Handler => L5'Address);
-
-   --           HR3 : constant Handler_Record := (
-   --                   Lo      => L1'Address,
-   --                   Hi      => L2'Address,
-   --                   Id      => b'Identity,
-   --                   Handler => L4'Address);
-
-   --        when others =>
-   --           <<L4>>
-   --           {statements-3}
-
-   --           HR1 : constant Handler_Record := (
-   --                   Lo      => L1'Address,
-   --                   Hi      => L2'Address,
-   --                   Id      => Others_Id,
-   --                   Handler => L4'Address);
-   --     end;
-
-   --  The exception handlers in the transformed version are marked with the
-   --  Zero_Cost_Handling flag set, and all gigi does in this case is simply
-   --  to put the handler code somewhere. It can optionally be put inline
-   --  between the goto L3 and the label <<L3>> (which is why we generate
-   --  that goto in the first place).
-
-   procedure Expand_Exception_Handler_Tables (HSS : Node_Id) is
-      Loc     : constant Source_Ptr := Sloc (HSS);
-      Handlrs : constant List_Id    := Exception_Handlers (HSS);
-      Stms    : constant List_Id    := Statements (HSS);
-      Handler : Node_Id;
-
-      Hlist : List_Id;
-      --  This is the list to which handlers are to be appended. It is
-      --  either the list for the enclosing subprogram, or the enclosing
-      --  selective accept statement (which will turn into a subprogram
-      --  during expansion later on).
-
-      L1 : constant Entity_Id :=
-             Make_Defining_Identifier (Loc,
-               Chars => New_Internal_Name ('L'));
-
-      L2 : constant Entity_Id :=
-             Make_Defining_Identifier (Loc,
-               Chars => New_Internal_Name ('L'));
-
-      Lnn    : Entity_Id;
-      Choice : Node_Id;
-      E_Id   : Node_Id;
-      HR_Ent : Node_Id;
-      HL_Ref : Node_Id;
-      Item   : Node_Id;
-
-      Subp_Entity : Entity_Id;
-      --  This is the entity for the subprogram (or library level package)
-      --  to which the handler record is to be attached for later reference
-      --  in a subprogram descriptor for this entity.
-
-      procedure Append_To_Stms (N : Node_Id);
-      --  Append given statement to the end of the statements of the
-      --  handled sequence of statements and analyze it in place.
-
-      function Inside_Selective_Accept return Boolean;
-      --  This function is called if we are inside the scope of an entry
-      --  or task. It checks if the handler is appearing in the context
-      --  of a selective accept statement. If so, Hlist is set to
-      --  temporarily park the handlers in the N_Accept_Alternative.
-      --  node. They will subsequently be moved to the procedure entity
-      --  for the procedure built for this alternative. The statements that
-      --  follow the Accept within the alternative are not inside the Accept
-      --  for purposes of this test, and handlers that may appear within
-      --  them belong in the enclosing task procedure.
-
-      procedure Set_Hlist;
-      --  Sets the handler list corresponding to Subp_Entity
-
-      --------------------
-      -- Append_To_Stms --
-      --------------------
-
-      procedure Append_To_Stms (N : Node_Id) is
-      begin
-         Insert_After_And_Analyze (Last (Stms), N);
-         Set_Exception_Junk (N);
-      end Append_To_Stms;
-
-      -----------------------------
-      -- Inside_Selective_Accept --
-      -----------------------------
-
-      function Inside_Selective_Accept return Boolean is
-         Parnt : Node_Id;
-         Curr  : Node_Id := HSS;
-
-      begin
-         Parnt := Parent (HSS);
-         while Nkind (Parnt) /= N_Compilation_Unit loop
-            if Nkind (Parnt) = N_Accept_Alternative
-              and then Curr = Accept_Statement (Parnt)
-            then
-               if Present (Accept_Handler_Records (Parnt)) then
-                  Hlist := Accept_Handler_Records (Parnt);
-               else
-                  Hlist := New_List;
-                  Set_Accept_Handler_Records (Parnt, Hlist);
-               end if;
-
-               return True;
-            else
-               Curr  := Parnt;
-               Parnt := Parent (Parnt);
-            end if;
-         end loop;
-
-         return False;
-      end Inside_Selective_Accept;
-
-      ---------------
-      -- Set_Hlist --
-      ---------------
-
-      procedure Set_Hlist is
-      begin
-         --  Never try to inline a subprogram with exception handlers
-
-         Set_Is_Inlined (Subp_Entity, False);
-
-         if Present (Subp_Entity)
-           and then Present (Handler_Records (Subp_Entity))
-         then
-            Hlist := Handler_Records (Subp_Entity);
-         else
-            Hlist := New_List;
-            Set_Handler_Records (Subp_Entity, Hlist);
-         end if;
-      end Set_Hlist;
-
-   --  Start of processing for Expand_Exception_Handler_Tables
-
-   begin
-      --  Nothing to do if this handler has already been processed
-
-      if Zero_Cost_Handling (HSS) then
-         return;
-      end if;
-
-      Set_Zero_Cost_Handling (HSS);
-
-      --  Find the parent subprogram or package scope containing this
-      --  exception frame. This should always find a real package or
-      --  subprogram. If it does not it will stop at Standard, but
-      --  this cannot legitimately occur.
-
-      --  We only stop at library level packages, for inner packages
-      --  we always attach handlers to the containing procedure.
-
-      Subp_Entity := Current_Scope;
-      Scope_Loop : loop
-
-         --  Never need tables expanded inside a generic template
-
-         if Is_Generic_Unit (Subp_Entity) then
-            return;
-
-         --  Stop if we reached containing subprogram. Go to protected
-         --  subprogram if there is one defined.
-
-         elsif Ekind (Subp_Entity) = E_Function
-           or else Ekind (Subp_Entity) = E_Procedure
-         then
-            if Present (Protected_Body_Subprogram (Subp_Entity)) then
-               Subp_Entity := Protected_Body_Subprogram (Subp_Entity);
-            end if;
-
-            Set_Hlist;
-            exit Scope_Loop;
-
-         --  Case of within an entry
-
-         elsif Is_Entry (Subp_Entity) then
-
-            --  Protected entry, use corresponding body subprogram
-
-            if Present (Protected_Body_Subprogram (Subp_Entity)) then
-               Subp_Entity := Protected_Body_Subprogram (Subp_Entity);
-               Set_Hlist;
-               exit Scope_Loop;
-
-            --  Check if we are within a selective accept alternative
-
-            elsif Inside_Selective_Accept then
-
-               --  As a side effect, Inside_Selective_Accept set Hlist,
-               --  in much the same manner as Set_Hlist, except that
-               --  the list involved was the one for the selective accept.
-
-               exit Scope_Loop;
-            end if;
-
-         --  Case of within library level package
-
-         elsif Ekind (Subp_Entity) = E_Package
-           and then Is_Compilation_Unit (Subp_Entity)
-         then
-            if Is_Body_Name (Unit_Name (Get_Code_Unit (HSS))) then
-               Subp_Entity := Body_Entity (Subp_Entity);
-            end if;
-
-            Set_Hlist;
-            exit Scope_Loop;
-
-         --  Task type case
-
-         elsif Ekind (Subp_Entity) = E_Task_Type then
-
-            --  Check if we are within a selective accept alternative
-
-            if Inside_Selective_Accept then
-
-               --  As a side effect, Inside_Selective_Accept set Hlist,
-               --  in much the same manner as Set_Hlist, except that the
-               --  list involved was the one for the selective accept.
-
-               exit Scope_Loop;
-
-            --  Stop if we reached task type with task body procedure,
-            --  use the task body procedure.
-
-            elsif Present (Get_Task_Body_Procedure (Subp_Entity)) then
-               Subp_Entity := Get_Task_Body_Procedure (Subp_Entity);
-               Set_Hlist;
-               exit Scope_Loop;
-            end if;
-         end if;
-
-         --  If we fall through, keep looking
-
-         Subp_Entity := Scope (Subp_Entity);
-      end loop Scope_Loop;
-
-      pragma Assert (Subp_Entity /= Standard_Standard);
-
-      --  Analyze standard labels
-
-      Analyze_Label_Entity (L1);
-      Analyze_Label_Entity (L2);
-
-      Insert_Before_And_Analyze (First (Stms),
-        Make_Label (Loc,
-          Identifier => New_Occurrence_Of (L1, Loc)));
-      Set_Exception_Junk (First (Stms));
-
-      Append_To_Stms (
-        Make_Label (Loc,
-          Identifier => New_Occurrence_Of (L2, Loc)));
-
-      --  Loop through exception handlers
-
-      Handler := First_Non_Pragma (Handlrs);
-      while Present (Handler) loop
-         Set_Zero_Cost_Handling (Handler);
-
-         --  Add label at start of handler, and goto at the end
-
-         Lnn :=
-           Make_Defining_Identifier (Loc,
-             Chars => New_Internal_Name ('L'));
-
-         Analyze_Label_Entity (Lnn);
-
-         Item :=
-           Make_Label (Loc,
-             Identifier => New_Occurrence_Of (Lnn, Loc));
-         Set_Exception_Junk (Item);
-         Insert_Before_And_Analyze (First (Statements (Handler)), Item);
-
-         --  Loop through choices
-
-         Choice := First (Exception_Choices (Handler));
-         while Present (Choice) loop
-
-            --  Others (or all others) choice
-
-            if Nkind (Choice) = N_Others_Choice then
-               if All_Others (Choice) then
-                  E_Id := New_Occurrence_Of (RTE (RE_All_Others_Id), Loc);
-               else
-                  E_Id := New_Occurrence_Of (RTE (RE_Others_Id), Loc);
-               end if;
-
-            --  Special case of VMS_Exception. Not clear what we will do
-            --  eventually here if and when we implement zero cost exceptions
-            --  on VMS. But at least for now, don't blow up trying to take
-            --  a garbage code address for such an exception.
-
-            elsif Is_VMS_Exception (Entity (Choice)) then
-               E_Id := New_Occurrence_Of (RTE (RE_Null_Id), Loc);
-
-            --  Normal case of specific exception choice
-
-            else
-               E_Id :=
-                 Make_Attribute_Reference (Loc,
-                   Prefix => New_Occurrence_Of (Entity (Choice), Loc),
-                   Attribute_Name => Name_Identity);
-            end if;
-
-            HR_Ent :=
-              Make_Defining_Identifier (Loc,
-                Chars => New_Internal_Name ('H'));
-
-            HL_Ref :=
-              Make_Attribute_Reference (Loc,
-                Prefix => New_Occurrence_Of (HR_Ent, Loc),
-                Attribute_Name => Name_Unrestricted_Access);
-
-            --  Now we need to add the entry for the new handler record to
-            --  the list of handler records for the current subprogram.
-
-            --  Normally we end up generating the handler records in exactly
-            --  the right order. Here right order means innermost first,
-            --  since the table will be searched sequentially. Since we
-            --  generally expand from outside to inside, the order is just
-            --  what we want, and we need to append the new entry to the
-            --  end of the list.
-
-            --  However, there are exceptions, notably in the case where
-            --  a generic body is inserted later on. See for example the
-            --  case of ACVC test C37213J, which has the following form:
-
-            --    generic package x ... end x;
-            --    package body x is
-            --    begin
-            --       ...
-            --    exception  (1)
-            --       ...
-            --    end x;
-
-            --    ...
-
-            --    declare
-            --       package q is new x;
-            --    begin
-            --       ...
-            --    exception (2)
-            --       ...
-            --    end;
-
-            --  In this case, we will expand exception handler (2) first,
-            --  since the expansion of (1) is delayed till later when the
-            --  generic body is inserted. But (1) belongs before (2) in
-            --  the chain.
-
-            --  Note that scopes are not totally ordered, because two
-            --  scopes can be in parallel blocks, so that it does not
-            --  matter what order these entries appear in. An ordering
-            --  relation exists if one scope is inside another, and what
-            --  we really want is some partial ordering.
-
-            --  A simple, not very efficient, but adequate algorithm to
-            --  achieve this partial ordering is to search the list for
-            --  the first entry containing the given scope, and put the
-            --  new entry just before it.
-
-            declare
-               New_Scop : constant Entity_Id := Current_Scope;
-               Ent      : Node_Id;
-
-            begin
-               Ent := First (Hlist);
-               loop
-                  --  If all searched, then we can just put the new
-                  --  entry at the end of the list (it actually does
-                  --  not matter where we put it in this case).
-
-                  if No (Ent) then
-                     Append_To (Hlist, HL_Ref);
-                     exit;
-
-                  --  If the current scope is within the scope of the
-                  --  entry then insert the entry before to retain the
-                  --  proper order as per above discussion.
-
-                  --  Note that for equal entries, we just keep going,
-                  --  which is fine, the entry will end up at the end
-                  --  of the list where it belongs.
-
-                  elsif Scope_Within
-                          (New_Scop, Scope (Entity (Prefix (Ent))))
-                  then
-                     Insert_Before (Ent, HL_Ref);
-                     exit;
-
-                  --  Otherwise keep looking
-
-                  else
-                     Next (Ent);
-                  end if;
-               end loop;
-            end;
-
-            Item :=
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => HR_Ent,
-                Constant_Present    => True,
-                Aliased_Present     => True,
-                Object_Definition   =>
-                  New_Occurrence_Of (RTE (RE_Handler_Record), Loc),
-
-                Expression          =>
-                  Make_Aggregate (Loc,
-                    Expressions => New_List (
-                      Make_Attribute_Reference (Loc,             -- Lo
-                        Prefix => New_Occurrence_Of (L1, Loc),
-                        Attribute_Name => Name_Address),
-
-                      Make_Attribute_Reference (Loc,             -- Hi
-                        Prefix => New_Occurrence_Of (L2, Loc),
-                        Attribute_Name => Name_Address),
-
-                      E_Id,                                      -- Id
-
-                      Make_Attribute_Reference (Loc,
-                        Prefix => New_Occurrence_Of (Lnn, Loc),  -- Handler
-                        Attribute_Name => Name_Address))));
-
-            Set_Handler_List_Entry (Item, HL_Ref);
-            Set_Exception_Junk (Item);
-            Insert_After_And_Analyze (Last (Statements (Handler)), Item);
-            Set_Is_Statically_Allocated (HR_Ent);
-
-            --  If this is a late insertion (from body instance) it is being
-            --  inserted in the component list of an already analyzed aggre-
-            --  gate, and must be analyzed explicitly.
-
-            Analyze_And_Resolve (HL_Ref, RTE (RE_Handler_Record_Ptr));
-
-            Next (Choice);
-         end loop;
-
-         Next_Non_Pragma (Handler);
-      end loop;
-   end Expand_Exception_Handler_Tables;
-
    -------------------------------
    -- Expand_Exception_Handlers --
    -------------------------------
@@ -850,13 +326,6 @@ package body Exp_Ch11 is
       then
          Set_Exception_Handlers (HSS, No_List);
       end if;
-
-      --  The last step for expanding exception handlers is to expand the
-      --  exception tables if zero cost exception handling is active.
-
-      if Exception_Mechanism = Front_End_ZCX_Exceptions then
-         Expand_Exception_Handler_Tables (HSS);
-      end if;
    end Expand_Exception_Handlers;
 
    ------------------------------------
@@ -1331,574 +800,6 @@ package body Exp_Ch11 is
       Analyze_And_Resolve (N, RTE (RE_Code_Loc));
    end Expand_N_Subprogram_Info;
 
-   ------------------------------------
-   -- Generate_Subprogram_Descriptor --
-   ------------------------------------
-
-   procedure Generate_Subprogram_Descriptor
-     (N     : Node_Id;
-      Loc   : Source_Ptr;
-      Spec  : Entity_Id;
-      Slist : List_Id)
-   is
-      Code  : Node_Id;
-      Ent   : Entity_Id;
-      Decl  : Node_Id;
-      Dtyp  : Entity_Id;
-      Numh  : Nat;
-      Sdes  : Node_Id;
-      Hrc   : List_Id;
-
-   begin
-      if Exception_Mechanism /= Front_End_ZCX_Exceptions then
-         return;
-      end if;
-
-      if Restriction_Active (No_Exception_Handlers) then
-         return;
-      end if;
-
-      --  Suppress descriptor if we are not generating code. This happens
-      --  in the case of a -gnatc -gnatt compilation where we force generics
-      --  to be generated, but we still don't want exception tables.
-
-      if Operating_Mode /= Generate_Code then
-         return;
-      end if;
-
-      --  Suppress descriptor if we are in No_Exceptions restrictions mode,
-      --  since we can never propagate exceptions in any case in this mode.
-      --  The same consideration applies for No_Exception_Handlers (which
-      --  is also set in High_Integrity_Mode).
-
-      if Restriction_Active (No_Exceptions)
-        or Restriction_Active (No_Exception_Handlers)
-      then
-         return;
-      end if;
-
-      --  Suppress descriptor if we are inside a generic. There are two
-      --  ways that we can tell that, depending on what is going on. If
-      --  we are actually inside the processing for a generic right now,
-      --  then Expander_Active will be reset. If we are outside the
-      --  generic, then we will see the generic entity.
-
-      if not Expander_Active then
-         return;
-      end if;
-
-      --  Suppress descriptor is subprogram is marked as eliminated, for
-      --  example if this is a subprogram created to analyze a default
-      --  expression with potential side effects. Ditto if it is nested
-      --  within an eliminated subprogram, for example a cleanup action.
-
-      declare
-         Scop : Entity_Id;
-
-      begin
-         Scop := Spec;
-         while Scop /= Standard_Standard loop
-            if Is_Generic_Unit (Scop) or else Is_Eliminated (Scop) then
-               return;
-            end if;
-
-            Scop := Scope (Scop);
-         end loop;
-      end;
-
-      --  Suppress descriptor for original protected subprogram (we will
-      --  be called again later to generate the descriptor for the actual
-      --  protected body subprogram.) This does not apply to barrier
-      --  functions which are there own protected subprogram.
-
-      if Is_Subprogram (Spec)
-        and then Present (Protected_Body_Subprogram (Spec))
-        and then Protected_Body_Subprogram (Spec) /= Spec
-      then
-         return;
-      end if;
-
-      --  Suppress descriptors for packages unless they have at least one
-      --  handler. The binder will generate the dummy (no handler) descriptors
-      --  for elaboration procedures. We can't do it here, because we don't
-      --  know if an elaboration routine does in fact exist.
-
-      --  If there is at least one handler for the package spec or body
-      --  then most certainly an elaboration routine must exist, so we
-      --  can safely reference it.
-
-      if (Nkind (N) = N_Package_Declaration
-            or else
-          Nkind (N) = N_Package_Body)
-        and then No (Handler_Records (Spec))
-      then
-         return;
-      end if;
-
-      --  Suppress all subprogram descriptors for the file System.Exceptions.
-      --  We similarly suppress subprogram descriptors for Ada.Exceptions.
-      --  These are all init procs for types which cannot raise exceptions.
-      --  The reason this is done is that otherwise we get embarassing
-      --  elaboration dependencies.
-
-      Get_Name_String (Unit_File_Name (Current_Sem_Unit));
-
-      if Name_Buffer (1 .. 12) = "s-except.ads"
-           or else
-         Name_Buffer (1 .. 12) = "a-except.ads"
-      then
-         return;
-      end if;
-
-      --  Similarly, we need to suppress entries for System.Standard_Library,
-      --  since otherwise we get elaboration circularities. Again, this would
-      --  better be done with a Suppress_Initialization pragma :-)
-
-      if Name_Buffer (1 .. 11) = "s-stalib.ad" then
-         return;
-      end if;
-
-      --  For now, also suppress entries for s-stoele because we have
-      --  some kind of unexplained error there ???
-
-      if Name_Buffer (1 .. 11) = "s-stoele.ad" then
-         return;
-      end if;
-
-      --  And also for g-htable, because it cannot raise exceptions,
-      --  and generates some kind of elaboration order problem.
-
-      if Name_Buffer (1 .. 11) = "g-htable.ad" then
-         return;
-      end if;
-
-      --  Suppress subprogram descriptor if already generated. This happens
-      --  in the case of late generation from Delay_Subprogram_Descriptors
-      --  beging set (where there is more than one instantiation in the list)
-
-      if Has_Subprogram_Descriptor (Spec) then
-         return;
-      else
-         Set_Has_Subprogram_Descriptor (Spec);
-      end if;
-
-      --  Never generate descriptors for inlined bodies
-
-      if Analyzing_Inlined_Bodies then
-         return;
-      end if;
-
-      --  Here we definitely are going to generate a subprogram descriptor
-
-      declare
-         Hnum : Nat := Homonym_Number (Spec);
-
-      begin
-         if Hnum = 1 then
-            Hnum := 0;
-         end if;
-
-         Ent :=
-           Make_Defining_Identifier (Loc,
-             Chars => New_External_Name (Chars (Spec), "SD", Hnum));
-      end;
-
-      if No (Handler_Records (Spec)) then
-         Hrc  := Empty_List;
-         Numh := 0;
-      else
-         Hrc  := Handler_Records (Spec);
-         Numh := List_Length (Hrc);
-      end if;
-
-      New_Scope (Spec);
-
-      --  We need a static subtype for the declaration of the subprogram
-      --  descriptor. For the case of 0-3 handlers we can use one of the
-      --  predefined subtypes in System.Exceptions. For more handlers,
-      --  we build our own subtype here.
-
-      case Numh is
-         when 0 =>
-            Dtyp := RTE (RE_Subprogram_Descriptor_0);
-
-         when 1 =>
-            Dtyp := RTE (RE_Subprogram_Descriptor_1);
-
-         when 2 =>
-            Dtyp := RTE (RE_Subprogram_Descriptor_2);
-
-         when 3 =>
-            Dtyp := RTE (RE_Subprogram_Descriptor_3);
-
-         when others =>
-            Dtyp :=
-              Make_Defining_Identifier (Loc,
-                Chars => New_Internal_Name ('T'));
-
-            --  Set the constructed type as global, since we will be
-            --  referencing the object that is of this type globally
-
-            Set_Is_Statically_Allocated (Dtyp);
-
-            Decl :=
-              Make_Subtype_Declaration (Loc,
-                Defining_Identifier => Dtyp,
-                Subtype_Indication =>
-                  Make_Subtype_Indication (Loc,
-                    Subtype_Mark =>
-                      New_Occurrence_Of (RTE (RE_Subprogram_Descriptor), Loc),
-                    Constraint =>
-                      Make_Index_Or_Discriminant_Constraint (Loc,
-                        Constraints => New_List (
-                          Make_Integer_Literal (Loc, Numh)))));
-
-            Append (Decl, Slist);
-
-            --  We analyze the descriptor for the subprogram and package
-            --  case, but not for the imported subprogram case (it will
-            --  be analyzed when the freeze entity actions are analyzed.
-
-            if Present (N) then
-               Analyze (Decl);
-            end if;
-
-            Set_Exception_Junk (Decl);
-      end case;
-
-      --  Prepare the code address entry for the table entry. For the normal
-      --  case of being within a procedure, this is simply:
-
-      --    P'Code_Address
-
-      --  where P is the procedure, but for the package case, it is
-
-      --    P'Elab_Body'Code_Address
-      --    P'Elab_Spec'Code_Address
-
-      --  for the body and spec respectively. Note that we do our own
-      --  analysis of these attribute references, because we know in this
-      --  case that the prefix of ELab_Body/Spec is a visible package,
-      --  which can be referenced directly instead of using the general
-      --  case expansion for these attributes.
-
-      if Ekind (Spec) = E_Package then
-         Code :=
-           Make_Attribute_Reference (Loc,
-             Prefix         => New_Occurrence_Of (Spec, Loc),
-             Attribute_Name => Name_Elab_Spec);
-         Set_Etype (Code, Standard_Void_Type);
-         Set_Analyzed (Code);
-
-      elsif Ekind (Spec) = E_Package_Body then
-         Code :=
-           Make_Attribute_Reference (Loc,
-             Prefix         => New_Occurrence_Of (Spec_Entity (Spec), Loc),
-             Attribute_Name => Name_Elab_Body);
-         Set_Etype (Code, Standard_Void_Type);
-         Set_Analyzed (Code);
-
-      else
-         Code := New_Occurrence_Of (Spec, Loc);
-      end if;
-
-      Code :=
-        Make_Attribute_Reference (Loc,
-          Prefix         => Code,
-          Attribute_Name => Name_Code_Address);
-
-      Set_Etype (Code, RTE (RE_Address));
-      Set_Analyzed (Code);
-
-      --  Now we can build the subprogram descriptor
-
-      Sdes :=
-        Make_Object_Declaration (Loc,
-          Defining_Identifier      => Ent,
-          Constant_Present         => True,
-          Aliased_Present          => True,
-          Object_Definition        => New_Occurrence_Of (Dtyp, Loc),
-
-          Expression               =>
-            Make_Aggregate (Loc,
-              Expressions => New_List (
-                Make_Integer_Literal (Loc, Numh),          -- Num_Handlers
-
-                Code,                                      -- Code
-
---  temp code ???
-
---                Make_Subprogram_Info (Loc,                 -- Subprogram_Info
---                  Identifier =>
---                    New_Occurrence_Of (Spec, Loc)),
-
-                New_Copy_Tree (Code),
-
-                Make_Aggregate (Loc,                       -- Handler_Records
-                  Expressions => Hrc))));
-
-      Set_Exception_Junk (Sdes);
-      Set_Is_Subprogram_Descriptor (Sdes);
-
-      Append (Sdes, Slist);
-
-      --  We analyze the descriptor for the subprogram and package case,
-      --  but not for the imported subprogram case (it will be analyzed
-      --  when the freeze entity actions are analyzed.
-
-      if Present (N) then
-         Analyze (Sdes);
-      end if;
-
-      --  We can now pop the scope used for analyzing the descriptor
-
-      Pop_Scope;
-
-      --  We need to set the descriptor as statically allocated, since
-      --  it will be referenced from the unit exception table.
-
-      Set_Is_Statically_Allocated (Ent);
-
-      --  Append the resulting descriptor to the list. We do this only
-      --  if we are in the main unit. You might think that we could
-      --  simply skip generating the descriptors completely if we are
-      --  not in the main unit, but in fact this is not the case, since
-      --  we have problems with inconsistent serial numbers for internal
-      --  names if we do this.
-
-      if In_Extended_Main_Code_Unit (Spec) then
-         Append_To (SD_List,
-           Make_Attribute_Reference (Loc,
-             Prefix => New_Occurrence_Of (Ent, Loc),
-             Attribute_Name => Name_Unrestricted_Access));
-
-         Unit_Exception_Table_Present := True;
-      end if;
-
-   end Generate_Subprogram_Descriptor;
-
-   ------------------------------------------------------------
-   -- Generate_Subprogram_Descriptor_For_Imported_Subprogram --
-   ------------------------------------------------------------
-
-   procedure Generate_Subprogram_Descriptor_For_Imported_Subprogram
-     (Spec  : Entity_Id;
-      Slist : List_Id)
-   is
-   begin
-      Generate_Subprogram_Descriptor (Empty, Sloc (Spec), Spec, Slist);
-   end Generate_Subprogram_Descriptor_For_Imported_Subprogram;
-
-   ------------------------------------------------
-   -- Generate_Subprogram_Descriptor_For_Package --
-   ------------------------------------------------
-
-   procedure Generate_Subprogram_Descriptor_For_Package
-     (N    : Node_Id;
-      Spec : Entity_Id)
-   is
-      Adecl : Node_Id;
-
-   begin
-      --  If N is empty with prior errors, ignore
-
-      if Total_Errors_Detected /= 0 and then No (N) then
-         return;
-      end if;
-
-      --  Do not generate if no exceptions
-
-      if Restriction_Active (No_Exception_Handlers) then
-         return;
-      end if;
-
-      --  Otherwise generate descriptor
-
-      Adecl := Aux_Decls_Node (Parent (N));
-
-      if No (Actions (Adecl)) then
-         Set_Actions (Adecl, New_List);
-      end if;
-
-      Generate_Subprogram_Descriptor (N, Sloc (N), Spec, Actions (Adecl));
-   end Generate_Subprogram_Descriptor_For_Package;
-
-   ---------------------------------------------------
-   -- Generate_Subprogram_Descriptor_For_Subprogram --
-   ---------------------------------------------------
-
-   procedure Generate_Subprogram_Descriptor_For_Subprogram
-     (N    : Node_Id;
-      Spec : Entity_Id)
-   is
-   begin
-      --  If we have no subprogram body and prior errors, ignore
-
-      if Total_Errors_Detected /= 0 and then No (N) then
-         return;
-      end if;
-
-      --  Do not generate if no exceptions
-
-      if Restriction_Active (No_Exception_Handlers) then
-         return;
-      end if;
-
-      --  Else generate descriptor
-
-      declare
-         HSS : constant Node_Id := Handled_Statement_Sequence (N);
-
-      begin
-         if No (Exception_Handlers (HSS)) then
-            Generate_Subprogram_Descriptor
-              (N, Sloc (N), Spec, Statements (HSS));
-         else
-            Generate_Subprogram_Descriptor
-              (N, Sloc (N),
-               Spec, Statements (Last (Exception_Handlers (HSS))));
-         end if;
-      end;
-   end Generate_Subprogram_Descriptor_For_Subprogram;
-
-   -----------------------------------
-   -- Generate_Unit_Exception_Table --
-   -----------------------------------
-
-   --  The only remaining thing to generate here is to generate the
-   --  reference to the subprogram descriptor chain. See Ada.Exceptions
-   --  for details of required data structures.
-
-   procedure Generate_Unit_Exception_Table is
-      Loc      : constant Source_Ptr := No_Location;
-      Num      : Nat;
-      Decl     : Node_Id;
-      Ent      : Entity_Id;
-      Next_Ent : Entity_Id;
-      Stent    : Entity_Id;
-
-   begin
-      --  Nothing to be done if zero length exceptions not active
-
-      if Exception_Mechanism /= Front_End_ZCX_Exceptions then
-         return;
-      end if;
-
-      --  Nothing to do if no exceptions
-
-      if Restriction_Active (No_Exception_Handlers) then
-         return;
-      end if;
-
-      --  Remove any entries from SD_List that correspond to eliminated
-      --  subprograms.
-
-      Ent := First (SD_List);
-      while Present (Ent) loop
-         Next_Ent := Next (Ent);
-         if Is_Eliminated (Scope (Entity (Prefix (Ent)))) then
-            Remove (Ent); -- After this, there is no Next (Ent) anymore
-         end if;
-
-         Ent := Next_Ent;
-      end loop;
-
-      --  Nothing to do if no unit exception table present.
-      --  An empty table can result from subprogram elimination,
-      --  in such a case, eliminate the exception table itself.
-
-      if Is_Empty_List (SD_List) then
-         Unit_Exception_Table_Present := False;
-         return;
-      end if;
-
-      --  Do not generate table in a generic
-
-      if Inside_A_Generic then
-         return;
-      end if;
-
-      --  Generate the unit exception table
-
-      --    subtype Tnn is Subprogram_Descriptors_Record (Num);
-      --    __gnat_unitname__SDP : aliased constant Tnn :=
-      --                             Num,
-      --                             (sub1'unrestricted_access,
-      --                              sub2'unrestricted_access,
-      --                              ...
-      --                              subNum'unrestricted_access));
-
-      Num := List_Length (SD_List);
-
-      Stent :=
-        Make_Defining_Identifier (Loc,
-          Chars => New_Internal_Name ('T'));
-
-      Insert_Library_Level_Action (
-        Make_Subtype_Declaration (Loc,
-          Defining_Identifier => Stent,
-          Subtype_Indication =>
-            Make_Subtype_Indication (Loc,
-              Subtype_Mark =>
-                New_Occurrence_Of
-                 (RTE (RE_Subprogram_Descriptors_Record), Loc),
-              Constraint =>
-                Make_Index_Or_Discriminant_Constraint (Loc,
-                  Constraints => New_List (
-                    Make_Integer_Literal (Loc, Num))))));
-
-      Set_Is_Statically_Allocated (Stent);
-
-      Get_External_Unit_Name_String (Unit_Name (Main_Unit));
-      Name_Buffer (1 + 7 .. Name_Len + 7) := Name_Buffer (1 .. Name_Len);
-      Name_Buffer (1 .. 7) := "__gnat_";
-      Name_Len := Name_Len + 7;
-      Add_Str_To_Name_Buffer ("__SDP");
-
-      Ent :=
-        Make_Defining_Identifier (Loc,
-          Chars => Name_Find);
-
-      Get_Name_String (Chars (Ent));
-      Set_Interface_Name (Ent,
-        Make_String_Literal (Loc, Strval => String_From_Name_Buffer));
-
-      Decl :=
-        Make_Object_Declaration (Loc,
-             Defining_Identifier => Ent,
-             Object_Definition   => New_Occurrence_Of (Stent, Loc),
-          Constant_Present => True,
-          Aliased_Present  => True,
-          Expression =>
-            Make_Aggregate (Loc,
-              New_List (
-                Make_Integer_Literal (Loc, List_Length (SD_List)),
-
-              Make_Aggregate (Loc,
-                Expressions => SD_List))));
-
-      Insert_Library_Level_Action (Decl);
-
-      Set_Is_Exported             (Ent, True);
-      Set_Is_Public               (Ent, True);
-      Set_Is_Statically_Allocated (Ent, True);
-
-      Get_Name_String (Chars (Ent));
-      Set_Interface_Name (Ent,
-        Make_String_Literal (Loc,
-          Strval => String_From_Name_Buffer));
-
-   end Generate_Unit_Exception_Table;
-
-   ----------------
-   -- Initialize --
-   ----------------
-
-   procedure Initialize is
-   begin
-      SD_List := Empty_List;
-   end Initialize;
-
    ----------------------
    -- Is_Non_Ada_Error --
    ----------------------
@@ -1922,59 +823,4 @@ package body Exp_Ch11 is
       return True;
    end Is_Non_Ada_Error;
 
-   ----------------------------
-   -- Remove_Handler_Entries --
-   ----------------------------
-
-   procedure Remove_Handler_Entries (N : Node_Id) is
-      function Check_Handler_Entry (N : Node_Id) return Traverse_Result;
-      --  This function checks one node for a possible reference to a
-      --  handler entry that must be deleted. it always returns OK.
-
-      function Remove_All_Handler_Entries is new
-        Traverse_Func (Check_Handler_Entry);
-      --  This defines the traversal operation
-
-      Discard : Traverse_Result;
-      pragma Warnings (Off, Discard);
-
-      function Check_Handler_Entry (N : Node_Id) return Traverse_Result is
-      begin
-         if Nkind (N) = N_Object_Declaration then
-
-            if Present (Handler_List_Entry (N)) then
-               Remove (Handler_List_Entry (N));
-               Delete_Tree (Handler_List_Entry (N));
-               Set_Handler_List_Entry (N, Empty);
-
-            elsif Is_Subprogram_Descriptor (N) then
-               declare
-                  SDN : Node_Id;
-
-               begin
-                  SDN := First (SD_List);
-                  while Present (SDN) loop
-                     if Defining_Identifier (N) = Entity (Prefix (SDN)) then
-                        Remove (SDN);
-                        Delete_Tree (SDN);
-                        exit;
-                     end if;
-
-                     Next (SDN);
-                  end loop;
-               end;
-            end if;
-         end if;
-
-         return OK;
-      end Check_Handler_Entry;
-
-   --  Start of processing for Remove_Handler_Entries
-
-   begin
-      if Exception_Mechanism = Front_End_ZCX_Exceptions then
-         Discard := Remove_All_Handler_Entries (N);
-      end if;
-   end Remove_Handler_Entries;
-
 end Exp_Ch11;

gcc/ada/exp_ch11.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -41,9 +41,6 @@ package Exp_Ch11 is
    --  See runtime routine Ada.Exceptions for full details on the format and
    --  content of these tables.
 
-   procedure Initialize;
-   --  Initializes these data structures for a new main unit file
-
    procedure Expand_At_End_Handler (HSS : Node_Id; Block : Node_Id);
    --  Given a handled statement sequence, HSS, for which the At_End_Proc
    --  field is set, and which currently has no exception handlers, this
@@ -59,59 +56,9 @@ package Exp_Ch11 is
    --  is also called to expand the special exception handler built for
    --  accept bodies (see Exp_Ch9.Build_Accept_Body).
 
-   procedure Generate_Unit_Exception_Table;
-   --  Procedure called by main driver to generate unit exception table if
-   --  zero cost exceptions are enabled. See System.Exceptions for details.
-
    function Is_Non_Ada_Error (E : Entity_Id) return Boolean;
    --  This function is provided for Gigi use. It returns True if operating on
    --  VMS, and the argument E is the entity for System.Aux_Dec.Non_Ada_Error.
    --  This is used to generate the special matching code for this exception.
 
-   procedure Remove_Handler_Entries (N : Node_Id);
-   --  This procedure is called when optimization circuits determine that
-   --  an entire subtree can be removed. If the subtree contains handler
-   --  entries in zero cost exception mode, then such removal can lead to
-   --  dangling references to non-existent handlers in the handler table.
-   --  This procedure removes such references.
-
-   --------------------------------------
-   -- Subprogram_Descriptor Generation --
-   --------------------------------------
-
-   --  Subprogram descriptors are required for all subprograms, including
-   --  explicit subprograms defined in the program, subprograms that are
-   --  imported via pragma Import, and also for the implicit elaboration
-   --  subprograms used to elaborate package specs and bodies.
-
-   procedure Generate_Subprogram_Descriptor_For_Package
-     (N    : Node_Id;
-      Spec : Entity_Id);
-   --  This is used to create a descriptor for the implicit elaboration
-   --  procedure for a package spec of body. The compiler only generates
-   --  such descriptors if the package spec or body contains exception
-   --  handlers (either explicitly in the case of a body, or from generic
-   --  package instantiations). N is the node for the package body or
-   --  spec, and Spec is the package body or package entity respectively.
-   --  N must be a compilation unit, and the descriptor is placed at
-   --  the end of the actions for the auxiliary compilation unit node.
-
-   procedure Generate_Subprogram_Descriptor_For_Subprogram
-     (N    : Node_Id;
-      Spec : Entity_Id);
-   --  This is used to create a desriptor for a subprogram, both those
-   --  present in the source, and those implicitly generated by code
-   --  expansion. N is the subprogram body node, and Spec is the entity
-   --  for the subprogram. The descriptor is placed at the end of the
-   --  Last exception handler, or, if there are no handlers, at the end
-   --  of the statement sequence.
-
-   procedure Generate_Subprogram_Descriptor_For_Imported_Subprogram
-     (Spec  : Entity_Id;
-      Slist : List_Id);
-   --  This is used to create a descriptor for an imported subprogram.
-   --  Such descriptors are needed for propagation of exceptions through
-   --  such subprograms. The descriptor never references any handlers,
-   --  and is appended to the given Slist.
-
 end Exp_Ch11;

gcc/ada/freeze.adb

@@ -30,7 +30,6 @@ with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Ch7;  use Exp_Ch7;
-with Exp_Ch11; use Exp_Ch11;
 with Exp_Pakd; use Exp_Pakd;
 with Exp_Util; use Exp_Util;
 with Exp_Tss;  use Exp_Tss;
@@ -3365,9 +3364,6 @@ package body Freeze is
             if Result = No_List then
                Result := Empty_List;
             end if;
-
-            Generate_Subprogram_Descriptor_For_Imported_Subprogram
-              (E, Result);
          end if;
       end if;
 

gcc/ada/frontend.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -31,7 +31,6 @@ with Checks;
 with CStand;
 with Debug;    use Debug;
 with Elists;
-with Exp_Ch11;
 with Exp_Dbug;
 with Fmap;
 with Fname.UF;
@@ -80,7 +79,6 @@ begin
    Lib.Load.Initialize;
    Sem_Ch8.Initialize;
    Fname.UF.Initialize;
-   Exp_Ch11.Initialize;
    Checks.Initialize;
 
    --  Create package Standard
@@ -329,11 +327,6 @@ begin
             end if;
 
             Check_Elab_Calls;
-
-            --  Build unit exception table. We leave this up to the end to
-            --  make sure that all the necessary information is at hand.
-
-            Exp_Ch11.Generate_Unit_Exception_Table;
          end if;
 
          --  List library units if requested

gcc/ada/gnat1drv.adb

@@ -203,27 +203,7 @@ begin
 
       if Targparm.ZCX_By_Default_On_Target then
          if Targparm.GCC_ZCX_Support_On_Target then
-            Exception_Mechanism := Back_End_ZCX_Exceptions;
-         else
-            Exception_Mechanism := Front_End_ZCX_Exceptions;
-         end if;
-      end if;
-
-      --  We take the command line exception mechanism into account
-
-      if Opt.Zero_Cost_Exceptions_Set then
-         if Opt.Zero_Cost_Exceptions_Val = False then
-            Exception_Mechanism := Front_End_Setjmp_Longjmp_Exceptions;
-
-         elsif Debug_Flag_XX then
-            Exception_Mechanism := Front_End_ZCX_Exceptions;
-
-         elsif Targparm.GCC_ZCX_Support_On_Target then
-            Exception_Mechanism := Back_End_ZCX_Exceptions;
-
-         elsif Targparm.Front_End_ZCX_Support_On_Target then
-            Exception_Mechanism := Front_End_ZCX_Exceptions;
-
+            Exception_Mechanism := Back_End_Exceptions;
          else
             Osint.Fail
               ("Zero Cost Exceptions not supported on this target");

gcc/ada/inline.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -29,7 +29,6 @@ with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Ch7;  use Exp_Ch7;
-with Exp_Ch11; use Exp_Ch11;
 with Exp_Tss;  use Exp_Tss;
 with Fname;    use Fname;
 with Fname.UF; use Fname.UF;
@@ -986,29 +985,6 @@ package body Inline is
            and then not Is_Generic_Unit (Main_Unit_Entity)
          then
             Cleanup_Scopes;
-
-            --  Also generate subprogram descriptors that were delayed
-
-            for J in Pending_Descriptor.First .. Pending_Descriptor.Last loop
-               declare
-                  Ent : constant Entity_Id := Pending_Descriptor.Table (J);
-
-               begin
-                  if Is_Subprogram (Ent) then
-                     Generate_Subprogram_Descriptor_For_Subprogram
-                       (Get_Subprogram_Body (Ent), Ent);
-
-                  elsif Ekind (Ent) = E_Package then
-                     Generate_Subprogram_Descriptor_For_Package
-                       (Parent (Declaration_Node (Ent)), Ent);
-
-                  elsif Ekind (Ent) = E_Package_Body then
-                     Generate_Subprogram_Descriptor_For_Package
-                       (Declaration_Node (Ent), Ent);
-                  end if;
-               end;
-            end loop;
-
          elsif Is_Generic_Unit (Cunit_Entity (Main_Unit)) then
             End_Generic;
          end if;

gcc/ada/lib-writ.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -63,7 +63,7 @@ package Lib.Writ is
    --  If the following guidelines are respected, downward compatibility
    --  problems (old tools reading new ali files) should be minimized:
 
-   --    The basic key character format must be kept.
+   --    The basic key character format must be kept
 
    --    The V line must be the first line, this is checked by ali.adb
    --    even in Ignore_Errors mode, and is used to verify that the file
@@ -233,10 +233,6 @@ package Lib.Writ is
    --         UA  Unreserve_All_Interrupts pragma was processed in one or
    --             more units in this file
    --
-   --         UX  Generated code contains unit exception table pointer
-   --             (i.e. it uses zero-cost exceptions, and there is at
-   --             least one subprogram present).
-   --
    --         ZX  Units in this file use zero-cost exceptions and have
    --             generated exception tables. If ZX is not present, the
    --             longjmp/setjmp exception scheme is in use.
@@ -390,7 +386,7 @@ package Lib.Writ is
    --  -- U  Unit Header --
    --  --------------------
 
-   --  The lines for each compilation unit have the following form.
+   --  The lines for each compilation unit have the following form
 
    --    U unit-name source-name version <<attributes>>
    --

gcc/ada/lib.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -39,7 +39,6 @@ with Atree;   use Atree;
 with Einfo;   use Einfo;
 with Fname;   use Fname;
 with Namet;   use Namet;
-with Namet;   use Namet;
 with Output;  use Output;
 with Sinfo;   use Sinfo;
 with Sinput;  use Sinput;
@@ -827,7 +826,6 @@ package body Lib is
       Linker_Option_Lines.Init;
       Load_Stack.Init;
       Units.Init;
-      Unit_Exception_Table_Present := False;
       Compilation_Switches.Init;
    end Initialize;
 

gcc/ada/raise.h

@@ -31,16 +31,18 @@
  ****************************************************************************/
 
 
+/* C counterparts of what System.Standard_Library defines.  */
+
 typedef unsigned Exception_Code;
-/* C counterpart of what System.Standard_Library defines.  */
 
 struct Exception_Data
 {
-  char  Handled_By_Others;
+  char Not_Handled_By_Others;
   char Lang;
   int Name_Length;
-  char *Full_Name, Htable_Ptr;
+  char *Full_Name, *Htable_Ptr;
   Exception_Code Import_Code;
+  void (*Raise_Hook)(void);
 };
 
 typedef struct Exception_Data *Exception_Id;

gcc/ada/s-except.ads

-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT RUN-TIME COMPONENTS                         --
---                                                                          --
---                    S Y S T E M . E X C E P T I O N S                     --
---                                                                          --
---                                 S p e c                                  --
---                                                                          --
---          Copyright (C) 1992-2000 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- --
--- ware  Foundation;  either version 2,  or (at your option) any later ver- --
--- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
--- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNAT;  see file COPYING.  If not, write --
--- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, USA.                                              --
---                                                                          --
--- As a special exception,  if other files  instantiate  generics from this --
--- unit, or you link  this unit with other files  to produce an executable, --
--- this  unit  does not  by itself cause  the resulting  executable  to  be --
--- covered  by the  GNU  General  Public  License.  This exception does not --
--- however invalidate  any other reasons why  the executable file  might be --
--- covered by the  GNU Public License.                                      --
---                                                                          --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.      --
---                                                                          --
-------------------------------------------------------------------------------
-
---  This package contains definitions used for zero cost exception handling.
---  See unit Ada.Exceptions for further details. Note that the reason that
---  we separate out these definitions is to avoid problems with recursion
---  in rtsfind. They must be in a unit which does not require any exception
---  table generation of any kind.
-
-with Ada.Exceptions;
-
-with System;
-with System.Standard_Library;
-
-with Unchecked_Conversion;
-
-package System.Exceptions is
-
-   package SSL renames System.Standard_Library;
-   package AEX renames Ada.Exceptions;
-
-   --  The following section defines data structures used for zero cost
-   --  exception handling if System.Parameters.Zero_Cost_Exceptions is
-   --  set true (i.e. zero cost exceptions are implemented on this target).
-
-   --  The approach is to build tables that describe the PC ranges that
-   --  are covered by various exception frames. When an exception occurs,
-   --  these tables are searched to determine the address of the applicable
-   --  handler for the current exception.
-
-   subtype Handler_Loc is System.Address;
-   --  Code location representing entry address of a handler. Values of
-   --  this type are created using the N_Handler_Loc node, and then
-   --  passed to the Enter_Handler procedure to enter a handler.
-
-   subtype Code_Loc is System.Address;
-   --  Code location used in building exception tables and for call
-   --  addresses when propagating an exception (also traceback table)
-   --  Values of this type are created by using Label'Address or
-   --  extracted from machine states using Get_Code_Loc.
-
-   --------------------
-   -- Handler_Record --
-   --------------------
-
-   --  A Handler record is built for each choice for each exception handler
-   --  in a frame.
-
-   function To_Exception_Id is
-     new Unchecked_Conversion (SSL.Exception_Data_Ptr, AEX.Exception_Id);
-
-   Others_Dummy_Exception : aliased SSL.Exception_Data;
-   Others_Id : constant AEX.Exception_Id :=
-                 To_Exception_Id (Others_Dummy_Exception'Access);
-   --  Dummy exception used to signal others exception
-
-   All_Others_Dummy_Exception : aliased SSL.Exception_Data;
-   All_Others_Id : constant AEX.Exception_Id :=
-                     To_Exception_Id (All_Others_Dummy_Exception'Access);
-   --  Dummy exception used to signal all others exception (including
-   --  exceptions not normally handled by others, e.g. Abort_Signal)
-
-   type Handler_Record is record
-      Lo : Code_Loc;
-      Hi : Code_Loc;
-      --  Range of PC values of code covered by this handler record. The
-      --  handler covers all code addresses that are greater than the Lo
-      --  value, and less than or equal to the Hi value.
-
-      Id : AEX.Exception_Id;
-      --  Id of exception being handled, or one of the above special values
-
-      Handler : Handler_Loc;
-      --  Address of label at start of handler
-   end record;
-
-   type Handler_Record_Ptr is access all Handler_Record;
-   type Handler_Record_List is array (Natural range <>) of Handler_Record_Ptr;
-
-   ---------------------------
-   -- Subprogram_Descriptor --
-   ---------------------------
-
-   --  A Subprogram_Descriptor is built for each subprogram through which
-   --  exceptions may propagate, this includes all Ada subprograms,
-   --  and also all foreign language imported subprograms.
-
-   subtype Subprogram_Info_Type is System.Address;
-   --  This type is used to represent a value that is used to unwind stack
-   --  frames. It references target dependent data that provides sufficient
-   --  information (e.g. about the location of the return point, use of a
-   --  frame pointer, save-over-call registers etc) to unwind the machine
-   --  state to the caller. For some targets, this is simply a pointer to
-   --  the entry point of the procedure (and the routine to pop the machine
-   --  state disassembles the code at the entry point to obtain the required
-   --  information). On other targets, it is a pointer to data created by the
-   --  backend or assembler to represent the required information.
-
-   No_Info : constant Subprogram_Info_Type := System.Null_Address;
-   --  This is a special value used to indicate that it is not possible
-   --  to pop past this frame. This is used at the outer level (e.g. for
-   --  package elaboration procedures or the main procedure), and for any
-   --  other foreign language procedure for which propagation is known
-   --  to be impossible. An exception is considered unhandled if an
-   --  attempt is made to pop a frame whose Subprogram_Info_Type value
-   --  is set to No_Info.
-
-   type Subprogram_Descriptor (Num_Handlers : Natural) is record
-      Code : Code_Loc;
-      --  This is a code location used to determine which procedure we are
-      --  in. Most usually it is simply the entry address for the procedure.
-      --  hA given address is considered to be within the procedure referenced
-      --  by a Subprogram_Descriptor record if this is the descriptor for
-      --  which the Code value is as large as possible without exceeding
-      --  the given value.
-
-      Subprogram_Info : Subprogram_Info_Type;
-      --  This is a pointer to a target dependent data item that provides
-      --  sufficient information for unwinding the stack frame of this
-      --  procedure. A value of No_Info (zero) means that we are the
-      --  outer level procedure.
-
-      Handler_Records : Handler_Record_List (1 .. Num_Handlers);
-      --  List of pointers to Handler_Records for this procedure. The array
-      --  is sorted inside out, i.e. entries for inner frames appear before
-      --  entries for outer handlers. This ensures that a serial search
-      --  finds the innermost applicable handler
-   end record;
-
-   subtype Subprogram_Descriptor_0 is Subprogram_Descriptor (0);
-   subtype Subprogram_Descriptor_1 is Subprogram_Descriptor (1);
-   subtype Subprogram_Descriptor_2 is Subprogram_Descriptor (2);
-   subtype Subprogram_Descriptor_3 is Subprogram_Descriptor (3);
-   --  Predeclare commonly used subtypes for buildingt he tables
-
-   type Subprogram_Descriptor_Ptr is access all Subprogram_Descriptor;
-
-   type Subprogram_Descriptor_List
-     is array (Natural range <>) of Subprogram_Descriptor_Ptr;
-
-   type Subprogram_Descriptors_Record (Count : Natural) is record
-      SDesc : Subprogram_Descriptor_List (1 .. Count);
-   end record;
-
-   type Subprogram_Descriptors_Ptr is
-     access all Subprogram_Descriptors_Record;
-
-   --------------------------
-   -- Unit Exception_Table --
-   --------------------------
-
-   --  If a unit contains at least one subprogram, then a library level
-   --  declaration of the form:
-
-   --    Tnn : aliased constant Subprogram_Descriptors :=
-   --            (Count => n,
-   --             SDesc =>
-   --              (SD1'Unrestricted_Access,
-   --               SD2'Unrestricted_Access,
-   --               ...
-   --               SDn'Unrestricted_Access));
-   --    pragma Export (Ada, Tnn, "__gnat_unit_name__SDP");
-
-   --  is generated where the initializing expression is an array aggregate
-   --  whose elements are pointers to the generated subprogram descriptors
-   --  for the units.
-
-   --  Note: the ALI file contains the designation UX in each unit entry
-   --  if a unit exception table is generated.
-
-   --  The binder generates a list of addresses of pointers to these tables.
-
-end System.Exceptions;

gcc/ada/s-mastop-irix.adb

@@ -44,7 +44,6 @@ with Unchecked_Conversion;
 package body System.Machine_State_Operations is
 
    use System.Storage_Elements;
-   use System.Exceptions;
 
    --  The exc_unwind function in libexc operats on a Sigcontext
 
@@ -182,66 +181,6 @@ package body System.Machine_State_Operations is
         (Memory.Alloc (Sigcontext'Max_Size_In_Storage_Elements));
    end Allocate_Machine_State;
 
-   -------------------
-   -- Enter_Handler --
-   -------------------
-
-   procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
-      pragma Warnings (Off, M);
-      pragma Warnings (Off, Handler);
-
-      LOADI : constant String (1 .. 2) := 'l' & LSC;
-      --  This is "lw" in o32 mode, and "ld" in n32/n64 mode
-
-      LOADF : constant String (1 .. 4) := 'l' & LSC & "c1";
-      --  This is "lwc1" in o32 mode and "ldc1" in n32/n64 mode
-
-   begin
-      --  Restore integer registers from machine state. Note that we know
-      --  that $4 points to M, and $5 points to Handler, since this is
-      --  the standard calling sequence
-
-      Asm (LOADI & " $16,  16*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $17,  17*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $18,  18*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $19,  19*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $20,  20*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $21,  21*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $22,  22*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $23,  23*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $24,  24*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $25,  25*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $26,  26*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $27,  27*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $28,  28*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $29,  29*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $30,  30*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-      Asm (LOADI & " $31,  31*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-
-      --  Restore floating-point registers from machine state
-
-      Asm (LOADF & " $f16, 16*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f17, 17*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f18, 18*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f19, 19*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f20, 20*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f21, 21*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f22, 22*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f23, 23*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f24, 24*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f25, 25*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f26, 26*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f27, 27*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f28, 28*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f29, 29*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f30, 30*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-      Asm (LOADF & " $f31, 31*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-
-      --  Jump directly to the handler
-
-      Asm ("jr  $5");
-   end Enter_Handler;
-
    ----------------
    -- Fetch_Code --
    ----------------
@@ -284,12 +223,7 @@ package body System.Machine_State_Operations is
    -- Pop_Frame --
    ---------------
 
-   procedure Pop_Frame
-     (M    : Machine_State;
-      Info : Subprogram_Info_Type)
-   is
-      pragma Warnings (Off, Info);
-
+   procedure Pop_Frame (M : Machine_State) is
       Scp : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
 
       procedure Exc_Unwind (Scp : Sigcontext_Ptr; Fde : Long_Integer := 0);
@@ -407,21 +341,7 @@ package body System.Machine_State_Operations is
       --  This pop operation will properly set the PC value in the machine
       --  state, so there is no need to save PC in the above code.
 
-      Pop_Frame (M, Set_Machine_State'Address);
+      Pop_Frame (M);
    end Set_Machine_State;
 
-   ------------------------------
-   -- Set_Signal_Machine_State --
-   ------------------------------
-
-   procedure Set_Signal_Machine_State
-     (M       : Machine_State;
-      Context : System.Address)
-   is
-      pragma Warnings (Off, M);
-      pragma Warnings (Off, Context);
-   begin
-      null;
-   end Set_Signal_Machine_State;
-
 end System.Machine_State_Operations;

gcc/ada/s-mastop-tru64.adb

@@ -39,8 +39,6 @@ with System.Memory;
 
 package body System.Machine_State_Operations is
 
-   use System.Exceptions;
-
    pragma Linker_Options ("-lexc");
    --  Needed for definitions of exc_capture_context and exc_virtual_unwind
 
@@ -59,18 +57,6 @@ package body System.Machine_State_Operations is
         (Memory.Alloc (Memory.size_t (c_machine_state_length)));
    end Allocate_Machine_State;
 
-   -------------------
-   -- Enter_Handler --
-   -------------------
-
-   procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
-      procedure c_enter_handler (M : Machine_State; Handler : Handler_Loc);
-      pragma Import (C, c_enter_handler, "__gnat_enter_handler");
-
-   begin
-      c_enter_handler (M, Handler);
-   end Enter_Handler;
-
    ----------------
    -- Fetch_Code --
    ----------------
@@ -135,12 +121,7 @@ package body System.Machine_State_Operations is
    -- Pop_Frame --
    ---------------
 
-   procedure Pop_Frame
-     (M    : Machine_State;
-      Info : Subprogram_Info_Type)
-   is
-      pragma Warnings (Off, Info);
-
+   procedure Pop_Frame (M : Machine_State) is
       procedure exc_virtual_unwind (Fcn : System.Address; M : Machine_State);
       pragma Import (C, exc_virtual_unwind, "exc_virtual_unwind");
 
@@ -178,21 +159,7 @@ package body System.Machine_State_Operations is
       pragma Import (C, c_capture_context, "exc_capture_context");
    begin
       c_capture_context (M);
-      Pop_Frame (M, System.Null_Address);
+      Pop_Frame (M);
    end Set_Machine_State;
 
-   ------------------------------
-   -- Set_Signal_Machine_State --
-   ------------------------------
-
-   procedure Set_Signal_Machine_State
-     (M       : Machine_State;
-      Context : System.Address)
-   is
-      pragma Warnings (Off, M);
-      pragma Warnings (Off, Context);
-   begin
-      null;
-   end Set_Signal_Machine_State;
-
 end System.Machine_State_Operations;

gcc/ada/s-mastop-vms.adb

@@ -41,7 +41,6 @@ with Unchecked_Conversion;
 
 package body System.Machine_State_Operations is
 
-   use System.Exceptions;
    subtype Cond_Value_Type is Unsigned_Longword;
 
    --  Record layouts copied from Starlet.
@@ -148,48 +147,6 @@ package body System.Machine_State_Operations is
         (Memory.Alloc (Invo_Handle_Type'Max_Size_In_Storage_Elements));
    end Allocate_Machine_State;
 
-   -------------------
-   -- Enter_Handler --
-   -------------------
-
-   procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
-      procedure Get_Invo_Context (
-         Result       : out Unsigned_Longword; -- return value
-         Invo_Handle  : Invo_Handle_Type;
-         Invo_Context : out Invo_Context_Blk_Type);
-
-      pragma Interface (External, Get_Invo_Context);
-
-      pragma Import_Valued_Procedure (Get_Invo_Context, "LIB$GET_INVO_CONTEXT",
-         (Unsigned_Longword, Invo_Handle_Type, Invo_Context_Blk_Type),
-         (Value, Value, Reference));
-
-      ICB : Invo_Context_Blk_Type;
-
-      procedure Goto_Unwind (
-         Status      : out Cond_Value_Type; -- return value
-         Target_Invo : Address := Address_Zero;
-         Target_PC   : Address := Address_Zero;
-         New_R0      : Unsigned_Quadword := Unsigned_Quadword'Null_Parameter;
-         New_R1      : Unsigned_Quadword := Unsigned_Quadword'Null_Parameter);
-
-      pragma Interface (External, Goto_Unwind);
-
-      pragma Import_Valued_Procedure
-        (Goto_Unwind, "SYS$GOTO_UNWIND",
-         (Cond_Value_Type, Address, Address,
-          Unsigned_Quadword, Unsigned_Quadword),
-         (Value, Reference, Reference,
-          Reference, Reference));
-
-      Status : Cond_Value_Type;
-
-   begin
-      Get_Invo_Context (Status, To_Invo_Handle_Access (M).all, ICB);
-      Goto_Unwind
-        (Status, System.Address (To_Invo_Handle_Access (M).all), Handler);
-   end Enter_Handler;
-
    ----------------
    -- Fetch_Code --
    ----------------
@@ -261,12 +218,7 @@ package body System.Machine_State_Operations is
    -- Pop_Frame --
    ---------------
 
-   procedure Pop_Frame
-     (M    : Machine_State;
-      Info : Subprogram_Info_Type)
-   is
-      pragma Warnings (Off, Info);
-
+   procedure Pop_Frame (M : Machine_State) is
       procedure Get_Prev_Invo_Handle (
          Result : out Invo_Handle_Type; -- return value
          ICB    : in  Invo_Handle_Type);
@@ -321,18 +273,4 @@ package body System.Machine_State_Operations is
       Pop_Frame (M, System.Null_Address);
    end Set_Machine_State;
 
-   ------------------------------
-   -- Set_Signal_Machine_State --
-   ------------------------------
-
-   procedure Set_Signal_Machine_State
-     (M       : Machine_State;
-      Context : System.Address)
-   is
-      pragma Warnings (Off, M);
-      pragma Warnings (Off, Context);
-   begin
-      null;
-   end Set_Signal_Machine_State;
-
 end System.Machine_State_Operations;

gcc/ada/s-mastop-x86.adb

-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT COMPILER COMPONENTS                         --
---                                                                          --
---                     SYSTEM.MACHINE_STATE_OPERATIONS                      --
---                                                                          --
---                                 B o d y                                  --
---                            (Version for x86)                             --
---                                                                          --
---           Copyright (C) 1999-2004 Ada Core Technologies, 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- --
--- ware  Foundation;  either version 2,  or (at your option) any later ver- --
--- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
--- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNAT;  see file COPYING.  If not, write --
--- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, USA.                                              --
---                                                                          --
--- As a special exception,  if other files  instantiate  generics from this --
--- unit, or you link  this unit with other files  to produce an executable, --
--- this  unit  does not  by itself cause  the resulting  executable  to  be --
--- covered  by the  GNU  General  Public  License.  This exception does not --
--- however invalidate  any other reasons why  the executable file  might be --
--- covered by the  GNU Public License.                                      --
---                                                                          --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.      --
---                                                                          --
-------------------------------------------------------------------------------
-
---  Note: it is very important that this unit not generate any exception
---  tables of any kind. Otherwise we get a nasty rtsfind recursion problem.
---  This means no subprograms, including implicitly generated ones.
-
-with Unchecked_Conversion;
-with System.Storage_Elements;
-with System.Machine_Code; use System.Machine_Code;
-with System.Memory;
-
-package body System.Machine_State_Operations is
-
-   function "+" (Left, Right : Address) return Address;
-   pragma Import (Intrinsic, "+");
-   --  Provide addition operation on type Address (this may not be directly
-   --  available if type System.Address is non-private and the operations on
-   --  the type are made abstract to hide them from public users of System).
-
-   use System.Exceptions;
-
-   type Uns8  is mod 2 ** 8;
-   type Uns32 is mod 2 ** 32;
-
-   type Bits5 is mod 2 ** 5;
-   type Bits6 is mod 2 ** 6;
-
-   function To_Address is new Unchecked_Conversion (Uns32, Address);
-
-   type Uns32_Ptr is access all Uns32;
-   function To_Uns32_Ptr is new Unchecked_Conversion (Uns32,   Uns32_Ptr);
-
-   --  Note: the type Uns32 has an alignment of 4. However, in some cases
-   --  values of type Uns32_Ptr will not be aligned (notably in the case
-   --  where we get the immediate field from an instruction). However this
-   --  does not matter in practice, since the x86 does not require that
-   --  operands be aligned.
-
-   ----------------------
-   -- General Approach --
-   ----------------------
-
-   --  For the x86 version of this unit, the Subprogram_Info_Type values
-   --  are simply the starting code address for the subprogram. Popping
-   --  of stack frames works by analyzing the code in the prolog, and
-   --  deriving from this analysis the necessary information for restoring
-   --  the registers, including the return point.
-
-   ---------------------------
-   -- Description of Prolog --
-   ---------------------------
-
-   --  If a frame pointer is present, the prolog looks like
-
-   --     pushl %ebp
-   --     movl  %esp,%ebp
-   --     subl  $nnn,%esp     omitted if nnn = 0
-   --     pushl %edi          omitted if edi not used
-   --     pushl %esi          omitted if esi not used
-   --     pushl %ebx          omitted if ebx not used
-
-   --  If a frame pointer is not present, the prolog looks like
-
-   --     subl  $nnn,%esp     omitted if nnn = 0
-   --     pushl %ebp          omitted if ebp not used
-   --     pushl %edi          omitted if edi not used
-   --     pushl %esi          omitted if esi not used
-   --     pushl %ebx          omitted if ebx not used
-
-   --  Note: any or all of the save over call registers may be used and
-   --  if so, will be saved using pushl as shown above. The order of the
-   --  pushl instructions will be as shown above for gcc generated code,
-   --  but the code in this unit does not assume this.
-
-   -------------------------
-   -- Description of Call --
-   -------------------------
-
-   --  A call looks like:
-
-   --     pushl ...           push parameters
-   --     pushl ...
-   --     call  ...           perform the call
-   --     addl  $nnn,%esp     omitted if no parameters
-
-   --  Note that we are not absolutely guaranteed that the call is always
-   --  followed by an addl operation that readjusts %esp for this particular
-   --  call. There are two reasons for this:
-
-   --    1) The addl can be delayed and combined in the case where more than
-   --       one call appears in sequence. This can be suppressed by using the
-   --       switch -fno-defer-pop and for Ada code, we automatically use
-   --       this switch, but we could still be dealing with C code that was
-   --       compiled without using this switch.
-
-   --    2) Scheduling may result in moving the addl instruction away from
-   --       the call. It is not clear if this actually can happen at the
-   --       current time, but it is certainly conceptually possible.
-
-   --  The addl after the call is important, since we need to be able to
-   --  restore the proper %esp value when we pop the stack. However, we do
-   --  not try to compensate for either of the above effects. As noted above,
-   --  case 1 does not occur for Ada code, and it does not appear in practice
-   --  that case 2 occurs with any significant frequency (we have never seen
-   --  an example so far for gcc generated code).
-
-   --  Furthermore, it is only in the case of -fomit-frame-pointer that we
-   --  really get into trouble from not properly restoring %esp. If we have
-   --  a frame pointer, then the worst that happens is that %esp is slightly
-   --  more depressed than it should be. This could waste a bit of space on
-   --  the stack, and even in some cases cause a storage leak on the stack,
-   --  but it will not affect the functional correctness of the processing.
-
-   ----------------------------------------
-   -- Definitions of Instruction Formats --
-   ----------------------------------------
-
-   type Rcode is (eax, ecx, edx, ebx, esp, ebp, esi, edi);
-   pragma Warnings (Off, Rcode);
-   --  Code indicating which register is referenced in an instruction
-
-   --  The following define the format of a pushl instruction
-
-   Op_pushl : constant Bits5 := 2#01010#;
-
-   type Ins_pushl is record
-      Op  : Bits5 := Op_pushl;
-      Reg : Rcode;
-   end record;
-
-   for Ins_pushl use record
-      Op  at 0 range 3 .. 7;
-      Reg at 0 range 0 .. 2;
-   end record;
-
-   Ins_pushl_ebp : constant Ins_pushl := (Op_pushl, Reg => ebp);
-
-   type Ins_pushl_Ptr is access all Ins_pushl;
-
-   --  For the movl %esp,%ebp instruction, we only need to know the length
-   --  because we simply skip past it when we analyze the prolog.
-
-   Ins_movl_length : constant := 2;
-
-   --  The following define the format of addl/subl esp instructions
-
-   Op_Immed : constant Bits6 := 2#100000#;
-
-   Op2_addl_Immed : constant Bits5 := 2#11100#;
-   pragma Unreferenced (Op2_addl_Immed);
-
-   Op2_subl_Immed : constant Bits5 := 2#11101#;
-
-   type Word_Byte is (Word, Byte);
-   pragma Unreferenced (Byte);
-
-   type Ins_addl_subl_byte is record
-      Op   : Bits6;           -- Set to Op_Immed
-      w    : Word_Byte;       -- Word/Byte flag (set to 1 = byte)
-      s    : Boolean;         -- Sign extension bit (1 = extend)
-      Op2  : Bits5;           -- Secondary opcode
-      Reg  : Rcode;           -- Register
-      Imm8 : Uns8;            -- Immediate operand
-   end record;
-
-   for Ins_addl_subl_byte use record
-      Op   at 0 range 2 .. 7;
-      w    at 0 range 1 .. 1;
-      s    at 0 range 0 .. 0;
-      Op2  at 1 range 3 .. 7;
-      Reg  at 1 range 0 .. 2;
-      Imm8 at 2 range 0 .. 7;
-   end record;
-
-   type Ins_addl_subl_word is record
-      Op    : Bits6;          -- Set to Op_Immed
-      w     : Word_Byte;      -- Word/Byte flag (set to 0 = word)
-      s     : Boolean;        -- Sign extension bit (1 = extend)
-      Op2   : Bits5;          -- Secondary opcode
-      Reg   : Rcode;          -- Register
-      Imm32 : Uns32;          -- Immediate operand
-   end record;
-
-   for Ins_addl_subl_word use record
-      Op    at 0 range 2 .. 7;
-      w     at 0 range 1 .. 1;
-      s     at 0 range 0 .. 0;
-      Op2   at 1 range 3 .. 7;
-      Reg   at 1 range 0 .. 2;
-      Imm32 at 2 range 0 .. 31;
-   end record;
-
-   type Ins_addl_subl_byte_Ptr is access all Ins_addl_subl_byte;
-   type Ins_addl_subl_word_Ptr is access all Ins_addl_subl_word;
-
-   ---------------------
-   -- Prolog Analysis --
-   ---------------------
-
-   --  The analysis of the prolog answers the following questions:
-
-   --    1. Is %ebp used as a frame pointer?
-   --    2. How far is SP depressed (i.e. what is the stack frame size)
-   --    3. Which registers are saved in the prolog, and in what order
-
-   --  The following data structure stores the answers to these questions
-
-   subtype SOC is Rcode range ebx .. edi;
-   --  Possible save over call registers
-
-   SOC_Max : constant := 4;
-   --  Max number of SOC registers that can be pushed
-
-   type SOC_Push_Regs_Type is array (1 .. 4) of Rcode;
-   --  Used to hold the register codes of pushed SOC registers
-
-   type Prolog_Type is record
-
-      Frame_Reg : Boolean;
-      --  This is set to True if %ebp is used as a frame register, and
-      --  False otherwise (in the False case, %ebp may be saved in the
-      --  usual manner along with the other SOC registers).
-
-      Frame_Length : Uns32;
-      --  Amount by which ESP is decremented on entry, includes the effects
-      --  of push's of save over call registers as indicated above, e.g. if
-      --  the prolog of a routine is:
-      --
-      --    pushl %ebp
-      --    movl %esp,%ebp
-      --    subl $424,%esp
-      --    pushl %edi
-      --    pushl %esi
-      --    pushl %ebx
-      --
-      --  Then the value of Frame_Length would be 436 (424 + 3 * 4). A
-      --  precise definition is that it is:
-      --
-      --    %esp on entry   minus   %esp after last SOC push
-      --
-      --  That definition applies both in the frame pointer present and
-      --  the frame pointer absent cases.
-
-      Num_SOC_Push : Integer range 0 .. SOC_Max;
-      --  Number of save over call registers actually saved by pushl
-      --  instructions (other than the initial pushl to save the frame
-      --  pointer if a frame pointer is in use).
-
-      SOC_Push_Regs : SOC_Push_Regs_Type;
-      --  The First Num_SOC_Push entries of this array are used to contain
-      --  the codes for the SOC registers, in the order in which they were
-      --  pushed. Note that this array excludes %ebp if it is used as a frame
-      --  register, since although %ebp is still considered an SOC register
-      --  in this case, it is saved and restored by a separate mechanism.
-      --  Also we will never see %esp represented in this list. Again, it is
-      --  true that %esp is saved over call, but it is restored by a separate
-      --  mechanism.
-
-   end record;
-
-   procedure Analyze_Prolog (A : Address; Prolog : out Prolog_Type);
-   --  Given the address of the start of the prolog for a procedure,
-   --  analyze the instructions of the prolog, and set Prolog to contain
-   --  the information obtained from this analysis.
-
-   ----------------------------------
-   -- Machine_State_Representation --
-   ----------------------------------
-
-   --  The type Machine_State is defined in the body of Ada.Exceptions as
-   --  a Storage_Array of length 1 .. Machine_State_Length. But really it
-   --  has structure as defined here. We use the structureless declaration
-   --  in Ada.Exceptions to avoid this unit from being implementation
-   --  dependent. The actual definition of Machine_State is as follows:
-
-   type SOC_Regs_Type is array (SOC) of Uns32;
-
-   type MState is record
-      eip : Uns32;
-      --  The instruction pointer location (which is the return point
-      --  value from the next level down in all cases).
-
-      Regs : SOC_Regs_Type;
-      --  Values of the save over call registers
-   end record;
-
-   for MState use record
-      eip  at 0 range 0 .. 31;
-      Regs at 4 range 0 .. 5 * 32 - 1;
-   end record;
-   --  Note: the routines Enter_Handler, and Set_Machine_State reference
-   --  the fields in this structure non-symbolically.
-
-   type MState_Ptr is access all MState;
-
-   function To_MState_Ptr is
-     new Unchecked_Conversion (Machine_State, MState_Ptr);
-
-   ----------------------------
-   -- Allocate_Machine_State --
-   ----------------------------
-
-   function Allocate_Machine_State return Machine_State is
-      use System.Storage_Elements;
-
-   begin
-      return Machine_State
-        (Memory.Alloc (MState'Max_Size_In_Storage_Elements));
-   end Allocate_Machine_State;
-
-   --------------------
-   -- Analyze_Prolog --
-   --------------------
-
-   procedure Analyze_Prolog (A : Address; Prolog : out Prolog_Type) is
-      Ptr : Address;
-      Ppl : Ins_pushl_Ptr;
-      Pas : Ins_addl_subl_byte_Ptr;
-
-      function To_Ins_pushl_Ptr is
-        new Unchecked_Conversion (Address, Ins_pushl_Ptr);
-
-      function To_Ins_addl_subl_byte_Ptr is
-        new Unchecked_Conversion (Address, Ins_addl_subl_byte_Ptr);
-
-      function To_Ins_addl_subl_word_Ptr is
-        new Unchecked_Conversion (Address, Ins_addl_subl_word_Ptr);
-
-   begin
-      Ptr := A;
-      Prolog.Frame_Length := 0;
-
-      if Ptr = Null_Address then
-         Prolog.Num_SOC_Push := 0;
-         Prolog.Frame_Reg := True;
-         return;
-      end if;
-
-      if To_Ins_pushl_Ptr (Ptr).all = Ins_pushl_ebp then
-         Ptr := Ptr + 1 + Ins_movl_length;
-         Prolog.Frame_Reg := True;
-      else
-         Prolog.Frame_Reg := False;
-      end if;
-
-      Pas := To_Ins_addl_subl_byte_Ptr (Ptr);
-
-      if Pas.Op = Op_Immed
-        and then Pas.Op2 = Op2_subl_Immed
-        and then Pas.Reg = esp
-      then
-         if Pas.w = Word then
-            Prolog.Frame_Length := Prolog.Frame_Length +
-                                     To_Ins_addl_subl_word_Ptr (Ptr).Imm32;
-            Ptr := Ptr + 6;
-
-         else
-            Prolog.Frame_Length := Prolog.Frame_Length + Uns32 (Pas.Imm8);
-            Ptr := Ptr + 3;
-
-            --  Note: we ignore sign extension, since a sign extended
-            --  value that was negative would imply a ludicrous frame size.
-         end if;
-      end if;
-
-      --  Now scan push instructions for SOC registers
-
-      Prolog.Num_SOC_Push := 0;
-
-      loop
-         Ppl := To_Ins_pushl_Ptr (Ptr);
-
-         if Ppl.Op = Op_pushl and then Ppl.Reg in SOC then
-            Prolog.Num_SOC_Push := Prolog.Num_SOC_Push + 1;
-            Prolog.SOC_Push_Regs (Prolog.Num_SOC_Push) := Ppl.Reg;
-            Prolog.Frame_Length := Prolog.Frame_Length + 4;
-            Ptr := Ptr + 1;
-
-         else
-            exit;
-         end if;
-      end loop;
-
-   end Analyze_Prolog;
-
-   -------------------
-   -- Enter_Handler --
-   -------------------
-
-   procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
-   begin
-      Asm ("mov %0,%%edx", Inputs => Machine_State'Asm_Input ("r", M));
-      Asm ("mov %0,%%eax", Inputs => Handler_Loc'Asm_Input ("r", Handler));
-
-      Asm ("mov 4(%%edx),%%ebx");    -- M.Regs (ebx)
-      Asm ("mov 12(%%edx),%%ebp");   -- M.Regs (ebp)
-      Asm ("mov 16(%%edx),%%esi");   -- M.Regs (esi)
-      Asm ("mov 20(%%edx),%%edi");   -- M.Regs (edi)
-      Asm ("mov 8(%%edx),%%esp");    -- M.Regs (esp)
-      Asm ("jmp %*%%eax");
-   end Enter_Handler;
-
-   ----------------
-   -- Fetch_Code --
-   ----------------
-
-   function Fetch_Code (Loc : Code_Loc) return Code_Loc is
-   begin
-      return Loc;
-   end Fetch_Code;
-
-   ------------------------
-   -- Free_Machine_State --
-   ------------------------
-
-   procedure Free_Machine_State (M : in out Machine_State) is
-   begin
-      Memory.Free (Address (M));
-      M := Machine_State (Null_Address);
-   end Free_Machine_State;
-
-   ------------------
-   -- Get_Code_Loc --
-   ------------------
-
-   function Get_Code_Loc (M : Machine_State) return Code_Loc is
-
-      Asm_Call_Size : constant := 2;
-      --  Minimum size for a call instruction under ix86. Using the minimum
-      --  size is safe here as the call point computed from the return point
-      --  will always be inside the call instruction.
-
-      MS : constant MState_Ptr := To_MState_Ptr (M);
-
-   begin
-      if MS.eip = 0 then
-         return To_Address (MS.eip);
-      else
-         --  When doing a call the return address is pushed to the stack.
-         --  We want to return the call point address, so we subtract
-         --  Asm_Call_Size from the return address. This value is set
-         --  to 5 as an asm call takes 5 bytes on x86 architectures.
-
-         return To_Address (MS.eip - Asm_Call_Size);
-      end if;
-   end Get_Code_Loc;
-
-   --------------------------
-   -- Machine_State_Length --
-   --------------------------
-
-   function Machine_State_Length
-     return System.Storage_Elements.Storage_Offset
-   is
-   begin
-      return MState'Max_Size_In_Storage_Elements;
-   end Machine_State_Length;
-
-   ---------------
-   -- Pop_Frame --
-   ---------------
-
-   procedure Pop_Frame
-     (M    : Machine_State;
-      Info : Subprogram_Info_Type)
-   is
-      MS  : constant MState_Ptr := To_MState_Ptr (M);
-      PL  : Prolog_Type;
-
-      SOC_Ptr : Uns32;
-      --  Pointer to stack location after last SOC push
-
-      Rtn_Ptr : Uns32;
-      --  Pointer to stack location containing return address
-
-   begin
-      Analyze_Prolog (Info, PL);
-
-      --  Case of frame register, use EBP, safer than ESP
-
-      if PL.Frame_Reg then
-         SOC_Ptr := MS.Regs (ebp) - PL.Frame_Length;
-         Rtn_Ptr := MS.Regs (ebp) + 4;
-         MS.Regs (ebp) := To_Uns32_Ptr (MS.Regs (ebp)).all;
-
-      --  No frame pointer, use ESP, and hope we have it exactly right!
-
-      else
-         SOC_Ptr := MS.Regs (esp);
-         Rtn_Ptr := SOC_Ptr + PL.Frame_Length;
-      end if;
-
-      --  Get saved values of SOC registers
-
-      for J in reverse 1 .. PL.Num_SOC_Push loop
-         MS.Regs (PL.SOC_Push_Regs (J)) := To_Uns32_Ptr (SOC_Ptr).all;
-         SOC_Ptr := SOC_Ptr + 4;
-      end loop;
-
-      MS.eip := To_Uns32_Ptr (Rtn_Ptr).all;
-      MS.Regs (esp) := Rtn_Ptr + 4;
-   end Pop_Frame;
-
-   -----------------------
-   -- Set_Machine_State --
-   -----------------------
-
-   procedure Set_Machine_State (M : Machine_State) is
-      N : constant Asm_Output_Operand := No_Output_Operands;
-
-   begin
-      Asm ("mov %0,%%edx", N, Machine_State'Asm_Input ("r", M));
-
-      --  At this stage, we have the following situation (note that we
-      --  are assuming that the -fomit-frame-pointer switch has not been
-      --  used in compiling this procedure.
-
-      --     (value of M)
-      --     return point
-      --     old ebp          <------ current ebp/esp value
-
-      --  The values of registers ebx/esi/edi are unchanged from entry
-      --  so they have the values we want, and %edx points to the parameter
-      --  value M, so we can store these values directly.
-
-      Asm ("mov %%ebx,4(%%edx)");    -- M.Regs (ebx)
-      Asm ("mov %%esi,16(%%edx)");   -- M.Regs (esi)
-      Asm ("mov %%edi,20(%%edx)");   -- M.Regs (edi)
-
-      --  The desired value of ebp is the old value
-
-      Asm ("mov 0(%%ebp),%%eax");
-      Asm ("mov %%eax,12(%%edx)");   -- M.Regs (ebp)
-
-      --  The return point is the desired eip value
-
-      Asm ("mov 4(%%ebp),%%eax");
-      Asm ("mov %%eax,(%%edx)");   -- M.eip
-
-      --  Finally, the desired %esp value is the value at the point of
-      --  call to this routine *before* pushing the parameter value.
-
-      Asm ("lea 12(%%ebp),%%eax");
-      Asm ("mov %%eax,8(%%edx)");   -- M.Regs (esp)
-   end Set_Machine_State;
-
-   ------------------------------
-   -- Set_Signal_Machine_State --
-   ------------------------------
-
-   procedure Set_Signal_Machine_State
-     (M       : Machine_State;
-      Context : System.Address)
-   is
-      pragma Warnings (Off, M);
-      pragma Warnings (Off, Context);
-
-   begin
-      null;
-   end Set_Signal_Machine_State;
-
-end System.Machine_State_Operations;

gcc/ada/s-mastop.adb

@@ -7,7 +7,7 @@
 --                                 B o d y                                  --
 --                             (Dummy version)                              --
 --                                                                          --
---          Copyright (C) 1999-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1999-2005 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- --
@@ -41,8 +41,6 @@ package body System.Machine_State_Operations is
 
    pragma Warnings (Off);
 
-   use System.Exceptions;
-
    ----------------------------
    -- Allocate_Machine_State --
    ----------------------------
@@ -52,15 +50,6 @@ package body System.Machine_State_Operations is
       return Machine_State (Null_Address);
    end Allocate_Machine_State;
 
-   -------------------
-   -- Enter_Handler --
-   -------------------
-
-   procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
-   begin
-      null;
-   end Enter_Handler;
-
    ----------------
    -- Fetch_Code --
    ----------------
@@ -102,9 +91,7 @@ package body System.Machine_State_Operations is
    -- Pop_Frame --
    ---------------
 
-   procedure Pop_Frame
-     (M    : Machine_State;
-      Info : Subprogram_Info_Type) is
+   procedure Pop_Frame (M : Machine_State) is
    begin
       null;
    end Pop_Frame;
@@ -118,16 +105,4 @@ package body System.Machine_State_Operations is
       null;
    end Set_Machine_State;
 
-   ------------------------------
-   -- Set_Signal_Machine_State --
-   ------------------------------
-
-   procedure Set_Signal_Machine_State
-     (M       : Machine_State;
-      Context : System.Address)
-   is
-   begin
-      null;
-   end Set_Signal_Machine_State;
-
 end System.Machine_State_Operations;

gcc/ada/s-mastop.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1999-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1999-2005 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,7 +36,6 @@ pragma Polling (Off);
 --  elaboration circularities with System.Exception_Tables.
 
 with System.Storage_Elements;
-with System.Exceptions;
 
 package System.Machine_State_Operations is
 
@@ -79,65 +78,11 @@ package System.Machine_State_Operations is
    --  outer level, or some other frame for which no information can be
    --  provided.
 
-   procedure Pop_Frame
-     (M    : Machine_State;
-      Info : System.Exceptions.Subprogram_Info_Type);
+   procedure Pop_Frame (M : Machine_State);
    --  This procedure pops the machine state M so that it represents the
    --  call point, as though the current subprogram had returned. It
    --  changes only the value referenced by M, and does not affect
    --  the current stack environment.
-   --
-   --  The Info parameter represents information generated by the backend
-   --  (see description of Subprogram_Info node in sinfo.ads). This
-   --  information is stored as static data during compilation. The
-   --  caller then passes this information to Pop_Frame, which will
-   --  use it to determine what must be changed in the machine state
-   --  (e.g. which save-over-call registers must be restored, and from
-   --  where on the stack frame they must be restored).
-   --
-   --  A value of No_Info for Info means either that the backend provided
-   --  no information for current frame, or that the current frame is an
-   --  other language frame for which no information exists, or that this
-   --  is an outer level subprogram. In any case, Pop_Frame sets the code
-   --  location to Null_Address when it pops past such a frame, and this
-   --  is taken as an indication that the exception is unhandled.
-
-   --  Note: at the current time, Info, if present is always a copy of
-   --  the entry point of the procedure, as found by searching the
-   --  subprogram table. For the case where a procedure is indeed in
-   --  the table (either it is an Ada procedure, or a foreign procedure
-   --  which is registered using pragma Propagate_Exceptions), then the
-   --  entry point information will indeed be correct. It may well be
-   --  possible for Pop_Frame to avoid using the Info parameter (for
-   --  example if it consults auxiliary Dwarf tables to do its job).
-   --  This is desirable if it can be done, because it means that it
-   --  will work fine to propagate exceptions through unregistered
-   --  foreign procedures. What will happen is that the search in the
-   --  Ada subprogram table will find a junk entry. Even if this junk
-   --  entry has an exception table, none of them will apply to the
-   --  current location, so they will be ignored, and then Pop_Frame
-   --  will be called to pop the frame. The Info parameter for this
-   --  call will be junk, but if it is not used that does not matter.
-   --  Note that the address recorded in the traceback table is of
-   --  the exception location, so the traceback will be correct even
-   --  in this case.
-
-   procedure Enter_Handler
-     (M       : Machine_State;
-      Handler : System.Exceptions.Handler_Loc);
-   --  When Propagate_Handler locates an applicable exception handler, it
-   --  calls Enter_Handler, passing it two parameters. The first is the
-   --  machine state that corresponds to what is required for entry to
-   --  the handler, as computed by repeated Pop_Frame calls to reach the
-   --  handler to be entered. The second is the code location for the
-   --  handler itself which is the address of the label at the start of
-   --  the handler code.
-   --
-   --  Note: The machine state M is likely stored on the part of the
-   --  stack that will be popped by the call, so care must be taken
-   --  not to pop the stack until the Machine_State is entirely read.
-   --  The value passed as Handler was obtained from elaboration of
-   --  an N_Handler_Loc node by the backend.
 
    function Fetch_Code (Loc : Code_Loc) return Code_Loc;
    --  Some architectures (notably VMS) use a descriptor to describe
@@ -150,14 +95,4 @@ package System.Machine_State_Operations is
    --  This routine sets M from the current machine state. It is called
    --  when an exception is initially signalled to initialize the state.
 
-   procedure Set_Signal_Machine_State
-     (M       : Machine_State;
-      Context : System.Address);
-   --  This routine sets M from the machine state that corresponds to the
-   --  point in the code where a signal was raised. The parameter Context
-   --  is a pointer to a structure created by the operating system when a
-   --  signal is raised, and made available to the signal handler. The
-   --  format of this context block, and the manner in which it is made
-   --  available to the handler, are implementation dependent.
-
 end System.Machine_State_Operations;

gcc/ada/s-traceb-mastop.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 1999-2003 Ada Core Technologies, Inc.            --
+--           Copyright (C) 1999-2005 Ada Core Technologies, 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- --
@@ -31,8 +31,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This version assumes that System.Machine_State_Operations.Pop_Frame can
---  work with the Info parameter being null.
+--  This version uses System.Machine_State_Operations routines
 
 with System.Machine_State_Operations;
 
@@ -73,7 +72,7 @@ package body System.Traceback is
          Code := Get_Code_Loc (M);
          exit when Code = Null_Address or else N_Skips = Skip_Frames;
 
-         Pop_Frame (M, System.Null_Address);
+         Pop_Frame (M);
          N_Skips := N_Skips + 1;
       end loop;
 
@@ -90,7 +89,7 @@ package body System.Traceback is
             Trace (Len) := Code;
          end if;
 
-         Pop_Frame (M, System.Null_Address);
+         Pop_Frame (M);
       end loop;
 
       Free_Machine_State (M);

gcc/ada/switch-b.adb

@@ -126,14 +126,6 @@ package body Switch.B is
                end if;
             end loop;
 
-            --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
-            --  is for backwards compatibility with old versions and usage.
-
-            if Debug_Flag_XX then
-               Zero_Cost_Exceptions_Set := True;
-               Zero_Cost_Exceptions_Val := True;
-            end if;
-
             return;
 
          --  Processing for D switch

gcc/ada/switch-m.adb

@@ -585,14 +585,6 @@ package body Switch.M is
                end if;
             end loop;
 
-            --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
-            --  is for backwards compatibility with old versions and usage.
-
-            if Debug_Flag_XX then
-               Zero_Cost_Exceptions_Set := True;
-               Zero_Cost_Exceptions_Val := True;
-            end if;
-
             return;
 
          --  Processing for e switch

gcc/ada/targparm.adb

@@ -67,10 +67,9 @@ package body Targparm is
       UAM,  --   Use_Ada_Main_Program_Name
       VMS,  --   OpenVMS
       ZCD,  --   ZCX_By_Default
-      ZCG,  --   GCC_ZCX_Support
-      ZCF); --   Front_End_ZCX_Support
+      ZCG); --   GCC_ZCX_Support
 
-   subtype Targparm_Tags_OK is Targparm_Tags range AAM .. ZCF;
+   subtype Targparm_Tags_OK is Targparm_Tags range AAM .. ZCG;
    --  Range excluding obsolete entries
 
    Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
@@ -106,7 +105,6 @@ package body Targparm is
    VMS_Str : aliased constant Source_Buffer := "OpenVMS";
    ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default";
    ZCG_Str : aliased constant Source_Buffer := "GCC_ZCX_Support";
-   ZCF_Str : aliased constant Source_Buffer := "Front_End_ZCX_Support";
 
    --  The following defines a set of pointers to the above strings,
    --  indexed by the tag values.
@@ -140,8 +138,7 @@ package body Targparm is
       UAM_Str'Access,
       VMS_Str'Access,
       ZCD_Str'Access,
-      ZCG_Str'Access,
-      ZCF_Str'Access);
+      ZCG_Str'Access);
 
    -----------------------
    -- Local Subprograms --
@@ -571,7 +568,6 @@ package body Targparm is
                      when VMS => OpenVMS_On_Target                   := Result;
                      when ZCD => ZCX_By_Default_On_Target            := Result;
                      when ZCG => GCC_ZCX_Support_On_Target           := Result;
-                     when ZCF => Front_End_ZCX_Support_On_Target     := Result;
 
                      goto Line_Loop_Continue;
                   end case;

gcc/ada/targparm.ads

@@ -278,50 +278,24 @@ package Targparm is
 
    --    Controlling the selection of methods
 
-   --      The Front-End Longjmp/Setjmp approach is always available in
-   --      all implementations. If it is not the default method, then it
-   --      may be explicitly specified by the use of -gnatL. Note however
-   --      that there is a requirement that all Ada units in a partition
-   --      be compiled with this overriding option if it is not the default.
-
-   --      On some, but not all, implementations of GNAT, one of the two
-   --      ZCX approaches (but not both) is implemented. If this is the
-   --      case, and ZCX is not the default mechanism, then ZCX handling
-   --      (front-end or back-end according to the implementation) may be
-   --      specified by use of the -gnatZ switch. Again, this switch must
-   --      be used to compile all Ada units in a partition. The use of
-   --      the -gnatZ switch will cause termination with a fatal error.
-
-   --      Finally the debug option -gnatdX can be used to force the
-   --      compiler to operate in front-end ZCX exception mode and force
-   --      the front end to generate exception tables. This is only useful
-   --      for debugging purposes for implementations which do not provide
-   --      the possibility of front-end ZCX mode. The resulting object file
-   --      is unusable, but this debug switch may still be useful (e.g. in
-   --      conjunction with -gnatG) for front-end debugging purposes.
+   --      On most implementations, back-end zero-cost exceptions are used.
+   --      Otherwise, Front-End Longjmp/Setjmp approach is used.
+   --      Note that there is a requirement that all Ada units in a partition
+   --      be compiled with the same exception model.
 
    --    Control of Available Methods and Defaults
 
-   --      The following switches specify which of the two ZCX methods
-   --      (if any) is available in an implementation, and which method
-   --      is the default method.
+   --      The following switches specify whether ZCX is available, and
+   --      whether it is enabled by default.
 
    ZCX_By_Default_On_Target : Boolean := False;
    --  Indicates if zero cost exceptions are active by default. If this
    --  variable is False, then the only possible exception method is the
    --  front-end setjmp/longjmp approach, and this is the default. If
-   --  this variable is True, then one of the following two flags must
-   --  be True, and represents the method to be used by default.
+   --  this variable is True, then GCC ZCX is used.
 
    GCC_ZCX_Support_On_Target  : Boolean := False;
-   --  Indicates that when ZCX is active, the mechanism to be used is the
-   --  back-end ZCX exception approach. If this variable is set to True,
-   --  then Front_End_ZCX_Support_On_Target must be False.
-
-   Front_End_ZCX_Support_On_Target : Boolean := False;
-   --  Indicates that when ZCX is active, the mechanism to be used is the
-   --  front-end ZCX exception approach. If this variable is set to True,
-   --  then GCC_ZCX_Support_On_Target must be False.
+   --  Indicates that the target supports GCC Exceptions.
 
    ------------------------------------
    -- Run-Time Library Configuration --
@@ -367,9 +341,6 @@ package Targparm is
    --    with the exception of the priority of the environment task, which
    --    is needed by the Ravenscar run-time.
    --
-   --    The generation of exception tables is suppressed for front end
-   --    ZCX exception handling (since we assume no exception handling).
-   --
    --    The calls to __gnat_initialize and __gnat_finalize are omitted
    --
    --    All finalization and initialization (controlled types) is omitted

gcc/ada/usage.adb

@@ -220,11 +220,6 @@ begin
    Write_Switch_Char ("l");
    Write_Line ("Output full source listing with embedded error messages");
 
-   --  Line for -gnatL switch
-
-   Write_Switch_Char ("L");
-   Write_Line ("Use longjmp/setjmp for exception handling");
-
    --  Line for -gnatm switch
 
    Write_Switch_Char ("mnnn");
@@ -465,11 +460,6 @@ begin
    Write_Switch_Char ("z");
    Write_Line ("Distribution stub generation (r/c for receiver/caller stubs)");
 
-   --  Line for -gnatZ switch
-
-   Write_Switch_Char ("Z");
-   Write_Line ("Use zero cost exception handling");
-
    --  Line for -gnat83 switch
 
    Write_Switch_Char ("83");