Skip to content

R
riscv-gcc-1
Commit 35ae2ed8 by Arnaud Charlet
Options

[multiple changes] 

2004-07-20  Olivier Hainque  <hainque@act-europe.fr>

	* a-elchha.adb (Last_Chance_Handler): Remove the bogus buffer dynamic
	allocation and potentially overflowing update with
	Tailored_Exception_Information. Use the sec-stack free procedural
	interface to output Exception_Information instead.

	* a-except.adb (To_Stderr): New subprogram for character, and string
	version moved from a-exextr to be visible from other separate units.
	(Tailored_Exception_Information): Remove the procedural version,
	previously used by the default Last_Chance_Handler and not any more.
	Adjust various comments.

	* a-exexda.adb: Generalize the exception information procedural
	interface, to minimize the use of secondary stack and the need for
	local buffers when the info is to be output to stderr:
	(Address_Image): Removed.
	(Append_Info_Character): New subprogram, checking for overflows and
	outputing to stderr if buffer to fill is of length 0.
	(Append_Info_String): Output to stderr if buffer to fill is of length 0.
	(Append_Info_Address, Append_Info_Exception_Name,
	Append_Info_Exception_Message, Append_Info_Basic_Exception_Information,
	Append_Info_Basic_Exception_Traceback,
	Append_Info_Exception_Information): New subprograms.
	(Append_Info_Nat, Append_Info_NL): Use Append_Info_Character.
	(Basic_Exception_Info_Maxlength, Basic_Exception_Tback_Maxlength,
	Exception_Info_Maxlength, Exception_Name_Length,
	Exception_Message_Length): New subprograms.
	(Exception_Information): Use Append_Info_Exception_Information.
	(Tailored_Exception_Information): Use
	Append_Info_Basic_Exception_Information.
	Export services for the default Last_Chance_Handler.

	* a-exextr.adb (To_Stderr): Remove. Now in a-except to be usable by
	other separate units.

2004-07-20  Vincent Celier  <celier@gnat.com>

	* clean.adb, mlib-utl.adb, osint.adb, makegpr.adb: Minor reformatting.

2004-07-20  Ed Schonberg  <schonberg@gnat.com>

	* freeze.adb (Freeze_Entity): If entity is a discriminated record type,
	emit itype references for the designated types of component types that
	are declared outside of the full record declaration, and that may
	denote a partial view of that record type.

2004-07-20  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15607
	* sem_ch3.adb (Build_Discriminated_Subtype): Do not attach a subtype
	which is the designated type in an access component declaration, to the
	list of incomplete dependents of the parent type, to avoid elaboration
	issues with out-of-scope subtypes.
	(Complete_Private_Subtype): Recompute Has_Unknown_Discriminants from the
	full view of the parent.

2004-07-20  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15610
	* sem_ch8.adb (Find_Expanded_Name): If name is overloaded, reject
	entities that are hidden, such as references to generic actuals
	outside an instance.

2004-07-20  Javier Miranda  <miranda@gnat.com>

	* sem_ch4.adb (Try_Object_Operation): New subprogram that gives
	support to the new notation.
	(Analyze_Selected_Component): Add call to Try_Object_Operation.

2004-07-20  Jose Ruiz  <ruiz@act-europe.fr>

	* s-taprob.adb: Adding the elaboration code required for initializing
	the tasking soft links that are common to the full and the restricted
	run times.

	* s-tarest.adb (Init_RTS): Tasking soft links that are shared with the
	restricted run time has been moved to the package
	System.Soft_Links.Tasking.

	* s-tasini.adb (Init_RTS): Tasking soft links that are shared with the
	restricted run time has been moved to the package
	System.Soft_Links.Tasking.

	* Makefile.rtl: Add entry for s-solita.o in run-time library list.

	* s-solita.ads, s-solita.adb: New files.

2004-07-20  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* trans.c (Identifier_to_gnu, Pragma_to_gnu, Attribute_to_gnu,
	Case_Statement_to_gnu): Split off from gnat_to_gnu.
	(Loop_Statement_to_gnu, Subprogram_Body_to_gnu, call_to_gnu,
	Handled_Sequence_Of_Statements_to_gnu, Exception_Handler_to_gnu_sjlj,
	Exception_Handler_to_gnu_zcx): Likewise.

