Skip to content

R
riscv-gcc-1
Commit 598c3446 by Geert Bosch
Options

gnatmain.adb: Initial version. 

	* gnatmain.adb: Initial version.

	* gnatmain.ads: Initial version.

	* prj-attr.adb (Initialisation_Data): Add package Gnatstub.

	* snames.adb: Updated to match snames.ads.

	* snames.ads: Added Gnatstub.

	* prj-attr.adb (Initialization_Data): Change name from
	Initialisation_Data.

	* g-regpat.adb (Parse_Literal): Properly handle simple operators ?,
	+ and * applied to backslashed expressions like \r.

	* g-os_lib.ads: String_List type added, Argument_List type is now
	subtype of String_List.

	* g-os_lib.ads: Change copyright to FSF
	Add comments for String_List type

	* g-dirope.adb (Expand_Path): Fix bug. (wrong length when adding a
	string to the buffer).

From-SVN: r47905
parent 0d7839da
Showing with 118 additions and 25 deletions
gcc/ada/ChangeLog
2001-12-11 Vincent Celier <celier@gnat.com>
* gnatmain.adb: Initial version.
* gnatmain.ads: Initial version.
* prj-attr.adb (Initialisation_Data): Add package Gnatstub.
* snames.adb: Updated to match snames.ads.
* snames.ads: Added Gnatstub.
2001-12-11 Vincent Celier <celier@gnat.com>
* prj-attr.adb (Initialization_Data): Change name from
Initialisation_Data.
2001-12-11 Emmanuel Briot <briot@gnat.com>
* g-regpat.adb (Parse_Literal): Properly handle simple operators ?,
+ and * applied to backslashed expressions like \r.
2001-12-11 Vasiliy Fofanov <fofanov@gnat.com>
* g-os_lib.ads: String_List type added, Argument_List type is now
subtype of String_List.
2001-12-11 Robert Dewar <dewar@gnat.com>
* g-os_lib.ads: Change copyright to FSF
Add comments for String_List type
2001-12-11 Vincent Celier <celier@gnat.com>
* g-dirope.adb (Expand_Path): Fix bug. (wrong length when adding a
string to the buffer).
2001-12-11 Ed Schonberg <schonber@gnat.com> 2001-12-11 Ed Schonberg <schonber@gnat.com>
* freeze.adb: Make Freeze_Fixed_Point_Type visible, for use in * freeze.adb: Make Freeze_Fixed_Point_Type visible, for use in
......
gcc/ada/g-dirope.adb
...@@ -253,8 +253,8 @@ package body GNAT.Directory_Operations is ...@@ -253,8 +253,8 @@ package body GNAT.Directory_Operations is
Double_Result_Size; Double_Result_Size;
end loop; end loop;
Result (Result_Last + 1 .. Result_Last + S'Length - 1) := S; Result (Result_Last + 1 .. Result_Last + S'Length) := S;
Result_Last := Result_Last + S'Length - 1; Result_Last := Result_Last + S'Length;
end Append; end Append;
------------------------ ------------------------
......
gcc/ada/g-os_lib.ads
...@@ -6,9 +6,9 @@ ...@@ -6,9 +6,9 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- $Revision: 1.79 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1995-2001 Ada Core Technologies, Inc. -- -- Copyright (C) 1995-2001 Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -56,10 +56,15 @@ package GNAT.OS_Lib is ...@@ -56,10 +56,15 @@ package GNAT.OS_Lib is
pragma Elaborate_Body (OS_Lib); pragma Elaborate_Body (OS_Lib);
type String_Access is access all String; type String_Access is access all String;
-- General purpose string access type
procedure Free is new Unchecked_Deallocation procedure Free is new Unchecked_Deallocation
(Object => String, Name => String_Access); (Object => String, Name => String_Access);
type String_List is array (Positive range <>) of String_Access;
type String_List_Access is access all String_List;
-- General purpose array and pointer for list of string accesses
--------------------- ---------------------
-- Time/Date Stuff -- -- Time/Date Stuff --
--------------------- ---------------------
...@@ -381,12 +386,12 @@ pragma Elaborate_Body (OS_Lib); ...@@ -381,12 +386,12 @@ pragma Elaborate_Body (OS_Lib);
-- Subprocesses -- -- Subprocesses --
------------------ ------------------
type Argument_List is array (Positive range <>) of String_Access; subtype Argument_List is String_List;
-- Type used for argument list in call to Spawn. The lower bound -- Type used for argument list in call to Spawn. The lower bound
-- of the array should be 1, and the length of the array indicates -- of the array should be 1, and the length of the array indicates
-- the number of arguments. -- the number of arguments.
type Argument_List_Access is access all Argument_List; subtype Argument_List_Access is String_List_Access;
-- Type used to return an Argument_List without dragging in secondary -- Type used to return an Argument_List without dragging in secondary
-- stack. -- stack.
......
gcc/ada/g-regpat.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.31 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1986 by University of Toronto. -- -- Copyright (C) 1986 by University of Toronto. --
-- Copyright (C) 1996-2001 Ada Core Technologies, Inc. -- -- Copyright (C) 1996-2001 Ada Core Technologies, Inc. --
...@@ -1563,6 +1563,7 @@ package body GNAT.Regpat is ...@@ -1563,6 +1563,7 @@ package body GNAT.Regpat is
Start_Pos : Natural := 0; Start_Pos : Natural := 0;
C : Character; C : Character;
Length_Ptr : Pointer; Length_Ptr : Pointer;
Has_Special_Operator : Boolean := False;
begin begin
Parse_Pos := Parse_Pos - 1; -- Look at current character Parse_Pos := Parse_Pos - 1; -- Look at current character
...@@ -1585,6 +1586,7 @@ package body GNAT.Regpat is ...@@ -1585,6 +1586,7 @@ package body GNAT.Regpat is
when '.' | '[' | '(' | ')' | '|' | ASCII.LF | '$' | '^' => when '.' | '[' | '(' | ')' | '|' | ASCII.LF | '$' | '^' =>
if Start_Pos = 0 then if Start_Pos = 0 then
Start_Pos := Parse_Pos;
Emit (C); -- First character is always emitted Emit (C); -- First character is always emitted
else else
exit Parse_Loop; -- Else we are done exit Parse_Loop; -- Else we are done
...@@ -1593,12 +1595,14 @@ package body GNAT.Regpat is ...@@ -1593,12 +1595,14 @@ package body GNAT.Regpat is
when '?' | '+' | '*' | '{' => when '?' | '+' | '*' | '{' =>
if Start_Pos = 0 then if Start_Pos = 0 then
Start_Pos := Parse_Pos;
Emit (C); -- First character is always emitted Emit (C); -- First character is always emitted
-- Are we looking at an operator, or is this -- Are we looking at an operator, or is this
-- simply a normal character ? -- simply a normal character ?
elsif not Is_Mult (Parse_Pos) then elsif not Is_Mult (Parse_Pos) then
Case_Emit (C); Start_Pos := Parse_Pos;
Case_Emit (C);
else else
-- We've got something like "abc?d". Mark this as a -- We've got something like "abc?d". Mark this as a
-- special case. What we want to emit is a first -- special case. What we want to emit is a first
...@@ -1606,11 +1610,12 @@ package body GNAT.Regpat is ...@@ -1606,11 +1610,12 @@ package body GNAT.Regpat is
-- ultimately be transformed with a CURLY operator, A -- ultimately be transformed with a CURLY operator, A
-- special case has to be handled for "a?", since there -- special case has to be handled for "a?", since there
-- is no initial string to emit. -- is no initial string to emit.
Start_Pos := Natural'Last; Has_Special_Operator := True;
exit Parse_Loop; exit Parse_Loop;
end if; end if;
when '\' => when '\' =>
Start_Pos := Parse_Pos;
if Parse_Pos = Parse_End then if Parse_Pos = Parse_End then
Fail ("Trailing \"); Fail ("Trailing \");
else else
...@@ -1629,12 +1634,13 @@ package body GNAT.Regpat is ...@@ -1629,12 +1634,13 @@ package body GNAT.Regpat is
Parse_Pos := Parse_Pos + 1; Parse_Pos := Parse_Pos + 1;
end if; end if;
when others => Case_Emit (C); when others =>
Start_Pos := Parse_Pos;
Case_Emit (C);
end case; end case;
exit Parse_Loop when Emit_Ptr - Length_Ptr = 254; exit Parse_Loop when Emit_Ptr - Length_Ptr = 254;
Start_Pos := Parse_Pos;
Parse_Pos := Parse_Pos + 1; Parse_Pos := Parse_Pos + 1;
exit Parse_Loop when Parse_Pos > Parse_End; exit Parse_Loop when Parse_Pos > Parse_End;
...@@ -1643,11 +1649,11 @@ package body GNAT.Regpat is ...@@ -1643,11 +1649,11 @@ package body GNAT.Regpat is
-- Is the string followed by a '*+?{' operator ? If yes, and if there -- Is the string followed by a '*+?{' operator ? If yes, and if there
-- is an initial string to emit, do it now. -- is an initial string to emit, do it now.
if Start_Pos = Natural'Last if Has_Special_Operator
and then Emit_Ptr >= Length_Ptr + 3 and then Emit_Ptr >= Length_Ptr + 3
then then
Emit_Ptr := Emit_Ptr - 1; Emit_Ptr := Emit_Ptr - 1;
Parse_Pos := Parse_Pos - 1; Parse_Pos := Start_Pos;
end if; end if;
if Emit_Code then if Emit_Code then
......
gcc/ada/gnatmain.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T M A I N --
-- --
-- S p e c --
-- --
-- $Revision$
-- --
-- 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- --
-- 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This procedure is the project-aware driver for the GNAT tools.
-- For gnatls, gnatxref, gnatfind and gnatstub, it setup the environment
-- variables ADA_INCLUDE_PATH and ADA_OBJECT_PATH and gather the switches
-- and file names from the project file (if any) and from the common line,
-- then call the non project-aware tool (gnatls, gnatxref, gnatfind or
-- gnatstub).
-- For other tools (compiler, binder, linker, gnatmake), it invokes
-- gnatmake with the proper switches.
procedure Gnatmain;
gcc/ada/prj-attr.adb
...@@ -49,7 +49,7 @@ package body Prj.Attr is ...@@ -49,7 +49,7 @@ package body Prj.Attr is
-- End is indicated by two consecutive '#'. -- End is indicated by two consecutive '#'.
Initialisation_Data : constant String := Initialization_Data : constant String :=
-- project attributes -- project attributes
...@@ -121,6 +121,11 @@ package body Prj.Attr is ...@@ -121,6 +121,11 @@ package body Prj.Attr is
"Ladefault_switches#" & "Ladefault_switches#" &
"LAswitches#" & "LAswitches#" &
-- package Gnatstub
"Pgnatstub#" &
"LVswitches#" &
"#"; "#";
---------------- ----------------
...@@ -128,7 +133,7 @@ package body Prj.Attr is ...@@ -128,7 +133,7 @@ package body Prj.Attr is
---------------- ----------------
procedure Initialize is procedure Initialize is
Start : Positive := Initialisation_Data'First; Start : Positive := Initialization_Data'First;
Finish : Positive := Start; Finish : Positive := Start;
Current_Package : Package_Node_Id := Empty_Package; Current_Package : Package_Node_Id := Empty_Package;
Current_Attribute : Attribute_Node_Id := Empty_Attribute; Current_Attribute : Attribute_Node_Id := Empty_Attribute;
...@@ -145,9 +150,9 @@ package body Prj.Attr is ...@@ -145,9 +150,9 @@ package body Prj.Attr is
Attributes.Set_Last (Attributes.First); Attributes.Set_Last (Attributes.First);
Package_Attributes.Set_Last (Package_Attributes.First); Package_Attributes.Set_Last (Package_Attributes.First);
while Initialisation_Data (Start) /= '#' loop while Initialization_Data (Start) /= '#' loop
Is_An_Attribute := True; Is_An_Attribute := True;
case Initialisation_Data (Start) is case Initialization_Data (Start) is
when 'P' => when 'P' =>
-- New allowed package -- New allowed package
...@@ -155,19 +160,19 @@ package body Prj.Attr is ...@@ -155,19 +160,19 @@ package body Prj.Attr is
Start := Start + 1; Start := Start + 1;
Finish := Start; Finish := Start;
while Initialisation_Data (Finish) /= '#' loop while Initialization_Data (Finish) /= '#' loop
Finish := Finish + 1; Finish := Finish + 1;
end loop; end loop;
Name_Len := Finish - Start; Name_Len := Finish - Start;
Name_Buffer (1 .. Name_Len) := Name_Buffer (1 .. Name_Len) :=
To_Lower (Initialisation_Data (Start .. Finish - 1)); To_Lower (Initialization_Data (Start .. Finish - 1));
Package_Name := Name_Find; Package_Name := Name_Find;
for Index in Package_First .. Package_Attributes.Last loop for Index in Package_First .. Package_Attributes.Last loop
if Package_Name = Package_Attributes.Table (Index).Name then if Package_Name = Package_Attributes.Table (Index).Name then
Write_Line ("Duplicate package name """ & Write_Line ("Duplicate package name """ &
Initialisation_Data (Start .. Finish - 1) & Initialization_Data (Start .. Finish - 1) &
""" in Prj.Attr body."); """ in Prj.Attr body.");
raise Program_Error; raise Program_Error;
end if; end if;
...@@ -196,7 +201,7 @@ package body Prj.Attr is ...@@ -196,7 +201,7 @@ package body Prj.Attr is
-- New attribute -- New attribute
Start := Start + 1; Start := Start + 1;
case Initialisation_Data (Start) is case Initialization_Data (Start) is
when 'V' => when 'V' =>
Kind_2 := Single; Kind_2 := Single;
when 'A' => when 'A' =>
...@@ -210,13 +215,13 @@ package body Prj.Attr is ...@@ -210,13 +215,13 @@ package body Prj.Attr is
Start := Start + 1; Start := Start + 1;
Finish := Start; Finish := Start;
while Initialisation_Data (Finish) /= '#' loop while Initialization_Data (Finish) /= '#' loop
Finish := Finish + 1; Finish := Finish + 1;
end loop; end loop;
Name_Len := Finish - Start; Name_Len := Finish - Start;
Name_Buffer (1 .. Name_Len) := Name_Buffer (1 .. Name_Len) :=
To_Lower (Initialisation_Data (Start .. Finish - 1)); To_Lower (Initialization_Data (Start .. Finish - 1));
Attribute_Name := Name_Find; Attribute_Name := Name_Find;
Attributes.Increment_Last; Attributes.Increment_Last;
if Current_Attribute = Empty_Attribute then if Current_Attribute = Empty_Attribute then
...@@ -234,7 +239,7 @@ package body Prj.Attr is ...@@ -234,7 +239,7 @@ package body Prj.Attr is
if Attribute_Name = if Attribute_Name =
Attributes.Table (Index).Name then Attributes.Table (Index).Name then
Write_Line ("Duplicate attribute name """ & Write_Line ("Duplicate attribute name """ &
Initialisation_Data (Start .. Finish - 1) & Initialization_Data (Start .. Finish - 1) &
""" in Prj.Attr body."); """ in Prj.Attr body.");
raise Program_Error; raise Program_Error;
end if; end if;
......
gcc/ada/snames.adb
...@@ -595,6 +595,7 @@ package body Snames is ...@@ -595,6 +595,7 @@ package body Snames is
"binder#" & "binder#" &
"linker#" & "linker#" &
"compiler#" & "compiler#" &
"gnatstub#" &
"#"; "#";
--------------------- ---------------------
......
gcc/ada/snames.ads
...@@ -894,10 +894,11 @@ package Snames is ...@@ -894,10 +894,11 @@ package Snames is
Name_Binder : constant Name_Id := N + 549; Name_Binder : constant Name_Id := N + 549;
Name_Linker : constant Name_Id := N + 550; Name_Linker : constant Name_Id := N + 550;
Name_Compiler : constant Name_Id := N + 551; Name_Compiler : constant Name_Id := N + 551;
Name_Gnatstub : constant Name_Id := N + 552;
-- Mark last defined name for consistency check in Snames body -- Mark last defined name for consistency check in Snames body
Last_Predefined_Name : constant Name_Id := N + 551; Last_Predefined_Name : constant Name_Id := N + 552;
subtype Any_Operator_Name is Name_Id range subtype Any_Operator_Name is Name_Id range
First_Operator_Name .. Last_Operator_Name; First_Operator_Name .. Last_Operator_Name;
......
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