procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

a-numaux-vxworks.ads, [...]: Fix bad package header comments.

Browse source 
2014-08-01  Robert Dewar  <dewar@adacore.com>

	* a-numaux-vxworks.ads, a-numaux-x86.adb, a-numaux-x86.ads,
	a-numaux-darwin.adb, a-numaux-darwin.ads, a-numaux.ads,
	a-numaux-libc-x86.ads: Fix bad package header comments.
	* elists.ads, elists.adb (Append_New_Elmt): New procedure.
	* gnat_rm.texi, a-calend.adb, gnatcmd.adb, einfo.adb, einfo.ads,
	checks.adb, sem_prag.adb, sem_prag.ads, rtsfind.ads, freeze.adb,
	sem_util.adb, sem_attr.adb, exp_dbug.adb, exp_dbug.ads, gnat1drv.adb,
	targparm.adb, targparm.ads, exp_ch6.adb, switch-b.adb, s-shasto.ads,
	stand.ads, s-auxdec.ads, opt.adb, opt.ads, mlib-tgt.ads, s-fatgen.adb,
	s-fatgen.ads, system.ads, snames.ads-tmpl, s-stalib.ads,
	s-os_lib.adb: Remove VMS-specific code.

From-SVN: r213437
This commit is contained in:
Robert Dewar 2014-08-01 09:48:28 +00:00 • committed by Arnaud Charlet
parent 78433fec9a
commit 21c51f53f0
45 changed files with 145 additions and 766 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
gcc/ada/ChangeLog
View file

@ -1,3 +1,17 @@
2014-08-01 Robert Dewar <dewar@adacore.com>
* a-numaux-vxworks.ads, a-numaux-x86.adb, a-numaux-x86.ads,
a-numaux-darwin.adb, a-numaux-darwin.ads, a-numaux.ads,
a-numaux-libc-x86.ads: Fix bad package header comments.
* elists.ads, elists.adb (Append_New_Elmt): New procedure.
* gnat_rm.texi, a-calend.adb, gnatcmd.adb, einfo.adb, einfo.ads,
checks.adb, sem_prag.adb, sem_prag.ads, rtsfind.ads, freeze.adb,
sem_util.adb, sem_attr.adb, exp_dbug.adb, exp_dbug.ads, gnat1drv.adb,
targparm.adb, targparm.ads, exp_ch6.adb, switch-b.adb, s-shasto.ads,
stand.ads, s-auxdec.ads, opt.adb, opt.ads, mlib-tgt.ads, s-fatgen.adb,
s-fatgen.ads, system.ads, snames.ads-tmpl, s-stalib.ads,
s-os_lib.adb: Remove VMS-specific code.
2014-08-01 Arnaud Charlet <charlet@adacore.com>
* exp_attr.adb (Is_Inline_Floating_Point_Attribute): Revert to

4
gcc/ada/a-calend.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -69,7 +69,7 @@ package body Ada.Calendar is
-- by Integer in various routines. One ramification of this model is that
-- the caller site must perform validity checks on returned results.
-- The end result of this model is the lack of target specific files per
-- child of Ada.Calendar (a-calfor, a-calfor-vms, a-calfor-vxwors, etc).
-- child of Ada.Calendar (e.g. a-calfor).
-----------------------
-- Local Subprograms --

4
gcc/ada/a-numaux-darwin.adb
View file

@ -7,7 +7,7 @@
-- B o d y --
-- (Apple OS X Version) --
-- --
-- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2014, 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- --
@ -30,8 +30,6 @@
-- --
------------------------------------------------------------------------------
-- File a-numaux.adb <- a-numaux-darwin.adb
package body Ada.Numerics.Aux is
-----------------------

9
gcc/ada/a-numaux-darwin.ads
View file

@ -30,12 +30,9 @@
-- --
------------------------------------------------------------------------------
-- This version is for use with normal Unix math functions, except for
-- sine/cosine which have been implemented directly in Ada to get the required
-- accuracy in OS X. Alternative packages are used on VxWorks (no need for the
-- -lm Linker_Options), and on the x86 (where we have two versions one using
-- inline ASM, and one importing from the C long routines that take 80-bit
-- arguments).
-- This version is for use on OS X. It uses the normal Unix math functions,
-- except for sine/cosine which have been implemented directly in Ada to get
-- the required accuracy.
package Ada.Numerics.Aux is
pragma Pure;

13
gcc/ada/a-numaux-libc-x86.ads
View file

@ -7,7 +7,7 @@
-- S p e c --
-- (C Library Version for x86) --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -30,16 +30,7 @@
-- --
------------------------------------------------------------------------------
-- This package provides the basic computational interface for the generic
-- elementary functions. The C library version interfaces with the routines
-- in the C mathematical library, and is thus quite portable, although it may
-- not necessarily meet the requirements for accuracy in the numerics annex.
-- One advantage of using this package is that it will interface directly to
-- hardware instructions, such as the those provided on the Intel x86.
-- Note: there are two versions of this package. One using the 80-bit x86
-- long double format (which is this version), and one using 64-bit IEEE
-- double (see file a-numaux.ads).
-- This version is for the x86 using the 80-bit x86 long double format
package Ada.Numerics.Aux is
pragma Pure;

17
gcc/ada/a-numaux-vxworks.ads
View file

@ -7,7 +7,7 @@
-- S p e c --
-- (C Library Version, VxWorks) --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -30,23 +30,12 @@
-- --
------------------------------------------------------------------------------
-- This package provides the basic computational interface for the generic
-- elementary functions. The C library version interfaces with the routines
-- in the C mathematical library, and is thus quite portable, although it may
-- not necessarily meet the requirements for accuracy in the numerics annex.
-- One advantage of using this package is that it will interface directly to
-- hardware instructions, such as the those provided on the Intel x86.
-- Note: there are two versions of this package. One using the normal IEEE
-- 64-bit double format (which is this version), and one using 80-bit x86
-- long double (see file 4onumaux.ads).
-- Version for use on VxWorks (where we have no libm.a library), so the pragma
-- Linker_Options ("-lm") is omitted in this version.
package Ada.Numerics.Aux is
pragma Pure;
-- This version omits the pragma linker_options ("-lm") since there is
-- no libm.a library for VxWorks.
type Double is digits 15;
-- Type Double is the type used to call the C routines

7
gcc/ada/a-numaux-x86.adb
View file

@ -7,7 +7,7 @@
-- B o d y --
-- (Machine Version for x86) --
-- --
-- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2014, 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- --
@ -30,11 +30,6 @@
-- --
------------------------------------------------------------------------------
-- File a-numaux.adb <- 86numaux.adb
-- This version of Numerics.Aux is for the IEEE Double Extended floating
-- point format on x86.
with System.Machine_Code; use System.Machine_Code;
package body Ada.Numerics.Aux is

11
gcc/ada/a-numaux-x86.ads
View file

@ -7,7 +7,7 @@
-- S p e c --
-- (Machine Version for x86) --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -30,14 +30,7 @@
-- --
------------------------------------------------------------------------------
-- This package provides the basic computational interface for the generic
-- elementary functions. This implementation is based on the glibc assembly
-- sources for the x86 glibc math library.
-- Note: there are two versions of this package. One using the 80-bit x86
-- long double format (which is this version), and one using 64-bit IEEE
-- double (see file a-numaux.ads). The latter version imports the C
-- routines directly.
-- Version for the x86, using 64-bit IEEE format with inline asm statements
package Ada.Numerics.Aux is
pragma Pure;

9
gcc/ada/a-numaux.ads
View file

@ -38,9 +38,12 @@
-- hardware instructions, such as the those provided on the Intel x86.
-- This version here is for use with normal Unix math functions. Alternative
-- packages are used VxWorks (no need for the -lm Linker_Options), and on the
-- x86 (where we have two versions one using inline ASM, and one importing
-- from the C long routines that take 80-bit arguments).
-- versions are provided for special situations:
-- a-numaux-darwin For OS/X (special handling of sin/cos for accuracy)
-- a-numaux-libc-x86 For the x86, using 80-bit long double format
-- a-numaux-x86 For the x86, using 64-bit IEEE (inline asm statements)
-- a-numaux-vxworks For use on VxWorks (where we have no libm.a library)
package Ada.Numerics.Aux is
pragma Pure;

13
gcc/ada/checks.adb
View file

@ -8524,14 +8524,7 @@ package body Checks is
function Range_Checks_Suppressed (E : Entity_Id) return Boolean is
begin
if Present (E) then
-- Note: for now we always suppress range checks on Vax float types,
-- since Gigi does not know how to generate these checks.
if Vax_Float (E) then
return True;
elsif Kill_Range_Checks (E) then
if Kill_Range_Checks (E) then
return True;
elsif Checks_May_Be_Suppressed (E) then
@ -8576,9 +8569,7 @@ package body Checks is
declare
Typ : constant Entity_Id := Etype (Expr);
begin
if Vax_Float (Typ) then
return True;
elsif Checks_May_Be_Suppressed (Typ)
if Checks_May_Be_Suppressed (Typ)
and then (Is_Check_Suppressed (Typ, Range_Check)
or else
Is_Check_Suppressed (Typ, Validity_Check))

