Skip to content

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

ali.ads, ali.adb (Optimize_Alignment_Setting): New field in ALI record 

2008-03-26  Robert Dewar  <dewar@adacore.com>

	* ali.ads, ali.adb (Optimize_Alignment_Setting): New field in ALI record

	* bcheck.adb (Check_Consistent_Optimize_Alignment): New procedure

	* debug.adb: Add debug flags d.r and d.v
	Add debug flag .T (Optimize_Alignment (Time))
	Add debug flag .S (Optimize_Alignment (Space))

	* freeze.adb (Freeze_Record_Type): Set OK_To_Reorder_Components
	depending on setting of relevant debug flags.
	Replace use of Warnings_Off by Has_Warnings_Off
	(Freeze_Entity): In circuit for warning on suspicious convention
	actuals, do not give warning if subprogram has same entity as formal
	type, or if subprogram does not come from source.
	(Freeze_Entity): Don't reset Is_Packed for fully rep speced record
	if Optimize_Alignment set to Space.

	* frontend.adb: Add call to Sem_Warn.Initialize
	Add call to Sem_Warn.Output_Unused_Warnings_Off_Warnings
	Reset Optimize_Alignment mode from debug switches .S and .T

	* layout.adb (Layout_Composite_Object): Rewritten for
	Optimize_Aligment pragma.

	* lib-writ.ads, lib-writ.adb: New Ox parameter for Optimize_Alignment
	mode.

	* opt.ads, opt.adb: (Optimize_Alignment): New global switch

	* par-prag.adb (N_Pragma): Chars field removed, use Chars
	(Pragma_Identifier (..  instead, adjustments throughout to accomodate
	this change. Add entry for pragma Optimize_Alignment

	* sem_prag.adb (N_Pragma): Chars field removed, use Chars
	(Pragma_Identifier (..
	instead, adjustments throughout to accomodate this change.
	(Process_Compile_Time_Warning_Or_Error): Use !! for generated msg
	(Favor_Top_Level): Use new function Is_Access_Subprogram_Type
	Add implementation of pragma Optimize_Alignment

From-SVN: r133549
parent 9fbecd1a
Showing with 277 additions and 129 deletions
gcc/ada/ali.adb
......@@ -818,6 +818,7 @@ 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,
......@@ -1040,6 +1041,11 @@ 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
......
gcc/ada/ali.ads
......@@ -122,82 +122,83 @@ package ALI is
-- Id of last Sdep table entry for this file
Main_Program : Main_Program_Type;
-- Indicator of whether first unit can be used as main program.
-- Not set if 'M' appears in Ignore_Lines.
-- Indicator of whether first unit can be used as main program. Not set
-- if 'M' appears in Ignore_Lines.
Main_Priority : Int;
-- Indicates priority value if Main_Program field indicates that
-- this can be a main program. A value of -1 (No_Main_Priority)
-- indicates that no parameter was found, or no M line was present.
-- Not set if 'M' appears in Ignore_Lines.
-- Indicates priority value if Main_Program field indicates that this
-- can be a main program. A value of -1 (No_Main_Priority) indicates
-- that no parameter was found, or no M line was present. Not set if
-- 'M' appears in Ignore_Lines.
Time_Slice_Value : Int;
-- Indicates value of time slice parameter from T=xxx on main program
-- line. A value of -1 indicates that no T=xxx parameter was found,
-- or no M line was present.
-- Not set if 'M' appears in Ignore_Lines.
-- line. A value of -1 indicates that no T=xxx parameter was found, or
-- no M line was present. Not set if 'M' appears in Ignore_Lines.
WC_Encoding : Character;
-- Wide character encoding if main procedure. Otherwise not relevant.
-- Not set if 'M' appears in Ignore_Lines.
Locking_Policy : Character;
-- Indicates locking policy for units in this file. Space means
-- tasking was not used, or that no Locking_Policy pragma was
-- present or that this is a language defined unit. Otherwise set
-- to first character (upper case) of policy name.
-- Not set if 'P' appears in Ignore_Lines.
-- Indicates locking policy for units in this file. Space means tasking
-- was not used, or that no Locking_Policy pragma was present or that
-- this is a language defined unit. Otherwise set to first character
-- (upper case) of policy name. Not set if 'P' appears in Ignore_Lines.
Queuing_Policy : Character;
-- Indicates queuing policy for units in this file. Space means
-- tasking was not used, or that no Queuing_Policy pragma was
-- present or that this is a language defined unit. Otherwise set
-- to first character (upper case) of policy name.
-- Not set if 'P' appears in Ignore_Lines.
-- Indicates queuing policy for units in this file. Space means tasking
-- was not used, or that no Queuing_Policy pragma was present or that
-- this is a language defined unit. Otherwise set to first character
-- (upper case) of policy name. Not set if 'P' appears in Ignore_Lines.
Task_Dispatching_Policy : Character;
-- Indicates task dispatching policy for units in this file. Space
-- means tasking was not used, or that no Task_Dispatching_Policy
-- pragma was present or that this is a language defined unit.
-- Otherwise set to first character (upper case) of policy name.
-- Not set if 'P' appears in Ignore_Lines.
-- Indicates task dispatching policy for units in this file. Space means
-- tasking was not used, or that no Task_Dispatching_Policy pragma was
-- present or that this is a language defined unit. Otherwise set to
-- first character (upper case) of policy name. Not set if 'P' appears
-- in Ignore_Lines.
Compile_Errors : Boolean;
-- Set to True if compile errors for unit. Note that No_Object
-- will always be set as well in this case.
-- Not set if 'P' appears in Ignore_Lines.
-- Set to True if compile errors for unit. Note that No_Object will
-- always be set as well in this case. Not set if 'P' appears in
-- Ignore_Lines.
Float_Format : Character;
-- Set to float format (set to I if no float-format given).
-- Not set if 'P' appears in Ignore_Lines.
-- Set to float format (set to I if no float-format given). Not set if
-- 'P' appears in Ignore_Lines.
No_Object : Boolean;
-- Set to True if no object file generated.
-- Not set if 'P' appears in Ignore_Lines.
-- Set to True if no object file generated. Not set if 'P' appears in
-- Ignore_Lines.
Normalize_Scalars : Boolean;
-- Set to True if file was compiled with Normalize_Scalars.
-- Not set if 'P' appears in Ignore_Lines.
-- 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.
-- Set to True if unit exception table pointer generated. Not set if 'P'
-- appears in Ignore_Lines.
Zero_Cost_Exceptions : Boolean;
-- Set to True if file was compiled with zero cost exceptions.
-- Not set if 'P' appears in Ignore_Lines.
-- Set to True if file was compiled with zero cost exceptions. Not set
-- if 'P' appears in Ignore_Lines.
Restrictions : Restrictions_Info;
-- Restrictions information reconstructed from R lines
First_Interrupt_State : Interrupt_State_Id;
Last_Interrupt_State : Interrupt_State_Id'Base;
-- These point to the first and last entries in the interrupt
-- state table for this unit. If there are no entries, then
-- Last_Interrupt_State = First_Interrupt_State - 1 (that's
-- why the 'Base reference is there, it can be one less than
-- the lower bound of the subtype).
-- Not set if 'I' appears in Ignore_Lines
-- These point to the first and last entries in the interrupt state
-- table for this unit. If no entries, then Last_Interrupt_State =
-- First_Interrupt_State - 1 (that's why the 'Base reference is there,
-- it can be one less than the lower bound of the subtype). Not set if
-- 'I' appears in Ignore_Lines
First_Specific_Dispatching : Priority_Specific_Dispatching_Id;
Last_Specific_Dispatching : Priority_Specific_Dispatching_Id'Base;
......
gcc/ada/bcheck.adb
......@@ -51,6 +51,7 @@ package body Bcheck is
procedure Check_Consistent_Interrupt_States;
procedure Check_Consistent_Locking_Policy;
procedure Check_Consistent_Normalize_Scalars;
procedure Check_Consistent_Optimize_Alignment;
procedure Check_Consistent_Queuing_Policy;
procedure Check_Consistent_Restrictions;
procedure Check_Consistent_Zero_Cost_Exception_Handling;
......@@ -86,8 +87,8 @@ package body Bcheck is
end if;
Check_Consistent_Normalize_Scalars;
Check_Consistent_Optimize_Alignment;
Check_Consistent_Dynamic_Elaboration_Checking;
Check_Consistent_Restrictions;
Check_Consistent_Interrupt_States;
Check_Consistent_Dispatching_Policy;
......@@ -657,12 +658,11 @@ package body Bcheck is
-- then all other units in the partition must also be compiled with
-- Normalized_Scalars in effect.
-- There is some issue as to whether this consistency check is
-- desirable, it is certainly required at the moment by the RM.
-- We should keep a watch on the ARG and HRG deliberations here.
-- GNAT no longer depends on this consistency (it used to do so,
-- but that has been corrected in the latest version, since the
-- Initialize_Scalars pragma does not require consistency.
-- There is some issue as to whether this consistency check is desirable,
-- it is certainly required at the moment by the RM. We should keep a watch
-- on the ARG and HRG deliberations here. GNAT no longer depends on this
-- consistency (it used to do so, but that is no longer the case, since
-- pragma Initialize_Scalars pragma does not require consistency.)
procedure Check_Consistent_Normalize_Scalars is
begin
......@@ -696,6 +696,44 @@ package body Bcheck is
end if;
end Check_Consistent_Normalize_Scalars;
-----------------------------------------
-- 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).
procedure Check_Consistent_Optimize_Alignment is
OA_Setting : Character := ' ';
-- Reset when we find a non-internal unit
OA_Unit : ALI_Id;
-- Id of unit from which OA_Setting was set
begin
for A in ALIs.First .. ALIs.Last loop
if not Is_Internal_File_Name (ALIs.Table (A).Afile) then
if OA_Setting = ' ' then
OA_Setting := ALIs.Table (A).Optimize_Alignment_Setting;
OA_Unit := A;
elsif OA_Setting = ALIs.Table (A).Optimize_Alignment_Setting then
null;
else
Error_Msg_File_1 := ALIs.Table (OA_Unit).Sfile;
Error_Msg_File_2 := ALIs.Table (A).Sfile;
Consistency_Error_Msg
("{ and { compiled with different "
& "Optimize_Alignment settings");
return;
end if;
end if;
end loop;
end Check_Consistent_Optimize_Alignment;
-------------------------------------
-- Check_Consistent_Queuing_Policy --
-------------------------------------
......
gcc/ada/debug.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- --
......@@ -93,7 +93,7 @@ package body Debug is
-- dY Enable configurable run-time mode
-- dZ Generate listing showing the contents of the dispatch tables
-- d.a Disable OpenVMS alignment optimization on types
-- d.a
-- d.b
-- d.c
-- d.d
......@@ -110,11 +110,11 @@ package body Debug is
-- d.o
-- d.p
-- d.q
-- d.r
-- d.r Enable OK_To_Reorder_Components in non-variant records
-- d.s Disable expansion of slice move, use memmove
-- d.t Disable static allocation of library level dispatch tables
-- d.u
-- d.v
-- d.v Enable OK_To_Reorder_Components in variant records
-- d.w Do not check for infinite while loops
-- d.x No exception handlers
-- d.y
......@@ -138,8 +138,8 @@ package body Debug is
-- d.P
-- d.Q
-- d.R
-- d.S
-- d.T
-- d.S Force Optimize_Alignment (Space)
-- d.T Force Optimize_Alignment (Time)
-- d.U
-- d.V
-- d.W
......@@ -474,33 +474,32 @@ package body Debug is
-- line has an internally generated number used for references between
-- tagged types and primitives. For each primitive the output has the
-- following fields:
--
-- - Letter 'P' or letter 's': The former indicates that this
-- primitive will be located in a primary dispatch table. The
-- latter indicates that it will be located in a secondary
-- dispatch table.
--
-- - Name of the primitive. In case of predefined Ada primitives
-- the text "(predefined)" is added before the name, and these
-- acronyms are used: SR (Stream_Read), SW (Stream_Write), SI
-- (Stream_Input), SO (Stream_Output), DA (Deep_Adjust), DF
-- (Deep_Finalize). In addition Oeq identifies the equality
-- operator, and "_assign" the assignment.
--
-- - If the primitive covers interface types, two extra fields
-- referencing other primitives are generated: "Alias" references
-- the primitive of the tagged type that covers an interface
-- primitive, and "AI_Alias" references the covered interface
-- primitive.
--
-- - The expression "at #xx" indicates the slot of the dispatch
-- table occupied by such primitive in its corresponding primary
-- or secondary dispatch table.
--
-- - In case of abstract subprograms the text "is abstract" is
-- added at the end of the line.
-- d.a Disable OpenVMS alignment optimization on types. On OpenVMS,
-- record types whose size is odd "in between" (e.g. 17 bits) are
-- over-aligned to the next power of 2 (until 8 bytes). This over
-- alignment improve generated code and is more consistent with
-- what Dec Ada does.
-- d.f Suppress folding of static expressions. This of course results
-- in seriously non-conforming behavior, but is useful sometimes
-- when tracking down handling of complex expressions.
......@@ -520,6 +519,9 @@ package body Debug is
-- main source (this corresponds to a previous behavior of -gnatl and
-- is used for running the ACATS tests).
-- d.r Forces the flag OK_To_Reorder_Components to be set in all record
-- base types that have no discriminants.
-- d.s Normally the compiler expands slice moves into loops if overlap
-- might be possible. This debug flag inhibits that expansion, and
-- the back end is expected to use an appropriate routine to handle
......@@ -531,6 +533,9 @@ package body Debug is
-- previous dynamic construction of tables. It is there as a possible
-- work around if we run into trouble with the new implementation.
-- d.v Forces the flag OK_To_Reorder_Components to be set in all record
-- base types that have at least one discriminant (v = variant).
-- d.w This flag turns off the scanning of while loops to detect possible
-- infinite loops.
......@@ -543,6 +548,10 @@ package body Debug is
-- byte code, even in case of unsupported construct, for the sake
-- of static analysis tools.
-- d.S Force Optimize_Alignment (Space) mode as the default
-- d.T Force Optimize_Alignment (Time) mode as the default
-- d1 Error messages have node numbers where possible. Normally error
-- messages have only source locations. This option is useful when
-- debugging errors caused by expanded code, where the source location
......
gcc/ada/frontend.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- --
......@@ -59,8 +59,8 @@ with Tbuild; use Tbuild;
with Types; use Types;
procedure Frontend is
Config_Pragmas : List_Id;
-- Gather configuration pragmas
Config_Pragmas : List_Id;
-- Gather configuration pragmas
begin
-- Carry out package initializations. These are initializations which
......@@ -78,6 +78,7 @@ begin
Sem_Ch8.Initialize;
Fname.UF.Initialize;
Checks.Initialize;
Sem_Warn.Initialize;
-- Create package Standard
......@@ -207,6 +208,14 @@ begin
Fmap.Initialize (Mapping_File_Name.all);
end if;
-- Adjust Optimize_Alignment mode from debug switches if necessary
if Debug_Flag_Dot_SS then
Optimize_Alignment := 'S';
elsif Debug_Flag_Dot_TT then
Optimize_Alignment := 'T';
end if;
-- We have now processed the command line switches, and the gnat.adc
-- file, so this is the point at which we want to capture the values
-- of the configuration switches (see Opt for further details).
......@@ -326,6 +335,7 @@ begin
Sem_Warn.Output_Non_Modifed_In_Out_Warnings;
Sem_Warn.Output_Unreferenced_Messages;
Sem_Warn.Check_Unused_Withs;
Sem_Warn.Output_Unused_Warnings_Off_Warnings;
end if;
end if;
......
gcc/ada/layout.adb
......@@ -2794,7 +2794,32 @@ package body Layout is
Align : Nat;
begin
if Unknown_Alignment (E) then
-- If alignment is already set, then nothing to do
if Known_Alignment (E) then
return;
end if;
-- Alignment is not known, see if we can set it, taking into account
-- the setting of the Optimize_Alignment mode.
-- If Optimize_Alignment is set to Space, then packed records always
-- have an aligmment of 1. But don't do anything for atomic records
-- since we may need higher alignment for indivisible access.
if Optimize_Alignment = 'S'
and then Is_Record_Type (E)
and then Is_Packed (E)
and then not Is_Atomic (E)
then
Align := 1;
-- Not a record, or not packed
else
-- The only other cases we worry about here are where the size is
-- staticallly known at compile time.
if Known_Static_Esize (E) then
Siz := Esize (E);
......@@ -2809,8 +2834,8 @@ package body Layout is
-- Size is known, alignment is not set
-- Reset alignment to match size if size is exactly 2, 4, or 8
-- storage units.
-- Reset alignment to match size if the known size is exactly 2, 4,
-- or 8 storage units.
if Siz = 2 * System_Storage_Unit then
Align := 2;
......@@ -2819,54 +2844,75 @@ package body Layout is
elsif Siz = 8 * System_Storage_Unit then
Align := 8;
-- On VMS, also reset for odd "in between" sizes, e.g. a 17-bit
-- record is given an alignment of 4. This is more consistent with
-- what DEC Ada does (-gnatd.a turns this off which can be used to
-- examine the value of this special transformation).
-- If Optimize_Alignment is set to Space, then make sure the
-- 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
if Siz mod (8 * System_Storage_Unit) = 0 then
Align := 8;
elsif Siz mod (4 * System_Storage_Unit) = 0 then
Align := 4;
elsif Siz mod (2 * System_Storage_Unit) = 0 then
Align := 2;
else
Align := 1;
end if;
-- If Optimize_Alignment is set to Time, then we reset for odd
-- "in between sizes", for example a 17 bit record is given an
-- alignment of 4. Note that this matches the old VMS behavior
-- in versions of GNAT prior to 6.1.1.
elsif OpenVMS_On_Target
and then not Debug_Flag_Dot_A
elsif Optimize_Alignment = 'T'
and then Siz > System_Storage_Unit
and then Siz <= 8 * System_Storage_Unit
then
if Siz <= 2 * System_Storage_Unit then
Align := 2;
elsif Siz <= 4 * System_Storage_Unit then
Align := 4;
elsif Siz <= 8 * System_Storage_Unit then
else -- Siz <= 8 * System_Storage_Unit then
Align := 8;
else
return;
end if;
-- No special alignment fiddling needed
-- No special alignment fiddling needed
else
return;
end if;
end if;
-- Here Align is set to the proposed improved alignment
-- Here we have Set Align to the proposed improved value. Make sure the
-- value set does not exceed Maximum_Alignment for the target.
if Align > Maximum_Alignment then
Align := Maximum_Alignment;
end if;
if Align > Maximum_Alignment then
Align := Maximum_Alignment;
end if;
-- Further processing for record types only to reduce the alignment
-- set by the above processing in some specific cases. We do not
-- do this for atomic records, since we need max alignment there.
-- Further processing for record types only to reduce the alignment
-- set by the above processing in some specific cases. We do not
-- do this for atomic records, since we need max alignment there,
if Is_Record_Type (E) then
if Is_Record_Type (E) and then not Is_Atomic (E) then
-- For records, there is generally no point in setting alignment
-- higher than word size since we cannot do better than move by
-- words in any case
-- For records, there is generally no point in setting alignment
-- higher than word size since we cannot do better than move by
-- words in any case. Omit this if we are optimizing for time,
-- since conceivably we may be able to do better.
if Align > System_Word_Size / System_Storage_Unit then
Align := System_Word_Size / System_Storage_Unit;
end if;
if Align > System_Word_Size / System_Storage_Unit
and then Optimize_Alignment /= 'T'
then
Align := System_Word_Size / System_Storage_Unit;
end if;
-- Check components. If any component requires a higher
-- alignment, then we set that higher alignment in any case.
-- Check components. If any component requires a higher alignment,
-- then we set that higher alignment in any case. Don't do this if
-- we have Optimize_Alignment set to Space. Note that that covers
-- the case of packed records, where we arleady set alignment to 1.
if Optimize_Alignment /= 'S' then
declare
Comp : Entity_Id;
......@@ -2878,19 +2924,19 @@ package body Layout is
Calign : constant Uint := Alignment (Etype (Comp));
begin
-- The cases to worry about are when the alignment
-- of the component type is larger than the alignment
-- we have so far, and either there is no component
-- clause for the alignment, or the length set by
-- the component clause matches the alignment set.
-- The cases to process are when the alignment of the
-- component type is larger than the alignment we have
-- so far, and either there is no component clause for
-- the component, or the length set by the component
-- clause matches the length of the component type.
if Calign > Align
and then
(Unknown_Esize (Comp)
or else (Known_Static_Esize (Comp)
and then
Esize (Comp) =
Calign * System_Storage_Unit))
or else (Known_Static_Esize (Comp)
and then
Esize (Comp) =
Calign * System_Storage_Unit))
then
Align := UI_To_Int (Calign);
end if;
......@@ -2901,16 +2947,17 @@ package body Layout is
end loop;
end;
end if;
end if;
-- Set chosen alignment
-- Set chosen alignment, and increase Esize if necessary to match
-- the chosen alignment.
Set_Alignment (E, UI_From_Int (Align));
Set_Alignment (E, UI_From_Int (Align));
if Known_Static_Esize (E)
and then Esize (E) < Align * System_Storage_Unit
then
Set_Esize (E, UI_From_Int (Align * System_Storage_Unit));
end if;
if Known_Static_Esize (E)
and then Esize (E) < Align * System_Storage_Unit
then
Set_Esize (E, UI_From_Int (Align * System_Storage_Unit));
end if;
end Set_Composite_Alignment;
......
gcc/ada/lib-writ.adb
......@@ -971,6 +971,11 @@ 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
......@@ -209,7 +209,11 @@ package Lib.Writ is
-- to all units in the file.
--
-- NS Normalize_Scalars pragma in effect for all units in
-- this file
-- 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)
......@@ -498,15 +502,15 @@ package Lib.Writ is
-- W unit-name [source-name lib-name] [E] [EA] [ED] [AD]
--
-- One of these lines is present for each unit that is mentioned in
-- an explicit with clause by the current unit. The first parameter
-- is the unit name in internal format. The second parameter is the
-- file name of the file that must be compiled to compile this unit.
-- It is usually the file for the body, except for packages
-- which have no body; for units that need a body, if the source file
-- for the body cannot be found, the file name of the spec is used
-- instead. The third parameter is the file name of the library
-- information file that contains the results of compiling this unit.
-- The optional modifiers are used as follows:
-- an explicit with clause by the current unit. The first parameter is
-- the unit name in internal format. The second parameter is the file
-- name of the file that must be compiled to compile this unit. It is
-- usually the file for the body, except for packages which have no
-- body. For units that need a body, if the source file for the body
-- cannot be found, the file name of the spec is used instead. The
-- third parameter is the file name of the library information file
-- that contains the results of compiling this unit. The optional
-- modifiers are used as follows:
--
-- E pragma Elaborate applies to this unit
--
......@@ -528,6 +532,8 @@ package Lib.Writ is
-- of a generic unit compiled with earlier versions of GNAT which
-- did not generate object or ali files for generics.
-- In fact W lines include implicit withs ???
-- -----------------------
-- -- L Linker_Options --
-- -----------------------
......
gcc/ada/opt.adb
......@@ -56,6 +56,7 @@ package body Opt is
External_Name_Exp_Casing_Config := External_Name_Exp_Casing;
External_Name_Imp_Casing_Config := External_Name_Imp_Casing;
Fast_Math_Config := Fast_Math;
Optimize_Alignment_Config := Optimize_Alignment;
Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
Polling_Required_Config := Polling_Required;
Use_VADS_Size_Config := Use_VADS_Size;
......@@ -77,6 +78,7 @@ package body Opt is
External_Name_Exp_Casing := Save.External_Name_Exp_Casing;
External_Name_Imp_Casing := Save.External_Name_Imp_Casing;
Fast_Math := Save.Fast_Math;
Optimize_Alignment := Save.Optimize_Alignment;
Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
Polling_Required := Save.Polling_Required;
Use_VADS_Size := Save.Use_VADS_Size;
......@@ -98,6 +100,7 @@ package body Opt is
Save.External_Name_Exp_Casing := External_Name_Exp_Casing;
Save.External_Name_Imp_Casing := External_Name_Imp_Casing;
Save.Fast_Math := Fast_Math;
Save.Optimize_Alignment := Optimize_Alignment;
Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
Save.Polling_Required := Polling_Required;
Save.Use_VADS_Size := Use_VADS_Size;
......@@ -125,6 +128,7 @@ package body Opt is
Extensions_Allowed := True;
External_Name_Exp_Casing := As_Is;
External_Name_Imp_Casing := Lowercase;
Optimize_Alignment := 'O';
Persistent_BSS_Mode := False;
Use_VADS_Size := False;
......@@ -151,12 +155,14 @@ package body Opt is
External_Name_Exp_Casing := External_Name_Exp_Casing_Config;
External_Name_Imp_Casing := External_Name_Imp_Casing_Config;
Fast_Math := Fast_Math_Config;
Optimize_Alignment := Optimize_Alignment_Config;
Persistent_BSS_Mode := Persistent_BSS_Mode_Config;
Use_VADS_Size := Use_VADS_Size_Config;
end if;
Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
Fast_Math := Fast_Math_Config;
Optimize_Alignment := Optimize_Alignment_Config;
Polling_Required := Polling_Required_Config;
end Set_Opt_Config_Switches;
......
gcc/ada/opt.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- --
......@@ -858,6 +858,10 @@ package Opt is
-- error is detected then this flag is reset from Generate_Code to
-- Check_Semantics after generating an error message.
Optimize_Alignment : Character := 'O';
-- Settinng of Optimize_Alignment, set to T/S/O for time/space/off. Can
-- be modified by use of pragma Optimize_Alignment.
Original_Operating_Mode : Operating_Mode_Type := Generate_Code;
-- GNAT
-- Indicates the original operating mode of the compiler as set by
......@@ -1298,6 +1302,12 @@ package Opt is
-- which have a record representation clause but this component does not
-- have a component clause. The default is that this warning is disabled.
Warn_On_Warnings_Off : Boolean := False;
-- GNAT
-- Set to True to generate warnings for use of Pragma Warnings (Off, ent),
-- where either the pragma is never used, or it could be replaced by a
-- pragma Unmodified or Unreferenced.
type Warning_Mode_Type is (Suppress, Normal, Treat_As_Error);
Warning_Mode : Warning_Mode_Type := Normal;
-- GNAT, GNATBIND
......@@ -1338,8 +1348,8 @@ package Opt is
-- These are settings that are used to establish the mode at the start of
-- each unit. The values defined below can be affected either by command
-- line switches, or by the use of appropriate configuration pragmas in the
-- gnat.adc file.
-- line switches, or by the use of appropriate configuration pragmas in a
-- configuration pragma file.
Ada_Version_Config : Ada_Version_Type;
-- GNAT
......@@ -1416,6 +1426,14 @@ package Opt is
-- used to set the initial value of Fast_Math at the start of each new
-- compilation unit.
Optimize_Alignment_Config : Character;
-- GNAT
-- This is the value of the configuration switch that controls the
-- alignment optimization mode, as set by an Optimize_Alignment pragma.
-- It is used to set the initial value of Optimize_Alignment at the start
-- of each new compilation unit, except that it is always set to 'O' (off)
-- for internal units.
Persistent_BSS_Mode_Config : Boolean;
-- GNAT
-- This is the value of the configuration switch that controls whether
......@@ -1553,6 +1571,7 @@ private
External_Name_Exp_Casing : External_Casing_Type;
External_Name_Imp_Casing : External_Casing_Type;
Fast_Math : Boolean;
Optimize_Alignment : Character;
Persistent_BSS_Mode : Boolean;
Polling_Required : Boolean;
Use_VADS_Size : Boolean;
......
gcc/ada/par-prag.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,8 +43,8 @@ with System.WCh_Con; use System.WCh_Con;
separate (Par)
function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
Pragma_Name : constant Name_Id := Chars (Pragma_Node);
Prag_Id : constant Pragma_Id := Get_Pragma_Id (Pragma_Name);
Prag_Name : constant Name_Id := Pragma_Name (Pragma_Node);
Prag_Id : constant Pragma_Id := Get_Pragma_Id (Prag_Name);
Pragma_Sloc : constant Source_Ptr := Sloc (Pragma_Node);
Arg_Count : Nat;
Arg_Node : Node_Id;
......@@ -241,10 +241,10 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
end loop;
end Process_Restrictions_Or_Restriction_Warnings;
-- Start if processing for Prag
-- Start of processing for Prag
begin
Error_Msg_Name_1 := Pragma_Name;
Error_Msg_Name_1 := Prag_Name;
-- Ignore unrecognized pragma. We let Sem post the warning for this, since
-- it is a semantic error, not a syntactic one (we have already checked
......@@ -626,7 +626,7 @@ begin
-- Source_File_Name_Project pragmas.
begin
if Get_Pragma_Id (Pragma_Name) = Pragma_Source_File_Name then
if Prag_Id = Pragma_Source_File_Name then
if Project_File_In_Use = In_Use then
Error_Msg
("pragma Source_File_Name cannot be used " &
......@@ -1135,6 +1135,7 @@ begin
Pragma_No_Strict_Aliasing |
Pragma_Normalize_Scalars |
Pragma_Optimize |
Pragma_Optimize_Alignment |
Pragma_Pack |
Pragma_Passive |
Pragma_Preelaborable_Initialization |
......
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