From-SVN: r84948
parent a6c0a76c
Showing with 509 additions and 319 deletions
gcc/ada/ChangeLog
2004-07-20 Olivier Hainque <hainque@act-europe.fr>
* a-elchha.adb (Last_Chance_Handler): Remove the bogus buffer dynamic
allocation and potentially overflowing update with
Tailored_Exception_Information. Use the sec-stack free procedural
interface to output Exception_Information instead.
* a-except.adb (To_Stderr): New subprogram for character, and string
version moved from a-exextr to be visible from other separate units.
(Tailored_Exception_Information): Remove the procedural version,
previously used by the default Last_Chance_Handler and not any more.
Adjust various comments.
* a-exexda.adb: Generalize the exception information procedural
interface, to minimize the use of secondary stack and the need for
local buffers when the info is to be output to stderr:
(Address_Image): Removed.
(Append_Info_Character): New subprogram, checking for overflows and
outputing to stderr if buffer to fill is of length 0.
(Append_Info_String): Output to stderr if buffer to fill is of length 0.
(Append_Info_Address, Append_Info_Exception_Name,
Append_Info_Exception_Message, Append_Info_Basic_Exception_Information,
Append_Info_Basic_Exception_Traceback,
Append_Info_Exception_Information): New subprograms.
(Append_Info_Nat, Append_Info_NL): Use Append_Info_Character.
(Basic_Exception_Info_Maxlength, Basic_Exception_Tback_Maxlength,
Exception_Info_Maxlength, Exception_Name_Length,
Exception_Message_Length): New subprograms.
(Exception_Information): Use Append_Info_Exception_Information.
(Tailored_Exception_Information): Use
Append_Info_Basic_Exception_Information.
Export services for the default Last_Chance_Handler.
* a-exextr.adb (To_Stderr): Remove. Now in a-except to be usable by
other separate units.
2004-07-20 Vincent Celier <celier@gnat.com>
* clean.adb, mlib-utl.adb, osint.adb, makegpr.adb: Minor reformatting.
2004-07-20 Ed Schonberg <schonberg@gnat.com>
* freeze.adb (Freeze_Entity): If entity is a discriminated record type,
emit itype references for the designated types of component types that
are declared outside of the full record declaration, and that may
denote a partial view of that record type.
2004-07-20 Ed Schonberg <schonberg@gnat.com>
PR ada/15607
* sem_ch3.adb (Build_Discriminated_Subtype): Do not attach a subtype
which is the designated type in an access component declaration, to the
list of incomplete dependents of the parent type, to avoid elaboration
issues with out-of-scope subtypes.
(Complete_Private_Subtype): Recompute Has_Unknown_Discriminants from the
full view of the parent.
2004-07-20 Ed Schonberg <schonberg@gnat.com>
PR ada/15610
* sem_ch8.adb (Find_Expanded_Name): If name is overloaded, reject
entities that are hidden, such as references to generic actuals
outside an instance.
2004-07-20 Javier Miranda <miranda@gnat.com>
* sem_ch4.adb (Try_Object_Operation): New subprogram that gives
support to the new notation.
(Analyze_Selected_Component): Add call to Try_Object_Operation.
2004-07-20 Jose Ruiz <ruiz@act-europe.fr>
* s-taprob.adb: Adding the elaboration code required for initializing
the tasking soft links that are common to the full and the restricted
run times.
* s-tarest.adb (Init_RTS): Tasking soft links that are shared with the
restricted run time has been moved to the package
System.Soft_Links.Tasking.
* s-tasini.adb (Init_RTS): Tasking soft links that are shared with the
restricted run time has been moved to the package
System.Soft_Links.Tasking.
* Makefile.rtl: Add entry for s-solita.o in run-time library list.
* s-solita.ads, s-solita.adb: New files.
2004-07-20 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* trans.c (Identifier_to_gnu, Pragma_to_gnu, Attribute_to_gnu,
Case_Statement_to_gnu): Split off from gnat_to_gnu.
(Loop_Statement_to_gnu, Subprogram_Body_to_gnu, call_to_gnu,
Handled_Sequence_Of_Statements_to_gnu, Exception_Handler_to_gnu_sjlj,
Exception_Handler_to_gnu_zcx): Likewise.
2004-07-17 Joseph S. Myers <jsm@polyomino.org.uk>
* gigi.h (builtin_function): Declare.
......
gcc/ada/Makefile.rtl
......@@ -46,6 +46,7 @@ GNATRTL_TASKING_OBJS= \
s-intman$(objext) \
s-osinte$(objext) \
s-proinf$(objext) \
s-solita$(objext) \
s-taenca$(objext) \
s-taprob$(objext) \
s-taprop$(objext) \
......
gcc/ada/a-elchha.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003 Free Software Foundation, Inc. --
-- Copyright (C) 2003-2004 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -45,83 +45,43 @@ is
pragma Import (C, Unhandled_Terminate, "__gnat_unhandled_terminate");
-- Perform system dependent shutdown code
function Tailored_Exception_Information
(X : Exception_Occurrence) return String;
-- Exception information to be output in the case of automatic tracing
-- requested through GNAT.Exception_Traces.
--
-- This is the same as Exception_Information if no backtrace decorator
-- is currently in place. Otherwise, this is Exception_Information with
-- the call chain raw addresses replaced by the result of a call to the
-- current decorator provided with the call chain addresses.
function Exception_Message_Length
(X : Exception_Occurrence) return Natural;
pragma Import (Ada, Exception_Message_Length, "__gnat_exception_msg_len");
procedure Append_Info_Exception_Message
(X : Exception_Occurrence; Info : in out String; Ptr : in out Natural);
pragma Import
(Ada, Tailored_Exception_Information,
"__gnat_tailored_exception_information");
(Ada, Append_Info_Exception_Message, "__gnat_append_info_e_msg");
procedure Tailored_Exception_Information
(X : Exception_Occurrence;
Buff : in out String;
Last : in out Integer);
-- Procedural version of the above function. Instead of returning the
-- result, this one is put in Buff (Buff'first .. Buff'first + Last)
procedure Append_Info_Exception_Information
(X : Exception_Occurrence; Info : in out String; Ptr : in out Natural);
pragma Import
(Ada, Append_Info_Exception_Information, "__gnat_append_info_e_info");
procedure To_Stderr (S : String);
pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
-- Little routine to output string to stderr
Ptr : Natural := 0;
Nobuf : String (1 .. 0);
Nline : constant String := String'(1 => ASCII.LF);
-- Convenient shortcut
Msg : constant String := Except.Msg (1 .. Except.Msg_Length);
Max_Static_Exc_Info : constant := 1024;
-- This should be enough for most exception information cases
-- even though tailoring introduces some uncertainty. The
-- name+message should not exceed 320 chars, so that leaves at
-- least 35 backtrace slots (each slot needs 19 chars for
-- representing a 64 bit address).
subtype Exc_Info_Type is String (1 .. Max_Static_Exc_Info);
type Str_Ptr is access Exc_Info_Type;
Exc_Info : Str_Ptr;
Exc_Info_Last : Natural := 0;
-- Buffer that is allocated to store the tailored exception
-- information while Adafinal is run. This buffer is allocated
-- on the heap only when it is needed. It is better to allocate
-- on the heap than on the stack since stack overflows are more
-- common than heap overflows.
procedure Tailored_Exception_Information
(X : Exception_Occurrence;
Buff : in out String;
Last : in out Integer)
is
Info : constant String := Tailored_Exception_Information (X);
begin
Last := Info'Last;
Buff (1 .. Last) := Info;
end Tailored_Exception_Information;
begin
-- First allocate & store the exception info in a buffer when
-- we know it will be needed. This needs to be done before
-- Adafinal because it implicitly uses the secondary stack.
if Except.Id.Full_Name.all (1) /= '_'
and then Except.Num_Tracebacks /= 0
then
Exc_Info := new Exc_Info_Type;
if Exc_Info /= null then
Tailored_Exception_Information
(Except, Exc_Info.all, Exc_Info_Last);
end if;
end if;
-- Let's shutdown the runtime now. The rest of the procedure needs to be
-- careful not to use anything that would require runtime support. In
-- particular, functions returning strings are banned since the sec stack
-- is no longer functional. This is particularly important to note for the
-- Exception_Information output. We used to allow the tailored version to
-- show up here, which turned out to be a bad idea as it might involve a
-- traceback decorator the length of which we don't control. Potentially
-- heavy primary/secondary stack use or dynamic allocations right before
-- this point are not welcome, moving the output before the finalization
-- raises order of outputs concerns, and decorators are intended to only
-- be used with exception traces, which should have been issued already.
-- Let's shutdown the runtime now. The rest of the procedure
-- needs to be careful not to use anything that would require
-- runtime support. In particular, functions returning strings
-- are banned since the sec stack is no longer functional.
System.Standard_Library.Adafinal;
-- Check for special case of raising _ABORT_SIGNAL, which is not
......@@ -142,9 +102,9 @@ begin
To_Stderr ("raised ");
To_Stderr (Except.Id.Full_Name.all (1 .. Except.Id.Name_Length - 1));
if Msg'Length /= 0 then
if Exception_Message_Length (Except) /= 0 then
To_Stderr (" : ");
To_Stderr (Msg);
Append_Info_Exception_Message (Except, Nobuf, Ptr);
end if;
To_Stderr (Nline);
......@@ -152,13 +112,11 @@ begin
-- Traceback exists
else
-- Note we can have this whole information output twice if
-- this occurrence gets reraised up to here.
To_Stderr (Nline);
To_Stderr ("Execution terminated by unhandled exception");
To_Stderr (Nline);
To_Stderr (Exc_Info (1 .. Exc_Info_Last));
Append_Info_Exception_Information (Except, Nobuf, Ptr);
end if;
Unhandled_Terminate;
......
gcc/ada/a-except.adb
......@@ -120,6 +120,17 @@ package body Ada.Exceptions is
-- Raise_From_Signal_Handler. The origin of the call is indicated by the
-- From_Signal_Handler argument.
procedure To_Stderr (S : String);
pragma Export (Ada, To_Stderr, "__gnat_to_stderr");
-- Little routine to output string to stderr that is also used
-- in the tasking run time.
procedure To_Stderr (C : Character);
pragma Inline (To_Stderr);
pragma Export (Ada, To_Stderr, "__gnat_to_stderr_char");
-- Little routine to output a character to stderr, used by some of
-- the separate units below.
package Exception_Data is
---------------------------------
......@@ -154,34 +165,40 @@ package body Ada.Exceptions is
function Exception_Information (X : Exception_Occurrence) return String;
-- The format of the exception information is as follows:
--
-- exception name (as in Exception_Name)
-- message (or a null line if no message)
-- PID=nnnn
-- 0xyyyyyyyy 0xyyyyyyyy ...
-- Exception_Name: <exception name> (as in Exception_Name)
-- Message: <message> (only if Exception_Message is empty)
-- PID=nnnn (only if != 0)
-- Call stack traceback locations: (only if at least one location)
-- <0xyyyyyyyy 0xyyyyyyyy ...> (is recorded)
--
-- The lines are separated by a ASCII.LF character
-- The lines are separated by a ASCII.LF character.
-- The nnnn is the partition Id given as decimal digits.
-- The 0x... line represents traceback program counter locations,
-- in order with the first one being the exception location.
-- The 0x... line represents traceback program counter locations, in
-- execution order with the first one being the exception location. It
-- is present only
--
-- The Exception_Name and Message lines are omitted in the abort
-- signal case, since this is not really an exception.
-- !! If the format of the generated string is changed, please note
-- !! that an equivalent modification to the routine String_To_EO must
-- !! be made to preserve proper functioning of the stream attributes.
---------------------------------------
-- Exception backtracing subprograms --
---------------------------------------
-- What is automatically output when exception tracing is on basically
-- corresponds to the usual exception information, but with the call
-- chain backtrace possibly tailored by a backtrace decorator. Modifying
-- Exception_Information itself is not a good idea because the decorated
-- output is completely out of control and would break all our code
-- related to the streaming of exceptions.
--
-- We then provide an alternative function to Exception_Information to
-- compute the possibly tailored output, which is equivalent if no
-- decorator is currently set.
-- What is automatically output when exception tracing is on is the
-- usual exception information with the call chain backtrace possibly
-- tailored by a backtrace decorator. Modifying Exception_Information
-- itself is not a good idea because the decorated output is completely
-- out of control and would break all our code related to the streaming
-- of exceptions. We then provide an alternative function to compute
-- the possibly tailored output, which is equivalent if no decorator is
-- currently set:
function Tailored_Exception_Information
(X : Exception_Occurrence)
return String;
(X : Exception_Occurrence) return String;
-- Exception information to be output in the case of automatic tracing
-- requested through GNAT.Exception_Traces.
--
......@@ -193,28 +210,7 @@ package body Ada.Exceptions is
pragma Export
(Ada, Tailored_Exception_Information,
"__gnat_tailored_exception_information");
-- This function is used within this package but also from within
-- System.Tasking.Stages.
--
-- The output of Exception_Information and
-- Tailored_Exception_Information share a common part which was
-- formerly built using local procedures within
-- Exception_Information. These procedures have been extracted
-- from their original place to be available to
-- Tailored_Exception_Information also.
--
-- Each of these procedures appends some input to an
-- information string currently being built. The Ptr argument
-- represents the last position in this string at which a
-- character has been written.
procedure Tailored_Exception_Information
(X : Exception_Occurrence;
Buff : in out String;
Last : in out Integer);
-- Procedural version of the above function. Instead of returning the
-- result, this one is put in Buff (Buff'first .. Buff'first + Last)
-- And what happens on overflow ???
-- This is currently used by System.Tasking.Stages.
end Exception_Data;
......@@ -234,14 +230,14 @@ package body Ada.Exceptions is
-- routine when the GCC 3 mechanism is used.
procedure Notify_Handled_Exception;
pragma Export (C, Notify_Handled_Exception,
"__gnat_notify_handled_exception");
pragma Export
(C, Notify_Handled_Exception, "__gnat_notify_handled_exception");
-- This routine is called for a handled occurrence is about to be
-- propagated.
procedure Notify_Unhandled_Exception;
pragma Export (C, Notify_Unhandled_Exception,
"__gnat_notify_unhandled_exception");
pragma Export
(C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception");
-- This routine is called when an unhandled occurrence is about to be
-- propagated.
......@@ -1309,6 +1305,30 @@ package body Ada.Exceptions is
Raise_Current_Excep (E);
end Raise_Exception_No_Defer;
---------------
-- To_Stderr --
---------------
procedure To_Stderr (C : Character) is
type int is new Integer;
procedure put_char_stderr (C : int);
pragma Import (C, put_char_stderr, "put_char_stderr");
begin
put_char_stderr (Character'Pos (C));
end To_Stderr;
procedure To_Stderr (S : String) is
begin
for J in S'Range loop
if S (J) /= ASCII.CR then
To_Stderr (S (J));
end if;
end loop;
end To_Stderr;
---------
-- ZZZ --
---------
......
gcc/ada/a-exextr.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 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- --
......@@ -57,8 +57,7 @@ package body Exception_Traces is
procedure Last_Chance_Handler
(Except : Exception_Occurrence);
pragma Import
(C, Last_Chance_Handler, "__gnat_last_chance_handler");
pragma Import (C, Last_Chance_Handler, "__gnat_last_chance_handler");
pragma No_Return (Last_Chance_Handler);
-- Users can replace the default version of this routine,
-- Ada.Exceptions.Last_Chance_Handler.
......@@ -76,11 +75,6 @@ package body Exception_Traces is
-- latter case because Notify_Handled_Exception may be called for an
-- actually unhandled occurrence in the Front-End-SJLJ case.
procedure To_Stderr (S : String);
pragma Export (Ada, To_Stderr, "__gnat_to_stderr");
-- Little routine to output string to stderr that is also used
-- in the tasking run time.
---------------------------------
-- Debugger Interface Routines --
---------------------------------
......@@ -185,8 +179,6 @@ package body Exception_Traces is
-- Unhandled_Exception_Terminate --
-----------------------------------
type int is new Integer;
procedure Unhandled_Exception_Terminate is
Excep : constant EOA := Save_Occurrence (Get_Current_Excep.all.all);
-- This occurrence will be used to display a message after finalization.
......@@ -198,22 +190,6 @@ package body Exception_Traces is
Last_Chance_Handler (Excep.all);
end Unhandled_Exception_Terminate;
---------------
-- To_Stderr --
---------------
procedure To_Stderr (S : String) is
procedure put_char_stderr (C : int);
pragma Import (C, put_char_stderr, "put_char_stderr");
begin
for J in 1 .. S'Length loop
if S (J) /= ASCII.CR then
put_char_stderr (Character'Pos (S (J)));
end if;
end loop;
end To_Stderr;
------------------------------------
-- Handling GNAT.Exception_Traces --
......
gcc/ada/clean.adb
......@@ -1065,7 +1065,7 @@ package body Clean is
begin
-- Do the necessary initializations
Initialize;
Clean.Initialize;
-- Parse the command line, getting the switches and the executable names
......
gcc/ada/freeze.adb
......@@ -3088,6 +3088,44 @@ package body Freeze is
else
Append (F_Node, Result);
end if;
-- A final pass over record types with discriminants. If the type
-- has an incomplete declaration, there may be constrained access
-- subtypes declared elsewhere, which do not depend on the discrimi-
-- nants of the type, and which are used as component types (i.e.
-- the full view is a recursive type). The designated types of these
-- subtypes can only be elaborated after the type itself, and they
-- need an itype reference.
if Ekind (E) = E_Record_Type
and then Has_Discriminants (E)
then
declare
Comp : Entity_Id;
IR : Node_Id;
Typ : Entity_Id;
begin
Comp := First_Component (E);
while Present (Comp) loop
Typ := Etype (Comp);
if Ekind (Comp) = E_Component
and then Is_Access_Type (Typ)
and then Scope (Typ) /= E
and then Base_Type (Designated_Type (Typ)) = E
and then Is_Itype (Designated_Type (Typ))
then
IR := Make_Itype_Reference (Sloc (Comp));
Set_Itype (IR, Designated_Type (Typ));
Append (IR, Result);
end if;
Next_Component (Comp);
end loop;
end;
end if;
end if;
-- When a type is frozen, the first subtype of the type is frozen as
......
gcc/ada/makegpr.adb
......@@ -2938,7 +2938,7 @@ package body Makegpr is
procedure Gprmake is
begin
Initialize;
Makegpr.Initialize;
if Verbose_Mode then
Write_Eol;
......
gcc/ada/mlib-utl.adb
......@@ -66,7 +66,7 @@ package body MLib.Utl is
Line_Length : Natural := 0;
begin
Initialize;
Utl.Initialize;
Arguments :=
new String_List (1 .. 1 + Ar_Options'Length + Objects'Length);
......@@ -177,7 +177,7 @@ package body MLib.Utl is
Driver : String_Access;
begin
Initialize;
Utl.Initialize;
if Driver_Name = No_Name then
Driver := Gcc_Exec;
......
gcc/ada/osint.adb
......@@ -2820,7 +2820,7 @@ begin
Lib_Search_Directories.Set_Last (Primary_Directory);
Lib_Search_Directories.Table (Primary_Directory) := new String'("");
Initialize;
Osint.Initialize;
end Initialization;
end Osint;
gcc/ada/s-solita.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S O F T _ L I N K S . T A S K I N G --
-- --
-- B o d y --
-- --
-- Copyright (C) 2004, 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, 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 the tasking versions soft links.
pragma Style_Checks (All_Checks);
-- Turn off subprogram alpha ordering check, since we group soft link
-- bodies and dummy soft link bodies together separately in this unit.
pragma Polling (Off);
-- Turn polling off for this package. We don't need polling during any
-- of the routines in this package, and more to the point, if we try
-- to poll it can cause infinite loops.
with System.Task_Primitives.Operations;
-- Used for Self
-- Timed_Delay
package body System.Soft_Links.Tasking is
package STPO renames System.Task_Primitives.Operations;
package SSL renames System.Soft_Links;
----------------
-- Local Data --
----------------
Initialized : Boolean := False;
-- Boolean flag that indicates whether the tasking soft links have
-- already been set.
----------------------------------------------------------------------
-- Tasking versions of some services needed by non-tasking programs --
----------------------------------------------------------------------
function Get_Jmpbuf_Address return Address;
procedure Set_Jmpbuf_Address (Addr : Address);
-- Get/Set Jmpbuf_Address for current task
function Get_Sec_Stack_Addr return Address;
procedure Set_Sec_Stack_Addr (Addr : Address);
-- Get/Set location of current task's secondary stack
function Get_Machine_State_Addr return Address;
procedure Set_Machine_State_Addr (Addr : Address);
-- Get/Set the address for storing the current task's machine state
function Get_Current_Excep return SSL.EOA;
-- Task-safe version of SSL.Get_Current_Excep
procedure Timed_Delay_T (Time : Duration; Mode : Integer);
-- Task-safe version of SSL.Timed_Delay
----------------------
-- Soft-Link Bodies --
----------------------
function Get_Current_Excep return SSL.EOA is
begin
return STPO.Self.Common.Compiler_Data.Current_Excep'Access;
end Get_Current_Excep;
function Get_Jmpbuf_Address return Address is
begin
return STPO.Self.Common.Compiler_Data.Jmpbuf_Address;
end Get_Jmpbuf_Address;
function Get_Machine_State_Addr return Address is
begin
return STPO.Self.Common.Compiler_Data.Machine_State_Addr;
end Get_Machine_State_Addr;
function Get_Sec_Stack_Addr return Address is
begin
return STPO.Self.Common.Compiler_Data.Sec_Stack_Addr;
end Get_Sec_Stack_Addr;
procedure Set_Jmpbuf_Address (Addr : Address) is
begin
STPO.Self.Common.Compiler_Data.Jmpbuf_Address := Addr;
end Set_Jmpbuf_Address;
procedure Set_Machine_State_Addr (Addr : Address) is
begin
STPO.Self.Common.Compiler_Data.Machine_State_Addr := Addr;
end Set_Machine_State_Addr;
procedure Set_Sec_Stack_Addr (Addr : Address) is
begin
STPO.Self.Common.Compiler_Data.Sec_Stack_Addr := Addr;
end Set_Sec_Stack_Addr;
procedure Timed_Delay_T (Time : Duration; Mode : Integer) is
begin
STPO.Timed_Delay (STPO.Self, Time, Mode);
end Timed_Delay_T;
-----------------------------
-- Init_Tasking_Soft_Links --
-----------------------------
procedure Init_Tasking_Soft_Links is
begin
-- If the tasking soft links have already been initialized do not
-- repeat it.
if not Initialized then
-- Mark tasking soft links as initialized
Initialized := True;
-- The application being executed uses tasking so that the tasking
-- version of the following soft links need to be used.
SSL.Get_Jmpbuf_Address := Get_Jmpbuf_Address'Access;
SSL.Set_Jmpbuf_Address := Set_Jmpbuf_Address'Access;
SSL.Get_Sec_Stack_Addr := Get_Sec_Stack_Addr'Access;
SSL.Set_Sec_Stack_Addr := Set_Sec_Stack_Addr'Access;
SSL.Get_Machine_State_Addr := Get_Machine_State_Addr'Access;
SSL.Set_Machine_State_Addr := Set_Machine_State_Addr'Access;
SSL.Get_Current_Excep := Get_Current_Excep'Access;
SSL.Timed_Delay := Timed_Delay_T'Access;
-- No need to create a new Secondary Stack, since we will use the
-- default one created in s-secsta.adb
SSL.Set_Sec_Stack_Addr (SSL.Get_Sec_Stack_Addr_NT);
SSL.Set_Jmpbuf_Address (SSL.Get_Jmpbuf_Address_NT);
SSL.Set_Machine_State_Addr (SSL.Get_Machine_State_Addr_NT);
end if;
end Init_Tasking_Soft_Links;
end System.Soft_Links.Tasking;
gcc/ada/s-solita.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S O F T _ L I N K S . T A S K I N G --
-- --
-- S p e c --
-- --
-- Copyright (C) 2004, 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, 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 the tasking versions soft links that are common
-- to the full and the restricted run times. The rest of the required soft
-- links are set by System.Tasking.Initialization and System.Tasking.Stages
-- (full run time) or System.Tasking.Restricted.Stages (restricted run
-- time).
package System.Soft_Links.Tasking is
procedure Init_Tasking_Soft_Links;
-- Set the tasking soft links that are common to the full and the
-- restricted run times.
end System.Soft_Links.Tasking;
gcc/ada/s-taprob.adb
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2003, Ada Core Technologies --
-- Copyright (C) 1995-2004, Ada Core Technologies --
-- --
-- GNARL 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- --
......@@ -46,6 +46,9 @@ with System.Parameters;
with System.Traces;
-- used for Send_Trace_Info
with System.Soft_Links.Tasking;
-- Used for Init_Tasking_Soft_Links
package body System.Tasking.Protected_Objects is
use System.Task_Primitives.Operations;
......@@ -137,4 +140,8 @@ package body System.Tasking.Protected_Objects is
end if;
end Unlock;
begin
-- Ensure that tasking soft links are set when using protected objects
System.Soft_Links.Tasking.Init_Tasking_Soft_Links;
end System.Tasking.Protected_Objects;
gcc/ada/s-tarest.adb
......@@ -67,6 +67,9 @@ with System.Soft_Links;
-- The GNARL must call these to be sure that all non-tasking
-- Ada constructs will work.
with System.Soft_Links.Tasking;
-- Used for Init_Tasking_Soft_Links
with System.Secondary_Stack;
-- used for SS_Init;
......@@ -105,21 +108,6 @@ package body System.Tasking.Restricted.Stages is
-- all nested locks must be released before other tasks competing for the
-- tasking lock are released.
-- See s-tasini.adb for more information on the following functions.
function Get_Jmpbuf_Address return Address;
procedure Set_Jmpbuf_Address (Addr : Address);
function Get_Sec_Stack_Addr return Address;
procedure Set_Sec_Stack_Addr (Addr : Address);
function Get_Machine_State_Addr return Address;
procedure Set_Machine_State_Addr (Addr : Address);
function Get_Current_Excep return SSL.EOA;
procedure Timed_Delay_T (Time : Duration; Mode : Integer);
-----------------------
-- Local Subprograms --
-----------------------
......@@ -158,45 +146,6 @@ package body System.Tasking.Restricted.Stages is
STPO.Unlock (Global_Task_Lock'Access, Global_Lock => True);
end Task_Unlock;
----------------------
-- Soft-Link Bodies --
----------------------
function Get_Current_Excep return SSL.EOA is
begin
return STPO.Self.Common.Compiler_Data.Current_Excep'Access;
end Get_Current_Excep;
function Get_Jmpbuf_Address return Address is
begin
return STPO.Self.Common.Compiler_Data.Jmpbuf_Address;
end Get_Jmpbuf_Address;
function Get_Machine_State_Addr return Address is
begin
return STPO.Self.Common.Compiler_Data.Machine_State_Addr;
end Get_Machine_State_Addr;
function Get_Sec_Stack_Addr return Address is
begin
return STPO.Self.Common.Compiler_Data.Sec_Stack_Addr;
end Get_Sec_Stack_Addr;
procedure Set_Jmpbuf_Address (Addr : Address) is
begin
STPO.Self.Common.Compiler_Data.Jmpbuf_Address := Addr;
end Set_Jmpbuf_Address;
procedure Set_Machine_State_Addr (Addr : Address) is
begin
STPO.Self.Common.Compiler_Data.Machine_State_Addr := Addr;
end Set_Machine_State_Addr;
procedure Set_Sec_Stack_Addr (Addr : Address) is
begin
STPO.Self.Common.Compiler_Data.Sec_Stack_Addr := Addr;
end Set_Sec_Stack_Addr;
------------------
-- Task_Wrapper --
------------------
......@@ -262,15 +211,6 @@ package body System.Tasking.Restricted.Stages is
end;
end Task_Wrapper;
-------------------
-- Timed_Delay_T --
-------------------
procedure Timed_Delay_T (Time : Duration; Mode : Integer) is
begin
STPO.Timed_Delay (STPO.Self, Time, Mode);
end Timed_Delay_T;
-----------------------
-- Restricted GNARLI --
-----------------------
......@@ -566,27 +506,14 @@ package body System.Tasking.Restricted.Stages is
-- Notify that the tasking run time has been elaborated so that
-- the tasking version of the soft links can be used.
SSL.Lock_Task := Task_Lock'Access;
SSL.Unlock_Task := Task_Unlock'Access;
SSL.Get_Jmpbuf_Address := Get_Jmpbuf_Address'Access;
SSL.Set_Jmpbuf_Address := Set_Jmpbuf_Address'Access;
SSL.Get_Machine_State_Addr := Get_Machine_State_Addr'Access;
SSL.Set_Machine_State_Addr := Set_Machine_State_Addr'Access;
SSL.Get_Current_Excep := Get_Current_Excep'Access;
SSL.Set_Jmpbuf_Address (SSL.Get_Jmpbuf_Address_NT);
SSL.Set_Machine_State_Addr (SSL.Get_Machine_State_Addr_NT);
SSL.Get_Sec_Stack_Addr := Get_Sec_Stack_Addr'Access;
SSL.Set_Sec_Stack_Addr := Set_Sec_Stack_Addr'Access;
-- No need to create a new Secondary Stack, since we will use the
-- default one created in s-secsta.adb
SSL.Lock_Task := Task_Lock'Access;
SSL.Unlock_Task := Task_Unlock'Access;
SSL.Adafinal := Finalize_Global_Tasks'Access;
Set_Sec_Stack_Addr (SSL.Get_Sec_Stack_Addr_NT);
-- Initialize the tasking soft links (if not done yet) that are common
-- to the full and the restricted run times.
SSL.Timed_Delay := Timed_Delay_T'Access;
SSL.Adafinal := Finalize_Global_Tasks'Access;
SSL.Tasking.Init_Tasking_Soft_Links;
end Init_RTS;
begin
......
gcc/ada/s-tasini.adb
......@@ -60,6 +60,9 @@ with System.Soft_Links;
-- used for the non-tasking routines (*_NT) that refer to global data.
-- They are needed here before the tasking run time has been elaborated.
with System.Soft_Links.Tasking;
-- Used for Init_Tasking_Soft_Links
with System.Tasking.Debug;
-- used for Trace
......@@ -87,9 +90,9 @@ package body System.Tasking.Initialization is
(Ada, Current_Target_Exception, "__gnat_current_target_exception");
-- Import this subprogram from the private part of Ada.Exceptions.
-----------------------------------------------------------------
-- Tasking versions of services needed by non-tasking programs --
-----------------------------------------------------------------
----------------------------------------------------------------------
-- Tasking versions of some services needed by non-tasking programs --
----------------------------------------------------------------------
procedure Task_Lock;
-- Locks out other tasks. Preceding a section of code by Task_Lock and
......@@ -104,14 +107,6 @@ package body System.Tasking.Initialization is
-- all nested locks must be released before other tasks competing for the
-- tasking lock are released.
function Get_Jmpbuf_Address return Address;
procedure Set_Jmpbuf_Address (Addr : Address);
-- Get/Set Jmpbuf_Address for current task
function Get_Sec_Stack_Addr return Address;
procedure Set_Sec_Stack_Addr (Addr : Address);
-- Get/Set location of current task's secondary stack
function Get_Exc_Stack_Addr return Address;
-- Get the exception stack for the current task
......@@ -119,16 +114,6 @@ package body System.Tasking.Initialization is
-- Self_ID is the Task_Id of the task that gets the exception stack.
-- For Self_ID = Null_Address, the current task gets the exception stack.
function Get_Machine_State_Addr return Address;
procedure Set_Machine_State_Addr (Addr : Address);
-- Get/Set the address for storing the current task's machine state
function Get_Current_Excep return SSL.EOA;
-- Task-safe version of SSL.Get_Current_Excep
procedure Timed_Delay_T (Time : Duration; Mode : Integer);
-- Task-safe version of SSL.Timed_Delay
function Get_Stack_Info return Stack_Checking.Stack_Access;
-- Get access to the current task's Stack_Info
......@@ -404,30 +389,21 @@ package body System.Tasking.Initialization is
SSL.Abort_Undefer := Undefer_Abortion'Access;
end if;
SSL.Update_Exception := Update_Exception'Access;
SSL.Lock_Task := Task_Lock'Access;
SSL.Unlock_Task := Task_Unlock'Access;
SSL.Get_Jmpbuf_Address := Get_Jmpbuf_Address'Access;
SSL.Set_Jmpbuf_Address := Set_Jmpbuf_Address'Access;
SSL.Get_Sec_Stack_Addr := Get_Sec_Stack_Addr'Access;
SSL.Set_Sec_Stack_Addr := Set_Sec_Stack_Addr'Access;
SSL.Get_Exc_Stack_Addr := Get_Exc_Stack_Addr'Access;
SSL.Set_Exc_Stack_Addr := Set_Exc_Stack_Addr'Access;
SSL.Get_Machine_State_Addr := Get_Machine_State_Addr'Access;
SSL.Set_Machine_State_Addr := Set_Machine_State_Addr'Access;
SSL.Get_Current_Excep := Get_Current_Excep'Access;
SSL.Timed_Delay := Timed_Delay_T'Access;
SSL.Check_Abort_Status := Check_Abort_Status'Access;
SSL.Get_Stack_Info := Get_Stack_Info'Access;
SSL.Task_Name := Task_Name'Access;
-- No need to create a new Secondary Stack, since we will use the
-- default one created in s-secsta.adb
SSL.Set_Sec_Stack_Addr (SSL.Get_Sec_Stack_Addr_NT);
SSL.Set_Exc_Stack_Addr (Null_Address, SSL.Get_Exc_Stack_Addr_NT);
SSL.Set_Jmpbuf_Address (SSL.Get_Jmpbuf_Address_NT);
SSL.Set_Machine_State_Addr (SSL.Get_Machine_State_Addr_NT);
SSL.Update_Exception := Update_Exception'Access;
SSL.Lock_Task := Task_Lock'Access;
SSL.Unlock_Task := Task_Unlock'Access;
SSL.Get_Exc_Stack_Addr := Get_Exc_Stack_Addr'Access;
SSL.Set_Exc_Stack_Addr := Set_Exc_Stack_Addr'Access;
SSL.Check_Abort_Status := Check_Abort_Status'Access;
SSL.Get_Stack_Info := Get_Stack_Info'Access;
SSL.Task_Name := Task_Name'Access;
SSL.Set_Exc_Stack_Addr (Null_Address, SSL.Get_Exc_Stack_Addr_NT);
-- Initialize the tasking soft links (if not done yet) that are common
-- to the full and the restricted run times.
SSL.Tasking.Init_Tasking_Soft_Links;
-- Install tasking locks in the GCC runtime.
......@@ -920,31 +896,11 @@ package body System.Tasking.Initialization is
-- Soft-Link Bodies --
----------------------
function Get_Current_Excep return SSL.EOA is
begin
return STPO.Self.Common.Compiler_Data.Current_Excep'Access;
end Get_Current_Excep;
function Get_Exc_Stack_Addr return Address is
begin
return STPO.Self.Common.Compiler_Data.Exc_Stack_Addr;
end Get_Exc_Stack_Addr;
function Get_Jmpbuf_Address return Address is
begin
return STPO.Self.Common.Compiler_Data.Jmpbuf_Address;
end Get_Jmpbuf_Address;
function Get_Machine_State_Addr return Address is
begin
return STPO.Self.Common.Compiler_Data.Machine_State_Addr;
end Get_Machine_State_Addr;
function Get_Sec_Stack_Addr return Address is
begin
return STPO.Self.Common.Compiler_Data.Sec_Stack_Addr;
end Get_Sec_Stack_Addr;
function Get_Stack_Info return Stack_Checking.Stack_Access is
begin
return STPO.Self.Common.Compiler_Data.Pri_Stack_Info'Access;
......@@ -960,26 +916,6 @@ package body System.Tasking.Initialization is
Me.Common.Compiler_Data.Exc_Stack_Addr := Addr;
end Set_Exc_Stack_Addr;
procedure Set_Jmpbuf_Address (Addr : Address) is
begin
STPO.Self.Common.Compiler_Data.Jmpbuf_Address := Addr;
end Set_Jmpbuf_Address;
procedure Set_Machine_State_Addr (Addr : Address) is
begin
STPO.Self.Common.Compiler_Data.Machine_State_Addr := Addr;
end Set_Machine_State_Addr;
procedure Set_Sec_Stack_Addr (Addr : Address) is
begin
STPO.Self.Common.Compiler_Data.Sec_Stack_Addr := Addr;
end Set_Sec_Stack_Addr;
procedure Timed_Delay_T (Time : Duration; Mode : Integer) is
begin
STPO.Timed_Delay (STPO.Self, Time, Mode);
end Timed_Delay_T;
-----------------------
-- Soft-Link Dummies --
-----------------------
......
gcc/ada/sem_ch3.adb
......@@ -6075,11 +6075,22 @@ package body Sem_Ch3 is
Set_Ekind (Def_Id, E_Class_Wide_Subtype);
else
-- Incomplete type. Attach subtype to list of dependents, to be
-- completed with full view of parent type.
-- Incomplete type. attach subtype to list of dependents, to be
-- completed with full view of parent type, unless is it the
-- designated subtype of a record component within an init_proc.
-- This last case arises for a component of an access type whose
-- designated type is incomplete (e.g. a Taft Amendment type).
-- The designated subtype is within an inner scope, and needs no
-- elaboration, because only the access type is needed in the
-- initialization procedure.
Set_Ekind (Def_Id, Ekind (T));
Append_Elmt (Def_Id, Private_Dependents (T));
if For_Access and then Within_Init_Proc then
null;
else
Append_Elmt (Def_Id, Private_Dependents (T));
end if;
end if;
Set_Etype (Def_Id, T);
......@@ -6831,6 +6842,12 @@ package body Sem_Ch3 is
if Has_Discriminants (Full_Base) then
Set_Discriminant_Constraint
(Full, Discriminant_Constraint (Full_Base));
-- The partial view may have been indefinite, the full view
-- might not be.
Set_Has_Unknown_Discriminants
(Full, Has_Unknown_Discriminants (Full_Base));
end if;
end if;
......
gcc/ada/sem_ch8.adb
......@@ -3592,7 +3592,11 @@ package body Sem_Ch8 is
begin
while Present (H) loop
if Scope (H) = Scope (Id) then
if Scope (H) = Scope (Id)
and then
(not Is_Hidden (H)
or else Is_Immediately_Visible (H))
then
Collect_Interps (N);
exit;
end if;
......
gcc/ada/trans.c
This source diff could not be displayed because it is too large. You can view the blob instead.
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