29
gcc/ada/einfo.adb
View file

@ -115,7 +115,6 @@ package body Einfo is
-- RM_Size Uint13
-- Alignment Uint14
-- First_Optional_Parameter Node14
-- Normalized_Position Uint14
-- Shadow_Entities List14
@ -1266,12 +1265,6 @@ package body Einfo is
return Node17 (Id);
end First_Literal;
function First_Optional_Parameter (Id : E) return E is
begin
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
return Node14 (Id);
end First_Optional_Parameter;
function First_Private_Entity (Id : E) return E is
begin
pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
@ -4004,12 +3997,6 @@ package body Einfo is
Set_Node17 (Id, V);
end Set_First_Literal;
procedure Set_First_Optional_Parameter (Id : E; V : E) is
begin
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
Set_Node14 (Id, V);
end Set_First_Optional_Parameter;
procedure Set_First_Private_Entity (Id : E; V : E) is
begin
pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
@ -8178,18 +8165,6 @@ package body Einfo is
end if;
end Underlying_Type;
---------------
-- Vax_Float --
---------------
-- To be removed ???
function Vax_Float (Id : E) return B is
pragma Unreferenced (Id);
begin
return False;
end Vax_Float;
------------------------
-- Write_Entity_Flags --
------------------------
@ -8891,10 +8866,6 @@ package body Einfo is
E_Loop_Parameter =>
Write_Str ("Alignment");
when E_Function |
E_Procedure =>
Write_Str ("First_Optional_Parameter");
when E_Component |
E_Discriminant =>
Write_Str ("Normalized_Position");

15
gcc/ada/einfo.ads
View file

@ -1278,13 +1278,6 @@ package Einfo is
-- Note that this field is set in enumeration subtypes, but it still
-- points to the first literal of the base type in this case.
-- First_Optional_Parameter (Node14)
-- Defined in (non-generic) function and procedure entities. Set to a
-- non-null value only if a pragma Import_Function, Import_Procedure
-- or Import_Valued_Procedure specifies a First_Optional_Parameter
-- argument, in which case this field points to the parameter entity
-- corresponding to the specified parameter.
-- First_Private_Entity (Node16)
-- Defined in all entities containing private parts (packages, protected
-- types and subtypes, task types and subtypes). The entities on the
@ -5615,7 +5608,6 @@ package Einfo is
-- Safe_Last_Value (synth)
-- Type_Low_Bound (synth)
-- Type_High_Bound (synth)
-- Vax_Float (synth)
-- (plus type attributes)
-- E_Function
@ -5626,7 +5618,6 @@ package Einfo is
-- Protected_Body_Subprogram (Node11)
-- Next_Inlined_Subprogram (Node12)
-- Elaboration_Entity (Node13) (not implicit /=)
-- First_Optional_Parameter (Node14) (non-generic case only)
-- DT_Position (Uint15)
-- DTC_Entity (Node16)
-- First_Entity (Node17)
@ -5926,7 +5917,6 @@ package Einfo is
-- Protected_Body_Subprogram (Node11)
-- Next_Inlined_Subprogram (Node12)
-- Elaboration_Entity (Node13)
-- First_Optional_Parameter (Node14) (non-generic case only)
-- DT_Position (Uint15)
-- DTC_Entity (Node16)
-- First_Entity (Node17)
@ -6537,7 +6527,6 @@ package Einfo is
function First_Exit_Statement (Id : E) return N;
function First_Index (Id : E) return N;
function First_Literal (Id : E) return E;
function First_Optional_Parameter (Id : E) return E;
function First_Private_Entity (Id : E) return E;
function First_Rep_Item (Id : E) return N;
function Float_Rep (Id : E) return F;
@ -6866,7 +6855,6 @@ package Einfo is
function Used_As_Generic_Actual (Id : E) return B;
function Uses_Lock_Free (Id : E) return B;
function Uses_Sec_Stack (Id : E) return B;
function Vax_Float (Id : E) return B;
function Warnings_Off (Id : E) return B;
function Warnings_Off_Used (Id : E) return B;
function Warnings_Off_Used_Unmodified (Id : E) return B;
@ -7172,7 +7160,6 @@ package Einfo is
procedure Set_First_Exit_Statement (Id : E; V : N);
procedure Set_First_Index (Id : E; V : N);
procedure Set_First_Literal (Id : E; V : E);
procedure Set_First_Optional_Parameter (Id : E; V : E);
procedure Set_First_Private_Entity (Id : E; V : E);
procedure Set_First_Rep_Item (Id : E; V : N);
procedure Set_Float_Rep (Id : E; V : F);
@ -7921,7 +7908,6 @@ package Einfo is
pragma Inline (First_Exit_Statement);
pragma Inline (First_Index);
pragma Inline (First_Literal);
pragma Inline (First_Optional_Parameter);
pragma Inline (First_Private_Entity);
pragma Inline (First_Rep_Item);
pragma Inline (Freeze_Node);
@ -8402,7 +8388,6 @@ package Einfo is
pragma Inline (Set_First_Exit_Statement);
pragma Inline (Set_First_Index);
pragma Inline (Set_First_Literal);
pragma Inline (Set_First_Optional_Parameter);
pragma Inline (Set_First_Private_Entity);
pragma Inline (Set_First_Rep_Item);
pragma Inline (Set_Freeze_Node);

15
gcc/ada/elists.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -138,6 +138,19 @@ package body Elists is
end if;
end Append_Elmt;
---------------------
-- Append_New_Elmt --
---------------------
procedure Append_New_Elmt (N : Node_Or_Entity_Id; To : in out Elist_Id) is
begin
if To = No_Elist then
To := New_Elmt_List;
end if;
Append_Elmt (N, To);
end Append_New_Elmt;
------------------------
-- Append_Unique_Elmt --
------------------------

7
gcc/ada/elists.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -126,6 +126,11 @@ package Elists is
-- Appends N at the end of To, allocating a new element. N must be a
-- non-empty node or entity Id, and To must be an Elist (not No_Elist).
procedure Append_New_Elmt (N : Node_Or_Entity_Id; To : in out Elist_Id);
pragma Inline (Append_New_Elmt);
-- Like Append_Elmt if Elist_Id is not No_List, but if Elist_Id is No_List,
-- then first assigns it an empty element list and then does the append.
procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id);
-- Like Append_Elmt, except that a check is made to see if To already
-- contains N and if so the call has no effect.

145
gcc/ada/exp_ch6.adb
View file

