Skip to content

R
riscv-gcc-1
Commit 17c5c8a5 by Geert Bosch
Options

bindgen.adb: Minor reformatting 

	* bindgen.adb: Minor reformatting

	* cstand.adb: Minor reformatting

	* fmap.adb: Minor reformatting
	Change name from Add for Add_To_File_Map (Add is much too generic)
	Change Path_Name_Of to Mapped_Path_Name
	Change File_Name_Of to Mapped_File_Name
	Fix copyright dates in header

	* fmap.ads:
	Change name from Add for Add_To_File_Map (Add is much too generic)
	Change Path_Name_Of to Mapped_Path_Name
	Change File_Name_Of to Mapped_File_Name
	Fix copyright dates in header

	* fname-uf.adb: Minor reformatting.  New names of stuff in Fmap.
	Add use clause for Fmap.

	* make.adb: Minor reformatting

	* osint.adb: Minor reformatting.  Change of names in Fmap.
	Add use clause for Fmap.

	* prj-env.adb: Minor reformatting

	* prj-env.ads: Minor reformatting

	* switch.adb: Minor reformatting.  Do proper raise of Bad_Switch if
	error found (there were odd exceptions to this general rule in
	-gnatec/-gnatem processing)

	* raise.c (__gnat_eh_personality): Exception handling personality
	routine for Ada.  Still in rough state, inspired from the C++ version
	and still containing a bunch of debugging artifacts.
	(parse_lsda_header, get_ttype_entry): Local (static) helpers, also
	inspired from the C++ library.

	* raise.c (eh_personality): Add comments. Part of work for the GCC 3
	exception handling integration.

	* Makefile.in: Remove use of 5smastop.adb which is obsolete.
	(HIE_SOURCES): Add s-secsta.ad{s,b}.
	(HIE_OBJS): Add s-fat*.o
	(RAVEN_SOURCES): Remove files that are no longer required. Add
	interrupt handling files.
	(RAVEN_MOD): Removed, no longer needed.

	* a-ngelfu.adb: Remove ??? comment for inappropriate Inline_Always
	Add 2001 to copyright date

	* g-regpat.adb: Change pragma Inline_Always to Inline. There is no
	need to force universal inlining for these cases.

	* s-taprob.adb: Minor clean ups so that this unit can be used in
	Ravenscar HI.

	* exp_ch7.adb: Allow use of secondary stack in HI mode.
	Disallow it when pragma Restrictions (No_Secondary_Stack) is specified.

	* prj-tree.ads (Project_Node_Record): Add comments for components
	Pkg_Id and Case_Insensitive.

	* g-socket.adb: Minor reformatting. Found while reading code.

	* prj-tree.ads: Minor reformatting

