Skip to content

R
riscv-gcc-1
Commit ce4a6e84 by Robert Dewar Committed by Arnaud Charlet
Options

fe.h: Remove global Optimize_Alignment flag, no longer used 

2008-04-08  Robert Dewar  <dewar@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* fe.h: Remove global Optimize_Alignment flag, no longer used

	* layout.adb: Test Optimize_Alignment flags rather than global switch

	* lib.ads, lib.adb: New OA_Setting field in library record

	* lib-load.adb: New OA_Setting field in library record

	* lib-writ.ads, lib-writ.adb (Collect_Withs, Write_With_Lines): Place
	units mentioned in limited_with_ clauses in the ali file, with an
	'Y' marker.
	New Ox fields in U line

	* opt.adb: New flag Optimize_Alignment_Local
	(Check_Policy_List[_Config]): New flags

	* opt.ads (Invalid_Value_Used): New flag
	New switch Optimize_Alignment_Local
	(Warn_On_Parameter_Order): New flag
	(Check_Policy_List[_Config]): New flags

	* ali.ads, ali.adb: Add indicator 'Y' to mark mark the presence of
	limited_with clauses.
	New data structures for Optimize_Alignment

	* bcheck.adb (Check_Consistent_Restriction_No_Default_Initialization):
	New procedure
	(Check_Consistent_Optimize_Alignment): Rework for new structure
	(Check_Consistent_Restrictions): Fix incorrect error message

	sem_ch10.adb (Decorate_Tagged_Type): Set the Parent field of a newly
	created class-wide type (to the Parent field of the specific type).
	(Install_Siblings): Handle properly private_with_clauses on subprogram
	bodies and on generic units.
	(Analyze_With_Clause, Install_Limited_Withed_Unit): Guard against an
	illegal limited_with_clause that names a non-existent package.
	(Check_Body_Required): Determine whether a unit named a limited_with
	clause needs a body.
	(Analyze_Context): A limited_with_clause is illegal on a unit_renaming.
	Capture Optimize_Alignment settings to set new OA_Setting field in
	library record.
	(Build_Limited_Views): Include task and protected type declarations.

	* sem_ch3.ads, sem_ch3.adb (Analyze_Object_Declaration): Handle the
	case of a possible constant redeclaration where the current object is
	an entry index constant.
	(Analyze_Object_Declaration): Generate an error in case of CPP
	class-wide object initialization.
	(Analyze_Object_Declaration): Add extra information on warnings for
	declaration of unconstrained objects.
	(Access_Type_Declaration): Set Associated_Final_Chain to Empty, to avoid
	conflicts with the setting of Stored_Constraint in the case where the
	access type entity has already been created as an E_Incomplete_Type due
	to a limited with clause.
	Use new Is_Standard_Character_Type predicate
	(Analyze_Object_Declaration): Apply access_constant check only after
	expression has been resolved, given that it may be overloaded with
	several access types.
	(Constant_Redeclaration): Additional legality checks for deferred
	constant declarations tha involve anonymous access types and/or null
	exclusion indicators.
	(Analyze_Type_Declaration): Set Optimize_Alignment flags
	(Analyze_Subtype_Declaration): Ditto
	(Analyze_Object_Declaration): Ditto
	(Analyze_Object_Declaration): Don't count tasks in generics
	Change name In_Default_Expression      => In_Spec_Expression
	Change name Analyze_Per_Use_Expression => Preanalyze_Spec_Expression
	Change name Pre_Analyze_And_Resolve    => Preanalyze_And_Resolve
	(Process_Discriminants): Additional check for illegal use of default
	expressions in access discriminant specifications in a type that is not
	explicitly limited.
	(Check_Abstract_Overriding): If an inherited function dispaches on an
	access result, it must be overridden, even if the type is a null
	extension.
	(Derive_Subprogram): The formals of the derived subprogram have the
	names and defaults of the parent subprogram, even if the type is
	obtained from the actual subprogram.
	(Derive_Subprogram): In the presence of interfaces, a formal of an
	inherited operation has the derived type not only if it descends from
	the type of the formal of the parent operation, but also if it
	implements it. This is relevant for the renamings created for the
	primitive operations of the actual for a formal derived type.
	(Is_Progenitor): New predicate, to determine whether the type of a
	formal in the parent operation must be replaced by the derived type.

	* sem_util.ads, sem_util.adb (Has_Overriding_Initialize): Make
	predicate recursive to handle components that have a user-defined
	Initialize procedure. Handle controlled derived types whose ancestor
	has a user-defined Initialize procedured.
	(Note_Possible_Modification): Add Sure parameter, generate warning if
	sure modification of constant
	Use new Is_Standard_Character_Type predicate
	(Find_Parameter_Type): when determining whether a protected operation
	implements an interface operation, retrieve the type of the formal from
	the entity when the formal is an access parameter or an
	anonymous-access-to-subprogram.
	Move Copy_Parameter_List to sem_util, for use when building stubbed
	subprogram bodies.
	(Has_Access_Values): Tagged types now return False
	(Within_HSS_Or_If): New procedure
	(Set_Optimize_Alignment_Flags): New procedure
	Change name In_Default_Expression      => In_Spec_Expression
	Change name Analyze_Per_Use_Expression => Preanalyze_Spec_Expression
	Change name Pre_Analyze_And_Resolve    => Preanalyze_And_Resolve