@ -1976,7 +1976,6 @@ package body Exp_Ch6 is
-- Rewrite call to predefined operator as operator
-- Replace actuals to in-out parameters that are numeric conversions,
-- with explicit assignment to temporaries before and after the call.
-- Remove optional actuals if First_Optional_Parameter specified.
-- Note that the list of actuals has been filled with default expressions
-- during semantic analysis of the call. Only the extra actuals required
@ -4022,150 +4021,6 @@ package body Exp_Ch6 is
Establish_Transient_Scope (Call_Node, Sec_Stack => True);
end if;
end if;
-- Test for First_Optional_Parameter, and if so, truncate parameter list
-- if there are optional parameters at the trailing end.
-- Note: we never delete procedures for call via a pointer.
if (Ekind (Subp) = E_Procedure or else Ekind (Subp) = E_Function)
and then Present (First_Optional_Parameter (Subp))
then
declare
Last_Keep_Arg : Node_Id;
begin
-- Last_Keep_Arg will hold the last actual that should be kept.
-- If it remains empty at the end, it means that all parameters
-- are optional.
Last_Keep_Arg := Empty;
-- Find first optional parameter, must be present since we checked
-- the validity of the parameter before setting it.
Formal := First_Formal (Subp);
Actual := First_Actual (Call_Node);
while Formal /= First_Optional_Parameter (Subp) loop
Last_Keep_Arg := Actual;
Next_Formal (Formal);
Next_Actual (Actual);
end loop;
-- We have Formal and Actual pointing to the first potentially
-- droppable argument. We can drop all the trailing arguments
-- whose actual matches the default. Note that we know that all
-- remaining formals have defaults, because we checked that this
-- requirement was met before setting First_Optional_Parameter.
-- We use Fully_Conformant_Expressions to check for identity
-- between formals and actuals, which may miss some cases, but
-- on the other hand, this is only an optimization (if we fail
-- to truncate a parameter it does not affect functionality).
-- So if the default is 3 and the actual is 1+2, we consider
-- them unequal, which hardly seems worrisome.
while Present (Formal) loop
if not Fully_Conformant_Expressions
(Actual, Default_Value (Formal))
then
Last_Keep_Arg := Actual;
end if;
Next_Formal (Formal);
Next_Actual (Actual);
end loop;
-- If no arguments, delete entire list, this is the easy case
if No (Last_Keep_Arg) then
Set_Parameter_Associations (Call_Node, No_List);
Set_First_Named_Actual (Call_Node, Empty);
-- Case where at the last retained argument is positional. This
-- is also an easy case, since the retained arguments are already
-- in the right form, and we don't need to worry about the order
-- of arguments that get eliminated.
elsif Is_List_Member (Last_Keep_Arg) then
while Present (Next (Last_Keep_Arg)) loop
Discard_Node (Remove_Next (Last_Keep_Arg));
end loop;
Set_First_Named_Actual (Call_Node, Empty);
-- This is the annoying case where the last retained argument
-- is a named parameter. Since the original arguments are not
-- in declaration order, we may have to delete some fairly
-- random collection of arguments.
else
declare
Temp : Node_Id;
Passoc : Node_Id;
begin
-- First step, remove all the named parameters from the
-- list (they are still chained using First_Named_Actual
-- and Next_Named_Actual, so we have not lost them).
Temp := First (Parameter_Associations (Call_Node));
-- Case of all parameters named, remove them all
if Nkind (Temp) = N_Parameter_Association then
-- Suppress warnings to avoid warning on possible
-- infinite loop (because Call_Node is not modified).
pragma Warnings (Off);
while Is_Non_Empty_List
(Parameter_Associations (Call_Node))
loop
Temp :=
Remove_Head (Parameter_Associations (Call_Node));
end loop;
pragma Warnings (On);
-- Case of mixed positional/named, remove named parameters
else
while Nkind (Next (Temp)) /= N_Parameter_Association loop
Next (Temp);
end loop;
while Present (Next (Temp)) loop
Remove (Next (Temp));
end loop;
end if;
-- Now we loop through the named parameters, till we get
-- to the last one to be retained, adding them to the list.
-- Note that the Next_Named_Actual list does not need to be
-- touched since we are only reordering them on the actual
-- parameter association list.
Passoc := Parent (First_Named_Actual (Call_Node));
loop
Temp := Relocate_Node (Passoc);
Append_To
(Parameter_Associations (Call_Node), Temp);
exit when
Last_Keep_Arg = Explicit_Actual_Parameter (Passoc);
Passoc := Parent (Next_Named_Actual (Passoc));
end loop;
Set_Next_Named_Actual (Temp, Empty);
loop
Temp := Next_Named_Actual (Passoc);
exit when No (Temp);
Set_Next_Named_Actual
(Passoc, Next_Named_Actual (Parent (Temp)));
end loop;
end;
end if;
end;
end if;
end Expand_Call;
-------------------------------

14
gcc/ada/exp_dbug.adb
View file

@ -604,20 +604,6 @@ package body Exp_Dbug is
Add_Real_To_Buffer (Small_Value (E));
end if;
-- Vax floating-point case
elsif Vax_Float (E) then
if Digits_Value (Base_Type (E)) = 6 then
Get_External_Name (E, True, "XFF");
elsif Digits_Value (Base_Type (E)) = 9 then
Get_External_Name (E, True, "XFF");
else
pragma Assert (Digits_Value (Base_Type (E)) = 15);
Get_External_Name (E, True, "XFG");
end if;
-- Discrete case where bounds do not match size
elsif Is_Discrete_Type (E)

25
gcc/ada/exp_dbug.ads
View file

@ -540,31 +540,6 @@ package Exp_Dbug is
-- delta. In this case, the first nn/dd rational value is for delta,
-- and the second value is for small.
------------------------------
-- VAX Floating-Point Types --
------------------------------
-- Vax floating-point types are represented at run time as integer
-- types, which are treated specially by the code generator. Their
-- type names are encoded with the following suffix:
-- typ___XFF
-- typ___XFD
-- typ___XFG
-- representing the Vax F Float, D Float, and G Float types. The
-- debugger must treat these specially. In particular, printing these
-- values can be achieved using the debug procedures that are provided
-- in package System.Vax_Float_Operations:
-- procedure Debug_Output_D (Arg : D);
-- procedure Debug_Output_F (Arg : F);
-- procedure Debug_Output_G (Arg : G);
-- These three procedures take a Vax floating-point argument, and
-- output a corresponding decimal representation to standard output
-- with no terminating line return.
--------------------
-- Discrete Types --
--------------------

14
gcc/ada/exp_smem.adb
View file

@ -212,17 +212,9 @@ package body Exp_Smem is
-- Mark object as locked in the current (transient) scope
declare
Locked_Shared_Objects : Elist_Id renames
Scope_Stack.Table (Scope_Stack.Last).Locked_Shared_Objects;
begin
if Locked_Shared_Objects = No_Elist then
Locked_Shared_Objects := New_Elmt_List;
end if;
Append_Elmt (Obj, To => Locked_Shared_Objects);
end;
Append_New_Elmt
(Obj,
To => Scope_Stack.Table (Scope_Stack.Last).Locked_Shared_Objects);
-- First insert the Lock call before

5
gcc/ada/freeze.adb
View file

@ -7233,9 +7233,8 @@ package body Freeze is
or else Nkind_In (Dcopy, N_Expanded_Name,
N_Integer_Literal,
N_Character_Literal,
N_String_Literal)
or else (Nkind (Dcopy) = N_Real_Literal
and then not Vax_Float (Etype (Dcopy)))
N_String_Literal,
N_Real_Literal)
or else (Nkind (Dcopy) = N_Attribute_Reference
and then Attribute_Name (Dcopy) = Name_Null_Parameter)
or else Known_Null (Dcopy)

5
gcc/ada/gnat1drv.adb
View file

@ -475,11 +475,6 @@ procedure Gnat1drv is
Ttypes.Bytes_Big_Endian := not Ttypes.Bytes_Big_Endian;
end if;
-- Temporarily set True_VMS_Target to OpenVMS_On_Target. This is just
-- temporary, we no longer deal with the debug flag -gnatdm here.
Opt.True_VMS_Target := Targparm.OpenVMS_On_Target;
-- Activate front end layout if debug flag -gnatdF is set
if Debug_Flag_FF then

61
gcc/ada/gnat_rm.texi
View file

@ -2883,13 +2883,7 @@ MECHANISM ::=
MECHANISM_ASSOCIATION ::=
[formal_parameter_NAME =>] MECHANISM_NAME
MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
MECHANISM_NAME ::= Value | Reference
@end smallexample
@noindent
@ -2917,13 +2911,6 @@ using positional notation to match parameters with subtype marks.
The form with an @code{'Access} attribute can be used to match an
anonymous access parameter.
@cindex OpenVMS
@cindex Passing by descriptor
Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
The default behavior for Export_Function is to accept either 64bit or
32bit descriptors unless short_descriptor is specified, then only 32bit
descriptors are accepted.
@cindex Suppressing external name
Special treatment is given if the EXTERNAL is an explicit null
string or a static string expressions that evaluates to the null
@ -2988,13 +2975,7 @@ MECHANISM ::=
MECHANISM_ASSOCIATION ::=
[formal_parameter_NAME =>] MECHANISM_NAME
MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
MECHANISM_NAME ::= Value | Reference
@end smallexample
@noindent
@ -3007,13 +2988,6 @@ not what is wanted, so it is usually appropriate to use this
pragma in conjunction with a @code{Export} or @code{Convention}
pragma that specifies the desired foreign convention.
@cindex OpenVMS
@cindex Passing by descriptor
Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
The default behavior for Export_Procedure is to accept either 64bit or
32bit descriptors unless short_descriptor is specified, then only 32bit
descriptors are accepted.
@cindex Suppressing external name
Special treatment is given if the EXTERNAL is an explicit null
string or a static string expressions that evaluates to the null
@ -3074,13 +3048,7 @@ MECHANISM ::=
MECHANISM_ASSOCIATION ::=
[formal_parameter_NAME =>] MECHANISM_NAME
MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
MECHANISM_NAME ::= Value | Reference
@end smallexample
@noindent
@ -3098,13 +3066,6 @@ with foreign language functions, so it is usually appropriate to use this
pragma in conjunction with a @code{Export} or @code{Convention}
pragma that specifies the desired foreign convention.
@cindex OpenVMS
@cindex Passing by descriptor
Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
The default behavior for Export_Valued_Procedure is to accept either 64bit or
32bit descriptors unless short_descriptor is specified, then only 32bit
descriptors are accepted.
@cindex Suppressing external name
Special treatment is given if the EXTERNAL is an explicit null
string or a static string expressions that evaluates to the null
@ -3608,8 +3569,7 @@ pragma Import_Function (
[, [Parameter_Types =>] PARAMETER_TYPES]
[, [Result_Type =>] SUBTYPE_MARK]
[, [Mechanism =>] MECHANISM]
[, [Result_Mechanism =>] MECHANISM_NAME]
[, [First_Optional_Parameter =>] IDENTIFIER]);
[, [Result_Mechanism =>] MECHANISM_NAME]);
EXTERNAL_SYMBOL ::=
IDENTIFIER
@ -3698,8 +3658,7 @@ pragma Import_Procedure (
[Internal =>] LOCAL_NAME
[, [External =>] EXTERNAL_SYMBOL]
[, [Parameter_Types =>] PARAMETER_TYPES]
[, [Mechanism =>] MECHANISM]
[, [First_Optional_Parameter =>] IDENTIFIER]);
[, [Mechanism =>] MECHANISM]);
EXTERNAL_SYMBOL ::=
IDENTIFIER
@ -3739,8 +3698,7 @@ pragma Import_Valued_Procedure (
[Internal =>] LOCAL_NAME
[, [External =>] EXTERNAL_SYMBOL]
[, [Parameter_Types =>] PARAMETER_TYPES]
[, [Mechanism =>] MECHANISM]
[, [First_Optional_Parameter =>] IDENTIFIER]);
[, [Mechanism =>] MECHANISM]);
EXTERNAL_SYMBOL ::=
IDENTIFIER
@ -6405,11 +6363,8 @@ pragma Short_Descriptors
@end smallexample
@noindent
In VMS versions of the compiler, this configuration pragma causes all
occurrences of the mechanism types Descriptor[_xxx] to be treated as
Short_Descriptor[_xxx]. This is helpful in porting legacy applications from a
32-bit environment to a 64-bit environment. This pragma is ignored for non-VMS
versions.
This pragma is provided for compatibility with other Ada implementations. It
is recognized but ignored by all current versions of GNAT.
@node Pragma Simple_Storage_Pool_Type
@unnumberedsec Pragma Simple_Storage_Pool_Type