From-SVN: r48195
parent a004eb82
Showing with 264 additions and 178 deletions
gcc/ada/ChangeLog
2001-12-19 Robert Dewar <dewar@gnat.com>
* bindgen.adb: Minor reformatting
* cstand.adb: Minor reformatting
* fmap.adb: Minor reformatting
Change name from Add for Add_To_File_Map (Add is much too generic)
Change Path_Name_Of to Mapped_Path_Name
Change File_Name_Of to Mapped_File_Name
Fix copyright dates in header
* fmap.ads:
Change name from Add for Add_To_File_Map (Add is much too generic)
Change Path_Name_Of to Mapped_Path_Name
Change File_Name_Of to Mapped_File_Name
Fix copyright dates in header
* fname-uf.adb: Minor reformatting. New names of stuff in Fmap.
Add use clause for Fmap.
* make.adb: Minor reformatting
* osint.adb: Minor reformatting. Change of names in Fmap.
Add use clause for Fmap.
* prj-env.adb: Minor reformatting
* prj-env.ads: Minor reformatting
* switch.adb: Minor reformatting. Do proper raise of Bad_Switch if
error found (there were odd exceptions to this general rule in
-gnatec/-gnatem processing)
2001-12-19 Olivier Hainque <hainque@gnat.com>
* raise.c (__gnat_eh_personality): Exception handling personality
routine for Ada. Still in rough state, inspired from the C++ version
and still containing a bunch of debugging artifacts.
(parse_lsda_header, get_ttype_entry): Local (static) helpers, also
inspired from the C++ library.
* raise.c (eh_personality): Add comments. Part of work for the GCC 3
exception handling integration.
2001-12-19 Arnaud Charlet <charlet@gnat.com>
* Makefile.in: Remove use of 5smastop.adb which is obsolete.
(HIE_SOURCES): Add s-secsta.ad{s,b}.
(HIE_OBJS): Add s-fat*.o
(RAVEN_SOURCES): Remove files that are no longer required. Add
interrupt handling files.
(RAVEN_MOD): Removed, no longer needed.
2001-12-19 Robert Dewar <dewar@gnat.com>
* a-ngelfu.adb: Remove ??? comment for inappropriate Inline_Always
Add 2001 to copyright date
* g-regpat.adb: Change pragma Inline_Always to Inline. There is no
need to force universal inlining for these cases.
2001-12-19 Arnaud Charlet <charlet@gnat.com>
* s-taprob.adb: Minor clean ups so that this unit can be used in
Ravenscar HI.
* exp_ch7.adb: Allow use of secondary stack in HI mode.
Disallow it when pragma Restrictions (No_Secondary_Stack) is specified.
2001-12-19 Vincent Celier <celier@gnat.com>
* prj-tree.ads (Project_Node_Record): Add comments for components
Pkg_Id and Case_Insensitive.
2001-12-19 Pascal Obry <obry@gnat.com>
* g-socket.adb: Minor reformatting. Found while reading code.
2001-12-19 Robert Dewar <dewar@gnat.com>
* prj-tree.ads: Minor reformatting
2001-12-20 Joseph S. Myers <jsm28@cam.ac.uk> 2001-12-20 Joseph S. Myers <jsm28@cam.ac.uk>
* config-lang.in (diff_excludes): Remove. * config-lang.in (diff_excludes): Remove.
......
gcc/ada/Makefile.in
...@@ -1060,7 +1060,6 @@ ifeq ($(strip $(filter-out sparc sun solaris2% sunos5%,$(targ))),) ...@@ -1060,7 +1060,6 @@ ifeq ($(strip $(filter-out sparc sun solaris2% sunos5%,$(targ))),)
a-intnam.ads<4sintnam.ads \ a-intnam.ads<4sintnam.ads \
s-inmaop.adb<7sinmaop.adb \ s-inmaop.adb<7sinmaop.adb \
s-intman.adb<5sintman.adb \ s-intman.adb<5sintman.adb \
s-mastop.adb<5smastop.adb \
s-osinte.adb<5sosinte.adb \ s-osinte.adb<5sosinte.adb \
s-osinte.ads<5sosinte.ads \ s-osinte.ads<5sosinte.ads \
s-osprim.adb<5posprim.adb \ s-osprim.adb<5posprim.adb \
...@@ -1086,7 +1085,6 @@ ifeq ($(strip $(filter-out sparc sun solaris2% sunos5%,$(targ))),) ...@@ -1086,7 +1085,6 @@ ifeq ($(strip $(filter-out sparc sun solaris2% sunos5%,$(targ))),)
a-intnam.ads<4sintnam.ads \ a-intnam.ads<4sintnam.ads \
s-inmaop.adb<7sinmaop.adb \ s-inmaop.adb<7sinmaop.adb \
s-intman.adb<5sintman.adb \ s-intman.adb<5sintman.adb \
s-mastop.adb<5smastop.adb \
s-osinte.adb<7sosinte.adb \ s-osinte.adb<7sosinte.adb \
s-osinte.ads<5tosinte.ads \ s-osinte.ads<5tosinte.ads \
s-osprim.adb<5posprim.adb \ s-osprim.adb<5posprim.adb \
...@@ -1105,7 +1103,6 @@ ifeq ($(strip $(filter-out sparc sun solaris2% sunos5%,$(targ))),) ...@@ -1105,7 +1103,6 @@ ifeq ($(strip $(filter-out sparc sun solaris2% sunos5%,$(targ))),)
a-intnam.ads<4sintnam.ads \ a-intnam.ads<4sintnam.ads \
s-inmaop.adb<7sinmaop.adb \ s-inmaop.adb<7sinmaop.adb \
s-intman.adb<7sintman.adb \ s-intman.adb<7sintman.adb \
s-mastop.adb<5smastop.adb \
s-osinte.adb<5iosinte.adb \ s-osinte.adb<5iosinte.adb \
s-osinte.ads<54osinte.ads \ s-osinte.ads<54osinte.ads \
s-osprim.adb<5posprim.adb \ s-osprim.adb<5posprim.adb \
...@@ -1909,6 +1906,8 @@ HIE_SOURCES = \ ...@@ -1909,6 +1906,8 @@ HIE_SOURCES = \
s-fatlfl.ads \ s-fatlfl.ads \
s-fatllf.ads \ s-fatllf.ads \
s-fatsfl.ads \ s-fatsfl.ads \
s-secsta.ads \
s-secsta.adb \
a-tags.ads \ a-tags.ads \
a-tags.adb $(EXTRA_HIE_SOURCES) a-tags.adb $(EXTRA_HIE_SOURCES)
...@@ -1923,23 +1922,19 @@ HIE_OBJS = \ ...@@ -1923,23 +1922,19 @@ HIE_OBJS = \
s-stoele.o \ s-stoele.o \
s-maccod.o \ s-maccod.o \
s-unstyp.o \ s-unstyp.o \
s-fatflt.o \
s-fatlfl.o \
s-fatllf.o \
s-secsta.o \
a-tags.o $(EXTRA_HIE_OBJS) a-tags.o $(EXTRA_HIE_OBJS)
# Files which are needed in ravenscar mode # Files which are needed in ravenscar mode
RAVEN_SOURCES = \ RAVEN_SOURCES = \
$(HIE_SOURCES) \ $(HIE_SOURCES) \
s-arit64.ads \
s-arit64.adb \
s-parame.ads \ s-parame.ads \
s-parame.adb \ s-parame.adb \
g-except.ads \ g-except.ads \
s-stalib.ads \
s-stalib.adb \
s-soflin.ads \
s-soflin.adb \
s-secsta.ads \
s-secsta.adb \
s-osinte.ads \ s-osinte.ads \
s-osinte.adb \ s-osinte.adb \
s-tasinf.ads \ s-tasinf.ads \
...@@ -1948,9 +1943,12 @@ RAVEN_SOURCES = \ ...@@ -1948,9 +1943,12 @@ RAVEN_SOURCES = \
s-taprop.ads \ s-taprop.ads \
s-taprop.adb \ s-taprop.adb \
s-taskin.ads \ s-taskin.ads \
s-taskin.adb \
s-interr.ads \ s-interr.ads \
s-interr.adb \ s-interr.adb \
s-taskin.adb \ a-interr.ads \
a-interr.adb \
a-intnam.ads \
a-reatim.ads \ a-reatim.ads \
a-reatim.adb \ a-reatim.adb \
a-retide.ads \ a-retide.ads \
...@@ -1963,33 +1961,24 @@ RAVEN_SOURCES = \ ...@@ -1963,33 +1961,24 @@ RAVEN_SOURCES = \
s-tarest.ads \ s-tarest.ads \
s-tarest.adb $(EXTRA_RAVEN_SOURCES) s-tarest.adb $(EXTRA_RAVEN_SOURCES)
# Files that need to be preprocessed before inclusion in a ravenscar run time
RAVEN_MOD = \
s-tposen.adb \
s-tarest.adb
# Objects to generate for the ravenscar run time # Objects to generate for the ravenscar run time
RAVEN_OBJS = \ RAVEN_OBJS = \
$(HIE_OBJS) \ $(HIE_OBJS) \
g-except.o \
s-stalib.o \
s-arit64.o \
s-parame.o \ s-parame.o \
s-soflin.o \ g-except.o \
s-secsta.o \
s-tasinf.o \
s-osinte.o \ s-osinte.o \
s-tasinf.o \
s-taspri.o \ s-taspri.o \
s-taprop.o \ s-taprop.o \
s-taskin.o \ s-taskin.o \
s-taprob.o \
s-tposen.o \
s-interr.o \ s-interr.o \
a-interr.o \ a-interr.o \
a-intnam.o \
a-reatim.o \ a-reatim.o \
a-retide.o \ a-retide.o \
s-taprob.o \
s-tposen.o \
s-tasres.o \ s-tasres.o \
s-tarest.o $(EXTRA_RAVEN_OBJS) s-tarest.o $(EXTRA_RAVEN_OBJS)
......
gcc/ada/a-ngelfu.adb
...@@ -6,9 +6,9 @@ ...@@ -6,9 +6,9 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.44 $ -- $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 -- -- 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- --
...@@ -52,11 +52,9 @@ package body Ada.Numerics.Generic_Elementary_Functions is ...@@ -52,11 +52,9 @@ package body Ada.Numerics.Generic_Elementary_Functions is
Log_Two : constant := 0.69314_71805_59945_30941_72321_21458_17656_80755; Log_Two : constant := 0.69314_71805_59945_30941_72321_21458_17656_80755;
Half_Log_Two : constant := Log_Two / 2; Half_Log_Two : constant := Log_Two / 2;
subtype T is Float_Type'Base; subtype T is Float_Type'Base;
subtype Double is Aux.Double; subtype Double is Aux.Double;
Two_Pi : constant T := 2.0 * Pi; Two_Pi : constant T := 2.0 * Pi;
Half_Pi : constant T := Pi / 2.0; Half_Pi : constant T := Pi / 2.0;
Fourth_Pi : constant T := Pi / 4.0; Fourth_Pi : constant T := Pi / 4.0;
...@@ -68,7 +66,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is ...@@ -68,7 +66,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is
Log_Inverse_Epsilon : constant T := T (T'Model_Mantissa - 1) * Log_Two; Log_Inverse_Epsilon : constant T := T (T'Model_Mantissa - 1) * Log_Two;
Sqrt_Epsilon : constant T := Sqrt_Two ** (1 - T'Model_Mantissa); Sqrt_Epsilon : constant T := Sqrt_Two ** (1 - T'Model_Mantissa);
DEpsilon : constant Double := Double (Epsilon); DEpsilon : constant Double := Double (Epsilon);
DIEpsilon : constant Double := Double (IEpsilon); DIEpsilon : constant Double := Double (IEpsilon);
...@@ -558,7 +555,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is ...@@ -558,7 +555,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is
-- Just reuse the code for Sin. The potential small -- Just reuse the code for Sin. The potential small
-- loss of speed is negligible with proper (front-end) inlining. -- loss of speed is negligible with proper (front-end) inlining.
-- ??? Add pragma Inline_Always in spec when this is supported
return -Sin (abs X - Cycle * 0.25, Cycle); return -Sin (abs X - Cycle * 0.25, Cycle);
end Cos; end Cos;
...@@ -716,7 +712,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is ...@@ -716,7 +712,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is
Q := ((Q3 * Z + Q2) * Z + Q1) * Z + Q0; Q := ((Q3 * Z + Q2) * Z + Q1) * Z + Q0;
R := 0.5 + P / (Q - P); R := 0.5 + P / (Q - P);
R := Float_Type'Base'Scaling (R, Integer (XN) + 1); R := Float_Type'Base'Scaling (R, Integer (XN) + 1);
-- Deal with case of Exp returning IEEE infinity. If Machine_Overflows -- Deal with case of Exp returning IEEE infinity. If Machine_Overflows
...@@ -732,7 +727,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is ...@@ -732,7 +727,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is
end Exp_Strict; end Exp_Strict;
---------------- ----------------
-- Local_Atan -- -- Local_Atan --
---------------- ----------------
......
gcc/ada/bindgen.adb
...@@ -343,16 +343,16 @@ package body Bindgen is ...@@ -343,16 +343,16 @@ package body Bindgen is
Write_Statement_Buffer; Write_Statement_Buffer;
-- Normal case (no pragma No_Run_Time). The global values are -- Normal case (not No_Run_Time mode). The global values are
-- assigned using the runtime routine Set_Globals (we have to use -- assigned using the runtime routine Set_Globals (we have to use
-- the routine call, rather than define the globals in the binder -- the routine call, rather than define the globals in the binder
-- file to deal with cross-library calls in some systems. -- file to deal with cross-library calls in some systems.
if No_Run_Time_Specified then if No_Run_Time_Specified then
-- Case of pragma No_Run_Time present. The only global variable
-- that might be needed (by the Ravenscar profile) is -- Case of No_Run_Time mode. The only global variable that might
-- the environment task's priority. Also no exception tables are -- be needed (by the Ravenscar profile) is the priority of the
-- needed. -- environment. Also no exception tables are needed.
if Main_Priority /= No_Main_Priority then if Main_Priority /= No_Main_Priority then
WBI (" Main_Priority : Integer;"); WBI (" Main_Priority : Integer;");
...@@ -513,8 +513,9 @@ package body Bindgen is ...@@ -513,8 +513,9 @@ package body Bindgen is
Write_Statement_Buffer; Write_Statement_Buffer;
if No_Run_Time_Specified then if No_Run_Time_Specified then
-- Case where No_Run_Time pragma is present.
-- Set __gl_main_priority if needed for the Ravenscar profile. -- Case of No_Run_Time mode. Set __gl_main_priority if needed
-- for the Ravenscar profile.
if Main_Priority /= No_Main_Priority then if Main_Priority /= No_Main_Priority then
Set_String (" extern int __gl_main_priority = "); Set_String (" extern int __gl_main_priority = ");
...@@ -524,7 +525,7 @@ package body Bindgen is ...@@ -524,7 +525,7 @@ package body Bindgen is
end if; end if;
else else
-- Code for normal case (no pragma No_Run_Time in use) -- Code for normal case (not in No_Run_Time mode)
Gen_Exception_Table_C; Gen_Exception_Table_C;
......
gcc/ada/cstand.adb
...@@ -1001,23 +1001,28 @@ package body CStand is ...@@ -1001,23 +1001,28 @@ package body CStand is
Set_Size_Known_At_Compile_Time Set_Size_Known_At_Compile_Time
(Universal_Fixed); (Universal_Fixed);
-- Create type declaration for Duration, using a 64-bit size. -- Create type declaration for Duration, using a 64-bit size. The
-- Delta is 1 nanosecond. -- delta value depends on the mode we are running in:
-- Except on 32 bits machine in No_Run_Time mode, in which case Duration
-- is a 32 bits value whose delta is 10E-4 seconds. -- Normal mode or No_Run_Time mode when word size is 64 bits:
-- 10**(-9) seconds, size is 64 bits
-- No_Run_Time mode when word size is 32 bits:
-- 10**(-4) seconds, oize is 32 bits
Build_Duration : declare Build_Duration : declare
Dlo : Uint; Dlo : Uint;
Dhi : Uint; Dhi : Uint;
Delta_Val : Ureal; Delta_Val : Ureal;
Use_32_Bits : constant Boolean := Use_32_Bits : constant Boolean :=
No_Run_Time and then System_Word_Size = 32; No_Run_Time and then System_Word_Size = 32;
begin begin
if Use_32_Bits then if Use_32_Bits then
Dlo := Intval (Type_Low_Bound (Standard_Integer_32)); Dlo := Intval (Type_Low_Bound (Standard_Integer_32));
Dhi := Intval (Type_High_Bound (Standard_Integer_32)); Dhi := Intval (Type_High_Bound (Standard_Integer_32));
Delta_Val := UR_From_Components (Uint_1, Uint_4, 10); Delta_Val := UR_From_Components (Uint_1, Uint_4, 10);
else else
Dlo := Intval (Type_Low_Bound (Standard_Integer_64)); Dlo := Intval (Type_Low_Bound (Standard_Integer_64));
Dhi := Intval (Type_High_Bound (Standard_Integer_64)); Dhi := Intval (Type_High_Bound (Standard_Integer_64));
......
gcc/ada/exp_ch7.adb
...@@ -601,7 +601,7 @@ package body Exp_Ch7 is ...@@ -601,7 +601,7 @@ package body Exp_Ch7 is
if Sec_Stk then if Sec_Stk then
Set_Uses_Sec_Stack (Current_Scope); Set_Uses_Sec_Stack (Current_Scope);
Disallow_In_No_Run_Time_Mode (N); Check_Restriction (No_Secondary_Stack, N);
end if; end if;
Set_Etype (Current_Scope, Standard_Void_Type); Set_Etype (Current_Scope, Standard_Void_Type);
...@@ -2449,7 +2449,7 @@ package body Exp_Ch7 is ...@@ -2449,7 +2449,7 @@ package body Exp_Ch7 is
if not Requires_Transient_Scope (Etype (S)) then if not Requires_Transient_Scope (Etype (S)) then
if not Functions_Return_By_DSP_On_Target then if not Functions_Return_By_DSP_On_Target then
Set_Uses_Sec_Stack (S, True); Set_Uses_Sec_Stack (S, True);
Disallow_In_No_Run_Time_Mode (Action); Check_Restriction (No_Secondary_Stack, Action);
end if; end if;
end if; end if;
...@@ -2470,7 +2470,7 @@ package body Exp_Ch7 is ...@@ -2470,7 +2470,7 @@ package body Exp_Ch7 is
then then
if not Functions_Return_By_DSP_On_Target then if not Functions_Return_By_DSP_On_Target then
Set_Uses_Sec_Stack (S, True); Set_Uses_Sec_Stack (S, True);
Disallow_In_No_Run_Time_Mode (Action); Check_Restriction (No_Secondary_Stack, Action);
end if; end if;
Set_Uses_Sec_Stack (Current_Scope, False); Set_Uses_Sec_Stack (Current_Scope, False);
...@@ -2703,7 +2703,7 @@ package body Exp_Ch7 is ...@@ -2703,7 +2703,7 @@ package body Exp_Ch7 is
null; null;
else else
Set_Uses_Sec_Stack (S); Set_Uses_Sec_Stack (S);
Disallow_In_No_Run_Time_Mode (N); Check_Restriction (No_Secondary_Stack, N);
end if; end if;
end if; end if;
end Wrap_Transient_Declaration; end Wrap_Transient_Declaration;
......
gcc/ada/fmap.adb
...@@ -6,9 +6,9 @@ ...@@ -6,9 +6,9 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision$ -- $Revision: 1.1 $
-- -- -- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- -- Copyright (C) 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- --
...@@ -26,14 +26,15 @@ ...@@ -26,14 +26,15 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with GNAT.HTable; with Namet; use Namet;
with Namet; use Namet; with Osint; use Osint;
with Osint; use Osint; with Output; use Output;
with Output; use Output;
with Table; with Table;
with Unchecked_Conversion; with Unchecked_Conversion;
with GNAT.HTable;
package body Fmap is package body Fmap is
subtype Big_String is String (Positive); subtype Big_String is String (Positive);
...@@ -63,6 +64,7 @@ package body Fmap is ...@@ -63,6 +64,7 @@ package body Fmap is
type Header_Num is range 0 .. 1_000; type Header_Num is range 0 .. 1_000;
function Hash (F : Unit_Name_Type) return Header_Num; function Hash (F : Unit_Name_Type) return Header_Num;
-- Function used to compute hash of unit name
No_Entry : constant Int := -1; No_Entry : constant Int := -1;
-- Signals no entry in following table -- Signals no entry in following table
...@@ -87,14 +89,15 @@ package body Fmap is ...@@ -87,14 +89,15 @@ package body Fmap is
-- Hash table to map file names to path names. Used in conjunction with -- Hash table to map file names to path names. Used in conjunction with
-- table Path_Mapping above. -- table Path_Mapping above.
--------- ---------------------
-- Add -- -- Add_To_File_Map --
--------- ---------------------
procedure Add procedure Add_To_File_Map
(Unit_Name : Unit_Name_Type; (Unit_Name : Unit_Name_Type;
File_Name : File_Name_Type; File_Name : File_Name_Type;
Path_Name : File_Name_Type) is Path_Name : File_Name_Type)
is
begin begin
File_Mapping.Increment_Last; File_Mapping.Increment_Last;
Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last); Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
...@@ -102,23 +105,7 @@ package body Fmap is ...@@ -102,23 +105,7 @@ package body Fmap is
Path_Mapping.Increment_Last; Path_Mapping.Increment_Last;
File_Hash_Table.Set (File_Name, Path_Mapping.Last); File_Hash_Table.Set (File_Name, Path_Mapping.Last);
Path_Mapping.Table (Path_Mapping.Last) := Path_Name; Path_Mapping.Table (Path_Mapping.Last) := Path_Name;
end Add; end Add_To_File_Map;
------------------
-- File_Name_Of --
------------------
function File_Name_Of (Unit : Unit_Name_Type) return File_Name_Type is
The_Index : constant Int := Unit_Hash_Table.Get (Unit);
begin
if The_Index = No_Entry then
return No_File;
else
return File_Mapping.Table (The_Index);
end if;
end File_Name_Of;
---------- ----------
-- Hash -- -- Hash --
...@@ -174,10 +161,12 @@ package body Fmap is ...@@ -174,10 +161,12 @@ package body Fmap is
procedure Get_Line is procedure Get_Line is
use ASCII; use ASCII;
begin begin
Deb := Fin + 1; Deb := Fin + 1;
-- If not at the end of file, skip the end of line -- If not at the end of file, skip the end of line
while Deb < SP'Last while Deb < SP'Last
and then (SP (Deb) = CR and then (SP (Deb) = CR
or else SP (Deb) = LF or else SP (Deb) = LF
...@@ -213,7 +202,7 @@ package body Fmap is ...@@ -213,7 +202,7 @@ package body Fmap is
Write_Line (""" is truncated"); Write_Line (""" is truncated");
end Report_Truncated; end Report_Truncated;
-- start of procedure Initialize -- Start of procedure Initialize
begin begin
Name_Len := File_Name'Length; Name_Len := File_Name'Length;
...@@ -230,7 +219,6 @@ package body Fmap is ...@@ -230,7 +219,6 @@ package body Fmap is
SP := BS (1 .. Natural (Hi))'Unrestricted_Access; SP := BS (1 .. Natural (Hi))'Unrestricted_Access;
loop loop
-- Get the unit name -- Get the unit name
Get_Line; Get_Line;
...@@ -303,30 +291,41 @@ package body Fmap is ...@@ -303,30 +291,41 @@ package body Fmap is
-- Add the mappings for this unit name -- Add the mappings for this unit name
Add (Uname, Fname, Pname); Add_To_File_Map (Uname, Fname, Pname);
end loop; end loop;
end if; end if;
end Initialize; end Initialize;
------------------ ----------------------
-- Path_Name_Of -- -- Mapped_File_Name --
------------------ ----------------------
function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type is
The_Index : constant Int := Unit_Hash_Table.Get (Unit);
begin
if The_Index = No_Entry then
return No_File;
else
return File_Mapping.Table (The_Index);
end if;
end Mapped_File_Name;
----------------------
-- Mapped_Path_Name --
----------------------
function Path_Name_Of (File : File_Name_Type) return File_Name_Type is function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type is
Index : Int := No_Entry; Index : Int := No_Entry;
begin begin
Index := File_Hash_Table.Get (File); Index := File_Hash_Table.Get (File);
if Index = No_Entry then if Index = No_Entry then
return No_File; return No_File;
else else
return Path_Mapping.Table (Index); return Path_Mapping.Table (Index);
end if; end if;
end Mapped_Path_Name;
end Path_Name_Of;
end Fmap; end Fmap;
gcc/ada/fmap.ads
...@@ -6,9 +6,9 @@ ...@@ -6,9 +6,9 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- $Revision$ -- $Revision: 1.1 $
-- -- -- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- -- Copyright (C) 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- --
...@@ -38,15 +38,15 @@ package Fmap is ...@@ -38,15 +38,15 @@ package Fmap is
-- If the mapping file is incorrect (non existent file, truncated file, -- If the mapping file is incorrect (non existent file, truncated file,
-- duplicate entries), output a warning and do not initialize the mappings. -- duplicate entries), output a warning and do not initialize the mappings.
function Path_Name_Of (File : File_Name_Type) return File_Name_Type; function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type;
-- Return the path name mapped to the file name File. -- Return the path name mapped to the file name File.
-- Return No_File if File is not mapped. -- Return No_File if File is not mapped.
function File_Name_Of (Unit : Unit_Name_Type) return File_Name_Type; function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type;
-- Return the file name mapped to the unit name Unit. -- Return the file name mapped to the unit name Unit.
-- Return No_File if Unit is not mapped. -- Return No_File if Unit is not mapped.
procedure Add procedure Add_To_File_Map
(Unit_Name : Unit_Name_Type; (Unit_Name : Unit_Name_Type;
File_Name : File_Name_Type; File_Name : File_Name_Type;
Path_Name : File_Name_Type); Path_Name : File_Name_Type);
......
gcc/ada/fname-uf.adb
...@@ -28,7 +28,7 @@ ...@@ -28,7 +28,7 @@
with Alloc; with Alloc;
with Debug; use Debug; with Debug; use Debug;
with Fmap; with Fmap; use Fmap;
with Krunch; with Krunch;
with Namet; use Namet; with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
...@@ -140,6 +140,7 @@ package body Fname.UF is ...@@ -140,6 +140,7 @@ package body Fname.UF is
Pname : File_Name_Type := No_File; Pname : File_Name_Type := No_File;
Fname : File_Name_Type := No_File; Fname : File_Name_Type := No_File;
-- Path name and File name for mapping
begin begin
-- Null or error name means that some previous error occurred -- Null or error name means that some previous error occurred
...@@ -149,12 +150,12 @@ package body Fname.UF is ...@@ -149,12 +150,12 @@ package body Fname.UF is
raise Unrecoverable_Error; raise Unrecoverable_Error;
end if; end if;
-- Look into the mapping from unit names to file names -- Look in the map from unit names to file names
Fname := Fmap.File_Name_Of (Uname); Fname := Mapped_File_Name (Uname);
-- If the unit name is already mapped, return the corresponding -- If the unit name is already mapped, return the corresponding
-- file name. -- file name from the map.
if Fname /= No_File then if Fname /= No_File then
return Fname; return Fname;
...@@ -394,7 +395,7 @@ package body Fname.UF is ...@@ -394,7 +395,7 @@ package body Fname.UF is
-- Add to mapping, so that we don't do another -- Add to mapping, so that we don't do another
-- path search in Find_File for this file name -- path search in Find_File for this file name
Fmap.Add (Get_File_Name.Uname, Fnam, Pname); Add_To_File_Map (Get_File_Name.Uname, Fnam, Pname);
return Fnam; return Fnam;
-- This entry does not match after all, because this is -- This entry does not match after all, because this is
......
gcc/ada/g-regpat.adb
...@@ -245,9 +245,9 @@ package body GNAT.Regpat is ...@@ -245,9 +245,9 @@ package body GNAT.Regpat is
procedure Reset_Class (Bitmap : in out Character_Class); procedure Reset_Class (Bitmap : in out Character_Class);
-- Clear all the entries in the class Bitmap. -- Clear all the entries in the class Bitmap.
pragma Inline_Always (Set_In_Class); pragma Inline (Set_In_Class);
pragma Inline_Always (Get_From_Class); pragma Inline (Get_From_Class);
pragma Inline_Always (Reset_Class); pragma Inline (Reset_Class);
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
...@@ -512,9 +512,9 @@ package body GNAT.Regpat is ...@@ -512,9 +512,9 @@ package body GNAT.Regpat is
-- Parse a posic character class, like [:alpha:] or [:^alpha:]. -- Parse a posic character class, like [:alpha:] or [:^alpha:].
-- The called is suppoed to absorbe the opening [. -- The called is suppoed to absorbe the opening [.
pragma Inline_Always (Is_Mult); pragma Inline (Is_Mult);
pragma Inline_Always (Emit_Natural); pragma Inline (Emit_Natural);
pragma Inline_Always (Parse_Character_Class); -- since used only once pragma Inline (Parse_Character_Class); -- since used only once
--------------- ---------------
-- Case_Emit -- -- Case_Emit --
...@@ -2401,12 +2401,13 @@ package body GNAT.Regpat is ...@@ -2401,12 +2401,13 @@ package body GNAT.Regpat is
return Boolean; return Boolean;
-- Return True it the simple operator (possibly non-greedy) matches -- Return True it the simple operator (possibly non-greedy) matches
pragma Inline_Always (Index); pragma Inline (Index);
pragma Inline_Always (Repeat); pragma Inline (Repeat);
-- These are two complex functions, but used only once. -- These are two complex functions, but used only once.
pragma Inline_Always (Match_Whilem);
pragma Inline_Always (Match_Simple_Operator); pragma Inline (Match_Whilem);
pragma Inline (Match_Simple_Operator);
----------- -----------
-- Index -- -- Index --
......
gcc/ada/g-socket.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.21 $ -- $Revision$
-- -- -- --
-- Copyright (C) 2001 Ada Core Technologies, Inc. -- -- Copyright (C) 2001 Ada Core Technologies, Inc. --
-- -- -- --
...@@ -166,12 +166,11 @@ package body GNAT.Sockets is ...@@ -166,12 +166,11 @@ package body GNAT.Sockets is
-- Types needed for Datagram_Socket_Stream_Type -- Types needed for Datagram_Socket_Stream_Type
type Datagram_Socket_Stream_Type is new Root_Stream_Type with type Datagram_Socket_Stream_Type is new Root_Stream_Type with record
record Socket : Socket_Type;
Socket : Socket_Type; To : Sock_Addr_Type;
To : Sock_Addr_Type; From : Sock_Addr_Type;
From : Sock_Addr_Type; end record;
end record;
type Datagram_Socket_Stream_Access is type Datagram_Socket_Stream_Access is
access all Datagram_Socket_Stream_Type; access all Datagram_Socket_Stream_Type;
...@@ -187,10 +186,9 @@ package body GNAT.Sockets is ...@@ -187,10 +186,9 @@ package body GNAT.Sockets is
-- Types needed for Stream_Socket_Stream_Type -- Types needed for Stream_Socket_Stream_Type
type Stream_Socket_Stream_Type is new Root_Stream_Type with type Stream_Socket_Stream_Type is new Root_Stream_Type with record
record Socket : Socket_Type;
Socket : Socket_Type; end record;
end record;
type Stream_Socket_Stream_Access is type Stream_Socket_Stream_Access is
access all Stream_Socket_Stream_Type; access all Stream_Socket_Stream_Type;
......
gcc/ada/make.adb
...@@ -3501,7 +3501,6 @@ package body Make is ...@@ -3501,7 +3501,6 @@ package body Make is
begin begin
Delete_File (Name => Mapping_File_Name, Success => Success); Delete_File (Name => Mapping_File_Name, Success => Success);
end; end;
end if; end if;
Exit_Program (E_Success); Exit_Program (E_Success);
......
gcc/ada/osint.adb
...@@ -26,7 +26,7 @@ ...@@ -26,7 +26,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Fmap; with Fmap; use Fmap;
with Hostparm; with Hostparm;
with Namet; use Namet; with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
...@@ -996,16 +996,16 @@ package body Osint is ...@@ -996,16 +996,16 @@ package body Osint is
-- directory where the user said it was. -- directory where the user said it was.
elsif Look_In_Primary_Directory_For_Current_Main elsif Look_In_Primary_Directory_For_Current_Main
and then Current_Main = N then and then Current_Main = N
then
return Locate_File (N, T, Primary_Directory, File_Name); return Locate_File (N, T, Primary_Directory, File_Name);
-- Otherwise do standard search for source file -- Otherwise do standard search for source file
else else
-- Check the mapping of this file name -- Check the mapping of this file name
File := Fmap.Path_Name_Of (N); File := Mapped_Path_Name (N);
-- If the file name is mapped to a path name, return the -- If the file name is mapped to a path name, return the
-- corresponding path name -- corresponding path name
......
gcc/ada/prj-env.adb
...@@ -804,6 +804,10 @@ package body Prj.Env is ...@@ -804,6 +804,10 @@ package body Prj.Env is
-- Put the mapping of the spec or body contained in Data in the file -- Put the mapping of the spec or body contained in Data in the file
-- (3 lines). -- (3 lines).
---------
-- Put --
---------
procedure Put (S : String) is procedure Put (S : String) is
Last : Natural; Last : Natural;
...@@ -813,9 +817,12 @@ package body Prj.Env is ...@@ -813,9 +817,12 @@ package body Prj.Env is
if Last /= S'Length then if Last /= S'Length then
Osint.Fail ("Disk full"); Osint.Fail ("Disk full");
end if; end if;
end Put; end Put;
--------------
-- Put_Data --
--------------
procedure Put_Data (Spec : Boolean) is procedure Put_Data (Spec : Boolean) is
begin begin
Put (Get_Name_String (The_Unit_Data.Name)); Put (Get_Name_String (The_Unit_Data.Name));
...@@ -833,6 +840,8 @@ package body Prj.Env is ...@@ -833,6 +840,8 @@ package body Prj.Env is
Put (S => (1 => ASCII.LF)); Put (S => (1 => ASCII.LF));
end Put_Data; end Put_Data;
-- Start of processing for Create_Mapping_File
begin begin
GNAT.OS_Lib.Create_Temp_File (File, Name => Name); GNAT.OS_Lib.Create_Temp_File (File, Name => Name);
...@@ -938,7 +947,7 @@ package body Prj.Env is ...@@ -938,7 +947,7 @@ package body Prj.Env is
for Current in reverse Units.First .. Units.Last loop for Current in reverse Units.First .. Units.Last loop
Unit := Units.Table (Current); Unit := Units.Table (Current);
-- If it is a unit of the same project -- Case of unit of the same project
if Unit.File_Names (Body_Part).Project = Project then if Unit.File_Names (Body_Part).Project = Project then
declare declare
...@@ -946,7 +955,7 @@ package body Prj.Env is ...@@ -946,7 +955,7 @@ package body Prj.Env is
Unit.File_Names (Body_Part).Name; Unit.File_Names (Body_Part).Name;
begin begin
-- If there is a body -- Case of a body present
if Current_Name /= No_Name then if Current_Name /= No_Name then
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -987,7 +996,7 @@ package body Prj.Env is ...@@ -987,7 +996,7 @@ package body Prj.Env is
end; end;
end if; end if;
-- If it is a unit of the same project -- Case of a unit of the same project
if Units.Table (Current).File_Names (Specification).Project = if Units.Table (Current).File_Names (Specification).Project =
Project Project
...@@ -997,7 +1006,7 @@ package body Prj.Env is ...@@ -997,7 +1006,7 @@ package body Prj.Env is
Unit.File_Names (Specification).Name; Unit.File_Names (Specification).Name;
begin begin
-- If there is a spec -- Case of spec present
if Current_Name /= No_Name then if Current_Name /= No_Name then
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -1007,8 +1016,7 @@ package body Prj.Env is ...@@ -1007,8 +1016,7 @@ package body Prj.Env is
Write_Eol; Write_Eol;
end if; end if;
-- If it has the same name as the original name, -- If name same as the original name, return original name
-- return the original name
if Unit.Name = The_Original_Name if Unit.Name = The_Original_Name
or else Current_Name = The_Original_Name or else Current_Name = The_Original_Name
...@@ -1020,7 +1028,7 @@ package body Prj.Env is ...@@ -1020,7 +1028,7 @@ package body Prj.Env is
return Get_Name_String (Current_Name); return Get_Name_String (Current_Name);
-- If it has the same name as the extended spec name, -- If it has the same name as the extended spec name,
-- return the extended spec name -- return the extended spec name.
elsif Current_Name = The_Spec_Name then elsif Current_Name = The_Spec_Name then
if Current_Verbosity = High then if Current_Verbosity = High then
......
gcc/ada/prj-env.ads
...@@ -40,9 +40,8 @@ package Prj.Env is ...@@ -40,9 +40,8 @@ package Prj.Env is
-- Output the list of sources, after Project files have been scanned -- Output the list of sources, after Project files have been scanned
procedure Create_Mapping_File (Name : in out Temp_File_Name); procedure Create_Mapping_File (Name : in out Temp_File_Name);
-- Create a temporary mapping file. -- Create a temporary mapping file. For each unit, put the mapping of
-- For each unit, put the mapping of its spec and or body to its -- its spec and or body to its file name and path name in this file.
-- file name and path name in this file.
procedure Create_Config_Pragmas_File procedure Create_Config_Pragmas_File
(For_Project : Project_Id; (For_Project : Project_Id;
......
gcc/ada/prj-tree.ads
...@@ -38,27 +38,30 @@ with Table; ...@@ -38,27 +38,30 @@ with Table;
package Prj.Tree is package Prj.Tree is
Project_Nodes_Initial : constant := 1_000; Project_Nodes_Initial : constant := 1_000;
-- Initial number of nodes in table Tree_Private_Part.Project_Nodes
Project_Nodes_Increment : constant := 100; Project_Nodes_Increment : constant := 100;
-- Allocation parameters for initializing and extending number
-- of nodes in table Tree_Private_Part.Project_Nodes
Project_Node_Low_Bound : constant := 0; Project_Node_Low_Bound : constant := 0;
Project_Node_High_Bound : constant := 099_999_999; -- In practice, infinite Project_Node_High_Bound : constant := 099_999_999;
-- Range of values for project node id's (in practice infinite)
type Project_Node_Id is range type Project_Node_Id is range
Project_Node_Low_Bound .. Project_Node_High_Bound; Project_Node_Low_Bound .. Project_Node_High_Bound;
-- The index of table Tree_Private_Part.Project_Nodes -- The index of table Tree_Private_Part.Project_Nodes
Empty_Node : constant Project_Node_Id := Project_Node_Low_Bound; Empty_Node : constant Project_Node_Id := Project_Node_Low_Bound;
-- Designates no node in table Project_Nodes -- Designates no node in table Project_Nodes
First_Node_Id : constant Project_Node_Id := Project_Node_Low_Bound; First_Node_Id : constant Project_Node_Id := Project_Node_Low_Bound;
subtype Variable_Node_Id is Project_Node_Id; subtype Variable_Node_Id is Project_Node_Id;
-- Used to designate a node whose expected kind is -- Used to designate a node whose expected kind is one of
-- N_Typed_Variable_Declaration, N_Variable_Declaration or -- N_Typed_Variable_Declaration, N_Variable_Declaration or
-- N_Variable_Reference. -- N_Variable_Reference.
subtype Package_Declaration_Id is Project_Node_Id; subtype Package_Declaration_Id is Project_Node_Id;
-- Used to designate a node whose expected kind is -- Used to designate a node whose expected kind is N_Proect_Declaration
-- N_Project_Declaration.
type Project_Node_Kind is type Project_Node_Kind is
(N_Project, (N_Project,
...@@ -90,7 +93,7 @@ package Prj.Tree is ...@@ -90,7 +93,7 @@ package Prj.Tree is
function Default_Project_Node function Default_Project_Node
(Of_Kind : Project_Node_Kind; (Of_Kind : Project_Node_Kind;
And_Expr_Kind : Variable_Kind := Undefined) And_Expr_Kind : Variable_Kind := Undefined)
return Project_Node_Id; return Project_Node_Id;
-- Returns a Project_Node_Record with the specified Kind and -- Returns a Project_Node_Record with the specified Kind and
-- Expr_Kind; all the other components have default nil values. -- Expr_Kind; all the other components have default nil values.
...@@ -121,7 +124,7 @@ package Prj.Tree is ...@@ -121,7 +124,7 @@ package Prj.Tree is
function First_Variable_Of function First_Variable_Of
(Node : Project_Node_Id) (Node : Project_Node_Id)
return Variable_Node_Id; return Variable_Node_Id;
-- Only valid for N_Project or N_Package_Declaration nodes -- Only valid for N_Project or N_Package_Declaration nodes
function First_Package_Of function First_Package_Of
...@@ -499,44 +502,52 @@ package Prj.Tree is ...@@ -499,44 +502,52 @@ package Prj.Tree is
type Project_Node_Record is record type Project_Node_Record is record
Kind : Project_Node_Kind; Kind : Project_Node_Kind;
Location : Source_Ptr := No_Location; Location : Source_Ptr := No_Location;
Directory : Name_Id := No_Name; Directory : Name_Id := No_Name;
-- Only for N_Project -- Only for N_Project
Expr_Kind : Variable_Kind := Undefined; Expr_Kind : Variable_Kind := Undefined;
-- See below for what Project_Node_Kind it is used -- See below for what Project_Node_Kind it is used
Variables : Variable_Node_Id := Empty_Node; Variables : Variable_Node_Id := Empty_Node;
-- First variable in a project or a package -- First variable in a project or a package
Packages : Package_Declaration_Id := Empty_Node; Packages : Package_Declaration_Id := Empty_Node;
-- First package declaration in a project -- First package declaration in a project
Pkg_Id : Package_Node_Id := Empty_Package; Pkg_Id : Package_Node_Id := Empty_Package;
-- Only use in Package_Declaration -- Only used for N_Package_Declaration
-- The component Pkg_Id is an entry into the table Package_Attributes
Name : Name_Id := No_Name; -- (in Prj.Attr). It is used to indicate all the attributes of the
-- package with their characteristics.
--
-- The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
-- are built once and for all through a call (from Prj.Initialize)
-- to procedure Prj.Attr.Initialize. It is never modified after that.
Name : Name_Id := No_Name;
-- See below for what Project_Node_Kind it is used -- See below for what Project_Node_Kind it is used
Path_Name : Name_Id := No_Name; Path_Name : Name_Id := No_Name;
-- See below for what Project_Node_Kind it is used -- See below for what Project_Node_Kind it is used
Value : String_Id := No_String; Value : String_Id := No_String;
-- See below for what Project_Node_Kind it is used -- See below for what Project_Node_Kind it is used
Field1 : Project_Node_Id := Empty_Node; Field1 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind -- See below the meaning for each Project_Node_Kind
Field2 : Project_Node_Id := Empty_Node; Field2 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind -- See below the meaning for each Project_Node_Kind
Field3 : Project_Node_Id := Empty_Node; Field3 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind -- See below the meaning for each Project_Node_Kind
Case_Insensitive : Boolean := False; Case_Insensitive : Boolean := False;
-- Significant only for N_Attribute_Declaration
-- Indicates, for an associative array attribute, that the -- Indicates, for an associative array attribute, that the
-- index is case insensitive. -- index is case insensitive.
...@@ -726,10 +737,12 @@ package Prj.Tree is ...@@ -726,10 +737,12 @@ package Prj.Tree is
-- from project files. -- from project files.
type Project_Name_And_Node is record type Project_Name_And_Node is record
Name : Name_Id; Name : Name_Id;
-- Name of the project -- Name of the project
Node : Project_Node_Id;
Node : Project_Node_Id;
-- Node of the project in table Project_Nodes -- Node of the project in table Project_Nodes
Modified : Boolean; Modified : Boolean;
-- True when the project is being modified by another project -- True when the project is being modified by another project
end record; end record;
......
gcc/ada/s-taprob.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.79 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1991-2001 Florida State University -- -- Copyright (C) 1991-2001 Florida State University --
-- -- -- --
...@@ -42,12 +42,8 @@ with System.Task_Primitives.Operations; ...@@ -42,12 +42,8 @@ with System.Task_Primitives.Operations;
-- used for Write_Lock -- used for Write_Lock
-- Unlock -- Unlock
with Ada.Exceptions;
-- used for Raise_Exception
package body System.Tasking.Protected_Objects is package body System.Tasking.Protected_Objects is
use Ada.Exceptions;
use System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
------------------------- -------------------------
...@@ -97,7 +93,7 @@ package body System.Tasking.Protected_Objects is ...@@ -97,7 +93,7 @@ package body System.Tasking.Protected_Objects is
Write_Lock (Object.L'Access, Ceiling_Violation); Write_Lock (Object.L'Access, Ceiling_Violation);
if Ceiling_Violation then if Ceiling_Violation then
Raise_Exception (Program_Error'Identity, "Ceiling Violation"); raise Program_Error;
end if; end if;
end Lock; end Lock;
...@@ -111,7 +107,7 @@ package body System.Tasking.Protected_Objects is ...@@ -111,7 +107,7 @@ package body System.Tasking.Protected_Objects is
Read_Lock (Object.L'Access, Ceiling_Violation); Read_Lock (Object.L'Access, Ceiling_Violation);
if Ceiling_Violation then if Ceiling_Violation then
Raise_Exception (Program_Error'Identity, "Ceiling Violation"); raise Program_Error;
end if; end if;
end Lock_Read_Only; end Lock_Read_Only;
......
gcc/ada/switch.adb
...@@ -610,8 +610,9 @@ package body Switch is ...@@ -610,8 +610,9 @@ package body Switch is
when 'c' => when 'c' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
if Ptr > Max then if Ptr > Max then
Osint.Fail ("Invalid switch: ", "ec"); raise Bad_Switch;
end if; end if;
Config_File_Name := Config_File_Name :=
...@@ -623,18 +624,17 @@ package body Switch is ...@@ -623,18 +624,17 @@ package body Switch is
when 'm' => when 'm' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
if Ptr > Max then if Ptr > Max then
Osint.Fail ("Invalid switch: ", "em"); raise Bad_Switch;
end if; end if;
Mapping_File_Name := Mapping_File_Name :=
new String'(Switch_Chars (Ptr .. Max)); new String'(Switch_Chars (Ptr .. Max));
return; return;
when others => when others =>
Osint.Fail ("Invalid switch: ", raise Bad_Switch;
(1 => 'e', 2 => Switch_Chars (Ptr)));
end case; end case;
-- Processing for E switch -- Processing for E switch
......
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