Skip to content

R
riscv-gcc-1
Commit 9b94bf9e by Joseph Myers
Options

* ChangeLog: Remove piece of diff output. 

From-SVN: r48051
parent 1e2bba35
Showing with 4 additions and 770 deletions
gcc/ada/ChangeLog
2001-12-16 Joseph S. Myers <jsm28@cam.ac.uk>
* ChangeLog: Remove piece of diff output.
2001-12-14 Geert Bosch <bosch@gnat.com>
* config-lang.in: Update copyright notice
......@@ -103,776 +107,6 @@
* g-dirope.adb (Expand_Path.Var): Correctly detect end of
variable name.
*** s-stalib.adb 2001/09/03 15:24:33 1.17
--- s-stalib.adb 2001/10/16 13:14:46 1.18
***************
*** 46,59 ****
-- elaboration circularities with Ada.Exceptions if polling is on.
with System.Soft_Links;
! -- Referenced directly from generated code
! -- Also referenced from exception handling routines.
-- This is needed for programs that don't use exceptions explicitely but
-- direct calls to Ada.Exceptions are generated by gigi (for example,
-- by calling __gnat_raise_constraint_error directly).
with System.Memory;
! -- Referenced directly from generated code
package body System.Standard_Library is
--- 46,62 ----
-- elaboration circularities with Ada.Exceptions if polling is on.
with System.Soft_Links;
! -- Referenced directly from generated code using external symbols so it
! -- must always be present in a build, even if no unit has a direct with
! -- of this unit. Also referenced from exception handling routines.
-- This is needed for programs that don't use exceptions explicitely but
-- direct calls to Ada.Exceptions are generated by gigi (for example,
-- by calling __gnat_raise_constraint_error directly).
with System.Memory;
! -- Referenced directly from generated code using external symbols, so it
! -- must always be present in a build, even if no unit has a direct with
! -- of this unit.
package body System.Standard_Library is
*** par-ch12.adb 2001/10/19 15:22:18 1.48
--- par-ch12.adb 2001/10/19 15:24:48 1.49
***************
*** 452,466 ****
if Def_Node /= Error then
Set_Formal_Type_Definition (Decl_Node, Def_Node);
TF_Semicolon;
else
Decl_Node := Error;
if Token = Tok_Semicolon then
- -- Avoid further cascaded errors.
Scan;
end if;
end if;
-
return Decl_Node;
end P_Formal_Type_Declaration;
--- 452,467 ----
if Def_Node /= Error then
Set_Formal_Type_Definition (Decl_Node, Def_Node);
TF_Semicolon;
+
else
Decl_Node := Error;
+ -- If we have semicolon, skip it to avoid cascaded errors
+
if Token = Tok_Semicolon then
Scan;
end if;
end if;
return Decl_Node;
end P_Formal_Type_Declaration;
*** prj-dect.ads 2001/10/20 10:28:13 1.4
--- prj-dect.ads 2001/10/20 11:43:56 1.5
***************
*** 8,14 ****
-- --
-- $Revision$
-- --
! -- Copyright (C) 2000-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- --
--- 8,14 ----
-- --
-- $Revision$
-- --
! -- Copyright (C) 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- --
*** s-arit64.adb 2001/02/09 15:10:29 1.16
--- s-arit64.adb 2001/10/20 14:50:39 1.17
***************
*** 325,337 ****
T2 := Xhi * Ylo;
end if;
! else
! if Yhi /= 0 then
! T2 := Xlo * Yhi;
! else
! return X * Y;
! end if;
end if;
T1 := Xlo * Ylo;
T2 := T2 + Hi (T1);
--- 325,339 ----
T2 := Xhi * Ylo;
end if;
! elsif Yhi /= 0 then
! T2 := Xlo * Yhi;
!
! else -- Yhi = Xhi = 0
! T2 := 0;
end if;
+
+ -- Here we have T2 set to the contribution to the upper half
+ -- of the result from the upper halves of the input values.
T1 := Xlo * Ylo;
T2 := T2 + Hi (T1);
*** s-fatgen.ads 2001/07/20 00:59:34 1.9
--- s-fatgen.ads 2001/10/20 18:37:39 1.10
***************
*** 89,97 ****
function Unbiased_Rounding (X : T) return T;
! function Valid (X : access T) return Boolean;
! -- The argument must be passed by reference here, as T may be
! -- an abnormal value that can be passed in a floating point register.
private
pragma Inline (Machine);
--- 89,100 ----
function Unbiased_Rounding (X : T) return T;
! function Valid (X : access T) return Boolean;
! -- This function checks if the object of type T referenced by X
! -- is valid, and returns True/False accordingly. The parameter is
! -- passed by reference (access) here, as the object of type T may
! -- be an abnormal value that cannot be passed in a floating-point
! -- register, and the whole point of 'Valid is to prevent exceptions.
private
pragma Inline (Machine);
*** sem_ch4.adb 2001/09/24 22:32:31 1.511
--- sem_ch4.adb 2001/10/21 17:41:52 1.512
***************
*** 2691,2696 ****
--- 2691,2708 ----
Check_Misspelled_Selector (Entity_List, Sel);
+ elsif Is_Generic_Type (Prefix_Type)
+ and then Ekind (Prefix_Type) = E_Record_Type_With_Private
+ and then Is_Record_Type (Etype (Prefix_Type))
+ then
+ -- If this is a derived formal type, the parent may have a
+ -- different visibility at this point. Try for an inherited
+ -- component before reporting an error.
+
+ Set_Etype (Prefix (N), Etype (Prefix_Type));
+ Analyze_Selected_Component (N);
+ return;
+
else
if Ekind (Prefix_Type) = E_Record_Subtype then
*** checks.ads 2001/07/16 01:26:04 1.55
--- checks.ads 2001/10/28 15:13:02 1.56
***************
*** 83,88 ****
--- 83,95 ----
-- the object denoted by the access parameter is not deeper than the
-- level of the type Typ. Program_Error is raised if the check fails.
+ procedure Apply_Alignment_Check (E : Entity_Id; N : Node_Id);
+ -- E is the entity for an object. If there is an address clause for
+ -- this entity, and checks are enabled, then this procedure generates
+ -- a check that the specified address has an alignment consistent with
+ -- the alignment of the object, raising PE if this is not the case. The
+ -- resulting check (if one is generated) is inserted before node N.
+
procedure Apply_Array_Size_Check (N : Node_Id; Typ : Entity_Id);
-- N is the node for an object declaration that declares an object of
-- array type Typ. This routine generates, if necessary, a check that
*** exp_ch13.adb 2001/07/16 21:21:29 1.76
--- exp_ch13.adb 2001/10/28 15:13:25 1.77
***************
*** 27,32 ****
--- 27,33 ----
------------------------------------------------------------------------------
with Atree; use Atree;
+ with Checks; use Checks;
with Einfo; use Einfo;
with Exp_Ch3; use Exp_Ch3;
with Exp_Ch6; use Exp_Ch6;
***************
*** 236,245 ****
Decl : Node_Id;
begin
! if not Is_Type (E) and then not Is_Subprogram (E) then
return;
end if;
E_Scope := Scope (E);
-- If we are freezing entities defined in protected types, they
--- 237,256 ----
Decl : Node_Id;
begin
! -- For object, with address clause, check alignment is OK
!
! if Is_Object (E) then
! Apply_Alignment_Check (E, N);
!
! -- Only other items requiring any front end action are
! -- types and subprograms.
!
! elsif not Is_Type (E) and then not Is_Subprogram (E) then
return;
end if;
+ -- Here E is a type or a subprogram
+
E_Scope := Scope (E);
-- If we are freezing entities defined in protected types, they
***************
*** 304,314 ****
elsif Is_Subprogram (E) then
Freeze_Subprogram (N);
-
- -- No other entities require any front end freeze actions
-
- else
- null;
end if;
-- Analyze actions generated by freezing. The init_proc contains
--- 315,320 ----
*** exp_util.ads 2001/07/23 10:05:17 1.112
--- exp_util.ads 2001/10/28 15:14:04 1.113
***************
*** 372,386 ****
-- routine is to help avoid generating troublesome temporaries that
-- intefere with the stack checking mechanism.
- function Must_Be_Aligned (Obj : Node_Id) return Boolean;
- -- Given an object reference, determines whether or not the object
- -- is required to be aligned according to its type'alignment value.
- -- Normally, objects are required to be aligned, and the result will
- -- be True. The situation in which this is not the case is if the
- -- object reference involves a component of a packed array, where
- -- the type of the component is not required to have strict alignment.
- -- In this case, false will be returned.
-
procedure Remove_Side_Effects
(Exp : Node_Id;
Name_Req : Boolean := False;
--- 372,377 ----
*** mdllfile.ads 2001/10/29 02:06:24 1.2
--- mdllfile.ads 2001/10/29 02:50:12 1.3
***************
*** 26,52 ****
-- --
------------------------------------------------------------------------------
! -- Simple services used by GNATDLL to deal with Filename extension.
package MDLL.Files is
No_Ext : constant String := "";
! function Get_Ext (Filename : in String)
! return String;
! -- return filename's extension.
!
! function Is_Ali (Filename : in String)
! return Boolean;
! -- test if Filename is an Ada library file (.ali).
!
! function Is_Obj (Filename : in String)
! return Boolean;
! -- test if Filename is an object file (.o or .obj).
!
! function Ext_To (Filename : in String;
! New_Ext : in String := No_Ext)
! return String;
! -- return Filename with the extension change to New_Ext.
end MDLL.Files;
--- 26,51 ----
-- --
------------------------------------------------------------------------------
! -- Simple services used by GNATDLL to deal with Filename extension
package MDLL.Files is
No_Ext : constant String := "";
+ -- Used to mark the absence of an extension
! function Get_Ext (Filename : String) return String;
! -- Return extension of Filename
!
! function Is_Ali (Filename : String) return Boolean;
! -- Test if Filename is an Ada library file (.ali).
!
! function Is_Obj (Filename : String) return Boolean;
! -- Test if Filename is an object file (.o or .obj)
!
! function Ext_To
! (Filename : String;
! New_Ext : String := No_Ext)
! return String;
! -- Return Filename with the extension change to New_Ext
end MDLL.Files;
*** mlib-fil.ads 2001/10/29 02:06:26 1.3
--- mlib-fil.ads 2001/10/29 02:51:28 1.4
***************
*** 36,51 ****
return String;
-- Return Filename with the extension change to New_Ext.
! function Get_Ext (Filename : in String) return String;
-- Return extension of filename.
function Is_Archive (Filename : String) return Boolean;
-- Test if filename is an archive
! function Is_C (Filename : in String) return Boolean;
-- Test if Filename is a C file
! function Is_Obj (Filename : in String) return Boolean;
-- Test if Filename is an object file
end MLib.Fil;
--- 36,51 ----
return String;
-- Return Filename with the extension change to New_Ext.
! function Get_Ext (Filename : String) return String;
-- Return extension of filename.
function Is_Archive (Filename : String) return Boolean;
-- Test if filename is an archive
! function Is_C (Filename : String) return Boolean;
-- Test if Filename is a C file
! function Is_Obj (Filename : String) return Boolean;
-- Test if Filename is an object file
end MLib.Fil;
*** exp_ch8.adb 2001/10/03 02:17:32 1.30
--- exp_ch8.adb 2001/10/29 17:32:24 1.31
***************
*** 59,65 ****
-- of the renamed object. The cases in which this is not true are when
-- this address is not computable, since it involves extraction of a
-- packed array element, or of a record component to which a component
! -- clause applies (that can specify an arbitrary bit boundary).
-- In these two cases, we pre-evaluate the renaming expression, by
-- extracting and freezing the values of any subscripts, and then we
--- 59,66 ----
-- of the renamed object. The cases in which this is not true are when
-- this address is not computable, since it involves extraction of a
-- packed array element, or of a record component to which a component
! -- clause applies (that can specify an arbitrary bit boundary), or where
! -- the enclosing record itself has a non-standard representation.
-- In these two cases, we pre-evaluate the renaming expression, by
-- extracting and freezing the values of any subscripts, and then we
***************
*** 211,228 ****
end if;
elsif Nkind (Nam) = N_Selected_Component then
! if Present (Component_Clause (Entity (Selector_Name (Nam)))) then
! return True;
! elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant
! and then Is_Record_Type (Etype (Prefix (Nam)))
! and then not Is_Concurrent_Record_Type (Etype (Prefix (Nam)))
! then
! return True;
! else
! return Evaluation_Required (Prefix (Nam));
! end if;
else
return False;
--- 212,236 ----
end if;
elsif Nkind (Nam) = N_Selected_Component then
! declare
! Rec_Type : Entity_Id := Etype (Prefix (Nam));
! begin
! if Present (Component_Clause (Entity (Selector_Name (Nam))))
! or else Has_Non_Standard_Rep (Rec_Type)
! then
! return True;
!
! elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant
! and then Is_Record_Type (Rec_Type)
! and then not Is_Concurrent_Record_Type (Rec_Type)
! then
! return True;
! else
! return Evaluation_Required (Prefix (Nam));
! end if;
! end;
else
return False;
*** g-dirope.ads 2001/08/27 09:48:38 1.12
--- g-dirope.ads 2001/10/29 19:18:13 1.13
***************
*** 38,43 ****
--- 38,47 ----
-- can be treated as a file, using open and close routines, and a scanning
-- routine is provided for iterating through the entries in a directory.
+ -- See also child package GNAT.Directory_Operations.Iteration
+
+ with Ada.Strings.Maps;
+
package GNAT.Directory_Operations is
subtype Dir_Name_Str is String;
***************
*** 187,248 ****
-- returned in target-OS form. Raises Directory_Error if Dir has not
-- be opened (Dir = Null_Dir).
- generic
- with procedure Action
- (Item : String;
- Index : Positive;
- Quit : in out Boolean);
- procedure Wildcard_Iterator (Path : Path_Name);
- -- Calls Action for each path matching Path. Path can include wildcards '*'
- -- and '?' and [...]. The rules are:
- --
- -- * can be replaced by any sequence of characters
- -- ? can be replaced by a single character
- -- [a-z] match one character in the range 'a' through 'z'
- -- [abc] match either character 'a', 'b' or 'c'
- --
- -- Item is the filename that has been matched. Index is set to one for the
- -- first call and is incremented by one at each call. The iterator's
- -- termination can be controlled by setting Quit to True. It is by default
- -- set to False.
- --
- -- For example, if we have the following directory structure:
- -- /boo/
- -- foo.ads
- -- /sed/
- -- foo.ads
- -- file/
- -- foo.ads
- -- /sid/
- -- foo.ads
- -- file/
- -- foo.ads
- -- /life/
- --
- -- A call with expression "/s*/file/*" will call Action for the following
- -- items:
- -- /sed/file/foo.ads
- -- /sid/file/foo.ads
-
- generic
- with procedure Action
- (Item : String;
- Index : Positive;
- Quit : in out Boolean);
- procedure Find
- (Root_Directory : Dir_Name_Str;
- File_Pattern : String);
- -- Recursively searches the directory structure rooted at Root_Directory.
- -- This provides functionality similar to the UNIX 'find' command.
- -- Action will be called for every item matching the regular expression
- -- File_Pattern (see GNAT.Regexp). Item is the full pathname to the file
- -- starting with Root_Directory that has been matched. Index is set to one
- -- for the first call and is incremented by one at each call. The iterator
- -- will pass in the value False on each call to Action. The iterator will
- -- terminate after passing the last matched path to Action or after
- -- returning from a call to Action which sets Quit to True.
- -- Raises GNAT.Regexp.Error_In_Regexp if File_Pattern is ill formed.
-
function Read_Is_Thread_Safe return Boolean;
-- Indicates if procedure Read is thread safe. On systems where the
-- target system supports this functionality, Read is thread safe,
--- 191,196 ----
***************
*** 259,263 ****
--- 207,215 ----
Null_Dir : constant Dir_Type := null;
pragma Import (C, Dir_Separator, "__gnat_dir_separator");
+
+ Dir_Seps : constant Ada.Strings.Maps.Character_Set :=
+ Ada.Strings.Maps.To_Set ("/\");
+ -- UNIX and DOS style directory separators.
end GNAT.Directory_Operations;
*** freeze.ads 2001/10/29 02:06:04 1.15
--- freeze.ads 2001/10/30 01:36:24 1.16
***************
*** 205,210 ****
--- 205,215 ----
-- so need to be similarly treated. Freeze_Expression takes care of
-- determining the proper insertion point for generated freeze actions.
+ procedure Freeze_Fixed_Point_Type (Typ : Entity_Id);
+ -- Freeze fixed point type. For fixed-point types, we have to defer
+ -- setting the size and bounds till the freeze point, since they are
+ -- potentially affected by the presence of size and small clauses.
+
procedure Freeze_Itype (T : Entity_Id; N : Node_Id);
-- This routine is called when an Itype is created and must be frozen
-- immediately at the point of creation (for the sake of the expansion
*** impunit.adb 2001/09/26 07:14:11 1.14
--- impunit.adb 2001/10/30 04:33:45 1.15
***************
*** 195,200 ****
--- 195,201 ----
"g-curexc", -- GNAT.Current_Exception
"g-debpoo", -- GNAT.Debug_Pools
"g-debuti", -- GNAT.Debug_Utilities
+ "g-diopit", -- GNAT.Directory_Operations.Iteration
"g-dirope", -- GNAT.Directory_Operations
"g-dyntab", -- GNAT.Dynamic_Tables
"g-exctra", -- GNAT.Exception_Traces
*** g-regexp.adb 2001/10/21 11:04:16 1.28
--- g-regexp.adb 2001/10/30 15:25:04 1.29
***************
*** 32,38 ****
-- --
------------------------------------------------------------------------------
- with System.IO;
with Unchecked_Deallocation;
with Ada.Exceptions;
with GNAT.Case_Util;
--- 32,37 ----
***************
*** 73,82 ****
end record;
-- Deterministic finite-state machine
- Debug : constant Boolean := False;
- -- When True, the primary and secondary tables will be printed.
- -- Gnat does not generate any code if this variable is False;
-
-----------------------
-- Local Subprograms --
-----------------------
--- 72,77 ----
***************
*** 188,199 ****
pragma No_Return (Raise_Exception);
-- Raise an exception, indicating an error at character Index in S.
- procedure Print_Table
- (Table : Regexp_Array;
- Num_States : State_Index;
- Is_Primary : Boolean := True);
- -- Print a table for debugging purposes
-
--------------------
-- Create_Mapping --
--------------------
--- 183,188 ----
***************
*** 1225,1309 ****
end loop;
end loop;
- if Debug then
- System.IO.New_Line;
- System.IO.Put_Line ("Secondary table : ");
- Print_Table (R.States, Nb_State, False);
- end if;
-
return (Ada.Finalization.Controlled with R => R);
end;
end Create_Secondary_Table;
- -----------------
- -- Print_Table --
- -----------------
-
- procedure Print_Table
- (Table : Regexp_Array;
- Num_States : State_Index;
- Is_Primary : Boolean := True)
- is
- function Reverse_Mapping (N : Column_Index) return Character;
- -- Return the character corresponding to a column in the mapping
-
- ---------------------
- -- Reverse_Mapping --
- ---------------------
-
- function Reverse_Mapping (N : Column_Index) return Character is
- begin
- for Column in Map'Range loop
- if Map (Column) = N then
- return Column;
- end if;
- end loop;
-
- return ' ';
- end Reverse_Mapping;
-
- -- Start of processing for Print_Table
-
- begin
- -- Print the header line
-
- System.IO.Put (" [*] ");
-
- for Column in 1 .. Alphabet_Size loop
- System.IO.Put
- (String'(1 .. 1 => Reverse_Mapping (Column)) & " ");
- end loop;
-
- if Is_Primary then
- System.IO.Put ("closure....");
- end if;
-
- System.IO.New_Line;
-
- -- Print every line
-
- for State in 1 .. Num_States loop
- System.IO.Put (State'Img);
-
- for K in 1 .. 3 - State'Img'Length loop
- System.IO.Put (" ");
- end loop;
-
- for K in 0 .. Alphabet_Size loop
- System.IO.Put (Table (State, K)'Img & " ");
- end loop;
-
- for K in Alphabet_Size + 1 .. Table'Last (2) loop
- if Table (State, K) /= 0 then
- System.IO.Put (Table (State, K)'Img & ",");
- end if;
- end loop;
-
- System.IO.New_Line;
- end loop;
-
- end Print_Table;
-
---------------------
-- Raise_Exception --
---------------------
--- 1214,1223 ----
***************
*** 1345,1356 ****
(Table, Num_States, Start_State, End_State);
end if;
- if Debug then
- Print_Table (Table.all, Num_States);
- System.IO.Put_Line ("Start_State : " & Start_State'Img);
- System.IO.Put_Line ("End_State : " & End_State'Img);
- end if;
-
-- Creates the secondary table
R := Create_Secondary_Table
--- 1259,1264 ----
***************
*** 1451,1467 ****
New_Table := new Regexp_Array (Table'First (1) .. New_Lines,
Table'First (2) .. New_Columns);
New_Table.all := (others => (others => 0));
-
- if Debug then
- System.IO.Put_Line ("Reallocating table: Lines from "
- & State_Index'Image (Table'Last (1))
- & " to "
- & State_Index'Image (New_Lines));
- System.IO.Put_Line (" and columns from "
- & Column_Index'Image (Table'Last (2))
- & " to "
- & Column_Index'Image (New_Columns));
- end if;
for J in Table'Range (1) loop
for K in Table'Range (2) loop
--- 1359,1364 ----
*** g-dirope.adb 2001/10/31 21:36:04 1.20
--- g-dirope.adb 2001/11/01 16:39:33 1.21
***************
*** 371,387 ****
E := E + 1;
Var_Name : loop
! exit Var_Name when E = Path'Last;
if Characters.Handling.Is_Letter (Path (E))
or else Characters.Handling.Is_Digit (Path (E))
then
E := E + 1;
else
- E := E - 1;
exit Var_Name;
end if;
end loop Var_Name;
declare
Env : OS_Lib.String_Access := OS_Lib.Getenv (Path (K .. E));
--- 371,388 ----
E := E + 1;
Var_Name : loop
! exit Var_Name when E > Path'Last;
if Characters.Handling.Is_Letter (Path (E))
or else Characters.Handling.Is_Digit (Path (E))
then
E := E + 1;
else
exit Var_Name;
end if;
end loop Var_Name;
+
+ E := E - 1;
declare
Env : OS_Lib.String_Access := OS_Lib.Getenv (Path (K .. E));
2001-12-11 Ed Schonberg <schonber@gnat.com>
* sem_ch10.adb (Install_Withed_Unit): If the unit is a generic instance
......
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