2
gcc/ada/gnatcmd.adb
View file

@ -1180,7 +1180,7 @@ procedure GNATCmd is
for C in Command_List'Range loop
-- No usage for VMS only command or for Sync
-- No usage for Sync
if C /= Sync then
if Targparm.AAMP_On_Target then

24
gcc/ada/inline.adb
View file

@ -518,11 +518,7 @@ package body Inline is
procedure Register_Backend_Inlined_Subprogram (Subp : Entity_Id) is
begin
if Backend_Inlined_Subps = No_Elist then
Backend_Inlined_Subps := New_Elmt_List;
end if;
Append_Elmt (Subp, To => Backend_Inlined_Subps);
Append_New_Elmt (Subp, To => Backend_Inlined_Subps);
end Register_Backend_Inlined_Subprogram;
---------------------------------------------
@ -531,11 +527,7 @@ package body Inline is
procedure Register_Backend_Not_Inlined_Subprogram (Subp : Entity_Id) is
begin
if Backend_Not_Inlined_Subps = No_Elist then
Backend_Not_Inlined_Subps := New_Elmt_List;
end if;
Append_Elmt (Subp, To => Backend_Not_Inlined_Subps);
Append_New_Elmt (Subp, To => Backend_Not_Inlined_Subps);
end Register_Backend_Not_Inlined_Subprogram;
-- Start of processing for Add_Inlined_Subprogram
@ -2802,11 +2794,7 @@ package body Inline is
-- Register the call in the list of inlined calls
if Inlined_Calls = No_Elist then
Inlined_Calls := New_Elmt_List;
end if;
Append_Elmt (N, To => Inlined_Calls);
Append_New_Elmt (N, To => Inlined_Calls);
-- Use generic machinery to copy body of inlined subprogram, as if it
-- were an instantiation, resetting source locations appropriately, so
@ -4027,11 +4015,7 @@ package body Inline is
procedure Register_Backend_Call (N : Node_Id) is
begin
if Backend_Calls = No_Elist then
Backend_Calls := New_Elmt_List;
end if;
Append_Elmt (N, To => Backend_Calls);
Append_New_Elmt (N, To => Backend_Calls);
end Register_Backend_Call;
--------------------------

6
gcc/ada/mlib-tgt.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2009, AdaCore --
-- Copyright (C) 2001-2014, AdaCore --
-- --
-- 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- --
@ -132,8 +132,8 @@ package MLib.Tgt is
-- "libtoto.so" will be a symbolic link to "libtoto.so.2.1" which
-- will be the actual library file.
--
-- Symbol_Data is used for some platforms, including VMS, to generate
-- the symbols to be exported by the library.
-- Symbol_Data is used for some platforms, to generate the symbols to be
-- exported by the library (not certain if it is currently in use or not).
--
-- Note: Depending on the OS, some of the parameters may not be taken into
-- account. For example, on Linux, Interfaces, Symbol_Data and Auto_Init

4
gcc/ada/opt.adb
View file

@ -63,7 +63,6 @@ package body Opt is
Optimize_Alignment_Config := Optimize_Alignment;
Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
Polling_Required_Config := Polling_Required;
Short_Descriptors_Config := Short_Descriptors;
SPARK_Mode_Config := SPARK_Mode;
SPARK_Mode_Pragma_Config := SPARK_Mode_Pragma;
Uneval_Old_Config := Uneval_Old;
@ -103,7 +102,6 @@ package body Opt is
Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
Polling_Required := Save.Polling_Required;
Short_Descriptors := Save.Short_Descriptors;
SPARK_Mode := Save.SPARK_Mode;
SPARK_Mode_Pragma := Save.SPARK_Mode_Pragma;
Uneval_Old := Save.Uneval_Old;
@ -144,7 +142,6 @@ package body Opt is
Save.Optimize_Alignment_Local := Optimize_Alignment_Local;
Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
Save.Polling_Required := Polling_Required;
Save.Short_Descriptors := Short_Descriptors;
Save.SPARK_Mode := SPARK_Mode;
Save.SPARK_Mode_Pragma := SPARK_Mode_Pragma;
Save.Uneval_Old := Uneval_Old;
@ -244,7 +241,6 @@ package body Opt is
Fast_Math := Fast_Math_Config;
Optimize_Alignment := Optimize_Alignment_Config;
Polling_Required := Polling_Required_Config;
Short_Descriptors := Short_Descriptors_Config;
end Set_Opt_Config_Switches;
---------------

31
gcc/ada/opt.ads
View file

@ -418,12 +418,9 @@ package Opt is
subtype Debug_Level_Value is Nat range 0 .. 3;
Debugger_Level : Debug_Level_Value := 0;
-- GNATBIND
-- The value given to the -g parameter. The default value for -g with
-- no value is 2. This is usually ignored by GNATBIND, except in the
-- VMS version where it is passed as an argument to __gnat_initialize
-- to trigger the activation of the remote debugging interface.
-- Is this still true ???
-- no value is 2. This is not currently used but is retained for possible
-- future use.
Default_Exit_Status : Int := 0;
-- GNATBIND
@ -709,11 +706,6 @@ package Opt is
-- GNAT
-- True if compiling in GNAT system mode (-gnatg switch)
Heap_Size : Nat := 0;
-- GNATBIND
-- Heap size for memory allocations. Valid values are 32 and 64. Only
-- available on VMS.
Identifier_Character_Set : Character;
-- GNAT
-- This variable indicates the character set to be used for identifiers.
@ -1291,10 +1283,6 @@ package Opt is
-- GNAT
-- Set True if a pragma Short_Circuit_And_Or applies to the current unit.
Short_Descriptors : Boolean := False;
-- GNAT
-- Set True if a pragma Short_Descriptors applies to the current unit.
type SPARK_Mode_Type is (None, Off, On);
-- Possible legal modes that can be set by aspect/pragma SPARK_Mode, as
-- well as the value None, which indicates no such pragma/aspect applies.
@ -1463,12 +1451,6 @@ package Opt is
-- GNAT
-- Set to True (-gnatt) to generate output tree file
True_VMS_Target : Boolean := False;
-- Set True if we are on a VMS target. The setting of this flag reflects
-- the true state of the compile, unlike Targparm.OpenVMS_On_Target which
-- can also be true when debug flag m is set (-gnatdm). This is used in the
-- few cases where we do NOT want -gnatdm to trigger the VMS behavior.
Try_Semantics : Boolean := False;
-- GNAT
-- Flag set to force attempt at semantic analysis, even if parser errors
@ -1955,14 +1937,6 @@ package Opt is
-- flag is used to set the initial value for Polling_Required at the start
-- of analyzing each unit.
Short_Descriptors_Config : Boolean;
-- GNAT
-- This is the value of the configuration switch that controls the use of
-- Short_Descriptors for setting descriptor default sizes. It can be set
-- True by the use of the pragma Short_Descriptors in the gnat.adc file.
-- This flag is used to set the initial value for Short_Descriptors at the
-- start of analyzing each unit.
SPARK_Mode_Config : SPARK_Mode_Type := None;
-- GNAT
-- The setting of SPARK_Mode from configuration pragmas
@ -2143,7 +2117,6 @@ private
Optimize_Alignment_Local : Boolean;
Persistent_BSS_Mode : Boolean;
Polling_Required : Boolean;
Short_Descriptors : Boolean;
SPARK_Mode : SPARK_Mode_Type;
SPARK_Mode_Pragma : Node_Id;
Uneval_Old : Character;