From-SVN: r134011
parent 21d27997
Showing with 344 additions and 130 deletions
gcc/ada/ali.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -53,6 +53,7 @@ package body ALI is
'D' => True, -- dependency
'X' => True, -- xref
'S' => True, -- specific dispatching
'Y' => True, -- limited_with
others => False);
--------------------
......@@ -772,7 +773,7 @@ package body ALI is
-- Acquire lines to be ignored
if Read_Xref then
Ignore := ('U' | 'W' | 'D' | 'X' => False, others => True);
Ignore := ('U' | 'W' | 'Y' | 'D' | 'X' => False, others => True);
-- Read_Lines parameter given
......@@ -818,7 +819,6 @@ package body ALI is
No_Object => False,
Normalize_Scalars => False,
Ofile_Full_Name => Full_Object_File_Name,
Optimize_Alignment_Setting => 'O',
Queuing_Policy => ' ',
Restrictions => No_Restrictions,
SAL_Interface => False,
......@@ -1041,11 +1041,6 @@ package body ALI is
Fatal_Error_Ignore;
end if;
-- Processing for Ox
elsif C = 'O' then
ALIs.Table (Id).Optimize_Alignment_Setting := Getc;
-- Processing for Qx
elsif C = 'Q' then
......@@ -1424,6 +1419,7 @@ package body ALI is
UL.SAL_Interface := ALIs.Table (Id).SAL_Interface;
UL.Body_Needed_For_SAL := False;
UL.Elaborate_Body_Desirable := False;
UL.Optimize_Alignment := 'O';
if Debug_Flag_U then
Write_Str (" ----> reading unit ");
......@@ -1626,6 +1622,19 @@ package body ALI is
Check_At_End_Of_Field;
-- OL/OO/OS/OT parameters
elsif C = 'O' then
C := Getc;
if C = 'L' or else C = 'O' or else C = 'S' or else C = 'T' then
Units.Table (Units.Last).Optimize_Alignment := C;
else
Fatal_Error_Ignore;
end if;
Check_At_End_Of_Field;
-- RC/RT parameters
elsif C = 'R' then
......@@ -1678,7 +1687,7 @@ package body ALI is
With_Loop : loop
Check_Unknown_Line;
exit With_Loop when C /= 'W';
exit With_Loop when C /= 'W' and then C /= 'Y';
if Ignore ('W') then
Skip_Line;
......@@ -1693,6 +1702,7 @@ package body ALI is
Withs.Table (Withs.Last).Elab_Desirable := False;
Withs.Table (Withs.Last).Elab_All_Desirable := False;
Withs.Table (Withs.Last).SAL_Interface := False;
Withs.Table (Withs.Last).Limited_With := (C = 'Y');
-- Generic case with no object file available
......
gcc/ada/ali.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -176,11 +176,6 @@ package ALI is
-- Set to True if file was compiled with Normalize_Scalars. Not set if
-- 'P' appears in Ignore_Lines.
Optimize_Alignment_Setting : Character;
-- Optimize_Alignment setting. Set to S/T if OS/OT parameters present,
-- otherwise set to 'O' (S/T/O = Space/Time/Off). Not set if 'P' appears
-- in Ignore_Lines.
Unit_Exception_Table : Boolean;
-- Set to True if unit exception table pointer generated. Not set if 'P'
-- appears in Ignore_Lines.
......@@ -358,6 +353,9 @@ package ALI is
-- for the body right after the call for the spec, or at least as close
-- together as possible.
Optimize_Alignment : Character;
-- Optimize_Alignment setting. Set to L/S/T/O for OL/OS/OT/OO present
end record;
package Units is new Table.Table (
......@@ -539,6 +537,8 @@ package ALI is
SAL_Interface : Boolean := False;
-- True if the Unit is an Interface of a Stand-Alone Library
Limited_With : Boolean := False;
-- True if unit is named in a limited_with_clause
end record;
package Withs is new Table.Table (
......@@ -669,8 +669,8 @@ package ALI is
-- Sdep (Source Dependency) Table --
------------------------------------
-- Each source dependency (D line) in an ALI file generates an
-- entry in the Sdep table.
-- Each source dependency (D line) in an ALI file generates an entry in the
-- Sdep table.
-- Note: there will be no entries in this table if 'D' lines are ignored
......@@ -678,9 +678,9 @@ package ALI is
-- Special value indicating no Sdep table entry
First_Sdep_Entry : Sdep_Id := No_Sdep_Id + 1;
-- Id of first Sdep entry for current ali file. This is initialized to
-- the first Sdep entry in the table, and then incremented appropriately
-- as successive ALI files are scanned.
-- Id of first Sdep entry for current ali file. This is initialized to the
-- first Sdep entry in the table, and then incremented appropriately as
-- successive ALI files are scanned.
type Sdep_Record is record
......@@ -688,24 +688,23 @@ package ALI is
-- Name of source file
Stamp : Time_Stamp_Type;
-- Time stamp value. Note that this will be all zero characters
-- for the dummy entries for missing or non-dependent files.
-- Time stamp value. Note that this will be all zero characters for the
-- dummy entries for missing or non-dependent files.
Checksum : Word;
-- Checksum value. Note that this will be all zero characters
-- for the dummy entries for missing or non-dependent files
-- Checksum value. Note that this will be all zero characters for the
-- dummy entries for missing or non-dependent files
Dummy_Entry : Boolean;
-- Set True for dummy entries that correspond to missing files
-- or files where no dependency relationship exists.
-- Set True for dummy entries that correspond to missing files or files
-- where no dependency relationship exists.
Subunit_Name : Name_Id;
-- Name_Id for subunit name if present, else No_Name
Rfile : File_Name_Type;
-- Reference file name. Same as Sfile unless a Source_Reference
-- pragma was used, in which case it reflects the name used in
-- the pragma.
-- Reference file name. Same as Sfile unless a Source_Reference pragma
-- was used, in which case it reflects the name used in the pragma.
Start_Line : Nat;
-- Starting line number in file. Always 1, unless a Source_Reference
......@@ -726,8 +725,8 @@ package ALI is
-- Use of Name Table Info --
----------------------------
-- All unit names and file names are entered into the Names table. The
-- Info fields of these entries are used as follows:
-- All unit names and file names are entered into the Names table. The Info
-- fields of these entries are used as follows:
-- Unit name Info field has Unit_Id of unit table entry
-- ALI file name Info field has ALI_Id of ALI table entry
......@@ -737,8 +736,8 @@ package ALI is
-- Cross-Reference Data --
--------------------------
-- The following table records cross-reference sections, there is one
-- entry for each X header line in the ALI file for an xref section.
-- The following table records cross-reference sections, there is one entry
-- for each X header line in the ALI file for an xref section.
-- Note: there will be no entries in this table if 'X' lines are ignored
......
gcc/ada/bcheck.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -43,7 +43,7 @@ package body Bcheck is
-----------------------
-- The following checking subprograms make up the parts of the
-- configuration consistency check.
-- configuration consistency check. See bodies for details of checks.
procedure Check_Consistent_Dispatching_Policy;
procedure Check_Consistent_Dynamic_Elaboration_Checking;
......@@ -54,6 +54,7 @@ package body Bcheck is
procedure Check_Consistent_Optimize_Alignment;
procedure Check_Consistent_Queuing_Policy;
procedure Check_Consistent_Restrictions;
procedure Check_Consistent_Restriction_No_Default_Initialization;
procedure Check_Consistent_Zero_Cost_Exception_Handling;
procedure Consistency_Error_Msg (Msg : String);
......@@ -90,6 +91,7 @@ package body Bcheck is
Check_Consistent_Optimize_Alignment;
Check_Consistent_Dynamic_Elaboration_Checking;
Check_Consistent_Restrictions;
Check_Consistent_Restriction_No_Default_Initialization;
Check_Consistent_Interrupt_States;
Check_Consistent_Dispatching_Policy;
end Check_Configuration_Consistency;
......@@ -700,34 +702,40 @@ package body Bcheck is
-- Check_Consistent_Optimize_Alignment --
-----------------------------------------
-- The rule is that all units other than internal units must be compiled
-- with the same setting for Optimize_Alignment. We can exclude internal
-- units since they are forced to compile with Optimize_Alignment (Off).
-- The rule is that all units which depend on the global default setting
-- of Optimize_Alignment must be compiled with the same settinng for this
-- default. Units which specify an explicit local value for this setting
-- are exempt from the consistency rule (this includes all internal units).
procedure Check_Consistent_Optimize_Alignment is
OA_Setting : Character := ' ';
-- Reset when we find a non-internal unit
-- Reset when we find a unit that depends on the default and does
-- not have a local specification of the Optimize_Alignment setting.
OA_Unit : ALI_Id;
OA_Unit : Unit_Id;
-- Id of unit from which OA_Setting was set
C : Character;
begin
for A in ALIs.First .. ALIs.Last loop
if not Is_Internal_File_Name (ALIs.Table (A).Afile) then
for U in First_Unit_Entry .. Units.Last loop
C := Units.Table (U).Optimize_Alignment;
if C /= 'L' then
if OA_Setting = ' ' then
OA_Setting := ALIs.Table (A).Optimize_Alignment_Setting;
OA_Unit := A;
OA_Setting := C;
OA_Unit := U;
elsif OA_Setting = ALIs.Table (A).Optimize_Alignment_Setting then
elsif OA_Setting = C then
null;
else
Error_Msg_File_1 := ALIs.Table (OA_Unit).Sfile;
Error_Msg_File_2 := ALIs.Table (A).Sfile;
Error_Msg_Unit_1 := Units.Table (OA_Unit).Uname;
Error_Msg_Unit_2 := Units.Table (U).Uname;
Consistency_Error_Msg
("{ and { compiled with different "
& "Optimize_Alignment settings");
("$ and $ compiled with different "
& "default Optimize_Alignment settings");
return;
end if;
end if;
......@@ -775,10 +783,9 @@ package body Bcheck is
-- Check_Consistent_Restrictions --
-----------------------------------
-- The rule is that if a restriction is specified in any unit,
-- then all units must obey the restriction. The check applies
-- only to restrictions which require partition wide consistency,
-- and not to internal units.
-- The rule is that if a restriction is specified in any unit, then all
-- units must obey the restriction. The check applies only to restrictions
-- which require partition wide consistency, and not to internal units.
procedure Check_Consistent_Restrictions is
Restriction_File_Output : Boolean;
......@@ -811,7 +818,7 @@ package body Bcheck is
declare
M1 : constant String := "{ has restriction ";
S : constant String := Restriction_Id'Image (R);
M2 : String (1 .. 200); -- big enough!
M2 : String (1 .. 2000); -- big enough!
P : Integer;
begin
......@@ -902,7 +909,7 @@ package body Bcheck is
(" { (count = at least #)");
else
Consistency_Error_Msg
(" % (count = #)");
(" { (count = #)");
end if;
end if;
end if;
......@@ -950,6 +957,75 @@ package body Bcheck is
end loop;
end Check_Consistent_Restrictions;
------------------------------------------------------------
-- Check_Consistent_Restriction_No_Default_Initialization --
------------------------------------------------------------
-- The Restriction (No_Default_Initialization) has special consistency
-- rules. The rule is that no unit compiled without this restriction
-- that violates the restriction can WITH a unit that is compiled with
-- the restriction.
procedure Check_Consistent_Restriction_No_Default_Initialization is
begin
-- Nothing to do if no one set this restriction
if not Cumulative_Restrictions.Set (No_Default_Initialization) then
return;
end if;
-- Nothing to do if no one violates the restriction
if not Cumulative_Restrictions.Violated (No_Default_Initialization) then
return;
end if;
-- Otherwise we go into a full scan to find possible problems
for U in Units.First .. Units.Last loop
declare
UTE : Unit_Record renames Units.Table (U);
ATE : ALIs_Record renames ALIs.Table (UTE.My_ALI);
begin
if ATE.Restrictions.Violated (No_Default_Initialization) then
for W in UTE.First_With .. UTE.Last_With loop
declare
AFN : constant File_Name_Type := Withs.Table (W).Afile;
begin
-- The file name may not be present for withs of certain
-- generic run-time files. The test can be safely left
-- out in such cases anyway.
if AFN /= No_File then
declare
WAI : constant ALI_Id :=
ALI_Id (Get_Name_Table_Info (AFN));
WTE : ALIs_Record renames ALIs.Table (WAI);
begin
if WTE.Restrictions.Set
(No_Default_Initialization)
then
Error_Msg_Unit_1 := UTE.Uname;
Consistency_Error_Msg
("unit $ compiled without restriction "
& "No_Default_Initialization");
Error_Msg_Unit_1 := Withs.Table (W).Uname;
Consistency_Error_Msg
("withs unit $, compiled with restriction "
& "No_Default_Initialization");
end if;
end;
end if;
end;
end loop;
end if;
end;
end loop;
end Check_Consistent_Restriction_No_Default_Initialization;
---------------------------------------------------
-- Check_Consistent_Zero_Cost_Exception_Handling --
---------------------------------------------------
......@@ -1056,15 +1132,7 @@ package body Bcheck is
-- If consistency errors are tolerated,
-- output the message as a warning.
declare
Warning_Msg : String (1 .. Msg'Length + 1);
begin
Warning_Msg (1) := '?';
Warning_Msg (2 .. Warning_Msg'Last) := Msg;
Error_Msg (Warning_Msg);
end;
Error_Msg ('?' & Msg);
-- Otherwise the consistency error is a true error
......
gcc/ada/fe.h
......@@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2007, Free Software Foundation, Inc. *
* Copyright (C) 1992-2008, 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- *
......@@ -46,11 +46,11 @@ extern char Fold_Lower[], Fold_Upper[];
/* debug: */
#define Debug_Flag_XX debug__debug_flag_xx
#define Debug_Flag_NN debug__debug_flag_nn
#define Debug_Flag_Dot_A debug__debug_flag_dot_a
extern Boolean Debug_Flag_XX;
extern Boolean Debug_Flag_NN;
extern Boolean Debug_Flag_Dot_A;
/* einfo: We will be setting Esize for types, Component_Bit_Offset for fields,
Alignment for types and objects, Component_Size for array types, and
......
gcc/ada/layout.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2008, 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- --
......@@ -2807,7 +2807,7 @@ package body Layout is
-- have an alignment of 1. But don't do anything for atomic records
-- since we may need higher alignment for indivisible access.
if Optimize_Alignment = 'S'
if Optimize_Alignment_Space (E)
and then Is_Record_Type (E)
and then Is_Packed (E)
and then not Is_Atomic (E)
......@@ -2848,7 +2848,7 @@ package body Layout is
-- alignment matches the size, for example, if the size is 17
-- bytes then we want an alignment of 1 for the type.
elsif Optimize_Alignment = 'S' then
elsif Optimize_Alignment_Space (E) then
if Siz mod (8 * System_Storage_Unit) = 0 then
Align := 8;
elsif Siz mod (4 * System_Storage_Unit) = 0 then
......@@ -2864,7 +2864,7 @@ package body Layout is
-- alignment of 4. Note that this matches the old VMS behavior
-- in versions of GNAT prior to 6.1.1.
elsif Optimize_Alignment = 'T'
elsif Optimize_Alignment_Time (E)
and then Siz > System_Storage_Unit
and then Siz <= 8 * System_Storage_Unit
then
......@@ -2902,7 +2902,7 @@ package body Layout is
-- since conceivably we may be able to do better.
if Align > System_Word_Size / System_Storage_Unit
and then Optimize_Alignment /= 'T'
and then not Optimize_Alignment_Time (E)
then
Align := System_Word_Size / System_Storage_Unit;
end if;
......@@ -2912,7 +2912,7 @@ package body Layout is
-- we have Optimize_Alignment set to Space. Note that that covers
-- the case of packed records, where we already set alignment to 1.
if Optimize_Alignment /= 'S' then
if not Optimize_Alignment_Space (E) then
declare
Comp : Entity_Id;
......
gcc/ada/lib-load.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -224,7 +224,8 @@ package body Lib.Load is
Source_Index => No_Source_File,
Unit_File_Name => Get_File_Name (Spec_Name, Subunit => False),
Unit_Name => Spec_Name,
Version => 0);
Version => 0,
OA_Setting => 'O');
Set_Comes_From_Source_Default (Save_CS);
Set_Error_Posted (Cunit_Entity);
......@@ -327,7 +328,8 @@ package body Lib.Load is
Source_Index => Main_Source_File,
Unit_File_Name => Fname,
Unit_Name => No_Unit_Name,
Version => Version);
Version => Version,
OA_Setting => 'O');
end if;
end Load_Main_Source;
......@@ -647,7 +649,8 @@ package body Lib.Load is
Source_Index => Src_Ind,
Unit_File_Name => Fname,
Unit_Name => Uname_Actual,
Version => Source_Checksum (Src_Ind));
Version => Source_Checksum (Src_Ind),
OA_Setting => 'O');
-- Parse the new unit
......
gcc/ada/lib-writ.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -87,7 +87,8 @@ package body Lib.Writ is
Munit_Index => 0,
Serial_Number => 0,
Version => 0,
Error_Location => No_Location);
Error_Location => No_Location,
OA_Setting => 'O');
end Add_Preprocessing_Dependency;
------------------------------
......@@ -141,7 +142,8 @@ package body Lib.Writ is
Munit_Index => 0,
Serial_Number => 0,
Version => 0,
Error_Location => No_Location);
Error_Location => No_Location,
OA_Setting => 'O');
-- Parse system.ads so that the checksum is set right
-- Style checks are not applied.
......@@ -236,14 +238,15 @@ package body Lib.Writ is
-- Process with clause
-- Ada 2005 (AI-50217): limited with_clauses do not create
-- dependencies
-- dependencies, but must be recorded as components of the
-- partition, in case there is no regular with_clause for
-- the unit anywhere else.
if Nkind (Item) = N_With_Clause
and then not (Limited_Present (Item))
then
if Nkind (Item) = N_With_Clause then
Unum := Get_Cunit_Unit_Number (Library_Unit (Item));
With_Flags (Unum) := True;
if not Limited_Present (Item) then
if Elaborate_Present (Item) then
Elab_Flags (Unum) := True;
end if;
......@@ -259,6 +262,10 @@ package body Lib.Writ is
if Elaborate_Desirable (Item) then
Elab_Des_Flags (Unum) := True;
end if;
else
Set_From_With_Type (Cunit_Entity (Unum));
end if;
end if;
Next (Item);
......@@ -441,6 +448,9 @@ package body Lib.Writ is
Write_Info_Str (" NE");
end if;
Write_Info_Str (" O");
Write_Info_Char (OA_Setting (Unit_Num));
if Is_Preelaborated (Uent) then
Write_Info_Str (" PR");
end if;
......@@ -512,7 +522,7 @@ package body Lib.Writ is
end case;
end if;
if Initialize_Scalars then
if Initialize_Scalars or else Invalid_Value_Used then
Write_Info_Str (" IS");
end if;
......@@ -696,7 +706,14 @@ package body Lib.Writ is
Uname := Units.Table (Unum).Unit_Name;
Fname := Units.Table (Unum).Unit_File_Name;
if Ekind (Cunit_Entity (Unum)) = E_Package
and then From_With_Type (Cunit_Entity (Unum))
then
Write_Info_Initiate ('Y');
else
Write_Info_Initiate ('W');
end if;
Write_Info_Char (' ');
Write_Info_Name (Uname);
......@@ -750,6 +767,11 @@ package body Lib.Writ is
Write_With_File_Names (Fname, Munit_Index (Unum));
end if;
if Ekind (Cunit_Entity (Unum)) = E_Package
and then From_With_Type (Cunit_Entity (Unum))
then
null;
else
if Elab_Flags (Unum) then
Write_Info_Str (" E");
end if;
......@@ -766,6 +788,7 @@ package body Lib.Writ is
Write_Info_Str (" AD");
end if;
end if;
end if;
Write_Info_EOL;
end loop;
......@@ -971,11 +994,6 @@ package body Lib.Writ is
Write_Info_Str (" NS");
end if;
if Optimize_Alignment /= 'O' then
Write_Info_Str (" O");
Write_Info_Char (Optimize_Alignment);
end if;
if Sec_Stack_Used then
Write_Info_Str (" SS");
end if;
......
gcc/ada/lib-writ.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -167,7 +167,7 @@ package Lib.Writ is
-- P <<parameters>>
-- Indicates various information that applies to the compilation
-- of the corresponding source unit. Parameters is a sequence of
-- of the corresponding source file. Parameters is a sequence of
-- zero or more two letter codes that indicate configuration
-- pragmas and other parameters that apply:
--
......@@ -211,10 +211,6 @@ package Lib.Writ is
-- NS Normalize_Scalars pragma in effect for all units in
-- this file.
--
-- OS Optimize_Alignment (Space) active for all units in this file
--
-- OT Optimize_Alignment (Time) active for all units in this file
--
-- Qx A valid Queueing_Policy pragma applies to all the units
-- in this file, where x is the first character (upper case)
-- of the policy name (e.g. 'P' for Priority_Queueing).
......@@ -462,7 +458,8 @@ package Lib.Writ is
-- case usage is detected, or the compiler cannot determine
-- the style, then no I parameter will appear.
--
-- IS Initialize_Scalars pragma applies to this unit
-- IS Initialize_Scalars pragma applies to this unit, or else there
-- is at least one use of the Invalid_Value attribute.
--
-- KM Unit source uses a style with keywords in mixed case
-- KU (KM) or all upper case (KU). If the standard lower-case
......@@ -475,6 +472,23 @@ package Lib.Writ is
-- elaboration code is required. Set if N_Compilation_Unit
-- node has flag Has_No_Elaboration_Code set.
--
-- OL The units in this file are commpiled with a local pragma
-- Optimize_Alignment, so no consistency requirement applies
-- to these units. All internal units have this status since
-- they have an automatic default of Optimize_Alignment (Off).
--
-- OO Optimize_Alignment (Off) is the default setting for all
-- units in this file. All files in the partition that specify
-- a default must specify the same default.
--
-- OS Optimize_Alignment (Space) is the default settinng for all
-- units in this file. All files in the partition that specify
-- a default must specify the same default.
--
-- OT Optimize_Alignment (Time) is the default settinng for all
-- units in this file. All files in the partition that specify
-- a default must specify the same default.
--
-- PK Unit is package, rather than a subprogram
--
-- PU Unit has pragma Pure
......
gcc/ada/lib.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -145,6 +145,11 @@ package body Lib is
return Units.Table (U).Munit_Index;
end Munit_Index;
function OA_Setting (U : Unit_Number_Type) return Character is
begin
return Units.Table (U).OA_Setting;
end OA_Setting;
function Source_Index (U : Unit_Number_Type) return Source_File_Index is
begin
return Units.Table (U).Source_Index;
......@@ -223,6 +228,11 @@ package body Lib is
Units.Table (U).Main_Priority := P;
end Set_Main_Priority;
procedure Set_OA_Setting (U : Unit_Number_Type; C : Character) is
begin
Units.Table (U).OA_Setting := C;
end Set_OA_Setting;
procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type) is
begin
Units.Table (U).Unit_Name := N;
......
gcc/ada/lib.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -344,6 +344,10 @@ package Lib is
-- that the default priority is to be used (and is also used for
-- entries that do not correspond to possible main programs).
-- OA_Setting
-- This is a character field containing L if Optimize_Alignment mode
-- was set locally, and O/T/S for Off/Time/Space default if not.
-- Serial_Number
-- This field holds a serial number used by New_Internal_Name to
-- generate unique temporary numbers on a unit by unit basis. The
......@@ -385,6 +389,7 @@ package Lib is
function Loading (U : Unit_Number_Type) return Boolean;
function Main_Priority (U : Unit_Number_Type) return Int;
function Munit_Index (U : Unit_Number_Type) return Nat;
function OA_Setting (U : Unit_Number_Type) return Character;
function Source_Index (U : Unit_Number_Type) return Source_File_Index;
function Unit_File_Name (U : Unit_Number_Type) return File_Name_Type;
function Unit_Name (U : Unit_Number_Type) return Unit_Name_Type;
......@@ -401,6 +406,7 @@ package Lib is
procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Main_Priority (U : Unit_Number_Type; P : Int);
procedure Set_OA_Setting (U : Unit_Number_Type; C : Character);
procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type);
-- Set value of named field for given units table entry. Note that we
-- do not have an entry for each possible field, since some of the fields
......@@ -630,6 +636,7 @@ private
pragma Inline (Loading);
pragma Inline (Main_Priority);
pragma Inline (Munit_Index);
pragma Inline (OA_Setting);
pragma Inline (Set_Cunit);
pragma Inline (Set_Cunit_Entity);
pragma Inline (Set_Fatal_Error);
......@@ -637,6 +644,7 @@ private
pragma Inline (Set_Has_RACW);
pragma Inline (Set_Loading);
pragma Inline (Set_Main_Priority);
pragma Inline (Set_OA_Setting);
pragma Inline (Set_Unit_Name);
pragma Inline (Source_Index);
pragma Inline (Unit_File_Name);
......@@ -662,6 +670,7 @@ private
Is_Compiler_Unit : Boolean;
Dynamic_Elab : Boolean;
Loading : Boolean;
OA_Setting : Character;
end record;
-- The following representation clause ensures that the above record
......@@ -686,11 +695,12 @@ private
Generate_Code at 53 range 0 .. 7;
Has_RACW at 54 range 0 .. 7;
Dynamic_Elab at 55 range 0 .. 7;
Is_Compiler_Unit at 56 range 0 .. 31;
Loading at 60 range 0 .. 31;
Is_Compiler_Unit at 56 range 0 .. 7;
OA_Setting at 57 range 0 .. 7;
Loading at 58 range 0 .. 15;
end record;
for Unit_Record'Size use 64 * 8;
for Unit_Record'Size use 60 * 8;
-- This ensures that we did not leave out any fields
package Units is new Table.Table (
......
gcc/ada/opt.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -49,6 +49,7 @@ package body Opt is
Ada_Version_Config := Ada_Version;
Ada_Version_Explicit_Config := Ada_Version_Explicit;
Assertions_Enabled_Config := Assertions_Enabled;
Check_Policy_List_Config := Check_Policy_List;
Debug_Pragmas_Enabled_Config := Debug_Pragmas_Enabled;
Dynamic_Elaboration_Checks_Config := Dynamic_Elaboration_Checks;
Exception_Locations_Suppressed_Config := Exception_Locations_Suppressed;
......@@ -60,6 +61,12 @@ package body Opt is
Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
Polling_Required_Config := Polling_Required;
Use_VADS_Size_Config := Use_VADS_Size;
-- Reset the indication that Optimize_Alignment was set locally, since
-- if we had a pragma in the config file, it would set this flag True,
-- but that's not a local setting.
Optimize_Alignment_Local := False;
end Register_Opt_Config_Switches;
---------------------------------
......@@ -71,6 +78,7 @@ package body Opt is
Ada_Version := Save.Ada_Version;
Ada_Version_Explicit := Save.Ada_Version_Explicit;
Assertions_Enabled := Save.Assertions_Enabled;
Check_Policy_List := Save.Check_Policy_List;
Debug_Pragmas_Enabled := Save.Debug_Pragmas_Enabled;
Dynamic_Elaboration_Checks := Save.Dynamic_Elaboration_Checks;
Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed;
......@@ -79,6 +87,7 @@ package body Opt is
External_Name_Imp_Casing := Save.External_Name_Imp_Casing;
Fast_Math := Save.Fast_Math;
Optimize_Alignment := Save.Optimize_Alignment;
Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
Polling_Required := Save.Polling_Required;
Use_VADS_Size := Save.Use_VADS_Size;
......@@ -93,6 +102,7 @@ package body Opt is
Save.Ada_Version := Ada_Version;
Save.Ada_Version_Explicit := Ada_Version_Explicit;
Save.Assertions_Enabled := Assertions_Enabled;
Save.Check_Policy_List := Check_Policy_List;
Save.Debug_Pragmas_Enabled := Debug_Pragmas_Enabled;
Save.Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks;
Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed;
......@@ -101,6 +111,7 @@ package body Opt is
Save.External_Name_Imp_Casing := External_Name_Imp_Casing;
Save.Fast_Math := Fast_Math;
Save.Optimize_Alignment := Optimize_Alignment;
Save.Optimize_Alignment_Local := Optimize_Alignment_Local;
Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
Save.Polling_Required := Polling_Required;
Save.Use_VADS_Size := Use_VADS_Size;
......@@ -131,6 +142,7 @@ package body Opt is
Optimize_Alignment := 'O';
Persistent_BSS_Mode := False;
Use_VADS_Size := False;
Optimize_Alignment_Local := True;
-- For an internal unit, assertions/debug pragmas are off unless this
-- is the main unit and they were explicitly enabled.
......@@ -138,9 +150,11 @@ package body Opt is
if Main_Unit then
Assertions_Enabled := Assertions_Enabled_Config;
Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
Check_Policy_List := Check_Policy_List_Config;
else
Assertions_Enabled := False;
Debug_Pragmas_Enabled := False;
Check_Policy_List := Empty;
end if;
-- Case of non-internal unit
......@@ -149,6 +163,7 @@ package body Opt is
Ada_Version := Ada_Version_Config;
Ada_Version_Explicit := Ada_Version_Explicit_Config;
Assertions_Enabled := Assertions_Enabled_Config;
Check_Policy_List := Check_Policy_List_Config;
Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config;
Extensions_Allowed := Extensions_Allowed_Config;
......@@ -156,6 +171,7 @@ package body Opt is
External_Name_Imp_Casing := External_Name_Imp_Casing_Config;
Fast_Math := Fast_Math_Config;
Optimize_Alignment := Optimize_Alignment_Config;
Optimize_Alignment_Local := False;
Persistent_BSS_Mode := Persistent_BSS_Mode_Config;
Use_VADS_Size := Use_VADS_Size_Config;
end if;
......@@ -192,6 +208,7 @@ package body Opt is
Tree_Read_Int (Assertions_Enabled_Config_Val);
Tree_Read_Bool (All_Errors_Mode);
Tree_Read_Bool (Assertions_Enabled);
Tree_Read_Int (Int (Check_Policy_List));
Tree_Read_Bool (Debug_Pragmas_Enabled);
Tree_Read_Bool (Enable_Overflow_Checks);
Tree_Read_Bool (Full_List);
......@@ -256,6 +273,7 @@ package body Opt is
Tree_Write_Int (Boolean'Pos (Assertions_Enabled_Config));
Tree_Write_Bool (All_Errors_Mode);
Tree_Write_Bool (Assertions_Enabled);
Tree_Write_Int (Int (Check_Policy_List));
Tree_Write_Bool (Debug_Pragmas_Enabled);
Tree_Write_Bool (Enable_Overflow_Checks);
Tree_Write_Bool (Full_List);
......
gcc/ada/opt.ads
......@@ -214,6 +214,12 @@ package Opt is
-- GNATBIND
-- Set to True to do checks only, no output of binder file
Check_Policy_List : Node_Id := Empty;
-- GNAT
-- This points to the list of N_Pragma nodes for Check_Policy pragmas
-- that are linked through the Next_Pragma fields, with the list being
-- terminated by Empty. The order is most recently processed first.
Check_Readonly_Files : Boolean := False;
-- GNATMAKE
-- Set to True to check readonly files during the make process
......@@ -400,7 +406,7 @@ package Opt is
-- message routines generates one line of output as a separate message.
-- If it is set to a non-zero value, then continuation lines are folded
-- to make a single long message, and then this message is split up into
-- multiple lines not exceeding the specified length. Set by -gnatLnnn.
-- multiple lines not exceeding the specified length. Set by -gnatj=nn.
Exception_Locations_Suppressed : Boolean := False;
-- GNAT
......@@ -620,6 +626,10 @@ package Opt is
-- generate code even in case of unsupported construct, so that the byte
-- code can be used by static analysis tools.
Invalid_Value_Used : Boolean := False;
-- GNAT
-- Set True if a valid Invalid_Value attribute is encountered
Follow_Links_For_Files : Boolean := False;
-- PROJECT MANAGER
-- Set to True (-eL) to process the project files in trusted mode
......@@ -862,6 +872,14 @@ package Opt is
-- Setting of Optimize_Alignment, set to T/S/O for time/space/off. Can
-- be modified by use of pragma Optimize_Alignment.
Optimize_Alignment_Local : Boolean := False;
-- Set True if Optimize_Alignment mode is set by a local configuration
-- pragma that overrides the gnat.adc (or other configuration file) default
-- so that the unit is not dependent on the default setting. Also always
-- set True for internal units, since these always have a default setting
-- of Optimize_Alignment (Off) that is enforced (essentially equivalent to
-- them all having such an explicit pragma in each unit).
Original_Operating_Mode : Operating_Mode_Type := Generate_Code;
-- GNAT
-- Indicates the original operating mode of the compiler as set by
......@@ -870,7 +888,7 @@ package Opt is
Optimization_Level : Int;
pragma Import (C, Optimization_Level, "optimize");
-- This constant reflects the optimization level (0,1,2 for -O0,-O1,-O2)
-- Constant reflecting the optimization level (0,1,2,3 for -O0,-O1,-O2,-O3)
Output_File_Name_Present : Boolean := False;
-- GNATBIND, GNAT, GNATMAKE, GPRMAKE
......@@ -1133,7 +1151,7 @@ package Opt is
Upper_Half_Encoding : Boolean := False;
-- GNAT, GNATBIND
-- Normally set False, indicating that upper half ASCII characters are
-- Normally set False, indicating that upper half ISO 8859-1 characters are
-- used in the normal way to represent themselves. If the wide character
-- encoding method uses the upper bit for this encoding, then this flag is
-- set True, and upper half characters in the source indicate the start of
......@@ -1190,6 +1208,12 @@ package Opt is
-- including warnings on Ada 2005 obsolescent features used in Ada 2005
-- mode. Set False by -gnatwY.
Warn_On_Parameter_Order : Boolean := False;
-- GNAT
-- Set to True to generate warnings for cases where the argument list for
-- a call is a sequence of identifiers that match the formal identifiers,
-- but are in the wrong order.
Warn_On_Assertion_Failure : Boolean := True;
-- GNAT
-- Set to True to activate warnings on assertions that can be determined
......@@ -1374,6 +1398,13 @@ package Opt is
-- mode, as possibly set by the command line switch -gnata, and possibly
-- modified by the use of the configuration pragma Assertion_Policy.
Check_Policy_List_Config : Node_Id;
-- GNAT
-- This points to the list of N_Pragma nodes for Check_Policy pragmas
-- that are linked through the Next_Pragma fields, with the list being
-- terminated by Empty. The order is most recently processed first. This
-- list includes only those pragmas in configuration pragma files.
Debug_Pragmas_Enabled_Config : Boolean;
-- GNAT
-- This is the value of the configuration switch for debug pragmas enabled
......@@ -1485,9 +1516,10 @@ package Opt is
-- call to Save_Opt_Switches.
procedure Register_Opt_Config_Switches;
-- This procedure is called after processing the gnat.adc file to record
-- the values of the Config switches, as possibly modified by the use of
-- command line switches and configuration pragmas.
-- This procedure is called after processing the gnat.adc file and other
-- configuration pragma files to record the values of the Config switches,
-- as possibly modified by the use of command line switches and pragmas
-- appearing in these files.
------------------------
-- Other Global Flags --
......@@ -1564,6 +1596,7 @@ private
Ada_Version : Ada_Version_Type;
Ada_Version_Explicit : Ada_Version_Type;
Assertions_Enabled : Boolean;
Check_Policy_List : Node_Id;
Debug_Pragmas_Enabled : Boolean;
Dynamic_Elaboration_Checks : Boolean;
Exception_Locations_Suppressed : Boolean;
......@@ -1572,6 +1605,7 @@ private
External_Name_Imp_Casing : External_Casing_Type;
Fast_Math : Boolean;
Optimize_Alignment : Character;
Optimize_Alignment_Local : Boolean;
Persistent_BSS_Mode : Boolean;
Polling_Required : Boolean;
Use_VADS_Size : Boolean;
......
gcc/ada/sem_ch3.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -71,14 +71,6 @@ package Sem_Ch3 is
procedure Analyze_Interface_Declaration (T : Entity_Id; Def : Node_Id);
-- Analyze an interface declaration or a formal interface declaration
procedure Analyze_Per_Use_Expression (N : Node_Id; T : Entity_Id);
-- Default and per object expressions do not freeze their components,
-- and must be analyzed and resolved accordingly. The analysis is
-- done by calling the Pre_Analyze_And_Resolve routine and setting
-- the global In_Default_Expression flag. See the documentation section
-- entitled "Handling of Default and Per-Object Expressions" in sem.ads
-- for details. N is the expression to be analyzed, T is the expected type.
procedure Array_Type_Declaration (T : in out Entity_Id; Def : Node_Id);
-- Process an array type declaration. If the array is constrained, we
-- create an implicit parent array type, with the same index types and
......@@ -204,6 +196,14 @@ package Sem_Ch3 is
-- Always False in Ada 95 mode. Equivalent to OK_For_Limited_Init_In_05 in
-- Ada 2005 mode.
procedure Preanalyze_Spec_Expression (N : Node_Id; T : Entity_Id);
-- Default and per object expressions do not freeze their components, and
-- must be analyzed and resolved accordingly. The analysis is done by
-- calling the Preanalyze_And_Resolve routine and setting the global
-- In_Default_Expression flag. See the documentation section entitled
-- "Handling of Default and Per-Object Expressions" in sem.ads for full
-- details. N is the expression to be analyzed, T is the expected type.
procedure Process_Full_View (N : Node_Id; Full_T, Priv_T : Entity_Id);
-- Process some semantic actions when the full view of a private type is
-- encountered and analyzed. The first action is to create the full views
......
gcc/ada/sem_util.ads
......@@ -139,6 +139,13 @@ package Sem_Util is
-- N is one of the statement forms that is a potentially blocking
-- operation. If it appears within a protected action, emit warning.
procedure Check_Unprotected_Access
(Context : Node_Id;
Expr : Node_Id);
-- Check whether the expression is a pointer to a protected component,
-- and the context is external to the protected operation, to warn against
-- a possible unlocked access to data.
procedure Check_VMS (Construct : Node_Id);
-- Check that this the target is OpenVMS, and if so, return with
-- no effect, otherwise post an error noting this can only be used
......@@ -196,6 +203,12 @@ package Sem_Util is
-- Sets the Has_Delayed_Freeze flag of New if the Delayed_Freeze flag
-- of Old is set and Old has no yet been Frozen (i.e. Is_Frozen is false);
function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id;
-- Utility to create a parameter profile for a new subprogram spec,
-- when the subprogram has a body that acts as spec. This is done for
-- some cases of inlining, and for private protected ops. Also used
-- to create bodies for stubbed subprograms.
function Current_Entity (N : Node_Id) return Entity_Id;
-- Find the currently visible definition for a given identifier, that is to
-- say the first entry in the visibility chain for the Chars of N.
......@@ -474,11 +487,13 @@ package Sem_Util is
-- declaration.
function Has_Access_Values (T : Entity_Id) return Boolean;
-- Returns true if type or subtype T is an access type, or has a
-- component (at any recursive level) that is an access type. This
-- is a conservative predicate, if it is not known whether or not
-- T contains access values (happens for generic formals in some
-- cases), then False is returned.
-- Returns true if type or subtype T is an access type, or has a component
-- (at any recursive level) that is an access type. This is a conservative
-- predicate, if it is not known whether or not T contains access values
-- (happens for generic formals in some cases), then False is returned.
-- Note that tagged types return False. Even though the tag is implemented
-- as an access type internally, this function tests only for access types
-- known to the programmer. See also Has_Tagged_Component.
function Has_Abstract_Interfaces
(T : Entity_Id;
......@@ -527,6 +542,10 @@ package Sem_Util is
function Has_Null_Exclusion (N : Node_Id) return Boolean;
-- Determine whether node N has a null exclusion
function Has_Overriding_Initialize (T : Entity_Id) return Boolean;
-- Predicate to determine whether a controlled type has a user-defined
-- initialize procedure, which makes the type not preelaborable.
function Has_Preelaborable_Initialization (E : Entity_Id) return Boolean;
-- Return True iff type E has preelaborable initialiation as defined in
-- Ada 2005 (see AI-161 for details of the definition of this attribute).
......@@ -544,8 +563,11 @@ package Sem_Util is
-- if there is no underlying type).
function Has_Tagged_Component (Typ : Entity_Id) return Boolean;
-- Typ must be a composite type (array or record). This function is used
-- to check if '=' has to be expanded into a bunch component comparaisons.
-- Returns True if Typ is a composite type (array or record) which is
-- either itself a tagged type, or has a component (recursively) which is
-- a tagged type. Returns False for non-composite type, or if no tagged
-- component is present. to check if '=' has to be expanded into a bunch
-- component comparisons.
function In_Instance return Boolean;
-- Returns True if the current scope is within a generic instance
......@@ -801,10 +823,10 @@ package Sem_Util is
-- set if you want to clear only the Last_Assignment field (see above).
procedure Kill_Size_Check_Code (E : Entity_Id);
-- Called when an address clause or pragma Import is applied to an
-- entity. If the entity is a variable or a constant, and size check
-- code is present, this size check code is killed, since the object
-- will not be allocated by the program.
-- Called when an address clause or pragma Import is applied to an entity.
-- If the entity is a variable or a constant, and size check code is
-- present, this size check code is killed, since the object will not
-- be allocated by the program.
function Known_To_Be_Assigned (N : Node_Id) return Boolean;
-- The node N is an entity reference. This function determines whether the
......@@ -900,13 +922,17 @@ package Sem_Util is
-- in Success indicates sucess of reordering. For more details, see body.
-- Errors are reported only if Report is set to True.
procedure Note_Possible_Modification (N : Node_Id);
procedure Note_Possible_Modification (N : Node_Id; Sure : Boolean);
-- This routine is called if the sub-expression N maybe the target of
-- an assignment (e.g. it is the left side of an assignment, used as
-- an out parameters, or used as prefixes of access attributes). It
-- sets May_Be_Modified in the associated entity if there is one,
-- taking into account the rule that in the case of renamed objects,
-- it is the flag in the renamed object that must be set.
--
-- The parameter Sure is set True if the modification is sure to occur
-- (e.g. target of assignment, or out parameter), and to False if the
-- modification is only potential (e.g. address of entity taken).
function Object_Access_Level (Obj : Node_Id) return Uint;
-- Return the accessibility level of the view of the object Obj.
......@@ -1057,6 +1083,10 @@ package Sem_Util is
-- parameters are already members of a list, and do not need to be
-- chained separately. See also First_Actual and Next_Actual.
procedure Set_Optimize_Alignment_Flags (E : Entity_Id);
pragma Inline (Set_Optimize_Alignment_Flags);
-- Sets Optimize_Aliignment_Space/Time flags in E from current settings
procedure Set_Public_Status (Id : Entity_Id);
-- If an entity (visible or otherwise) is defined in a library
-- package, or a package that is itself public, then this subprogram
......
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