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>
* config-lang.in (diff_excludes): Remove.
......
gcc/ada/Makefile.in
......@@ -1060,7 +1060,6 @@ ifeq ($(strip $(filter-out sparc sun solaris2% sunos5%,$(targ))),)
a-intnam.ads<4sintnam.ads \
s-inmaop.adb<7sinmaop.adb \
s-intman.adb<5sintman.adb \
s-mastop.adb<5smastop.adb \
s-osinte.adb<5sosinte.adb \
s-osinte.ads<5sosinte.ads \
s-osprim.adb<5posprim.adb \
......@@ -1086,7 +1085,6 @@ ifeq ($(strip $(filter-out sparc sun solaris2% sunos5%,$(targ))),)
a-intnam.ads<4sintnam.ads \
s-inmaop.adb<7sinmaop.adb \
s-intman.adb<5sintman.adb \
s-mastop.adb<5smastop.adb \
s-osinte.adb<7sosinte.adb \
s-osinte.ads<5tosinte.ads \
s-osprim.adb<5posprim.adb \
......@@ -1105,7 +1103,6 @@ ifeq ($(strip $(filter-out sparc sun solaris2% sunos5%,$(targ))),)
a-intnam.ads<4sintnam.ads \
s-inmaop.adb<7sinmaop.adb \
s-intman.adb<7sintman.adb \
s-mastop.adb<5smastop.adb \
s-osinte.adb<5iosinte.adb \
s-osinte.ads<54osinte.ads \
s-osprim.adb<5posprim.adb \
......@@ -1909,6 +1906,8 @@ HIE_SOURCES = \
s-fatlfl.ads \
s-fatllf.ads \
s-fatsfl.ads \
s-secsta.ads \
s-secsta.adb \
a-tags.ads \
a-tags.adb $(EXTRA_HIE_SOURCES)
......@@ -1923,23 +1922,19 @@ HIE_OBJS = \
s-stoele.o \
s-maccod.o \
s-unstyp.o \
s-fatflt.o \
s-fatlfl.o \
s-fatllf.o \
s-secsta.o \
a-tags.o $(EXTRA_HIE_OBJS)
# Files which are needed in ravenscar mode
RAVEN_SOURCES = \
$(HIE_SOURCES) \
s-arit64.ads \
s-arit64.adb \
s-parame.ads \
s-parame.adb \
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.adb \
s-tasinf.ads \
......@@ -1948,9 +1943,12 @@ RAVEN_SOURCES = \
s-taprop.ads \
s-taprop.adb \
s-taskin.ads \
s-taskin.adb \
s-interr.ads \
s-interr.adb \
s-taskin.adb \
a-interr.ads \
a-interr.adb \
a-intnam.ads \
a-reatim.ads \
a-reatim.adb \
a-retide.ads \
......@@ -1963,33 +1961,24 @@ RAVEN_SOURCES = \
s-tarest.ads \
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
RAVEN_OBJS = \
$(HIE_OBJS) \
g-except.o \
s-stalib.o \
s-arit64.o \
s-parame.o \
s-soflin.o \
s-secsta.o \
s-tasinf.o \
g-except.o \
s-osinte.o \
s-tasinf.o \
s-taspri.o \
s-taprop.o \
s-taskin.o \
s-taprob.o \
s-tposen.o \
s-interr.o \
a-interr.o \
a-intnam.o \
a-reatim.o \
a-retide.o \
s-taprob.o \
s-tposen.o \
s-tasres.o \
s-tarest.o $(EXTRA_RAVEN_OBJS)
......
gcc/ada/a-ngelfu.adb
......@@ -6,9 +6,9 @@
-- --
-- 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 --
-- 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
Log_Two : constant := 0.69314_71805_59945_30941_72321_21458_17656_80755;
Half_Log_Two : constant := Log_Two / 2;
subtype T is Float_Type'Base;
subtype Double is Aux.Double;
Two_Pi : constant T := 2.0 * Pi;
Half_Pi : constant T := Pi / 2.0;
Fourth_Pi : constant T := Pi / 4.0;
......@@ -68,7 +66,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is
Log_Inverse_Epsilon : constant T := T (T'Model_Mantissa - 1) * Log_Two;
Sqrt_Epsilon : constant T := Sqrt_Two ** (1 - T'Model_Mantissa);
DEpsilon : constant Double := Double (Epsilon);
DIEpsilon : constant Double := Double (IEpsilon);
......@@ -558,7 +555,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is
-- Just reuse the code for Sin. The potential small
-- 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);
end Cos;
......@@ -716,7 +712,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is
Q := ((Q3 * Z + Q2) * Z + Q1) * Z + Q0;
R := 0.5 + P / (Q - P);
R := Float_Type'Base'Scaling (R, Integer (XN) + 1);
-- Deal with case of Exp returning IEEE infinity. If Machine_Overflows
......@@ -732,7 +727,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is
end Exp_Strict;
----------------
-- Local_Atan --
----------------
......
gcc/ada/bindgen.adb
......@@ -343,16 +343,16 @@ package body Bindgen is
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
-- the routine call, rather than define the globals in the binder
-- file to deal with cross-library calls in some systems.
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
-- the environment task's priority. Also no exception tables are
-- needed.
-- Case of No_Run_Time mode. The only global variable that might
-- be needed (by the Ravenscar profile) is the priority of the
-- environment. Also no exception tables are needed.
if Main_Priority /= No_Main_Priority then
WBI (" Main_Priority : Integer;");
......@@ -513,8 +513,9 @@ package body Bindgen is
Write_Statement_Buffer;
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
Set_String (" extern int __gl_main_priority = ");
......@@ -524,7 +525,7 @@ package body Bindgen is
end if;
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;
......
gcc/ada/cstand.adb
......@@ -1001,23 +1001,28 @@ package body CStand is
Set_Size_Known_At_Compile_Time
(Universal_Fixed);
-- Create type declaration for Duration, using a 64-bit size.
-- Delta is 1 nanosecond.
-- 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.
-- Create type declaration for Duration, using a 64-bit size. The
-- delta value depends on the mode we are running in:
-- 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
Dlo : Uint;
Dhi : Uint;
Delta_Val : Ureal;
Use_32_Bits : constant Boolean :=
No_Run_Time and then System_Word_Size = 32;
No_Run_Time and then System_Word_Size = 32;
begin
if Use_32_Bits then
Dlo := Intval (Type_Low_Bound (Standard_Integer_32));
Dhi := Intval (Type_High_Bound (Standard_Integer_32));
Delta_Val := UR_From_Components (Uint_1, Uint_4, 10);
else
Dlo := Intval (Type_Low_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
if Sec_Stk then
Set_Uses_Sec_Stack (Current_Scope);
Disallow_In_No_Run_Time_Mode (N);
Check_Restriction (No_Secondary_Stack, N);
end if;
Set_Etype (Current_Scope, Standard_Void_Type);
......@@ -2449,7 +2449,7 @@ package body Exp_Ch7 is
if not Requires_Transient_Scope (Etype (S)) then
if not Functions_Return_By_DSP_On_Target then
Set_Uses_Sec_Stack (S, True);
Disallow_In_No_Run_Time_Mode (Action);
Check_Restriction (No_Secondary_Stack, Action);
end if;
end if;
......@@ -2470,7 +2470,7 @@ package body Exp_Ch7 is
then
if not Functions_Return_By_DSP_On_Target then
Set_Uses_Sec_Stack (S, True);
Disallow_In_No_Run_Time_Mode (Action);
Check_Restriction (No_Secondary_Stack, Action);
end if;
Set_Uses_Sec_Stack (Current_Scope, False);
......@@ -2703,7 +2703,7 @@ package body Exp_Ch7 is
null;
else
Set_Uses_Sec_Stack (S);
Disallow_In_No_Run_Time_Mode (N);
Check_Restriction (No_Secondary_Stack, N);
end if;
end if;
end Wrap_Transient_Declaration;
......
gcc/ada/fmap.adb
......@@ -6,9 +6,9 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -26,14 +26,15 @@
-- --
------------------------------------------------------------------------------
with GNAT.HTable;
with Namet; use Namet;
with Osint; use Osint;
with Output; use Output;
with Namet; use Namet;
with Osint; use Osint;
with Output; use Output;
with Table;
with Unchecked_Conversion;
with GNAT.HTable;
package body Fmap is
subtype Big_String is String (Positive);
......@@ -63,6 +64,7 @@ package body Fmap is
type Header_Num is range 0 .. 1_000;
function Hash (F : Unit_Name_Type) return Header_Num;
-- Function used to compute hash of unit name
No_Entry : constant Int := -1;
-- Signals no entry in following table
......@@ -87,14 +89,15 @@ package body Fmap is
-- Hash table to map file names to path names. Used in conjunction with
-- table Path_Mapping above.
---------
-- Add --
---------
---------------------
-- Add_To_File_Map --
---------------------
procedure Add
procedure Add_To_File_Map
(Unit_Name : Unit_Name_Type;
File_Name : File_Name_Type;
Path_Name : File_Name_Type) is
Path_Name : File_Name_Type)
is
begin
File_Mapping.Increment_Last;
Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
......@@ -102,23 +105,7 @@ package body Fmap is
Path_Mapping.Increment_Last;
File_Hash_Table.Set (File_Name, Path_Mapping.Last);
Path_Mapping.Table (Path_Mapping.Last) := Path_Name;
end Add;
------------------
-- 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;
end Add_To_File_Map;
----------
-- Hash --
......@@ -174,10 +161,12 @@ package body Fmap is
procedure Get_Line is
use ASCII;
begin
Deb := Fin + 1;
-- If not at the end of file, skip the end of line
while Deb < SP'Last
and then (SP (Deb) = CR
or else SP (Deb) = LF
......@@ -213,7 +202,7 @@ package body Fmap is
Write_Line (""" is truncated");
end Report_Truncated;
-- start of procedure Initialize
-- Start of procedure Initialize
begin
Name_Len := File_Name'Length;
......@@ -230,7 +219,6 @@ package body Fmap is
SP := BS (1 .. Natural (Hi))'Unrestricted_Access;
loop
-- Get the unit name
Get_Line;
......@@ -303,30 +291,41 @@ package body Fmap is
-- Add the mappings for this unit name
Add (Uname, Fname, Pname);
Add_To_File_Map (Uname, Fname, Pname);
end loop;
end if;
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;
begin
Index := File_Hash_Table.Get (File);
if Index = No_Entry then
return No_File;
else
return Path_Mapping.Table (Index);
end if;
end Path_Name_Of;
end Mapped_Path_Name;
end Fmap;
gcc/ada/fmap.ads
......@@ -6,9 +6,9 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -38,15 +38,15 @@ package Fmap is
-- If the mapping file is incorrect (non existent file, truncated file,
-- 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 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 No_File if Unit is not mapped.
procedure Add
procedure Add_To_File_Map
(Unit_Name : Unit_Name_Type;
File_Name : File_Name_Type;
Path_Name : File_Name_Type);
......
gcc/ada/fname-uf.adb
......@@ -28,7 +28,7 @@
with Alloc;
with Debug; use Debug;
with Fmap;
with Fmap; use Fmap;
with Krunch;
with Namet; use Namet;
with Opt; use Opt;
......@@ -140,6 +140,7 @@ package body Fname.UF is
Pname : File_Name_Type := No_File;
Fname : File_Name_Type := No_File;
-- Path name and File name for mapping
begin
-- Null or error name means that some previous error occurred
......@@ -149,12 +150,12 @@ package body Fname.UF is
raise Unrecoverable_Error;
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
-- file name.
-- file name from the map.
if Fname /= No_File then
return Fname;
......@@ -394,7 +395,7 @@ package body Fname.UF is
-- Add to mapping, so that we don't do another
-- 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;
-- This entry does not match after all, because this is
......
gcc/ada/g-regpat.adb
......@@ -245,9 +245,9 @@ package body GNAT.Regpat is
procedure Reset_Class (Bitmap : in out Character_Class);
-- Clear all the entries in the class Bitmap.
pragma Inline_Always (Set_In_Class);
pragma Inline_Always (Get_From_Class);
pragma Inline_Always (Reset_Class);
pragma Inline (Set_In_Class);
pragma Inline (Get_From_Class);
pragma Inline (Reset_Class);
-----------------------
-- Local Subprograms --
......@@ -512,9 +512,9 @@ package body GNAT.Regpat is
-- Parse a posic character class, like [:alpha:] or [:^alpha:].
-- The called is suppoed to absorbe the opening [.
pragma Inline_Always (Is_Mult);
pragma Inline_Always (Emit_Natural);
pragma Inline_Always (Parse_Character_Class); -- since used only once
pragma Inline (Is_Mult);
pragma Inline (Emit_Natural);
pragma Inline (Parse_Character_Class); -- since used only once
---------------
-- Case_Emit --
......@@ -2401,12 +2401,13 @@ package body GNAT.Regpat is
return Boolean;
-- Return True it the simple operator (possibly non-greedy) matches
pragma Inline_Always (Index);
pragma Inline_Always (Repeat);
pragma Inline (Index);
pragma Inline (Repeat);
-- 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 --
......
gcc/ada/g-socket.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.21 $
-- $Revision$
-- --
-- Copyright (C) 2001 Ada Core Technologies, Inc. --
-- --
......@@ -166,12 +166,11 @@ package body GNAT.Sockets is
-- Types needed for Datagram_Socket_Stream_Type
type Datagram_Socket_Stream_Type is new Root_Stream_Type with
record
Socket : Socket_Type;
To : Sock_Addr_Type;
From : Sock_Addr_Type;
end record;
type Datagram_Socket_Stream_Type is new Root_Stream_Type with record
Socket : Socket_Type;
To : Sock_Addr_Type;
From : Sock_Addr_Type;
end record;
type Datagram_Socket_Stream_Access is
access all Datagram_Socket_Stream_Type;
......@@ -187,10 +186,9 @@ package body GNAT.Sockets is
-- Types needed for Stream_Socket_Stream_Type
type Stream_Socket_Stream_Type is new Root_Stream_Type with
record
Socket : Socket_Type;
end record;
type Stream_Socket_Stream_Type is new Root_Stream_Type with record
Socket : Socket_Type;
end record;
type Stream_Socket_Stream_Access is
access all Stream_Socket_Stream_Type;
......
gcc/ada/make.adb
......@@ -3501,7 +3501,6 @@ package body Make is
begin
Delete_File (Name => Mapping_File_Name, Success => Success);
end;
end if;
Exit_Program (E_Success);
......
gcc/ada/osint.adb
......@@ -26,7 +26,7 @@
-- --
------------------------------------------------------------------------------
with Fmap;
with Fmap; use Fmap;
with Hostparm;
with Namet; use Namet;
with Opt; use Opt;
......@@ -996,16 +996,16 @@ package body Osint is
-- directory where the user said it was.
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);
-- Otherwise do standard search for source file
else
-- 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
-- corresponding path name
......
gcc/ada/prj-env.adb
......@@ -804,6 +804,10 @@ package body Prj.Env is
-- Put the mapping of the spec or body contained in Data in the file
-- (3 lines).
---------
-- Put --
---------
procedure Put (S : String) is
Last : Natural;
......@@ -813,9 +817,12 @@ package body Prj.Env is
if Last /= S'Length then
Osint.Fail ("Disk full");
end if;
end Put;
--------------
-- Put_Data --
--------------
procedure Put_Data (Spec : Boolean) is
begin
Put (Get_Name_String (The_Unit_Data.Name));
......@@ -833,6 +840,8 @@ package body Prj.Env is
Put (S => (1 => ASCII.LF));
end Put_Data;
-- Start of processing for Create_Mapping_File
begin
GNAT.OS_Lib.Create_Temp_File (File, Name => Name);
......@@ -938,7 +947,7 @@ package body Prj.Env is
for Current in reverse Units.First .. Units.Last loop
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
declare
......@@ -946,7 +955,7 @@ package body Prj.Env is
Unit.File_Names (Body_Part).Name;
begin
-- If there is a body
-- Case of a body present
if Current_Name /= No_Name then
if Current_Verbosity = High then
......@@ -987,7 +996,7 @@ package body Prj.Env is
end;
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 =
Project
......@@ -997,7 +1006,7 @@ package body Prj.Env is
Unit.File_Names (Specification).Name;
begin
-- If there is a spec
-- Case of spec present
if Current_Name /= No_Name then
if Current_Verbosity = High then
......@@ -1007,8 +1016,7 @@ package body Prj.Env is
Write_Eol;
end if;
-- If it has the same name as the original name,
-- return the original name
-- If name same as the original name, return original name
if Unit.Name = The_Original_Name
or else Current_Name = The_Original_Name
......@@ -1020,7 +1028,7 @@ package body Prj.Env is
return Get_Name_String (Current_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
if Current_Verbosity = High then
......
gcc/ada/prj-env.ads
......@@ -40,9 +40,8 @@ package Prj.Env is
-- Output the list of sources, after Project files have been scanned
procedure Create_Mapping_File (Name : in out Temp_File_Name);
-- Create a temporary mapping file.
-- For each unit, put the mapping of its spec and or body to its
-- file name and path name in this file.
-- Create a temporary mapping file. For each unit, put the mapping of
-- its spec and or body to its file name and path name in this file.
procedure Create_Config_Pragmas_File
(For_Project : Project_Id;
......
gcc/ada/prj-tree.ads
......@@ -38,27 +38,30 @@ with Table;
package Prj.Tree is
Project_Nodes_Initial : constant := 1_000;
-- Initial number of nodes in table Tree_Private_Part.Project_Nodes
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_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
Project_Node_Low_Bound .. Project_Node_High_Bound;
-- 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
First_Node_Id : constant Project_Node_Id := Project_Node_Low_Bound;
subtype Variable_Node_Id is Project_Node_Id;
-- Used to designate a node whose expected kind is
subtype Variable_Node_Id is Project_Node_Id;
-- Used to designate a node whose expected kind is one of
-- N_Typed_Variable_Declaration, N_Variable_Declaration or
-- N_Variable_Reference.
subtype Package_Declaration_Id is Project_Node_Id;
-- Used to designate a node whose expected kind is
-- N_Project_Declaration.
-- Used to designate a node whose expected kind is N_Proect_Declaration
type Project_Node_Kind is
(N_Project,
......@@ -90,7 +93,7 @@ package Prj.Tree is
function Default_Project_Node
(Of_Kind : Project_Node_Kind;
And_Expr_Kind : Variable_Kind := Undefined)
return Project_Node_Id;
return Project_Node_Id;
-- Returns a Project_Node_Record with the specified Kind and
-- Expr_Kind; all the other components have default nil values.
......@@ -121,7 +124,7 @@ package Prj.Tree is
function First_Variable_Of
(Node : Project_Node_Id)
return Variable_Node_Id;
return Variable_Node_Id;
-- Only valid for N_Project or N_Package_Declaration nodes
function First_Package_Of
......@@ -499,44 +502,52 @@ package Prj.Tree is
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
Expr_Kind : Variable_Kind := Undefined;
Expr_Kind : Variable_Kind := Undefined;
-- 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
Packages : Package_Declaration_Id := Empty_Node;
Packages : Package_Declaration_Id := Empty_Node;
-- First package declaration in a project
Pkg_Id : Package_Node_Id := Empty_Package;
-- Only use in Package_Declaration
Name : Name_Id := No_Name;
Pkg_Id : Package_Node_Id := Empty_Package;
-- Only used for N_Package_Declaration
-- The component Pkg_Id is an entry into the table Package_Attributes
-- (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
Path_Name : Name_Id := No_Name;
Path_Name : Name_Id := No_Name;
-- 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
Field1 : Project_Node_Id := Empty_Node;
Field1 : Project_Node_Id := Empty_Node;
-- 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
Field3 : Project_Node_Id := Empty_Node;
Field3 : Project_Node_Id := Empty_Node;
-- 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
-- index is case insensitive.
......@@ -726,10 +737,12 @@ package Prj.Tree is
-- from project files.
type Project_Name_And_Node is record
Name : Name_Id;
Name : Name_Id;
-- Name of the project
Node : Project_Node_Id;
Node : Project_Node_Id;
-- Node of the project in table Project_Nodes
Modified : Boolean;
-- True when the project is being modified by another project
end record;
......
gcc/ada/s-taprob.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.79 $
-- $Revision$
-- --
-- Copyright (C) 1991-2001 Florida State University --
-- --
......@@ -42,12 +42,8 @@ with System.Task_Primitives.Operations;
-- used for Write_Lock
-- Unlock
with Ada.Exceptions;
-- used for Raise_Exception
package body System.Tasking.Protected_Objects is
use Ada.Exceptions;
use System.Task_Primitives.Operations;
-------------------------
......@@ -97,7 +93,7 @@ package body System.Tasking.Protected_Objects is
Write_Lock (Object.L'Access, Ceiling_Violation);
if Ceiling_Violation then
Raise_Exception (Program_Error'Identity, "Ceiling Violation");
raise Program_Error;
end if;
end Lock;
......@@ -111,7 +107,7 @@ package body System.Tasking.Protected_Objects is
Read_Lock (Object.L'Access, Ceiling_Violation);
if Ceiling_Violation then
Raise_Exception (Program_Error'Identity, "Ceiling Violation");
raise Program_Error;
end if;
end Lock_Read_Only;
......
gcc/ada/switch.adb
......@@ -610,8 +610,9 @@ package body Switch is
when 'c' =>
Ptr := Ptr + 1;
if Ptr > Max then
Osint.Fail ("Invalid switch: ", "ec");
raise Bad_Switch;
end if;
Config_File_Name :=
......@@ -623,18 +624,17 @@ package body Switch is
when 'm' =>
Ptr := Ptr + 1;
if Ptr > Max then
Osint.Fail ("Invalid switch: ", "em");
raise Bad_Switch;
end if;
Mapping_File_Name :=
new String'(Switch_Chars (Ptr .. Max));
return;
when others =>
Osint.Fail ("Invalid switch: ",
(1 => 'e', 2 => Switch_Chars (Ptr)));
raise Bad_Switch;
end case;
-- 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