101
gcc/ada/rtsfind.ads
View file

@ -374,7 +374,6 @@ package Rtsfind is
System_Val_Real,
System_Val_Uns,
System_Val_WChar,
System_Vax_Float_Operations,
System_Version_Control,
System_WCh_StW,
System_WCh_WtS,
@ -1636,56 +1635,6 @@ package Rtsfind is
RE_Value_Wide_Character, -- System.Val_WChar
RE_Value_Wide_Wide_Character, -- System.Val_WChar
RE_D, -- System.Vax_Float_Operations
RE_F, -- System.Vax_Float_Operations
RE_G, -- System.Vax_Float_Operations
RE_Q, -- System.Vax_Float_Operations
RE_S, -- System.Vax_Float_Operations
RE_T, -- System.Vax_Float_Operations
RE_D_To_G, -- System.Vax_Float_Operations
RE_F_To_G, -- System.Vax_Float_Operations
RE_F_To_Q, -- System.Vax_Float_Operations
RE_F_To_S, -- System.Vax_Float_Operations
RE_G_To_D, -- System.Vax_Float_Operations
RE_G_To_F, -- System.Vax_Float_Operations
RE_G_To_Q, -- System.Vax_Float_Operations
RE_G_To_T, -- System.Vax_Float_Operations
RE_Q_To_F, -- System.Vax_Float_Operations
RE_Q_To_G, -- System.Vax_Float_Operations
RE_S_To_F, -- System.Vax_Float_Operations
RE_T_To_D, -- System.Vax_Float_Operations
RE_T_To_G, -- System.Vax_Float_Operations
RE_Abs_F, -- System.Vax_Float_Operations
RE_Abs_G, -- System.Vax_Float_Operations
RE_Add_F, -- System.Vax_Float_Operations
RE_Add_G, -- System.Vax_Float_Operations
RE_Div_F, -- System.Vax_Float_Operations
RE_Div_G, -- System.Vax_Float_Operations
RE_Mul_F, -- System.Vax_Float_Operations
RE_Mul_G, -- System.Vax_Float_Operations
RE_Neg_F, -- System.Vax_Float_Operations
RE_Neg_G, -- System.Vax_Float_Operations
RE_Return_D, -- System.Vax_Float_Operations
RE_Return_F, -- System.Vax_Float_Operations
RE_Return_G, -- System.Vax_Float_Operations
RE_Sub_F, -- System.Vax_Float_Operations
RE_Sub_G, -- System.Vax_Float_Operations
RE_Eq_F, -- System.Vax_Float_Operations
RE_Eq_G, -- System.Vax_Float_Operations
RE_Le_F, -- System.Vax_Float_Operations
RE_Le_G, -- System.Vax_Float_Operations
RE_Lt_F, -- System.Vax_Float_Operations
RE_Lt_G, -- System.Vax_Float_Operations
RE_Ne_F, -- System.Vax_Float_Operations
RE_Ne_G, -- System.Vax_Float_Operations
RE_Valid_D, -- System.Vax_Float_Operations
RE_Valid_F, -- System.Vax_Float_Operations
RE_Valid_G, -- System.Vax_Float_Operations
RE_Version_String, -- System.Version_Control
RE_Get_Version_String, -- System.Version_Control
@ -2921,56 +2870,6 @@ package Rtsfind is
RE_Value_Wide_Character => System_Val_WChar,
RE_Value_Wide_Wide_Character => System_Val_WChar,
RE_D => System_Vax_Float_Operations,
RE_F => System_Vax_Float_Operations,
RE_G => System_Vax_Float_Operations,
RE_Q => System_Vax_Float_Operations,
RE_S => System_Vax_Float_Operations,
RE_T => System_Vax_Float_Operations,
RE_D_To_G => System_Vax_Float_Operations,
RE_F_To_G => System_Vax_Float_Operations,
RE_F_To_Q => System_Vax_Float_Operations,
RE_F_To_S => System_Vax_Float_Operations,
RE_G_To_D => System_Vax_Float_Operations,
RE_G_To_F => System_Vax_Float_Operations,
RE_G_To_Q => System_Vax_Float_Operations,
RE_G_To_T => System_Vax_Float_Operations,
RE_Q_To_F => System_Vax_Float_Operations,
RE_Q_To_G => System_Vax_Float_Operations,
RE_S_To_F => System_Vax_Float_Operations,
RE_T_To_D => System_Vax_Float_Operations,
RE_T_To_G => System_Vax_Float_Operations,
RE_Abs_F => System_Vax_Float_Operations,
RE_Abs_G => System_Vax_Float_Operations,
RE_Add_F => System_Vax_Float_Operations,
RE_Add_G => System_Vax_Float_Operations,
RE_Div_F => System_Vax_Float_Operations,
RE_Div_G => System_Vax_Float_Operations,
RE_Mul_F => System_Vax_Float_Operations,
RE_Mul_G => System_Vax_Float_Operations,
RE_Neg_F => System_Vax_Float_Operations,
RE_Neg_G => System_Vax_Float_Operations,
RE_Return_D => System_Vax_Float_Operations,
RE_Return_F => System_Vax_Float_Operations,
RE_Return_G => System_Vax_Float_Operations,
RE_Sub_F => System_Vax_Float_Operations,
RE_Sub_G => System_Vax_Float_Operations,
RE_Eq_F => System_Vax_Float_Operations,
RE_Eq_G => System_Vax_Float_Operations,
RE_Le_F => System_Vax_Float_Operations,
RE_Le_G => System_Vax_Float_Operations,
RE_Lt_F => System_Vax_Float_Operations,
RE_Lt_G => System_Vax_Float_Operations,
RE_Ne_F => System_Vax_Float_Operations,
RE_Ne_G => System_Vax_Float_Operations,
RE_Valid_D => System_Vax_Float_Operations,
RE_Valid_F => System_Vax_Float_Operations,
RE_Valid_G => System_Vax_Float_Operations,
RE_Version_String => System_Version_Control,
RE_Get_Version_String => System_Version_Control,

10
gcc/ada/s-auxdec.ads
View file

@ -39,13 +39,7 @@ package System.Aux_DEC is
pragma Preelaborate;
subtype Short_Address is Address;
-- In some versions of System.Aux_DEC, notably that for VMS on IA64, there
-- are two address types (64-bit and 32-bit), and the name Short_Address
-- is used for the short address form. To avoid difficulties (in regression
-- tests and elsewhere) with units that reference Short_Address, it is
-- provided for other targets as a synonym for the normal Address type,
-- and, as in the case where the lengths are different, Address and
-- Short_Address can be freely inter-converted.
-- For compatibility with systems having short and long addresses
type Integer_8 is range -2 ** (8 - 1) .. +2 ** (8 - 1) - 1;
for Integer_8'Size use 8;
@ -112,7 +106,7 @@ package System.Aux_DEC is
type F_Float is digits 6;
type D_Float is digits 9;
type G_Float is digits 15;
-- We provide the type names, but these will be IEEE, not VMS format
-- We provide the type names, but these will be IEEE format, not VAX format
-- Floating point type declarations for IEEE floating point data types

5
gcc/ada/s-fatgen.adb
View file

@ -756,12 +756,7 @@ package body System.Fat_Gen is
-- Valid --
-----------
-- Note: this routine does not work for VAX float. We compensate for this
-- in Exp_Attr by using the Valid functions in Vax_Float_Operations rather
-- than the corresponding instantiation of this function.
function Valid (X : not null access T) return Boolean is
IEEE_Emin : constant Integer := T'Machine_Emin - 1;
IEEE_Emax : constant Integer := T'Machine_Emax - 1;

6
gcc/ada/s-fatgen.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -95,8 +95,6 @@ package System.Fat_Gen is
-- register, and the whole point of 'Valid is to prevent exceptions.
-- Note that the object of type T must have the natural alignment
-- for type T. See Unaligned_Valid for further discussion.
--
-- Note: this routine does not work for Vax_Float ???
function Unaligned_Valid (A : System.Address) return Boolean;
-- This version of Valid is used if the floating-point value to
@ -114,8 +112,6 @@ package System.Fat_Gen is
-- not require strict alignment (e.g. the ia32/x86), since on a
-- target not requiring strict alignment, it is fine to pass a
-- non-aligned value to the standard Valid routine.
--
-- Note: this routine does not work for Vax_Float ???
private
pragma Inline (Machine);

