Skip to content

R
riscv-gcc-1
Commit 1a2c495d by Arnaud Charlet
Options

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
parent 3b91d88e
Showing with 81 additions and 749 deletions
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.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/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.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 deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- 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.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");
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment