Skip to content

R
riscv-gcc-1
Commit 3a77b68d by Geert Bosch
Options

gnat_rm.texi: Fix minor typos. 

	* gnat_rm.texi: Fix minor typos. Found while reading the section
	regarding "Bit_Order Clauses" that was sent to a customer.
	Very interesting documentation!

	* sem_case.adb (Choice_Image): Avoid creating improper character
	literal names by using the routine Set_Character_Literal_Name. This
	fixes bombs in certain error message cases.

	* a-reatim.adb: Minor reformatting.

	* sem_ch12.adb (Validate_Derived_Type_Instance): Handle properly the
	case where the formal is an extension of another formal in the current
	unit or in a parent generic unit.

	* s-tposen.adb: Update comments.  Minor reformatting.
	Minor code clean up.

	* s-tarest.adb: Update comments.  Minor code reorganization.

	* exp_attr.adb (Attribute_Tag): Suppress expansion of <type_name>'Tag
	when Java_VM.

	* exp_attr.adb: Minor reformatting

	* sem_ch3.adb (Build_Derived_Private_Type): Refine check to handle
	derivations nested within a child unit: verify that the parent
	type is declared in an outer scope.

	* sem_ch12.adb: Minor reformatting

	* sem_warn.adb (Check_One_Unit): In No_Run_Time mode, do not post
	warning if current unit is a predefined one, from which bodies may
	have been deleted.

	* eval_fat.ads: Add comment that Round_Even is referenced in Ada code
	Fix header format. Add 2001 to copyright date.

	* exp_dbug.adb (Get_Encoded_Name): Fix out of bounds reference,
	which caused CE during compilation if checks were enabled.

From-SVN: r48136
parent ced7d98b
Showing with 152 additions and 69 deletions
gcc/ada/ChangeLog
2001-12-17 Joel Brobecker <brobecke@gnat.com>
* gnat_rm.texi: Fix minor typos. Found while reading the section
regarding "Bit_Order Clauses" that was sent to a customer.
Very interesting documentation!
2001-12-17 Robert Dewar <dewar@gnat.com>
* sem_case.adb (Choice_Image): Avoid creating improper character
literal names by using the routine Set_Character_Literal_Name. This
fixes bombs in certain error message cases.
2001-12-17 Arnaud Charlet <charlet@gnat.com>
* a-reatim.adb: Minor reformatting.
2001-12-17 Ed Schonberg <schonber@gnat.com>
* sem_ch12.adb (Validate_Derived_Type_Instance): Handle properly the
case where the formal is an extension of another formal in the current
unit or in a parent generic unit.
2001-12-17 Arnaud Charlet <charlet@gnat.com>
* s-tposen.adb: Update comments. Minor reformatting.
Minor code clean up.
* s-tarest.adb: Update comments. Minor code reorganization.
2001-12-17 Gary Dismukes <dismukes@gnat.com>
* exp_attr.adb (Attribute_Tag): Suppress expansion of <type_name>'Tag
when Java_VM.
2001-12-17 Robert Dewar <dewar@gnat.com>
* exp_attr.adb: Minor reformatting
2001-12-17 Ed Schonberg <schonber@gnat.com>
* sem_ch3.adb (Build_Derived_Private_Type): Refine check to handle
derivations nested within a child unit: verify that the parent
type is declared in an outer scope.
2001-12-17 Robert Dewar <dewar@gnat.com>
* sem_ch12.adb: Minor reformatting
2001-12-17 Ed Schonberg <schonber@gnat.com>
* sem_warn.adb (Check_One_Unit): In No_Run_Time mode, do not post
warning if current unit is a predefined one, from which bodies may
have been deleted.
2001-12-17 Robert Dewar <dewar@gnat.com>
* eval_fat.ads: Add comment that Round_Even is referenced in Ada code
Fix header format. Add 2001 to copyright date.
* exp_dbug.adb (Get_Encoded_Name): Fix out of bounds reference,
which caused CE during compilation if checks were enabled.
2001-12-17 Vincent Celier <celier@gnat.com>
* make.adb:
......
gcc/ada/a-reatim.adb
......@@ -174,8 +174,7 @@ package body Ada.Real_Time is
-- Extract the integer part of T, truncating towards zero.
if T_Val < 0.5 then
SC := 0;
SC := 0;
else
SC := Seconds_Count (Time_Span' (T_Val - 0.5));
end if;
......
gcc/ada/eval_fat.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- $Revision$
-- --
-- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2001 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- --
......@@ -49,7 +49,9 @@ package Eval_Fat is
-- The compile time representation of the floating-point root type
type Rounding_Mode is (Floor, Ceiling, Round, Round_Even);
for Rounding_Mode use (0, 1, 2, 3);
-- Used to indicate rounding mode for Machine attribute
-- Note that C code in gigi knows that Round_Even is 3
Rounding_Was_Biased : Boolean;
-- Set if last use of Machine rounded a halfway case away from zero
......
gcc/ada/exp_attr.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.304 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -3083,9 +3083,16 @@ package body Exp_Attr is
Ttyp := Underlying_Type (Ttyp);
if Prefix_Is_Type then
Rewrite (N,
Unchecked_Convert_To (RTE (RE_Tag),
New_Reference_To (Access_Disp_Table (Ttyp), Loc)));
-- For JGNAT we leave the type attribute unexpanded because
-- there's not a dispatching table to reference.
if not Java_VM then
Rewrite (N,
Unchecked_Convert_To (RTE (RE_Tag),
New_Reference_To (Access_Disp_Table (Ttyp), Loc)));
Analyze_And_Resolve (N, RTE (RE_Tag));
end if;
else
Rewrite (N,
......@@ -3093,9 +3100,8 @@ package body Exp_Attr is
Prefix => Relocate_Node (Pref),
Selector_Name =>
New_Reference_To (Tag_Component (Ttyp), Loc)));
Analyze_And_Resolve (N, RTE (RE_Tag));
end if;
Analyze_And_Resolve (N, RTE (RE_Tag));
end Tag;
----------------
......
gcc/ada/exp_dbug.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.56 $
-- $Revision$
-- --
-- Copyright (C) 1996-2001 Free Software Foundation, Inc. --
-- --
......@@ -705,9 +705,13 @@ package body Exp_Dbug is
-- Or if this is a dummy type for a renaming
or else Name_Buffer (Name_Len - 2 .. Name_Len) = "_XR"
or else Name_Buffer (Name_Len - 3 .. Name_Len) = "_XRE"
or else Name_Buffer (Name_Len - 3 .. Name_Len) = "_XRP"
or else (Name_Len >= 3 and then
Name_Buffer (Name_Len - 2 .. Name_Len) = "_XR")
or else (Name_Len >= 4 and then
(Name_Buffer (Name_Len - 3 .. Name_Len) = "_XRE"
or else
Name_Buffer (Name_Len - 3 .. Name_Len) = "_XRP"))
-- For all these cases, just return the name unchanged
......
gcc/ada/gnat_rm.texi
......@@ -9,7 +9,7 @@
@c o
@c G N A T _ RM o
@c o
@c $Revision: 1.1 $
@c $Revision$
@c o
@c Copyright (C) 1992-2001 Ada Core Technologies, Inc. o
@c o
......@@ -39,8 +39,8 @@
@title GNAT Reference Manual
@subtitle GNAT, The GNU Ada 95 Compiler
@subtitle Version 3.15w
@subtitle Document revision level $Revision: 1.1 $
@subtitle Date: $Date: 2001/10/26 13:55:51 $
@subtitle Document revision level $Revision$
@subtitle Date: $Date$
@author Ada Core Technologies, Inc.
@page
......@@ -84,7 +84,7 @@ GNAT, The GNU Ada 95 Compiler
Version 3.14a
Date: $Date: 2001/10/26 13:55:51 $
Date: $Date$
Ada Core Technologies, Inc.
......@@ -7830,7 +7830,7 @@ will be flagged as illegal by GNAT@.
Since the misconception that Bit_Order automatically deals with all
endian-related incompatibilities is a common one, the specification of
a component field that is an integral number of bytes will always
generate a warning This warning may be suppressed using
generate a warning. This warning may be suppressed using
@code{pragma Suppress} if desired. The following section contains additional
details regarding the issue of byte ordering.
......@@ -7840,7 +7840,7 @@ details regarding the issue of byte ordering.
@cindex ordering, of bytes
@noindent
In this section we will review the effec of the @code{Bit_Order} attribute
In this section we will review the effect of the @code{Bit_Order} attribute
definition clause on byte ordering. Briefly, it has no effect at all, but
a detailed example will be helpful. Before giving this
example, let us review the precise
......
gcc/ada/s-tarest.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.13 $
-- $Revision$
-- --
-- Copyright (C) 1999-2001 Ada Core Technologies --
-- --
......@@ -253,9 +253,9 @@ package body System.Tasking.Restricted.Stages is
Self_ID.Common.Task_Entry_Point (Self_ID.Common.Task_Arg);
Terminate_Task (Self_ID);
exception -- not needed in no exc mode
when others => -- not needed in no exc mode
Terminate_Task (Self_ID); -- not needed in no exc mode
exception
when others =>
Terminate_Task (Self_ID);
end;
end Task_Wrapper;
......@@ -285,10 +285,10 @@ package body System.Tasking.Restricted.Stages is
procedure Activate_Restricted_Tasks
(Chain_Access : Activation_Chain_Access)
is
Self_ID : constant Task_ID := STPO.Self;
C : Task_ID;
Activate_Prio : System.Any_Priority;
Success : Boolean;
Self_ID : constant Task_ID := STPO.Self;
C : Task_ID;
Activate_Prio : System.Any_Priority;
Success : Boolean;
begin
pragma Assert (Self_ID = Environment_Task);
......@@ -525,22 +525,25 @@ package body System.Tasking.Restricted.Stages is
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_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.Adafinal := Finalize_Global_Tasks'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.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);
Set_Sec_Stack_Addr (SSL.Get_Sec_Stack_Addr_NT);
SSL.Timed_Delay := Timed_Delay_T'Access;
SSL.Adafinal := Finalize_Global_Tasks'Access;
end Init_RTS;
begin
......
gcc/ada/s-tposen.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.14 $
-- $Revision$
-- --
-- Copyright (C) 1998-2001 Ada Core Technologies --
-- --
......@@ -141,6 +141,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is
(Self_Id : Task_ID;
Object : Protection_Entry_Access;
Entry_Call : Entry_Call_Link);
-- This procedure executes or queues an entry call, depending
-- on the status of the corresponding barrier. It assumes that the
-- specified object is locked.
---------------------
-- Check_Exception --
......@@ -150,11 +153,11 @@ package body System.Tasking.Protected_Objects.Single_Entry is
(Self_ID : Task_ID;
Entry_Call : Entry_Call_Link)
is
use type Ada.Exceptions.Exception_Id;
procedure Internal_Raise (X : Ada.Exceptions.Exception_Id);
pragma Import (C, Internal_Raise, "__gnat_raise_with_msg");
use type Ada.Exceptions.Exception_Id;
E : constant Ada.Exceptions.Exception_Id :=
Entry_Call.Exception_To_Raise;
......@@ -188,8 +191,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
procedure Wait_For_Completion
(Self_ID : Task_ID;
Entry_Call : Entry_Call_Link)
is
Entry_Call : Entry_Call_Link) is
begin
pragma Assert (Self_ID = Entry_Call.Self);
Self_ID.Common.State := Entry_Caller_Sleep;
......@@ -416,18 +418,17 @@ package body System.Tasking.Protected_Objects.Single_Entry is
STPO.Unlock (Entry_Call.Self);
end if;
exception -- not needed in no exc mode
when others => -- not needed in no exc mode
Send_Program_Error -- not needed in no exc mode
(Self_Id, Entry_Call); -- not needed in no exc mode
exception
when others =>
Send_Program_Error
(Self_Id, Entry_Call);
end PO_Do_Or_Queue;
----------------------------
-- Protected_Single_Count --
----------------------------
function Protected_Count_Entry
(Object : Protection_Entry) return Natural is
function Protected_Count_Entry (Object : Protection_Entry) return Natural is
begin
if Object.Call_In_Progress /= null then
return 1;
......@@ -469,14 +470,12 @@ package body System.Tasking.Protected_Objects.Single_Entry is
pragma Assert (Entry_Call.State /= Cancelled);
if Entry_Call.State = Done then
Check_Exception (Self_Id, Entry_Call'Access);
return;
if Entry_Call.State /= Done then
STPO.Write_Lock (Self_Id);
Wait_For_Completion (Self_Id, Entry_Call'Access);
STPO.Unlock (Self_Id);
end if;
STPO.Write_Lock (Self_Id);
Wait_For_Completion (Self_Id, Entry_Call'Access);
STPO.Unlock (Self_Id);
Check_Exception (Self_Id, Entry_Call'Access);
end Protected_Single_Entry_Call;
......@@ -496,20 +495,16 @@ package body System.Tasking.Protected_Objects.Single_Entry is
procedure Service_Entry (Object : Protection_Entry_Access) is
Self_Id : constant Task_ID := STPO.Self;
Entry_Call : Entry_Call_Link;
Entry_Call : constant Entry_Call_Link := Object.Entry_Queue;
Caller : Task_ID;
Barrier_Value : Boolean;
begin
Entry_Call := Object.Entry_Queue;
if Entry_Call /= null then
Barrier_Value :=
Object.Entry_Body.Barrier (Object.Compiler_Info, 1);
Barrier_Value := Object.Entry_Body.Barrier (Object.Compiler_Info, 1);
if Barrier_Value then
if Object.Call_In_Progress /= null then
-- This violates the No_Entry_Queue restriction, send
-- Program_Error to the caller.
......@@ -528,10 +523,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is
end if;
end if;
exception -- not needed in no exc mode
when others => -- not needed in no exc mode
Send_Program_Error -- not needed in no exc mode
(Self_Id, Entry_Call); -- not needed in no exc mode
exception
when others =>
Send_Program_Error (Self_Id, Entry_Call);
end Service_Entry;
---------------------------------------
......
gcc/ada/sem_case.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.13 $
-- $Revision$
-- --
-- Copyright (C) 1996-2001 Free Software Foundation, Inc. --
-- --
......@@ -264,10 +264,7 @@ package body Sem_Case is
C := UI_To_Int (Value);
if C in 16#20# .. 16#7E# then
Name_Buffer (1) := ''';
Name_Buffer (2) := Character'Val (C);
Name_Buffer (3) := ''';
Name_Len := 3;
Set_Character_Literal_Name (Char_Code (UI_To_Int (Value)));
return Name_Find;
end if;
......
gcc/ada/sem_ch12.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.14 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
......@@ -7212,7 +7212,13 @@ package body Sem_Ch12 is
Ancestor :=
Get_Instance_Of (Base_Type (Etype (A_Gen_T)));
elsif Is_Derived_Type (Get_Instance_Of (A_Gen_T)) then
-- The type may be a local derivation, or a type extension of
-- a previous formal, or of a formal of a parent package.
elsif Is_Derived_Type (Get_Instance_Of (A_Gen_T))
or else
Ekind (Get_Instance_Of (A_Gen_T)) = E_Record_Type_With_Private
then
Ancestor :=
Get_Instance_Of (Base_Type (Get_Instance_Of (A_Gen_T)));
......
gcc/ada/sem_ch3.adb
......@@ -3856,6 +3856,7 @@ package body Sem_Ch3 is
if Is_Child_Unit (Scope (Current_Scope))
and then Is_Completion
and then In_Private_Part (Current_Scope)
and then Scope (Parent_Type) /= Current_Scope
then
-- This is the unusual case where a type completed by a private
-- derivation occurs within a package nested in a child unit,
......
gcc/ada/sem_warn.adb
......@@ -674,6 +674,15 @@ package body Sem_Warn is
if Unit = Spec_Unit then
Set_Unreferenced_In_Spec (Item);
-- In No_Run_Time_Mode, we remove the bodies of non-
-- inlined subprograms, which may lead to spurious
-- warnings, clearly undesirable.
elsif No_Run_Time
and then Is_Predefined_File_Name (Unit_File_Name (Unit))
then
null;
-- Otherwise simple unreferenced message
else
......
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