15
gcc/ada/s-os_lib.adb
View file

@ -1851,6 +1851,7 @@ package body System.OS_Lib is
(Host_File : System.Address) return System.Address;
pragma Import
(C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec");
-- Convert possible foreign file syntax to canonical form
The_Name : String (1 .. Name'Length + 1);
Canonical_File_Addr : System.Address;
@ -1978,19 +1979,19 @@ package body System.OS_Lib is
return "";
end if;
-- First, convert VMS file spec to Unix file spec.
-- If Name is not in VMS syntax, then this is equivalent
-- to put Name at the beginning of Path_Buffer.
-- First, convert possible foreign file spec to Unix file spec. If no
-- conversion is required, all this does is put Name at the beginning
-- of Path_Buffer unchanged.
VMS_Conversion : begin
File_Name_Conversion : begin
The_Name (1 .. Name'Length) := Name;
The_Name (The_Name'Last) := ASCII.NUL;
Canonical_File_Addr := To_Canonical_File_Spec (The_Name'Address);
Canonical_File_Len := Integer (CRTL.strlen (Canonical_File_Addr));
-- If VMS syntax conversion has failed, return an empty string
-- to indicate the failure.
-- If syntax conversion has failed, return an empty string to
-- indicate the failure.
if Canonical_File_Len = 0 then
return "";
@ -2007,7 +2008,7 @@ package body System.OS_Lib is
End_Path := Canonical_File_Len;
Last := 1;
end;
end VMS_Conversion;
end File_Name_Conversion;
-- Replace all '/' by Directory Separators (this is for Windows)

6
gcc/ada/s-shasto.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2014, 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- --
@ -36,10 +36,6 @@
-- provides a more general implementation not dedicated to file
-- storage.
-- This unit (and shared passive partitions) are supported on all
-- GNAT implementations except on OpenVMS (where problems arise from
-- trying to share files, and with version numbers of files)
-- --------------------------
-- -- Shared Storage Model --
-- --------------------------

6
gcc/ada/s-stalib.ads
View file

@ -106,7 +106,6 @@ package System.Standard_Library is
Lang : Character;
-- A character indicating the language raising the exception.
-- Set to "A" for exceptions defined by an Ada program.
-- Set to "V" for imported VMS exceptions.
-- Set to "C" for imported C++ exceptions.
Name_Length : Natural;
@ -122,9 +121,8 @@ package System.Standard_Library is
-- identities and names.
Foreign_Data : Address;
-- Data for imported exceptions. This represents the exception code
-- for the handling of Import/Export_Exception for the VMS case.
-- This represents the address of the RTTI for the C++ case.
-- Data for imported exceptions. Not used in the Ada case. This
-- represents the address of the RTTI for the C++ case.
Raise_Hook : Raise_Action;
-- This field can be used to place a "hook" on an exception. If the

8
gcc/ada/sem.adb
View file

@ -1482,13 +1482,7 @@ package body Sem is
null;
else
-- Initialize if first time
if No (Comp_Unit_List) then
Comp_Unit_List := New_Elmt_List;
end if;
Append_Elmt (Comp_Unit, Comp_Unit_List);
Append_New_Elmt (Comp_Unit, To => Comp_Unit_List);
if Debug_Unit_Walk then
Write_Str ("Appending ");

39
gcc/ada/sem_attr.adb
View file

@ -6264,11 +6264,7 @@ package body Sem_Attr is
-- Mark this component as processed
else
if No (Comps) then
Comps := New_Elmt_List;
end if;
Append_Elmt (Comp_Or_Discr, Comps);
Append_New_Elmt (Comp_Or_Discr, Comps);
end if;
end if;
@ -6787,9 +6783,6 @@ package body Sem_Attr is
-- Computes the Fore value for the current attribute prefix, which is
-- known to be a static fixed-point type. Used by Fore and Width.
function Is_VAX_Float (Typ : Entity_Id) return Boolean;
-- Determine whether Typ denotes a VAX floating point type
function Mantissa return Uint;
-- Returns the Mantissa value for the prefix type
@ -6921,16 +6914,6 @@ package body Sem_Attr is
return R;
end Fore_Value;
------------------
-- Is_VAX_Float --
------------------
function Is_VAX_Float (Typ : Entity_Id) return Boolean is
pragma Unreferenced (Typ);
begin
return False;
end Is_VAX_Float;
--------------
-- Mantissa --
--------------
@ -7953,16 +7936,6 @@ package body Sem_Attr is
Fold_Uint (N, Expr_Value (Lo_Bound), Static);
end if;
-- Replace VAX Float_Type'First with a reference to the temporary
-- which represents the low bound of the type. This transformation
-- is needed since the back end cannot evaluate 'First on VAX.
elsif Is_VAX_Float (P_Type)
and then Nkind (Lo_Bound) = N_Identifier
then
Rewrite (N, New_Occurrence_Of (Entity (Lo_Bound), Sloc (N)));
Analyze (N);
else
Check_Concurrent_Discriminant (Lo_Bound);
end if;
@ -8206,16 +8179,6 @@ package body Sem_Attr is
Fold_Uint (N, Expr_Value (Hi_Bound), Static);
end if;
-- Replace VAX Float_Type'Last with a reference to the temporary
-- which represents the high bound of the type. This transformation
-- is needed since the back end cannot evaluate 'Last on VAX.
elsif Is_VAX_Float (P_Type)
and then Nkind (Hi_Bound) = N_Identifier
then
Rewrite (N, New_Occurrence_Of (Entity (Hi_Bound), Sloc (N)));
Analyze (N);
else
Check_Concurrent_Discriminant (Hi_Bound);
end if;

11
gcc/ada/sem_ch12.adb
View file

@ -1751,9 +1751,7 @@ package body Sem_Ch12 is
-- If this is a nested generic, preserve default for later
-- instantiations.
if No (Match)
and then Box_Present (Formal)
then
if No (Match) and then Box_Present (Formal) then
Append_Elmt
(Defining_Unit_Name (Specification (Last (Assoc))),
Default_Actuals);
@ -8919,12 +8917,7 @@ package body Sem_Ch12 is
and then Remove_Suffix (Prim_A, 'P') = Chars (Prim_G)
then
Set_Chars (Prim_A, Chars (Prim_G));
if List = No_Elist then
List := New_Elmt_List;
end if;
Append_Elmt (Prim_A, List);
Append_New_Elmt (Prim_A, To => List);
end if;
Next_Elmt (Prim_A_Elmt);

123
gcc/ada/sem_prag.adb
View file

@ -326,11 +326,7 @@ package body Sem_Prag is
procedure Add_Item (Item : Entity_Id; To_List : in out Elist_Id) is
begin
if No (To_List) then
To_List := New_Elmt_List;
end if;
Append_Elmt (Item, To_List);
Append_New_Elmt (Item, To => To_List);
end Add_Item;
-------------------------------
@ -3248,8 +3244,7 @@ package body Sem_Prag is
Arg_Parameter_Types : Node_Id;
Arg_Result_Type : Node_Id := Empty;
Arg_Mechanism : Node_Id;
Arg_Result_Mechanism : Node_Id := Empty;
Arg_First_Optional_Parameter : Node_Id := Empty);
Arg_Result_Mechanism : Node_Id := Empty);
-- Common processing for all extended Import and Export pragmas applying
-- to subprograms. The caller omits any arguments that do not apply to
-- the pragma in question (for example, Arg_Result_Type can be non-Empty
@ -7309,13 +7304,8 @@ package body Sem_Prag is
Arg_Parameter_Types : Node_Id;
Arg_Result_Type : Node_Id := Empty;
Arg_Mechanism : Node_Id;
Arg_Result_Mechanism : Node_Id := Empty;
Arg_First_Optional_Parameter : Node_Id := Empty)
Arg_Result_Mechanism : Node_Id := Empty)
is
pragma Unreferenced (Arg_First_Optional_Parameter);
-- We ignore the First_Optional_Parameter argument. It was only
-- relevant for VMS anyway, and otherwise ignored.
Ent : Entity_Id;
Def_Id : Entity_Id;
Hom_Id : Entity_Id;
@ -9317,9 +9307,9 @@ package body Sem_Prag is
if Warn_On_Export_Import
-- Only do this for something that was in the source. Not
-- clear if this can be False now (there used for sure to
-- be cases on VMS where it was False), but anyway the test
-- is harmless if not needed, so it is retained.
-- clear if this can be False now (there used for sure to be
-- cases on some systems where it was False), but anyway the
-- test is harmless if not needed, so it is retained.
and then Comes_From_Source (Arg)
then
@ -13535,9 +13525,6 @@ package body Sem_Prag is
-- MECHANISM_NAME ::=
-- Value
-- | Reference
-- | Descriptor [([Class =>] CLASS_NAME)]
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
when Pragma_Export_Function => Export_Function : declare
Args : Args_List (1 .. 6);
@ -13599,9 +13586,6 @@ package body Sem_Prag is
-- MECHANISM_NAME ::=
-- Value
-- | Reference
-- | Descriptor [([Class =>] CLASS_NAME)]
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
when Pragma_Export_Object => Export_Object : declare
Args : Args_List (1 .. 3);
@ -13655,9 +13639,6 @@ package body Sem_Prag is
-- MECHANISM_NAME ::=
-- Value
-- | Reference
-- | Descriptor [([Class =>] CLASS_NAME)]
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
when Pragma_Export_Procedure => Export_Procedure : declare
Args : Args_List (1 .. 4);
@ -13733,9 +13714,6 @@ package body Sem_Prag is
-- MECHANISM_NAME ::=
-- Value
-- | Reference
-- | Descriptor [([Class =>] CLASS_NAME)]
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
when Pragma_Export_Valued_Procedure =>
Export_Valued_Procedure : declare
@ -14071,10 +14049,8 @@ package body Sem_Prag is
-- pragma Ident (static_string_EXPRESSION)
-- Note: pragma Comment shares this processing. Pragma Comment is
-- identical to Ident, except that the restriction of the argument to
-- 31 characters and the placement restrictions are not enforced for
-- pragma Comment.
-- Note: pragma Comment shares this processing. Pragma Ident is
-- identical in effect to pragma Commment.
when Pragma_Ident | Pragma_Comment => Ident : declare
Str : Node_Id;
@ -14086,13 +14062,6 @@ package body Sem_Prag is
Check_Arg_Is_OK_Static_Expression (Arg1, Standard_String);
Store_Note (N);
-- For pragma Ident, preserve DEC compatibility by requiring the
-- pragma to appear in a declarative part or package spec.
if Prag_Id = Pragma_Ident then
Check_Is_In_Decl_Part_Or_Package_Spec;
end if;
Str := Expr_Value_S (Get_Pragma_Arg (Arg1));
declare
@ -14116,15 +14085,10 @@ package body Sem_Prag is
if Present (CS) then
-- For Ident, we do not permit multiple instances
-- If we have multiple instances, concatenate them, but
-- not in ASIS, where we want the original tree.
if Prag_Id = Pragma_Ident then
Error_Pragma ("duplicate% pragma not permitted");
-- For Comment, we concatenate the string, unless we want
-- to preserve the tree structure for ASIS.
elsif not ASIS_Mode then
if not ASIS_Mode then
Start_String (Strval (CS));
Store_String_Char (' ');
Store_String_Chars (Strval (Str));
@ -14141,15 +14105,6 @@ package body Sem_Prag is
elsif Nkind (GP) = N_Subunit then
null;
-- Otherwise we have a misplaced pragma Ident, but we ignore
-- this if we are in an instantiation, since it comes from
-- a generic, and has no relevance to the instantiation.
elsif Prag_Id = Pragma_Ident then
if Instantiation_Location (Loc) = No_Location then
Error_Pragma ("pragma% only allowed at outer level");
end if;
end if;
end;
end Ident;
@ -14338,8 +14293,7 @@ package body Sem_Prag is
-- [, [Parameter_Types =>] (PARAMETER_TYPES)]
-- [, [Result_Type =>] SUBTYPE_MARK]
-- [, [Mechanism =>] MECHANISM]
-- [, [Result_Mechanism =>] MECHANISM_NAME]
-- [, [First_Optional_Parameter =>] IDENTIFIER]);
-- [, [Result_Mechanism =>] MECHANISM_NAME]);
-- EXTERNAL_SYMBOL ::=
-- IDENTIFIER
@ -14363,20 +14317,16 @@ package body Sem_Prag is
-- MECHANISM_NAME ::=
-- Value
-- | Reference
-- | Descriptor [([Class =>] CLASS_NAME)]
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
when Pragma_Import_Function => Import_Function : declare
Args : Args_List (1 .. 7);
Names : constant Name_List (1 .. 7) := (
Args : Args_List (1 .. 6);
Names : constant Name_List (1 .. 6) := (
Name_Internal,
Name_External,
Name_Parameter_Types,
Name_Result_Type,
Name_Mechanism,
Name_Result_Mechanism,
Name_First_Optional_Parameter);
Name_Result_Mechanism);
Internal : Node_Id renames Args (1);
External : Node_Id renames Args (2);
@ -14384,7 +14334,6 @@ package body Sem_Prag is
Result_Type : Node_Id renames Args (4);
Mechanism : Node_Id renames Args (5);
Result_Mechanism : Node_Id renames Args (6);
First_Optional_Parameter : Node_Id renames Args (7);
begin
GNAT_Pragma;
@ -14395,8 +14344,7 @@ package body Sem_Prag is
Arg_Parameter_Types => Parameter_Types,
Arg_Result_Type => Result_Type,
Arg_Mechanism => Mechanism,
Arg_Result_Mechanism => Result_Mechanism,
Arg_First_Optional_Parameter => First_Optional_Parameter);
Arg_Result_Mechanism => Result_Mechanism);
end Import_Function;
-------------------
@ -14440,8 +14388,7 @@ package body Sem_Prag is
-- [Internal =>] LOCAL_NAME
-- [, [External =>] EXTERNAL_SYMBOL]
-- [, [Parameter_Types =>] (PARAMETER_TYPES)]
-- [, [Mechanism =>] MECHANISM]
-- [, [First_Optional_Parameter =>] IDENTIFIER]);
-- [, [Mechanism =>] MECHANISM]);
-- EXTERNAL_SYMBOL ::=
-- IDENTIFIER
@ -14465,24 +14412,19 @@ package body Sem_Prag is
-- MECHANISM_NAME ::=
-- Value
-- | Reference
-- | Descriptor [([Class =>] CLASS_NAME)]
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
when Pragma_Import_Procedure => Import_Procedure : declare
Args : Args_List (1 .. 5);
Names : constant Name_List (1 .. 5) := (
Args : Args_List (1 .. 4);
Names : constant Name_List (1 .. 4) := (
Name_Internal,
Name_External,
Name_Parameter_Types,
Name_Mechanism,
Name_First_Optional_Parameter);
Name_Mechanism);
Internal : Node_Id renames Args (1);
External : Node_Id renames Args (2);
Parameter_Types : Node_Id renames Args (3);
Mechanism : Node_Id renames Args (4);
First_Optional_Parameter : Node_Id renames Args (5);
begin
GNAT_Pragma;
@ -14491,8 +14433,7 @@ package body Sem_Prag is
Arg_Internal => Internal,
Arg_External => External,
Arg_Parameter_Types => Parameter_Types,
Arg_Mechanism => Mechanism,
Arg_First_Optional_Parameter => First_Optional_Parameter);
Arg_Mechanism => Mechanism);
end Import_Procedure;
-----------------------------
@ -14503,8 +14444,7 @@ package body Sem_Prag is
-- [Internal =>] LOCAL_NAME
-- [, [External =>] EXTERNAL_SYMBOL]
-- [, [Parameter_Types =>] (PARAMETER_TYPES)]
-- [, [Mechanism =>] MECHANISM]
-- [, [First_Optional_Parameter =>] IDENTIFIER]);
-- [, [Mechanism =>] MECHANISM]);
-- EXTERNAL_SYMBOL ::=
-- IDENTIFIER
@ -14528,25 +14468,20 @@ package body Sem_Prag is
-- MECHANISM_NAME ::=
-- Value
-- | Reference
-- | Descriptor [([Class =>] CLASS_NAME)]
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
when Pragma_Import_Valued_Procedure =>
Import_Valued_Procedure : declare
Args : Args_List (1 .. 5);
Names : constant Name_List (1 .. 5) := (
Args : Args_List (1 .. 4);
Names : constant Name_List (1 .. 4) := (
Name_Internal,
Name_External,
Name_Parameter_Types,
Name_Mechanism,
Name_First_Optional_Parameter);
Name_Mechanism);
Internal : Node_Id renames Args (1);
External : Node_Id renames Args (2);
Parameter_Types : Node_Id renames Args (3);
Mechanism : Node_Id renames Args (4);
First_Optional_Parameter : Node_Id renames Args (5);
begin
GNAT_Pragma;
@ -14555,8 +14490,7 @@ package body Sem_Prag is
Arg_Internal => Internal,
Arg_External => External,
Arg_Parameter_Types => Parameter_Types,
Arg_Mechanism => Mechanism,
Arg_First_Optional_Parameter => First_Optional_Parameter);
Arg_Mechanism => Mechanism);
end Import_Valued_Procedure;
-----------------
@ -18910,11 +18844,12 @@ package body Sem_Prag is
-- pragma Short_Descriptors;
-- Recognize and validate, but otherwise ignore
when Pragma_Short_Descriptors =>
GNAT_Pragma;
Check_Arg_Count (0);
Check_Valid_Configuration_Pragma;
Short_Descriptors := True;
------------------------------
-- Simple_Storage_Pool_Type --
@ -25354,7 +25289,7 @@ package body Sem_Prag is
Set_Body_References (State_Id, New_Elmt_List);
end if;
Append_Elmt (Ref, Body_References (State_Id));
Append_Elmt (Ref, To => Body_References (State_Id));
exit;
end if;
end if;

