summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2012-07-09 10:36:42 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2012-07-09 10:36:42 +0000
commite4c87fa54e168be9cdbb50057992277b6984ea12 (patch)
treed2e9bd8a5faa86e9021f0ad569650516d8108c88
parent5ab7f2859836f90a6b9ff0816bfdda210b97ecc7 (diff)
downloadppe42-gcc-e4c87fa54e168be9cdbb50057992277b6984ea12.tar.gz
ppe42-gcc-e4c87fa54e168be9cdbb50057992277b6984ea12.zip
2012-07-09 Vincent Celier <celier@adacore.com>
* lib-writ.ads: Add documentation for the Z lines (implicitly withed units) and Y lines (limited withed units). 2012-07-09 Robert Dewar <dewar@adacore.com> * lib.ads, exp_attr.adb, exp_ch9.adb, sem_dim.adb, sem_ch9.adb, sem_prag.adb, sem_ch12.adb, mlib-utl.adb, freeze.adb, sem_res.adb, sem_attr.adb, sem_case.adb, gnatlink.adb, exp_ch4.adb, sem_ch6.adb, sem_elim.adb, s-dimmks.ads, sem_ch13.adb: Minor code clean ups. 2012-07-09 Eric Botcazou <ebotcazou@adacore.com> * gnat_ugn.texi (Switches for gcc): Document -gnatn[12] only lightly in the summary and more thoroughly in inlining section. (Performance Considerations): Document -gnatn[12] in inlining section. 2012-07-09 Tristan Gingold <gingold@adacore.com> * a-exexpr-gcc.adb (Unhandled_Except_Handler): New procedure. (Unhandled_Others_Value): New const. * raise-gcc.c (GNAT_UNHANDLED_OTHERS): Define. (action_descriptor): Remove ttype_entry. (get_action_description_for): Do not assign ttype_entry. (is_handled_by): Consider GNAT_UNHANDLED_OTHERS. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@189367 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ada/ChangeLog28
-rw-r--r--gcc/ada/a-exexpr-gcc.adb31
-rw-r--r--gcc/ada/exp_attr.adb14
-rw-r--r--gcc/ada/exp_ch4.adb7
-rw-r--r--gcc/ada/exp_ch9.adb11
-rw-r--r--gcc/ada/freeze.adb21
-rw-r--r--gcc/ada/gnat_ugn.texi48
-rw-r--r--gcc/ada/gnatlink.adb35
-rw-r--r--gcc/ada/lib-writ.ads27
-rw-r--r--gcc/ada/lib.ads2
-rw-r--r--gcc/ada/mlib-utl.adb17
-rw-r--r--gcc/ada/raise-gcc.c8
-rw-r--r--gcc/ada/s-dimmks.ads25
-rw-r--r--gcc/ada/sem_attr.adb13
-rw-r--r--gcc/ada/sem_case.adb13
-rw-r--r--gcc/ada/sem_ch12.adb4
-rw-r--r--gcc/ada/sem_ch13.adb6
-rw-r--r--gcc/ada/sem_ch6.adb16
-rw-r--r--gcc/ada/sem_ch9.adb7
-rw-r--r--gcc/ada/sem_dim.adb83
-rw-r--r--gcc/ada/sem_elim.adb4
-rw-r--r--gcc/ada/sem_prag.adb15
-rw-r--r--gcc/ada/sem_res.adb6
23 files changed, 256 insertions, 185 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 60f6ef8128f..555ac567969 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,31 @@
+2012-07-09 Vincent Celier <celier@adacore.com>
+
+ * lib-writ.ads: Add documentation for the Z lines (implicitly
+ withed units) and Y lines (limited withed units).
+
+2012-07-09 Robert Dewar <dewar@adacore.com>
+
+ * lib.ads, exp_attr.adb, exp_ch9.adb, sem_dim.adb, sem_ch9.adb,
+ sem_prag.adb, sem_ch12.adb, mlib-utl.adb, freeze.adb, sem_res.adb,
+ sem_attr.adb, sem_case.adb, gnatlink.adb, exp_ch4.adb, sem_ch6.adb,
+ sem_elim.adb, s-dimmks.ads, sem_ch13.adb: Minor code clean ups.
+
+2012-07-09 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat_ugn.texi (Switches for gcc): Document -gnatn[12] only
+ lightly in the summary and more thoroughly in inlining section.
+ (Performance Considerations): Document -gnatn[12] in inlining
+ section.
+
+2012-07-09 Tristan Gingold <gingold@adacore.com>
+
+ * a-exexpr-gcc.adb (Unhandled_Except_Handler): New procedure.
+ (Unhandled_Others_Value): New const.
+ * raise-gcc.c (GNAT_UNHANDLED_OTHERS): Define.
+ (action_descriptor): Remove ttype_entry.
+ (get_action_description_for): Do not assign ttype_entry.
+ (is_handled_by): Consider GNAT_UNHANDLED_OTHERS.
+
2012-07-03 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (Call_to_gnu): Robustify test for function case
diff --git a/gcc/ada/a-exexpr-gcc.adb b/gcc/ada/a-exexpr-gcc.adb
index 2f2e7a76cba..014b48f84bb 100644
--- a/gcc/ada/a-exexpr-gcc.adb
+++ b/gcc/ada/a-exexpr-gcc.adb
@@ -205,6 +205,15 @@ package body Exception_Propagation is
pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
-- Write Get_Current_Excep.all from GCC_Exception
+ procedure Unhandled_Except_Handler
+ (GCC_Exception : not null GCC_Exception_Access);
+ pragma No_Return (Unhandled_Except_Handler);
+ pragma Export (C, Unhandled_Except_Handler,
+ "__gnat_unhandled_except_handler");
+ -- Called for handle unhandled exceptions, ie the last chance handler
+ -- on platforms (such as SEH) that never returns after throwing an
+ -- exception. Called directly by gigi.
+
function CleanupUnwind_Handler
(UW_Version : Integer;
UW_Phases : Unwind_Action;
@@ -280,6 +289,12 @@ package body Exception_Propagation is
All_Others_Value : constant Integer := 16#7FFF#;
pragma Export (C, All_Others_Value, "__gnat_all_others_value");
+ Unhandled_Others_Value : constant Integer := 16#7FFF#;
+ pragma Export (C, Unhandled_Others_Value, "__gnat_unhandled_others_value");
+ -- Special choice (emitted by gigi) to catch and notify unhandled
+ -- exceptions on targets which always handle exceptions (such as SEH).
+ -- The handler will simply call Unhandled_Except_Handler.
+
--------------------------------
-- GNAT_GCC_Exception_Cleanup --
--------------------------------
@@ -319,8 +334,7 @@ package body Exception_Propagation is
-- Terminate when the end of the stack is reached
if UW_Phases >= UA_END_OF_STACK then
- Setup_Current_Excep (UW_Exception);
- Unhandled_Exception_Terminate;
+ Unhandled_Except_Handler (UW_Exception);
end if;
-- We know there is at least one cleanup further up. Return so that it
@@ -438,9 +452,20 @@ package body Exception_Propagation is
-- We get here in case of error. The debugger has been notified before
-- the second step above.
+ Unhandled_Except_Handler (GCC_Exception);
+ end Propagate_GCC_Exception;
+
+ ------------------------------
+ -- Unhandled_Except_Handler --
+ ------------------------------
+
+ procedure Unhandled_Except_Handler
+ (GCC_Exception : not null GCC_Exception_Access)
+ is
+ begin
Setup_Current_Excep (GCC_Exception);
Unhandled_Exception_Terminate;
- end Propagate_GCC_Exception;
+ end Unhandled_Except_Handler;
-------------------------
-- Propagate_Exception --
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 54ce3ee0baa..ad75f90556c 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -3072,19 +3072,9 @@ package body Exp_Attr is
-- Rewrite the attribute reference with the value of Uses_Lock_Free
when Attribute_Lock_Free => Lock_Free : declare
- Val : Entity_Id;
-
+ V : constant Entity_Id := Boolean_Literals (Uses_Lock_Free (Ptyp));
begin
- if Uses_Lock_Free (Ptyp) then
- Val := Standard_True;
-
- else
- Val := Standard_False;
- end if;
-
- Rewrite (N,
- New_Occurrence_Of (Val, Loc));
-
+ Rewrite (N, New_Occurrence_Of (V, Loc));
Analyze_And_Resolve (N, Standard_Boolean);
end Lock_Free;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 5ed4e8afaca..76f5a971340 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -11327,12 +11327,7 @@ package body Exp_Ch4 is
if AV = False then
if True_Result or False_Result then
- if True_Result then
- Result := Standard_True;
- else
- Result := Standard_False;
- end if;
-
+ Result := Boolean_Literals (True_Result);
Rewrite (N,
Convert_To (Typ,
New_Occurrence_Of (Result, Sloc (N))));
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 620efc96ad7..e95db771798 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -13955,13 +13955,10 @@ package body Exp_Ch9 is
-- will allocate an array to hold the string names of task entries.
if not Restricted_Profile then
- if Has_Entries (Ttyp)
- and then Entry_Names_OK
- then
- Append_To (Args, New_Reference_To (Standard_True, Loc));
- else
- Append_To (Args, New_Reference_To (Standard_False, Loc));
- end if;
+ Append_To (Args,
+ New_Reference_To
+ (Boolean_Literals (Has_Entries (Ttyp) and then Entry_Names_OK),
+ Loc));
end if;
if Restricted_Profile then
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 5464462a229..350a1b00b5c 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4697,16 +4697,17 @@ package body Freeze is
else
Id := Defining_Unit_Name (Specification (P));
+ -- Following complex conditional could use comments ???
+
if Nkind (Id) = N_Defining_Identifier
- and then (Is_Init_Proc (Id) or else
- Is_TSS (Id, TSS_Stream_Input) or else
- Is_TSS (Id, TSS_Stream_Output) or else
- Is_TSS (Id, TSS_Stream_Read) or else
- Is_TSS (Id, TSS_Stream_Write) or else
- Nkind (Original_Node (P)) =
- N_Subprogram_Renaming_Declaration or else
- Nkind (Original_Node (P)) =
- N_Expression_Function)
+ and then (Is_Init_Proc (Id)
+ or else Is_TSS (Id, TSS_Stream_Input)
+ or else Is_TSS (Id, TSS_Stream_Output)
+ or else Is_TSS (Id, TSS_Stream_Read)
+ or else Is_TSS (Id, TSS_Stream_Write)
+ or else Nkind_In (Original_Node (P),
+ N_Subprogram_Renaming_Declaration,
+ N_Expression_Function))
then
return True;
else
@@ -5122,7 +5123,7 @@ package body Freeze is
if not Is_Compilation_Unit (Current_Scope)
and then (Is_Record_Type (Scope (Current_Scope))
or else Nkind (Parent (Current_Scope)) =
- N_Quantified_Expression)
+ N_Quantified_Expression)
then
Pos := Pos - 1;
end if;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 4a1baf2aadf..0edaed05934 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -4306,10 +4306,8 @@ means that no limit applies.
@cindex @option{-gnatn} (@command{gcc})
Activate inlining for subprograms for which pragma @code{Inline} is
specified. This inlining is performed by the GCC back-end. An optional
-digit sets the inlining level: 1 for moderate inlining across modules,
-which is a good compromise between compilation times and performances
-at run time, and 2 for full inlining across modules, which may bring
-about longer compilation times. If no inlining level is specified,
+digit sets the inlining level: 1 for moderate inlining across modules
+or 2 for full inlining across modules. If no inlining level is specified,
the compiler will pick it based on the optimization level.
@item -gnatN
@@ -7335,21 +7333,28 @@ For the source file naming rules, @xref{File Naming Rules}.
@table @option
@c !sort!
-@item -gnatn
+@item -gnatn[12]
@cindex @option{-gnatn} (@command{gcc})
@ifclear vms
The @code{n} here is intended to suggest the first syllable of the
word ``inline''.
@end ifclear
GNAT recognizes and processes @code{Inline} pragmas. However, for the
-inlining to actually occur, optimization must be enabled. To enable
-inlining of subprograms specified by pragma @code{Inline},
+inlining to actually occur, optimization must be enabled and, in order
+to enable inlining of subprograms specified by pragma @code{Inline},
you must also specify this switch.
In the absence of this switch, GNAT does not attempt
inlining and does not need to access the bodies of
subprograms for which @code{pragma Inline} is specified if they are not
in the current unit.
+You can optionally specify the inlining level: 1 for moderate inlining across
+modules, which is a good compromise between compilation times and performances
+at run time, or 2 for full inlining across modules, which may bring about
+longer compilation times. If no inlining level is specified, the compiler will
+pick it based on the optimization level: 1 for @option{-O1}, @option{-O2} or
+@option{-Os} and 2 for @option{-O3}.
+
If you specify this switch the compiler will access these bodies,
creating an extra source dependency for the resulting object file, and
where possible, the call will be inlined.
@@ -10733,19 +10738,22 @@ Note: The @option{-fno-inline-functions-called-once} switch
can be used to prevent inlining of subprograms local to the unit
and called once from within it if @option{-O1} is used.
-Note regarding the use of @option{-O3}: There is no difference in inlining
-behavior between @option{-O2} and @option{-O3} for subprograms with an explicit
-pragma @code{Inline} assuming the use of @option{-gnatn}
-or @option{-gnatN} (the switches that activate inlining). If you have used
-pragma @code{Inline} in appropriate cases, then it is usually much better
-to use @option{-O2} and @option{-gnatn} and avoid the use of @option{-O3} which
-in this case only has the effect of inlining subprograms you did not
-think should be inlined. We often find that the use of @option{-O3} slows
-down code by performing excessive inlining, leading to increased instruction
-cache pressure from the increased code size. So the bottom line here is
-that you should not automatically assume that @option{-O3} is better than
-@option{-O2}, and indeed you should use @option{-O3} only if tests show that
-it actually improves performance.
+Note regarding the use of @option{-O3}: @option{-gnatn} is made up of two
+sub-switches @option{-gnatn1} and @option{-gnatn2} that can be directly
+specified in lieu of it, @option{-gnatn} being translated into one of them
+based on the optimization level. With @option{-O2} or below, @option{-gnatn}
+is equivalent to @option{-gnatn1} which activates pragma @code{Inline} with
+moderate inlining across modules. With @option{-O3}, @option{-gnatn} is
+equivalent to @option{-gnatn2} which activates pragma @code{Inline} with
+full inlining across modules. If you have used pragma @code{Inline} in appropriate cases, then it is usually much better to use @option{-O2} and @option{-gnatn} and avoid the use of @option{-O3} which has the additional
+effect of inlining subprograms you did not think should be inlined. We have
+found that the use of @option{-O3} may slow down the compilation and increase
+the code size by performing excessive inlining, leading to increased
+instruction cache pressure from the increased code size and thus minor
+performance improvements. So the bottom line here is that you should not
+automatically assume that @option{-O3} is better than @option{-O2}, and
+indeed you should use @option{-O3} only if tests show that it actually
+improves performance for your program.
@node Vectorization of loops
@subsection Vectorization of loops
diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb
index d6834ab5ae2..9562b3bbc8d 100644
--- a/gcc/ada/gnatlink.adb
+++ b/gcc/ada/gnatlink.adb
@@ -904,6 +904,7 @@ procedure Gnatlink is
procedure Write_RF (S : String) is
Success : Boolean := True;
+
begin
-- If a GNU response file is used, space and backslash need to be
-- escaped because they are interpreted as a string separator and
@@ -912,17 +913,18 @@ procedure Gnatlink is
-- they are interpreted as string delimiters on both sides.
if Using_GNU_response_file then
- for I in S'Range loop
- if S (I) = ' ' or else S (I) = '\' then
+ for J in S'Range loop
+ if S (J) = ' ' or else S (J) = '\' then
if Write (Tname_FD, ASCII.BACK_SLASH'Address, 1) /= 1 then
Success := False;
end if;
end if;
- if Write (Tname_FD, S (I)'Address, 1) /= 1 then
+ if Write (Tname_FD, S (J)'Address, 1) /= 1 then
Success := False;
end if;
end loop;
+
else
if Write (Tname_FD, S'Address, S'Length) /= S'Length then
Success := False;
@@ -973,9 +975,9 @@ procedure Gnatlink is
Linker_Objects.Increment_Last;
- -- Mark the positions of first and last object files in case
- -- they need to be placed with a named file on systems having
- -- linker line limitations.
+ -- Mark the positions of first and last object files in case they
+ -- need to be placed with a named file on systems having linker
+ -- line limitations.
if Objs_Begin = 0 then
Objs_Begin := Linker_Objects.Last;
@@ -1016,9 +1018,9 @@ procedure Gnatlink is
and then Link_Bytes > Link_Max)
then
-- Create a temporary file containing the Ada user object files
- -- needed by the link. This list is taken from the bind file
- -- and is output one object per line for maximal compatibility with
- -- linkers supporting this option.
+ -- needed by the link. This list is taken from the bind file and is
+ -- output one object per line for maximal compatibility with linkers
+ -- supporting this option.
Create_Temp_File (Tname_FD, Tname);
@@ -1045,9 +1047,9 @@ procedure Gnatlink is
Tname (Tname'First .. Tname'Last - 1));
-- The slots containing these object file names are then removed
- -- from the objects table so they do not appear in the link. They
- -- are removed by moving up the linker options and non-Ada object
- -- files appearing after the Ada object list in the table.
+ -- from the objects table so they do not appear in the link. They are
+ -- removed by moving up the linker options and non-Ada object files
+ -- appearing after the Ada object list in the table.
declare
N : Integer;
@@ -1082,8 +1084,8 @@ procedure Gnatlink is
elsif Next_Line (Nfirst .. Nlast) = "-shared" then
GNAT_Shared := True;
- -- Add binder options only if not already set on the command
- -- line. This rule is a way to control the linker options order.
+ -- Add binder options only if not already set on the command line.
+ -- This rule is a way to control the linker options order.
-- The following test needs comments, why is it VMS specific.
-- The above comment looks out of date ???
@@ -1095,8 +1097,8 @@ procedure Gnatlink is
if Nlast > Nfirst + 2 and then
Next_Line (Nfirst .. Nfirst + 1) = "-L"
then
- -- Construct a library search path for use later
- -- to locate static gnatlib libraries.
+ -- Construct a library search path for use later to locate
+ -- static gnatlib libraries.
if Libpath.Last > 1 then
Libpath.Increment_Last;
@@ -2208,6 +2210,7 @@ begin
System.OS_Lib.Spawn (Linker_Path.all, Args, Success);
if Success then
+
-- Delete the temporary file used in conjunction with linking
-- if one was created. See Process_Bind_File for details.
diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads
index d7bea5ea2c4..204ba3a3572 100644
--- a/gcc/ada/lib-writ.ads
+++ b/gcc/ada/lib-writ.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -517,18 +517,25 @@ package Lib.Writ is
--
-- The attributes may appear in any order, separated by spaces.
- -- ---------------------
- -- -- W Withed Units --
- -- ---------------------
+ -- -----------------------------
+ -- -- W, Y and Z Withed Units --
+ -- -----------------------------
-- Following each U line, is a series of lines of the form
-- 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
+ -- or
+ -- Y unit-name [source-name lib-name] [E] [EA] [ED] [AD]
+ -- or
+ -- Z unit-name [source-name lib-name] [E] [EA] [ED] [AD]
+ --
+ -- One W line is present for each unit that is mentioned in an explicit
+ -- non-limited with clause by the current unit. One Y line is present
+ -- for each unit that is mentioned in an explicit limited with clause
+ -- by the current unit. One Z line is present for each unit that is
+ -- only implicitly withed 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
@@ -555,8 +562,6 @@ package Lib.Writ is
-- 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 --
-- -----------------------
diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads
index d7607ee097b..f2cc330fdb9 100644
--- a/gcc/ada/lib.ads
+++ b/gcc/ada/lib.ads
@@ -661,7 +661,7 @@ package Lib is
-- one with no code, but the ALI file has the normal form, and we need
-- this ALI file so that the binder can work out a correct order of
-- elaboration.
-
+ --
-- However, ancient versions of GNAT used to not generate code or ALI
-- files for generic units, and this would yield complex order of
-- elaboration issues. These were fixed in GNAT 3.10. The support for not
diff --git a/gcc/ada/mlib-utl.adb b/gcc/ada/mlib-utl.adb
index 2e3f0c0c108..edd6749d1c7 100644
--- a/gcc/ada/mlib-utl.adb
+++ b/gcc/ada/mlib-utl.adb
@@ -355,8 +355,10 @@ package body MLib.Utl is
-- The linker option which specifies the response file as a string
Using_GNU_response_file : constant Boolean :=
- Object_File_Option'Length > 0
- and then Object_File_Option (Object_File_Option'Last) = '@';
+ Object_File_Option'Length > 0
+ and then
+ Object_File_Option
+ (Object_File_Option'Last) = '@';
-- Whether a GNU response file is used
Tname : String_Access;
@@ -395,6 +397,7 @@ package body MLib.Utl is
procedure Write_RF (S : String) is
Success : Boolean := True;
+
begin
-- If a GNU response file is used, space and backslash need to be
-- escaped because they are interpreted as a string separator and
@@ -403,17 +406,18 @@ package body MLib.Utl is
-- they are interpreted as string delimiters on both sides.
if Using_GNU_response_file then
- for I in S'Range loop
- if S (I) = ' ' or else S (I) = '\' then
+ for J in S'Range loop
+ if S (J) = ' ' or else S (J) = '\' then
if Write (Tname_FD, ASCII.BACK_SLASH'Address, 1) /= 1 then
Success := False;
end if;
end if;
- if Write (Tname_FD, S (I)'Address, 1) /= 1 then
+ if Write (Tname_FD, S (J)'Address, 1) /= 1 then
Success := False;
end if;
end loop;
+
else
if Write (Tname_FD, S'Address, S'Length) /= S'Length then
Success := False;
@@ -429,6 +433,8 @@ package body MLib.Utl is
end if;
end Write_RF;
+ -- Start of processing for Gcc
+
begin
if Driver_Name = No_Name then
if Gcc_Exec = null then
@@ -544,6 +550,7 @@ package body MLib.Utl is
end loop;
if Object_List_File_Supported and then Link_Bytes > Link_Max then
+
-- Create a temporary file containing the object files, one object
-- file per line for maximal compatibility with linkers supporting
-- this option.
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 74983ae093e..26bbd63ebf0 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -475,6 +475,9 @@ extern const int __gnat_others_value;
extern const int __gnat_all_others_value;
#define GNAT_ALL_OTHERS ((_Unwind_Ptr) &__gnat_all_others_value)
+extern const int __gnat_unhandled_others_value;
+#define GNAT_UNHANDLED_OTHERS ((_Unwind_Ptr) &__gnat_unhandled_others_value)
+
/* Describe the useful region data associated with an unwind context. */
typedef struct
@@ -653,7 +656,6 @@ typedef struct
/* If we have a handler matching our exception, these are the filter to
trigger it and the corresponding id. */
_Unwind_Sword ttype_filter;
- _Unwind_Ptr ttype_entry;
} action_descriptor;
@@ -852,8 +854,9 @@ is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
bool is_handled =
choice == E
+ || (choice == GNAT_OTHERS && Is_Handled_By_Others (E))
|| choice == GNAT_ALL_OTHERS
- || (choice == GNAT_OTHERS && Is_Handled_By_Others (E));
+ || choice == GNAT_UNHANDLED_OTHERS;
/* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
may have different exception data pointers that should match for the
@@ -970,7 +973,6 @@ get_action_description_for (_Unwind_Context *uw_context,
{
action->kind = handler;
action->ttype_filter = ar_filter;
- action->ttype_entry = choice;
return;
}
}
diff --git a/gcc/ada/s-dimmks.ads b/gcc/ada/s-dimmks.ads
index 50553d1d195..fd0fc0060eb 100644
--- a/gcc/ada/s-dimmks.ads
+++ b/gcc/ada/s-dimmks.ads
@@ -64,31 +64,37 @@ package System.Dim.Mks is
Dimension => (Symbol => 'm',
Meter => 1,
others => 0);
+
subtype Mass is Mks_Type
with
Dimension => (Symbol => "kg",
Kilogram => 1,
others => 0);
+
subtype Time is Mks_Type
with
Dimension => (Symbol => 's',
Second => 1,
others => 0);
+
subtype Electric_Current is Mks_Type
with
Dimension => (Symbol => 'A',
Ampere => 1,
others => 0);
+
subtype Thermodynamic_Temperature is Mks_Type
with
Dimension => (Symbol => 'K',
Kelvin => 1,
others => 0);
+
subtype Amount_Of_Substance is Mks_Type
with
Dimension => (Symbol => "mol",
Mole => 1,
others => 0);
+
subtype Luminous_Intensity is Mks_Type
with
Dimension => (Symbol => "cd",
@@ -122,6 +128,7 @@ package System.Dim.Mks is
Dimension => (Symbol => "Hz",
Second => -1,
others => 0);
+
subtype Force is Mks_Type
with
Dimension => (Symbol => 'N',
@@ -129,6 +136,7 @@ package System.Dim.Mks is
Kilogram => 1,
Second => -2,
others => 0);
+
subtype Pressure is Mks_Type
with
Dimension => (Symbol => "Pa",
@@ -136,6 +144,7 @@ package System.Dim.Mks is
Kilogram => 1,
Second => -2,
others => 0);
+
subtype Energy is Mks_Type
with
Dimension => (Symbol => 'J',
@@ -143,6 +152,7 @@ package System.Dim.Mks is
Kilogram => 1,
Second => -2,
others => 0);
+
subtype Power is Mks_Type
with
Dimension => (Symbol => 'W',
@@ -150,12 +160,14 @@ package System.Dim.Mks is
Kilogram => 1,
Second => -3,
others => 0);
+
subtype Electric_Charge is Mks_Type
with
Dimension => (Symbol => 'C',
Second => 1,
Ampere => 1,
others => 0);
+
subtype Electric_Potential_Difference is Mks_Type
with
Dimension => (Symbol => 'V',
@@ -164,6 +176,7 @@ package System.Dim.Mks is
Second => -3,
Ampere => -1,
others => 0);
+
subtype Electric_Capacitance is Mks_Type
with
Dimension => (Symbol => 'F',
@@ -172,6 +185,7 @@ package System.Dim.Mks is
Second => 4,
Ampere => 2,
others => 0);
+
subtype Electric_Resistance is Mks_Type
with
Dimension => (Symbol => "Ω",
@@ -180,6 +194,7 @@ package System.Dim.Mks is
Second => -3,
Ampere => -2,
others => 0);
+
subtype Electric_Conductance is Mks_Type
with
Dimension => (Symbol => 'S',
@@ -188,6 +203,7 @@ package System.Dim.Mks is
Second => 3,
Ampere => 2,
others => 0);
+
subtype Magnetic_Flux is Mks_Type
with
Dimension => (Symbol => "Wb",
@@ -196,6 +212,7 @@ package System.Dim.Mks is
Second => -2,
Ampere => -1,
others => 0);
+
subtype Magnetic_Flux_Density is Mks_Type
with
Dimension => (Symbol => 'T',
@@ -203,6 +220,7 @@ package System.Dim.Mks is
Second => -2,
Ampere => -1,
others => 0);
+
subtype Inductance is Mks_Type
with
Dimension => (Symbol => 'H',
@@ -211,39 +229,46 @@ package System.Dim.Mks is
Second => -2,
Ampere => -2,
others => 0);
+
subtype Celsius_Temperature is Mks_Type
with
Dimension => (Symbol => "°C",
Kelvin => 1,
others => 0);
+
subtype Luminous_Flux is Mks_Type
with
Dimension => (Symbol => "lm",
Candela => 1,
others => 0);
+
subtype Illuminance is Mks_Type
with
Dimension => (Symbol => "lx",
Meter => -2,
Candela => 1,
others => 0);
+
subtype Radioactivity is Mks_Type
with
Dimension => (Symbol => "Bq",
Second => -1,
others => 0);
+
subtype Absorbed_Dose is Mks_Type
with
Dimension => (Symbol => "Gy",
Meter => 2,
Second => -2,
others => 0);
+
subtype Equivalent_Dose is Mks_Type
with
Dimension => (Symbol => "Sv",
Meter => 2,
Second => -2,
others => 0);
+
subtype Catalytic_Activity is Mks_Type
with
Dimension => (Symbol => "kat",
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index a5d7bee3212..abb0344ad70 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3296,12 +3296,7 @@ package body Sem_Attr is
when Attribute_Fast_Math =>
Check_Standard_Prefix;
-
- if Opt.Fast_Math then
- Rewrite (N, New_Occurrence_Of (Standard_True, Loc));
- else
- Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
- end if;
+ Rewrite (N, New_Occurrence_Of (Boolean_Literals (Fast_Math), Loc));
-----------
-- First --
@@ -5879,11 +5874,7 @@ package body Sem_Attr is
R := Is_Check_Suppressed (Entity (E1), C);
end if;
- if R then
- Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
- else
- Rewrite (N, New_Occurrence_Of (Standard_True, Loc));
- end if;
+ Rewrite (N, New_Occurrence_Of (Boolean_Literals (not R), Loc));
end;
end if;
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index 8fa307442a6..3dd3b617820 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -162,9 +162,7 @@ package body Sem_Case is
-- AI05-0188 : within an instance the non-others choices do not
-- have to belong to the actual subtype.
- if Ada_Version >= Ada_2012
- and then In_Instance
- then
+ if Ada_Version >= Ada_2012 and then In_Instance then
return;
end if;
@@ -714,7 +712,8 @@ package body Sem_Case is
-- Do not insert non static choices in the table to be sorted
elsif not Is_Static_Expression (Lo)
- or else not Is_Static_Expression (Hi)
+ or else
+ not Is_Static_Expression (Hi)
then
Process_Non_Static_Choice (Choice);
return;
@@ -727,12 +726,10 @@ package body Sem_Case is
Raises_CE := True;
return;
- -- AI05-0188 : within an instance the non-others choices do not
+ -- AI05-0188 : Within an instance the non-others choices do not
-- have to belong to the actual subtype.
- elsif Ada_Version >= Ada_2012
- and then In_Instance
- then
+ elsif Ada_Version >= Ada_2012 and then In_Instance then
return;
-- Otherwise we have an OK static choice
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index c4351fce11a..835e8799f26 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -10811,8 +10811,8 @@ package body Sem_Ch12 is
pragma Assert (Present (Ancestor));
- -- the ancestor itself may be a previous formal that
- -- has been instantiated.
+ -- The ancestor itself may be a previous formal that has been
+ -- instantiated.
Ancestor := Get_Instance_Of (Ancestor);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index e177f930f6b..4f2c6855d35 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -850,7 +850,6 @@ package body Sem_Ch13 is
Set_Is_Delayed_Aspect (Prag);
Set_Parent (Prag, ASN);
end if;
-
end Make_Pragma_From_Boolean_Aspect;
-- Start of processing for Analyze_Aspects_At_Freeze_Point
@@ -866,7 +865,6 @@ package body Sem_Ch13 is
-- Look for aspect specification entries for this entity
ASN := First_Rep_Item (E);
-
while Present (ASN) loop
if Nkind (ASN) = N_Aspect_Specification
and then Entity (ASN) = E
@@ -875,6 +873,7 @@ package body Sem_Ch13 is
A_Id := Get_Aspect_Id (Chars (Identifier (ASN)));
case A_Id is
+
-- For aspects whose expression is an optional Boolean, make
-- the corresponding pragma at the freezing point.
@@ -889,7 +888,8 @@ package body Sem_Ch13 is
Aspect_Default_Component_Value =>
Analyze_Aspect_Default_Value (ASN);
- when others => null;
+ when others =>
+ null;
end case;
Ritem := Aspect_Rep_Item (ASN);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d0f918df397..b9243f9fdc4 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -1260,9 +1260,7 @@ package body Sem_Ch6 is
-- rewritten if the original call was in prefix notation) then error
-- has been emitted already, mark node and return.
- if Error_Posted (N)
- or else Etype (Name (N)) = Any_Type
- then
+ if Error_Posted (N) or else Etype (Name (N)) = Any_Type then
Set_Etype (N, Any_Type);
return;
end if;
@@ -1282,9 +1280,9 @@ package body Sem_Ch6 is
-- Special processing for Elab_Spec, Elab_Body and Elab_Subp_Body calls
if Nkind (P) = N_Attribute_Reference
- and then (Attribute_Name (P) = Name_Elab_Spec
- or else Attribute_Name (P) = Name_Elab_Body
- or else Attribute_Name (P) = Name_Elab_Subp_Body)
+ and then (Attribute_Name (P) = Name_Elab_Spec or else
+ Attribute_Name (P) = Name_Elab_Body or else
+ Attribute_Name (P) = Name_Elab_Subp_Body)
then
if Present (Actuals) then
Error_Msg_N
@@ -5503,12 +5501,10 @@ package body Sem_Ch6 is
end if;
end if;
- -- Ada 2012: mode conformance also requires that formal parameters
+ -- Ada 2012: Mode conformance also requires that formal parameters
-- be both aliased, or neither.
- if Ctype >= Mode_Conformant
- and then Ada_Version >= Ada_2012
- then
+ if Ctype >= Mode_Conformant and then Ada_Version >= Ada_2012 then
if Is_Aliased (Old_Formal) /= Is_Aliased (New_Formal) then
Conformance_Error
("\aliased parameter mismatch!", New_Formal);
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 58a27c93256..02a19050436 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -1455,14 +1455,17 @@ package body Sem_Ch9 is
begin
if Present (Ritem) then
+
-- Pragma with one argument
if Nkind (Ritem) = N_Pragma
and then Present (Pragma_Argument_Associations (Ritem))
then
return
- Is_False (Static_Boolean
- (Expression (First (Pragma_Argument_Associations (Ritem)))));
+ Is_False
+ (Static_Boolean
+ (Expression
+ (First (Pragma_Argument_Associations (Ritem)))));
-- Aspect Specification with expression present
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index 49f29a3423b..28e8cee52d5 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -116,6 +116,8 @@ package body Sem_Dim is
No_Symbols : constant Symbol_Array := (others => No_String);
+ -- The following record should be documented field by field
+
type System_Type is record
Type_Decl : Node_Id;
Unit_Names : Name_Array;
@@ -543,8 +545,7 @@ package body Sem_Dim is
Errors_Count : Nat;
-- Errors_Count is a count of errors detected by the compiler so far
-- just before the extraction of symbol, names and values in the
- -- aggregate
- -- (Step 2).
+ -- aggregate (Step 2).
--
-- At the end of the analysis, there is a check to verify that this
-- count equals to Serious_Errors_Detected i.e. no erros have been
@@ -614,9 +615,8 @@ package body Sem_Dim is
Assoc := First (Component_Associations (Aggr));
Choice := First (Choices (Assoc));
- if No (Next (Choice))
- and then Nkind (Choice) = N_Identifier
- then
+ if No (Next (Choice)) and then Nkind (Choice) = N_Identifier then
+
-- Symbol component association is present
if Chars (Choice) = Name_Symbol then
@@ -629,9 +629,9 @@ package body Sem_Dim is
N_String_Literal)
then
Symbol_Expr := Empty;
- Error_Msg_N ("symbol expression must be character or " &
- "string",
- Symbol_Expr);
+ Error_Msg_N
+ ("symbol expression must be character or string",
+ Symbol_Expr);
end if;
-- Special error if no Symbol choice but expression is string
@@ -656,9 +656,7 @@ package body Sem_Dim is
-- Skip the symbol expression when present
- if Present (Symbol_Expr)
- and then Num_Choices = 0
- then
+ if Present (Symbol_Expr) and then Num_Choices = 0 then
Expr := Next (Expr);
end if;
@@ -689,9 +687,9 @@ package body Sem_Dim is
end if;
while Present (Assoc) loop
- Expr := Expression (Assoc);
- Choice := First (Choices (Assoc));
+ Expr := Expression (Assoc);
+ Choice := First (Choices (Assoc));
while Present (Choice) loop
-- Identifier case: NAME => EXPRESSION
@@ -747,9 +745,7 @@ package body Sem_Dim is
-- Others case: OTHERS => EXPRESSION
elsif Nkind (Choice) = N_Others_Choice then
- if Present (Next (Choice))
- or else Present (Prev (Choice))
- then
+ if Present (Next (Choice)) or else Present (Prev (Choice)) then
Error_Msg_N
("OTHERS must appear alone in a choice list", Choice);
@@ -828,11 +824,10 @@ package body Sem_Dim is
-- Check that no errors have been detected during the analysis
if Errors_Count = Serious_Errors_Detected then
- -- useless declaration
- if Symbol = No_String
- and then not Exists (Dimensions)
- then
+ -- Check for useless declaration
+
+ if Symbol = No_String and then not Exists (Dimensions) then
Error_Msg_N ("useless dimension declaration", Aggr);
end if;
@@ -968,6 +963,7 @@ package body Sem_Dim is
-- Named dimension aggregate
if Present (Component_Associations (Dim_Aggr)) then
+
-- Check first argument denotes the unit name
Assoc := First (Component_Associations (Dim_Aggr));
@@ -2235,11 +2231,11 @@ package body Sem_Dim is
-- Expand_Put_Call_With_Symbol --
---------------------------------
- -- For procedure Put (resp. Put_Dim_Of) defined in
- -- System.Dim.Float_IO/System.Dim.Integer_IO, the default string parameter
- -- must be rewritten to include the unit symbols (resp. dimension symbols)
- -- in the output of a dimensioned object. Note that if a value is already
- -- supplied for parameter Symbol, this routine doesn't do anything.
+ -- For procedure Put (resp. Put_Dim_Of) defined in System.Dim.Float_IO
+ -- (System.Dim.Integer_IO), the default string parameter must be rewritten
+ -- to include the unit symbols (resp. dimension symbols) in the output
+ -- of a dimensioned object. Note that if a value is already supplied for
+ -- parameter Symbol, this routine doesn't do anything.
-- Case 1. Item is dimensionless
@@ -2330,22 +2326,20 @@ package body Sem_Dim is
if Nkind (Actual) = N_Parameter_Association
and then Chars (Selector_Name (Actual)) = Name_Symbol
then
-
- -- return True if the actual comes from source or if the string
- -- of symbols doesn't have the default value (i.e "").
+ -- Return True if the actual comes from source or if the string
+ -- of symbols doesn't have the default value (i.e. it is "").
return Comes_From_Source (Actual)
- or else String_Length
- (Strval
- (Explicit_Actual_Parameter (Actual))) /= 0;
+ or else
+ String_Length
+ (Strval (Explicit_Actual_Parameter (Actual))) /= 0;
end if;
Next (Actual);
end loop;
- -- At this point, the call has no parameter association
- -- Look to the last actual since the symbols parameter is the last
- -- one.
+ -- At this point, the call has no parameter association. Look to the
+ -- last actual since the symbols parameter is the last one.
return Nkind (Last (Actuals)) = N_String_Literal;
end Has_Symbols;
@@ -2441,6 +2435,7 @@ package body Sem_Dim is
-- Put_Dim_Of case
if Is_Put_Dim_Of then
+
-- Check that the item is not dimensionless
-- Create the new String_Literal with the new String_Id generated
@@ -2536,11 +2531,10 @@ package body Sem_Dim is
-- From_Dim_To_Str_Of_Dim_Symbols --
------------------------------------
- -- Given a dimension vector and the corresponding dimension system,
- -- create a String_Id to output the dimension symbols corresponding to the
- -- dimensions Dims. If In_Error_Msg is True, there is a special handling
- -- for character asterisk * which is an insertion character in error
- -- messages.
+ -- Given a dimension vector and the corresponding dimension system, create
+ -- a String_Id to output dimension symbols corresponding to the dimensions
+ -- Dims. If In_Error_Msg is True, there is a special handling for character
+ -- asterisk * which is an insertion character in error messages.
function From_Dim_To_Str_Of_Dim_Symbols
(Dims : Dimension_Type;
@@ -2551,9 +2545,9 @@ package body Sem_Dim is
First_Dim : Boolean := True;
procedure Store_String_Oexpon;
- -- Store the expon operator symbol "**" to the string. In error
- -- messages, asterisk * is a special character and must be precede by a
- -- quote ' to be placed literally into the message.
+ -- Store the expon operator symbol "**" in the string. In error
+ -- messages, asterisk * is a special character and must be quoted
+ -- to be placed literally into the message.
-------------------------
-- Store_String_Oexpon --
@@ -2563,7 +2557,6 @@ package body Sem_Dim is
begin
if In_Error_Msg then
Store_String_Chars ("'*'*");
-
else
Store_String_Chars ("**");
end if;
@@ -2639,7 +2632,6 @@ package body Sem_Dim is
end loop;
Store_String_Char (']');
-
return End_String;
end From_Dim_To_Str_Of_Dim_Symbols;
@@ -2669,6 +2661,7 @@ package body Sem_Dim is
for Position in Dimension_Type'Range loop
Dim_Power := Dims (Position);
+
if Dim_Power /= Zero then
if First_Dim then
@@ -2682,6 +2675,7 @@ package body Sem_Dim is
-- Positive dimension case
if Dim_Power.Numerator > 0 then
+
-- Integer case
if Dim_Power.Denominator = 1 then
@@ -2956,4 +2950,5 @@ package body Sem_Dim is
return Null_System;
end System_Of;
+
end Sem_Dim;
diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb
index 3d1bd14eb7c..fdf9ba354c8 100644
--- a/gcc/ada/sem_elim.adb
+++ b/gcc/ada/sem_elim.adb
@@ -832,8 +832,8 @@ package body Sem_Elim is
function OK_Selected_Component (N : Node_Id) return Boolean;
-- Test if N is a selected component with all identifiers, or a selected
- -- component whose selector is an operator symbol. As a side effect if
- -- result is True, sets Num_Names to the number of names present
+ -- component whose selector is an operator symbol. As a side effect
+ -- if result is True, sets Num_Names to the number of names present
-- (identifiers, and operator if any).
---------------------------
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 13d5a91980e..ecec30f8378 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -11146,8 +11146,7 @@ package body Sem_Prag is
Arg := Get_Pragma_Arg (Arg1);
Val := Is_True (Static_Boolean (Arg));
- -- Zero argument. In this case the expression is considered to
- -- be True.
+ -- No arguments (expression is considered to be True)
else
Val := True;
@@ -11160,7 +11159,7 @@ package body Sem_Prag is
Record_Rep_Item (Ent, N);
Set_Uses_Lock_Free (Ent, Val);
- -- Anything else is incorrect
+ -- Anything else is incorrect placement
else
Pragma_Misplaced;
@@ -11178,6 +11177,7 @@ package body Sem_Prag is
range First_Locking_Policy_Name .. Last_Locking_Policy_Name;
LP_Val : LP_Range;
LP : Character;
+
begin
Check_Ada_83_Warning;
Check_Arg_Count (1);
@@ -11187,9 +11187,12 @@ package body Sem_Prag is
LP_Val := Chars (Get_Pragma_Arg (Arg1));
case LP_Val is
- when Name_Ceiling_Locking => LP := 'C';
- when Name_Inheritance_Locking => LP := 'I';
- when Name_Concurrent_Readers_Locking => LP := 'R';
+ when Name_Ceiling_Locking =>
+ LP := 'C';
+ when Name_Inheritance_Locking =>
+ LP := 'I';
+ when Name_Concurrent_Readers_Locking =>
+ LP := 'R';
end case;
if Locking_Policy /= ' '
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 28832237997..eb2b509e1ab 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5839,9 +5839,9 @@ package body Sem_Res is
Check_Restriction (No_Relative_Delay, N);
end if;
- -- Issue an error for a call to an eliminated subprogram.
- -- The routine will not perform the check if the call appears within
- -- a default expression.
+ -- Issue an error for a call to an eliminated subprogram. This routine
+ -- will not perform the check if the call appears within a default
+ -- expression.
Check_For_Eliminated_Subprogram (Subp, Nam);
OpenPOWER on IntegriCloud