10
gcc/ada/sem_prag.ads
View file

@ -262,13 +262,11 @@ package Sem_Prag is
-- dealing with subprogram body stubs or expression functions.
procedure Set_Encoded_Interface_Name (E : Entity_Id; S : Node_Id);
-- This routine is used to set an encoded interface name. The node S is an
-- N_String_Literal node for the external name to be set, and E is an
-- This routine is used to set an encoded interface name. The node S is
-- an N_String_Literal node for the external name to be set, and E is an
-- entity whose Interface_Name field is to be set. In the normal case where
-- S contains a name that is a valid C identifier, then S is simply set as
-- the value of the Interface_Name. Otherwise it is encoded. See the body
-- for details of the encoding. This encoding is only done on VMS systems,
-- since it seems pretty silly, but is needed to pass some dubious tests in
-- the test suite.
-- the value of the Interface_Name. Otherwise it is encoded as needed by
-- particular operating systems. See the body for details of the encoding.
end Sem_Prag;

18
gcc/ada/sem_util.adb
View file

@ -1875,11 +1875,7 @@ package body Sem_Util is
return Abandon;
end if;
if Writable_Actuals_List = No_Elist then
Writable_Actuals_List := New_Elmt_List;
end if;
Append_Elmt (N, Writable_Actuals_List);
Append_New_Elmt (N, To => Writable_Actuals_List);
else
if Identifiers_List = No_Elist then
@ -6128,9 +6124,7 @@ package body Sem_Util is
declare
Comp : constant Entity_Id := Defining_Identifier (Comp_Item);
begin
if not Is_Tag (Comp)
and then Chars (Comp) /= Name_uParent
then
if not Is_Tag (Comp) and then Chars (Comp) /= Name_uParent then
Append_Elmt (Comp, Into);
end if;
end;
@ -7410,9 +7404,7 @@ package body Sem_Util is
function Has_Denormals (E : Entity_Id) return Boolean is
begin
return Is_Floating_Point_Type (E)
and then Denorm_On_Target
and then not Vax_Float (E);
return Is_Floating_Point_Type (E) and then Denorm_On_Target;
end Has_Denormals;
-------------------------------------------
@ -8369,9 +8361,7 @@ package body Sem_Util is
function Has_Signed_Zeros (E : Entity_Id) return Boolean is
begin
return Is_Floating_Point_Type (E)
and then Signed_Zeros_On_Target
and then not Vax_Float (E);
return Is_Floating_Point_Type (E) and then Signed_Zeros_On_Target;
end Has_Signed_Zeros;
-----------------------------

8
gcc/ada/snames.ads-tmpl
View file

@ -342,10 +342,6 @@ package Snames is
-- Ada 83, Ada 95, and Ada 2005 mode as well, where they are technically
-- considered to be implementation dependent pragmas.
-- The entries marked VMS are VMS specific pragmas that are recognized only
-- in OpenVMS versions of GNAT. They are ignored in other versions with an
-- appropriate warning.
-- The entries marked AAMP are AAMP specific pragmas that are recognized
-- only in GNAT for the AAMP. They are ignored in other versions with
-- appropriate warnings.
@ -579,7 +575,7 @@ package Snames is
-- pragma.
Name_Provide_Shift_Operators : constant Name_Id := N + $; -- GNAT
Name_Psect_Object : constant Name_Id := N + $; -- VMS
Name_Psect_Object : constant Name_Id := N + $; -- GNAT
Name_Pure : constant Name_Id := N + $;
Name_Pure_Function : constant Name_Id := N + $; -- GNAT
Name_Refined_Depends : constant Name_Id := N + $; -- GNAT
@ -614,7 +610,7 @@ package Snames is
Name_Test_Case : constant Name_Id := N + $; -- GNAT
Name_Task_Info : constant Name_Id := N + $; -- GNAT
Name_Task_Name : constant Name_Id := N + $; -- GNAT
Name_Task_Storage : constant Name_Id := N + $; -- VMS
Name_Task_Storage : constant Name_Id := N + $; -- GNAT
Name_Thread_Local_Storage : constant Name_Id := N + $; -- GNAT
Name_Time_Slice : constant Name_Id := N + $; -- GNAT
Name_Title : constant Name_Id := N + $; -- GNAT

3
gcc/ada/stand.ads
View file

@ -443,8 +443,7 @@ package Stand is
-- Entity for universal real type. The bounds of this type correspond to
-- to the largest supported real type (i.e. Long_Long_Float). It is the
-- type used for runtime calculations in type universal real. Note that
-- this type is always IEEE format, even if Long_Long_Float is Vax_Float
-- (and in that case the bounds don't correspond exactly).
-- this type is always IEEE format.
Universal_Fixed : Entity_Id;
-- Entity for universal fixed type. This is a type with arbitrary

14
gcc/ada/switch-b.adb
View file

@ -262,20 +262,6 @@ package body Switch.B is
Ptr := Ptr + 1;
Usage_Requested := True;
-- Processing for H switch
when 'H' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
Ptr := Ptr + 1;
Scan_Nat (Switch_Chars, Max, Ptr, Heap_Size, C);
if Heap_Size /= 32 and then Heap_Size /= 64 then
Bad_Switch (Switch_Chars);
end if;
-- Processing for i switch
when 'i' =>

3
gcc/ada/system.ads
View file

@ -7,7 +7,7 @@
-- S p e c --
-- (Compiler Version) --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -148,7 +148,6 @@ private
Frontend_Layout : constant Boolean := False;
Machine_Overflows : constant Boolean := False;
Machine_Rounds : constant Boolean := True;
OpenVMS : constant Boolean := False;
Preallocated_Stacks : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;

8
gcc/ada/targparm.adb
View file

@ -67,8 +67,6 @@ package body Targparm is
SNZ, -- Signed_Zeros
SSL, -- Suppress_Standard_Library
UAM, -- Use_Ada_Main_Program_Name
VMS, -- OpenVMS
VXF, -- VAX Float
ZCD); -- ZCX_By_Default
Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
@ -105,8 +103,6 @@ package body Targparm is
SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
SSL_Str : aliased constant Source_Buffer := "Suppress_Standard_Library";
UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name";
VMS_Str : aliased constant Source_Buffer := "OpenVMS";
VXF_Str : aliased constant Source_Buffer := "VAX_Float";
ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default";
-- The following defines a set of pointers to the above strings,
@ -143,8 +139,6 @@ package body Targparm is
SNZ_Str'Access,
SSL_Str'Access,
UAM_Str'Access,
VMS_Str'Access,
VXF_Str'Access,
ZCD_Str'Access);
-----------------------
@ -678,8 +672,6 @@ package body Targparm is
when SSL => Suppress_Standard_Library_On_Target := Result;
when SNZ => Signed_Zeros_On_Target := Result;
when UAM => Use_Ada_Main_Program_Name_On_Target := Result;
when VMS => OpenVMS_On_Target := Result;
when VXF => VAX_Float_On_Target := Result;
when ZCD => ZCX_By_Default_On_Target := Result;
goto Line_Loop_Continue;

14
gcc/ada/targparm.ads
View file

@ -179,13 +179,13 @@ package Targparm is
-- The default values here are used if no value is found in system.ads.
-- This should normally happen if the special version of system.ads used
-- by the compiler itself is in use or if the value is only relevant to
-- a particular target (e.g. OpenVMS, AAMP). The default values are
-- suitable for use in normal environments. This approach allows the
-- possibility of new versions of the compiler (possibly with new system
-- parameters added) being used to compile older versions of the compiler
-- sources, as well as avoiding duplicating values in all system-*.ads
-- files for flags that are used on a few platforms only.
-- by the compiler itself is in use or if the value is only relevant to a
-- particular target (e.g. AAMP). The default values are suitable for use
-- in normal environments. This approach allows the possibility of new
-- versions of the compiler (possibly with new system parameters added)
-- being used to compile older versions of the compiler sources, as well as
-- avoiding duplicating values in all system-*.ads files for flags that are
-- used on a few platforms only.
-- All these parameters should be regarded as read only by all clients
-- of the package. The only way they get modified is by calling the