aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2013-10-10 12:47:59 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2013-10-10 12:47:59 +0200
commit0c5dba7ff5ca748346488e651641e4b93eb53a17 (patch)
treeaef1bc519fb72a6d3e5a3e8a0d806e1fdf2b1d32 /gcc/ada
parentcd38efa560f565cb02cba62fe919e591dc110b74 (diff)
downloadgcc-0c5dba7ff5ca748346488e651641e4b93eb53a17.zip
gcc-0c5dba7ff5ca748346488e651641e4b93eb53a17.tar.gz
gcc-0c5dba7ff5ca748346488e651641e4b93eb53a17.tar.bz2
[multiple changes]
2013-10-10 Robert Dewar <dewar@adacore.com> * gnatlink.adb: Minor reformatting. 2013-10-10 Yannick Moy <moy@adacore.com> * debug.adb: Free flag d.E and change doc for flag d.K. 2013-10-10 Ed Schonberg <schonberg@adacore.com> * sem_prag.adb (Check_Precondition_Postcondition): If the pragma comes from an aspect spec, and the subprogram is a library unit, treat as a ppc in a declarative part in ASIS mode, so that expression in aspect is properly analyzed. In this case there is no later point at which the aspect specification would be examined. 2013-10-10 Bob Duff <duff@adacore.com> * opt.ads: Minor comment fix. 2013-10-10 Vadim Godunko <godunko@adacore.com> * a-coinho-shared.ads, a-coinho-shared.adb: New file. * s-atocou.ads: Add procedure to initialize counter. * s-atocou.adb: Likewise. * s-atocou-builtin.adb: Likewise. * s-atocou-x86.adb: Likewise. * gcc-interface/Makefile.in: Select special version of Indefinite_Holders package on platforms where atomic built-ins are supported. Update tools target pairs for PikeOS. From-SVN: r203344
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog32
-rw-r--r--gcc/ada/a-coinho-shared.adb358
-rw-r--r--gcc/ada/a-coinho-shared.ads115
-rw-r--r--gcc/ada/debug.adb12
-rw-r--r--gcc/ada/gcc-interface/Makefile.in9
-rw-r--r--gcc/ada/gnatlink.adb112
-rw-r--r--gcc/ada/opt.ads12
-rw-r--r--gcc/ada/s-atocou-builtin.adb11
-rw-r--r--gcc/ada/s-atocou-x86.adb11
-rw-r--r--gcc/ada/s-atocou.adb11
-rw-r--r--gcc/ada/s-atocou.ads8
-rw-r--r--gcc/ada/sem_prag.adb10
12 files changed, 625 insertions, 76 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d0658b9..6f24bc6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,37 @@
2013-10-10 Robert Dewar <dewar@adacore.com>
+ * gnatlink.adb: Minor reformatting.
+
+2013-10-10 Yannick Moy <moy@adacore.com>
+
+ * debug.adb: Free flag d.E and change doc for flag d.K.
+
+2013-10-10 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_prag.adb (Check_Precondition_Postcondition): If the
+ pragma comes from an aspect spec, and the subprogram is a
+ library unit, treat as a ppc in a declarative part in ASIS mode,
+ so that expression in aspect is properly analyzed. In this case
+ there is no later point at which the aspect specification would
+ be examined.
+
+2013-10-10 Bob Duff <duff@adacore.com>
+
+ * opt.ads: Minor comment fix.
+
+2013-10-10 Vadim Godunko <godunko@adacore.com>
+
+ * a-coinho-shared.ads, a-coinho-shared.adb: New file.
+ * s-atocou.ads: Add procedure to initialize counter.
+ * s-atocou.adb: Likewise.
+ * s-atocou-builtin.adb: Likewise.
+ * s-atocou-x86.adb: Likewise.
+ * gcc-interface/Makefile.in: Select special version of
+ Indefinite_Holders package on platforms where atomic built-ins
+ are supported. Update tools target pairs for PikeOS.
+
+2013-10-10 Robert Dewar <dewar@adacore.com>
+
* sem_ch3.adb: Minor reformatting.
2013-10-10 Robert Dewar <dewar@adacore.com>
diff --git a/gcc/ada/a-coinho-shared.adb b/gcc/ada/a-coinho-shared.adb
new file mode 100644
index 0000000..9300c0b
--- /dev/null
+++ b/gcc/ada/a-coinho-shared.adb
@@ -0,0 +1,358 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT LIBRARY COMPONENTS --
+-- --
+-- A D A . C O N T A I N E R S . I N D E F I N I T E _ H O L D E R S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2013, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Deallocation;
+
+package body Ada.Containers.Indefinite_Holders is
+
+ procedure Free is
+ new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
+
+ ---------
+ -- "=" --
+ ---------
+
+ function "=" (Left, Right : Holder) return Boolean is
+ begin
+ if Left.Reference = null and Right.Reference = null then
+ return True;
+
+ elsif Left.Reference /= null and Right.Reference /= null then
+ return Left.Reference.Element.all = Right.Reference.Element.all;
+
+ else
+ return False;
+ end if;
+ end "=";
+
+ ------------
+ -- Adjust --
+ ------------
+
+ overriding procedure Adjust (Container : in out Holder) is
+ begin
+ if Container.Reference /= null then
+ Reference (Container.Reference);
+ end if;
+
+ Container.Busy := 0;
+ end Adjust;
+
+ ------------
+ -- Assign --
+ ------------
+
+ procedure Assign (Target : in out Holder; Source : Holder) is
+ begin
+ if Target.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ if Target.Reference /= Source.Reference then
+ if Target.Reference /= null then
+ Unreference (Target.Reference);
+ end if;
+
+ Target.Reference := Source.Reference;
+
+ if Source.Reference /= null then
+ Reference (Target.Reference);
+ end if;
+ end if;
+ end Assign;
+
+ -----------
+ -- Clear --
+ -----------
+
+ procedure Clear (Container : in out Holder) is
+ begin
+ if Container.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ Unreference (Container.Reference);
+ Container.Reference := null;
+ end Clear;
+
+ ----------
+ -- Copy --
+ ----------
+
+ function Copy (Source : Holder) return Holder is
+ begin
+ if Source.Reference = null then
+ return (AF.Controlled with null, 0);
+ else
+ Reference (Source.Reference);
+
+ return (AF.Controlled with Source.Reference, 0);
+ end if;
+ end Copy;
+
+ -------------
+ -- Element --
+ -------------
+
+ function Element (Container : Holder) return Element_Type is
+ begin
+ if Container.Reference = null then
+ raise Constraint_Error with "container is empty";
+ else
+ return Container.Reference.Element.all;
+ end if;
+ end Element;
+
+ --------------
+ -- Finalize --
+ --------------
+
+ overriding procedure Finalize (Container : in out Holder) is
+ begin
+ if Container.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ if Container.Reference /= null then
+ Unreference (Container.Reference);
+ Container.Reference := null;
+ end if;
+ end Finalize;
+
+ --------------
+ -- Is_Empty --
+ --------------
+
+ function Is_Empty (Container : Holder) return Boolean is
+ begin
+ return Container.Reference = null;
+ end Is_Empty;
+
+ ----------
+ -- Move --
+ ----------
+
+ procedure Move (Target : in out Holder; Source : in out Holder) is
+ begin
+ if Target.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ if Source.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ if Target.Reference /= Source.Reference then
+ if Target.Reference /= null then
+ Unreference (Target.Reference);
+ end if;
+
+ Target.Reference := Source.Reference;
+ Source.Reference := null;
+ end if;
+ end Move;
+
+ -------------------
+ -- Query_Element --
+ -------------------
+
+ procedure Query_Element
+ (Container : Holder;
+ Process : not null access procedure (Element : Element_Type))
+ is
+ B : Natural renames Container'Unrestricted_Access.Busy;
+
+ begin
+ if Container.Reference = null then
+ raise Constraint_Error with "container is empty";
+ end if;
+
+ B := B + 1;
+
+ begin
+ Process (Container.Reference.Element.all);
+ exception
+ when others =>
+ B := B - 1;
+ raise;
+ end;
+
+ B := B - 1;
+ end Query_Element;
+
+ ----------
+ -- Read --
+ ----------
+
+ procedure Read
+ (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+ Container : out Holder)
+ is
+ begin
+ Clear (Container);
+
+ if not Boolean'Input (Stream) then
+ Container.Reference :=
+ new Shared_Holder'
+ (Counter => <>,
+ Element => new Element_Type'(Element_Type'Input (Stream)));
+ end if;
+ end Read;
+
+ ---------------
+ -- Reference --
+ ---------------
+
+ procedure Reference (Item : not null Shared_Holder_Access) is
+ begin
+ System.Atomic_Counters.Increment (Item.Counter);
+ end Reference;
+
+ ---------------------
+ -- Replace_Element --
+ ---------------------
+
+ procedure Replace_Element
+ (Container : in out Holder;
+ New_Item : Element_Type)
+ is
+ -- Element allocator may need an accessibility check in case actual type
+ -- is class-wide or has access discriminants (RM 4.8(10.1) and
+ -- AI12-0035).
+
+ pragma Unsuppress (Accessibility_Check);
+
+ begin
+ if Container.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ if Container.Reference = null then
+ -- Holder is empty, allocate new Shared_Holder.
+
+ Container.Reference :=
+ new Shared_Holder'
+ (Counter => <>,
+ Element => new Element_Type'(New_Item));
+
+ elsif System.Atomic_Counters.Is_One (Container.Reference.Counter) then
+ -- Shared_Holder can be reused.
+
+ Free (Container.Reference.Element);
+ Container.Reference.Element := new Element_Type'(New_Item);
+
+ else
+ Unreference (Container.Reference);
+ Container.Reference :=
+ new Shared_Holder'
+ (Counter => <>,
+ Element => new Element_Type'(New_Item));
+ end if;
+ end Replace_Element;
+
+ ---------------
+ -- To_Holder --
+ ---------------
+
+ function To_Holder (New_Item : Element_Type) return Holder is
+ -- The element allocator may need an accessibility check in the case the
+ -- actual type is class-wide or has access discriminants (RM 4.8(10.1)
+ -- and AI12-0035).
+
+ pragma Unsuppress (Accessibility_Check);
+
+ begin
+ return
+ (AF.Controlled with
+ new Shared_Holder'
+ (Counter => <>,
+ Element => new Element_Type'(New_Item)), 0);
+ end To_Holder;
+
+ -----------------
+ -- Unreference --
+ -----------------
+
+ procedure Unreference (Item : not null Shared_Holder_Access) is
+
+ procedure Free is
+ new Ada.Unchecked_Deallocation (Shared_Holder, Shared_Holder_Access);
+
+ Aux : Shared_Holder_Access := Item;
+
+ begin
+ if System.Atomic_Counters.Decrement (Aux.Counter) then
+ Free (Aux.Element);
+ Free (Aux);
+ end if;
+ end Unreference;
+
+ --------------------
+ -- Update_Element --
+ --------------------
+
+ procedure Update_Element
+ (Container : Holder;
+ Process : not null access procedure (Element : in out Element_Type))
+ is
+ B : Natural renames Container'Unrestricted_Access.Busy;
+
+ begin
+ if Container.Reference = null then
+ raise Constraint_Error with "container is empty";
+ end if;
+
+ B := B + 1;
+
+ begin
+ Process (Container.Reference.Element.all);
+ exception
+ when others =>
+ B := B - 1;
+ raise;
+ end;
+
+ B := B - 1;
+ end Update_Element;
+
+ -----------
+ -- Write --
+ -----------
+
+ procedure Write
+ (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+ Container : Holder)
+ is
+ begin
+ Boolean'Output (Stream, Container.Reference = null);
+
+ if Container.Reference /= null then
+ Element_Type'Output (Stream, Container.Reference.Element.all);
+ end if;
+ end Write;
+
+end Ada.Containers.Indefinite_Holders;
diff --git a/gcc/ada/a-coinho-shared.ads b/gcc/ada/a-coinho-shared.ads
new file mode 100644
index 0000000..9abeda3
--- /dev/null
+++ b/gcc/ada/a-coinho-shared.ads
@@ -0,0 +1,115 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT LIBRARY COMPONENTS --
+-- --
+-- A D A . C O N T A I N E R S . I N D E F I N I T E _ H O L D E R S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2013, Free Software Foundation, Inc. --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the contents of the part following the private keyword. --
+-- --
+-- 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+------------------------------------------------------------------------------
+
+private with Ada.Finalization;
+private with Ada.Streams;
+private with System.Atomic_Counters;
+
+generic
+ type Element_Type (<>) is private;
+ with function "=" (Left, Right : Element_Type) return Boolean is <>;
+
+package Ada.Containers.Indefinite_Holders is
+ pragma Preelaborate (Indefinite_Holders);
+ pragma Remote_Types (Indefinite_Holders);
+
+ type Holder is tagged private;
+ pragma Preelaborable_Initialization (Holder);
+
+ Empty_Holder : constant Holder;
+
+ function "=" (Left, Right : Holder) return Boolean;
+
+ function To_Holder (New_Item : Element_Type) return Holder;
+
+ function Is_Empty (Container : Holder) return Boolean;
+
+ procedure Clear (Container : in out Holder);
+
+ function Element (Container : Holder) return Element_Type;
+
+ procedure Replace_Element
+ (Container : in out Holder;
+ New_Item : Element_Type);
+
+ procedure Query_Element
+ (Container : Holder;
+ Process : not null access procedure (Element : Element_Type));
+ procedure Update_Element
+ (Container : Holder;
+ Process : not null access procedure (Element : in out Element_Type));
+
+ procedure Assign (Target : in out Holder; Source : Holder);
+
+ function Copy (Source : Holder) return Holder;
+
+ procedure Move (Target : in out Holder; Source : in out Holder);
+
+private
+
+ package AF renames Ada.Finalization;
+
+ type Element_Access is access all Element_Type;
+
+ type Shared_Holder is record
+ Counter : System.Atomic_Counters.Atomic_Counter;
+ Element : Element_Access;
+ end record;
+
+ type Shared_Holder_Access is access all Shared_Holder;
+
+ procedure Reference (Item : not null Shared_Holder_Access);
+ -- Increment reference counter
+
+ procedure Unreference (Item : not null Shared_Holder_Access);
+ -- Decrement reference counter, deallocate Item when counter goes to zero
+
+ procedure Read
+ (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+ Container : out Holder);
+
+ procedure Write
+ (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+ Container : Holder);
+
+ type Holder is new Ada.Finalization.Controlled with record
+ Reference : Shared_Holder_Access;
+ Busy : Natural := 0;
+ end record;
+ for Holder'Read use Read;
+ for Holder'Write use Write;
+
+ overriding procedure Adjust (Container : in out Holder);
+ overriding procedure Finalize (Container : in out Holder);
+
+ Empty_Holder : constant Holder := (AF.Controlled with null, 0);
+
+end Ada.Containers.Indefinite_Holders;
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 0162479..8775af7 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -122,13 +122,13 @@ package body Debug is
-- d.B
-- d.C Generate concatenation call, do not generate inline code
-- d.D SPARK strict mode
- -- d.E Force SPARK mode for gnat2why
+ -- d.E
-- d.F SPARK mode
-- d.G Frame condition mode for gnat2why
-- d.H Standard package only mode for gnat2why
-- d.I Do not ignore enum representation clauses in CodePeer mode
-- d.J Disable parallel SCIL generation mode
- -- d.K SPARK detection only mode for gnat2why
+ -- d.K SPARK check mode for gnat2why
-- d.L Depend on back end for limited types in if and case expressions
-- d.M Relaxed RM semantics
-- d.N Add node to all entities
@@ -597,10 +597,6 @@ package body Debug is
-- d.D SPARK strict mode. Interpret compiler permissions as strictly as
-- possible in SPARK mode.
- -- d.E Force SPARK mode for gnat2why. In this mode, errors are issued for
- -- all violations of SPARK in user code, and warnings are issued for
- -- constructs not yet implemented in gnat2why.
-
-- d.F SPARK mode. Generate AST in a form suitable for formal
-- verification, as well as additional cross reference information in
-- ALI files to compute effects of subprograms. Note that ALI files
@@ -624,8 +620,8 @@ package body Debug is
-- done in parallel to speed processing. This switch disables this
-- behavior.
- -- d.K SPARK detection only mode for gnat2why. In this mode, gnat2why
- -- does not generate Why code.
+ -- d.K SPARK check mode for gnat2why. In this mode, gnat2why does not
+ -- generate Why code.
-- d.L Normally the front end generates special expansion for conditional
-- expressions of a limited type. This debug flag removes this special
diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in
index 2c51a00..067d5a1 100644
--- a/gcc/ada/gcc-interface/Makefile.in
+++ b/gcc/ada/gcc-interface/Makefile.in
@@ -408,6 +408,8 @@ DUMMY_SOCKETS_TARGET_PAIRS = \
# special version of Ada.Strings.Unbounded package can be used.
ATOMICS_TARGET_PAIRS = \
+ a-coinho.adb<a-coinho-shared.adb \
+ a-coinho.ads<a-coinho-shared.ads \
a-stunau.adb<a-stunau-shared.adb \
a-suteio.adb<a-suteio-shared.adb \
a-strunb.ads<a-strunb-shared.ads \
@@ -1581,6 +1583,13 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(target_
LIBRARY_VERSION := $(subst .,_,$(LIB_VERSION))
endif
+# PikeOS
+ifeq ($(strip $(filter-out powerpc% %86 sysgo pikeos,$(target_cpu) $(target_vendor) $(target_os)))),)
+ TOOLS_TARGET_PAIRS=\
+ mlib-tgt-specific.adb<mlib-tgt-specific-xi.adb \
+ indepsw.adb<indepsw-gnu.adb
+endif
+
# *-elf, *-eabi or *-eabispe
ifeq ($(strip $(filter-out elf eabi eabispe,$(target_os))),)
TOOLS_TARGET_PAIRS=\
diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb
index 793feb9..68262f4 100644
--- a/gcc/ada/gnatlink.adb
+++ b/gcc/ada/gnatlink.adb
@@ -265,9 +265,7 @@ procedure Gnatlink is
end loop;
Findex2 := File_Name'Last;
- while Findex2 > Findex1
- and then File_Name (Findex2) /= '.'
- loop
+ while Findex2 > Findex1 and then File_Name (Findex2) /= '.' loop
Findex2 := Findex2 - 1;
end loop;
@@ -343,7 +341,8 @@ procedure Gnatlink is
------------------
procedure Process_Args is
- Next_Arg : Integer;
+ Next_Arg : Integer;
+
Skip_Next : Boolean := False;
-- Set to true if the next argument is to be added into the list of
-- linker's argument without parsing it.
@@ -637,8 +636,8 @@ procedure Gnatlink is
Linker_Objects.Table (Linker_Objects.Last) :=
new String'(Arg);
- -- If host object file, record object file
- -- e.g. accept foo.o as well as foo.obj on VMS target
+ -- If host object file, record object file e.g. accept foo.o
+ -- as well as foo.obj on VMS target.
elsif Arg'Length > Get_Object_Suffix.all'Length
and then Arg
@@ -684,8 +683,8 @@ procedure Gnatlink is
and then Linker_Options.Last >= Linker_Options.First
then
Ali_File_Name :=
- new String'(Linker_Options.Table (Linker_Options.First).all &
- ".ali");
+ new String'(Linker_Options.Table (Linker_Options.First).all
+ & ".ali");
end if;
end Process_Args;
@@ -895,6 +894,7 @@ procedure Gnatlink is
procedure Store_File_Context is
use type System.CRTL.long;
+
begin
RB_Next_Line := Next_Line;
RB_Nfirst := Nfirst;
@@ -995,9 +995,10 @@ procedure Gnatlink is
Linker_Objects.Table (Linker_Objects.Last) :=
new String'(Next_Line (Nfirst .. Nlast));
- Link_Bytes := Link_Bytes + Nlast - Nfirst + 2;
-- Nlast - Nfirst + 1, for the size, plus one for the space between
-- each arguments.
+
+ Link_Bytes := Link_Bytes + Nlast - Nfirst + 2;
end loop;
Objs_End := Linker_Objects.Last;
@@ -1127,10 +1128,12 @@ procedure Gnatlink is
elsif Next_Line (Nfirst .. Nlast) = "-ldecgnat"
or else Next_Line (Nfirst .. Nlast) = "-lgnarl"
or else Next_Line (Nfirst .. Nlast) = "-lgnat"
- or else Next_Line
+ or else
+ Next_Line
(1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) =
Shared_Lib ("gnarl")
- or else Next_Line
+ or else
+ Next_Line
(1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) =
Shared_Lib ("gnat")
then
@@ -1138,8 +1141,8 @@ procedure Gnatlink is
-- We will be looking for the static version of the library
-- as it is in the same directory as the shared version.
- if Next_Line (Nlast - Library_Version'Length + 1 .. Nlast)
- = Library_Version
+ if Next_Line (Nlast - Library_Version'Length + 1 .. Nlast) =
+ Library_Version
then
-- Set Last to point to last character before the
-- library version.
@@ -1159,11 +1162,10 @@ procedure Gnatlink is
File_Path : String_Access;
Object_Lib_Extension : constant String :=
- Value (Object_Library_Ext_Ptr);
+ Value (Object_Library_Ext_Ptr);
File_Name : constant String := "lib" &
- Next_Line (Nfirst + 2 .. Last) &
- Object_Lib_Extension;
+ Next_Line (Nfirst + 2 .. Last) & Object_Lib_Extension;
Run_Path_Opt : constant String :=
Value (Run_Path_Option_Ptr);
@@ -1179,9 +1181,9 @@ procedure Gnatlink is
if File_Path /= null then
if GNAT_Static then
- -- If static gnatlib found, explicitly
- -- specify to overcome possible linker
- -- default usage of shared version.
+ -- If static gnatlib found, explicitly specify to
+ -- overcome possible linker default usage of shared
+ -- version.
Linker_Options.Increment_Last;
@@ -1191,9 +1193,9 @@ procedure Gnatlink is
elsif GNAT_Shared then
if Opt.Run_Path_Option then
- -- If shared gnatlib desired, add the
- -- appropriate system specific switch
- -- so that it can be located at runtime.
+ -- If shared gnatlib desired, add appropriate
+ -- system specific switch so that it can be
+ -- located at runtime.
if Run_Path_Opt'Length /= 0 then
@@ -1204,6 +1206,7 @@ procedure Gnatlink is
declare
Path : String (1 .. File_Path'Length + 15);
+
Path_Last : constant Natural :=
File_Path'Length;
@@ -1299,9 +1302,9 @@ procedure Gnatlink is
Run_Path_Opt
then
-- We have found an already
- -- specified run_path_option: we
- -- will add to this switch,
- -- because only one
+ -- specified run_path_option:
+ -- we will add to this
+ -- switch, because only one
-- run_path_option should be
-- specified.
@@ -1378,9 +1381,8 @@ procedure Gnatlink is
end if;
else
- -- If gnatlib library not found, then
- -- add it anyway in case some other
- -- mechanism may find it.
+ -- If gnatlib library not found, then add it anyway in
+ -- case some other mechanism may find it.
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
@@ -1872,8 +1874,9 @@ begin
if Compile_Bind_File then
Bind_Step : declare
Success : Boolean;
- Args : Argument_List
- (1 .. Binder_Options_From_ALI.Last + Binder_Options.Last + 1);
+
+ Args : Argument_List
+ (1 .. Binder_Options_From_ALI.Last + Binder_Options.Last + 1);
begin
for J in 1 .. Binder_Options_From_ALI.Last loop
@@ -1954,8 +1957,7 @@ begin
elsif RTX_RTSS_Kernel_Module_On_Target then
- -- Remove flags not relevant for Microsoft linker and adapt some
- -- others.
+ -- Remove irrelevant flags for Microsoft linker, adapt some others
for J in reverse Linker_Options.First .. Linker_Options.Last loop
@@ -1976,12 +1978,13 @@ begin
-- Replace "-L" by its counterpart "/LIBPATH:" and UNIX "/" by
-- Windows "\".
+
elsif Linker_Options.Table (J) (1 .. 2) = "-L" then
declare
Libpath_Option : constant String_Access := new String'
("/LIBPATH:" &
- Linker_Options.Table (J)
- (3 .. Linker_Options.Table (J).all'Last));
+ Linker_Options.Table
+ (J) (3 .. Linker_Options.Table (J).all'Last));
begin
for Index in 10 .. Libpath_Option'Last loop
if Libpath_Option (Index) = '/' then
@@ -1993,10 +1996,12 @@ begin
end;
-- Replace "-g" by "/DEBUG"
+
elsif Linker_Options.Table (J) (1 .. 2) = "-g" then
Linker_Options.Table (J) := new String'("/DEBUG");
-- Replace "-o" by "/OUT:"
+
elsif Linker_Options.Table (J) (1 .. 2) = "-o" then
Linker_Options.Table (J + 1) := new String'
("/OUT:" & Linker_Options.Table (J + 1).all);
@@ -2007,6 +2012,7 @@ begin
Num_Args := Num_Args - 1;
-- Replace "--stack=" by "/STACK:"
+
elsif Linker_Options.Table (J) (1 .. 8) = "--stack=" then
Linker_Options.Table (J) := new String'
("/STACK:" &
@@ -2014,6 +2020,7 @@ begin
(9 .. Linker_Options.Table (J).all'Last));
-- Replace "-v" by its counterpart "/VERBOSE"
+
elsif Linker_Options.Table (J) (1 .. 2) = "-v" then
Linker_Options.Table (J) := new String'("/VERBOSE");
end if;
@@ -2069,30 +2076,30 @@ begin
end;
end if;
- -- Remove duplicate stack size setting from the Linker_Options
- -- table. The stack setting option "-Xlinker --stack=R,C" can be
- -- found in one line when set by a pragma Linker_Options or in two
- -- lines ("-Xlinker" then "--stack=R,C") when set on the command
- -- line. We also check for the "-Wl,--stack=R" style option.
+ -- Remove duplicate stack size setting from the Linker_Options table.
+ -- The stack setting option "-Xlinker --stack=R,C" can be found
+ -- in one line when set by a pragma Linker_Options or in two lines
+ -- ("-Xlinker" then "--stack=R,C") when set on the command line. We
+ -- also check for the "-Wl,--stack=R" style option.
- -- We must remove the second stack setting option instance
- -- because the one on the command line will always be the first
- -- one. And any subsequent stack setting option will overwrite the
- -- previous one. This is done especially for GNAT/NT where we set
- -- the stack size for tasking programs by a pragma in the NT
- -- specific tasking package System.Task_Primitives.Operations.
+ -- We must remove the second stack setting option instance because
+ -- the one on the command line will always be the first one. And any
+ -- subsequent stack setting option will overwrite the previous one.
+ -- This is done especially for GNAT/NT where we set the stack size
+ -- for tasking programs by a pragma in the NT specific tasking
+ -- package System.Task_Primitives.Operations.
-- Note: This is not a FOR loop that runs from Linker_Options.First
-- to Linker_Options.Last, since operations within the loop can
-- modify the length of the table.
Clean_Link_Option_Set : declare
- J : Natural := Linker_Options.First;
+ J : Natural;
Shared_Libgcc_Seen : Boolean := False;
begin
+ J := Linker_Options.First;
while J <= Linker_Options.Last loop
-
if Linker_Options.Table (J).all = "-Xlinker"
and then J < Linker_Options.Last
and then Linker_Options.Table (J + 1)'Length > 8
@@ -2128,12 +2135,12 @@ begin
-- pragma Linker_Options set in the NT runtime.
if (Linker_Options.Table (J)'Length > 17
- and then Linker_Options.Table (J) (1 .. 17)
- = "-Xlinker --stack=")
+ and then Linker_Options.Table (J) (1 .. 17) =
+ "-Xlinker --stack=")
or else
(Linker_Options.Table (J)'Length > 12
- and then Linker_Options.Table (J) (1 .. 12)
- = "-Wl,--stack=")
+ and then Linker_Options.Table (J) (1 .. 12) =
+ "-Wl,--stack=")
then
if Stack_Op then
Linker_Options.Table (J .. Linker_Options.Last - 1) :=
@@ -2245,8 +2252,7 @@ begin
Write_Eol;
for J in
- Response_File_Objects.First ..
- Response_File_Objects.Last
+ Response_File_Objects.First .. Response_File_Objects.Last
loop
Write_Str (Response_File_Objects.Table (J).all);
Write_Eol;
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 605dc89e..42b1369 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1734,12 +1734,12 @@ package Opt is
Ada_Version_Config : Ada_Version_Type;
-- GNAT
-- This is the value of the configuration switch for the Ada 83 mode, as
- -- set by the command line switches -gnat83/95/05, and possibly modified by
- -- the use of configuration pragmas Ada_*. This switch is used to set the
- -- initial value for Ada_Version mode at the start of analysis of a unit.
- -- Note however that the setting of this flag is ignored for internal and
- -- predefined units (which are always compiled in the most up to date
- -- version of Ada).
+ -- set by the command line switches -gnat83/95/2005/2012, and possibly
+ -- modified by the use of configuration pragmas Ada_*. This switch is used
+ -- to set the initial value for Ada_Version mode at the start of analysis
+ -- of a unit. Note however that the setting of this flag is ignored for
+ -- internal and predefined units (which are always compiled in the most up
+ -- to date version of Ada).
Ada_Version_Pragma_Config : Node_Id;
-- This will be set non empty if it is set by a configuration pragma
diff --git a/gcc/ada/s-atocou-builtin.adb b/gcc/ada/s-atocou-builtin.adb
index f230721..5e31c18 100644
--- a/gcc/ada/s-atocou-builtin.adb
+++ b/gcc/ada/s-atocou-builtin.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2011, AdaCore --
+-- Copyright (C) 2011-2013, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -72,6 +72,15 @@ package body System.Atomic_Counters is
Sync_Add_And_Fetch (Item.Value'Unrestricted_Access, 1);
end Increment;
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize (Item : out Atomic_Counter) is
+ begin
+ Item.Value := 1;
+ end Initialize;
+
------------
-- Is_One --
------------
diff --git a/gcc/ada/s-atocou-x86.adb b/gcc/ada/s-atocou-x86.adb
index bd02c35..2281e10 100644
--- a/gcc/ada/s-atocou-x86.adb
+++ b/gcc/ada/s-atocou-x86.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2011, AdaCore --
+-- Copyright (C) 2011-2013, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -74,6 +74,15 @@ package body System.Atomic_Counters is
Volatile => True);
end Increment;
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize (Item : out Atomic_Counter) is
+ begin
+ Item.Value := 1;
+ end Initialize;
+
------------
-- Is_One --
------------
diff --git a/gcc/ada/s-atocou.adb b/gcc/ada/s-atocou.adb
index 8f2ca01..8650fe7 100644
--- a/gcc/ada/s-atocou.adb
+++ b/gcc/ada/s-atocou.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2011, AdaCore --
+-- Copyright (C) 2011-2013, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -57,6 +57,15 @@ package body System.Atomic_Counters is
raise Program_Error;
end Increment;
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize (Item : out Atomic_Counter) is
+ begin
+ raise Program_Error;
+ end Initialize;
+
------------
-- Is_One --
------------
diff --git a/gcc/ada/s-atocou.ads b/gcc/ada/s-atocou.ads
index cad18d2..fc2fd43 100644
--- a/gcc/ada/s-atocou.ads
+++ b/gcc/ada/s-atocou.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2011, AdaCore --
+-- Copyright (C) 2011-2013, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -65,6 +65,12 @@ package System.Atomic_Counters is
pragma Inline_Always (Is_One);
-- Returns True when value of the atomic counter is one.
+ procedure Initialize (Item : out Atomic_Counter);
+ pragma Inline_Always (Initialize);
+ -- Initialize counter by setting its value to one. This subprogram is
+ -- intended to be used in special cases when counter object can't be
+ -- initialized in standard way.
+
private
type Unsigned_32 is mod 2 ** 32;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 165df61..25ba327 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3654,9 +3654,11 @@ package body Sem_Prag is
elsif Nkind (PO) = N_Compilation_Unit_Aux then
-- In formal verification mode, analyze pragma expression for
- -- correctness, as it is not expanded later.
+ -- correctness, as it is not expanded later. Ditto in ASIS_Mode
+ -- where there is no later point at which the aspect will be
+ -- analyzed.
- if SPARK_Mode then
+ if SPARK_Mode or else ASIS_Mode then
Analyze_PPC_In_Decl_Part
(N, Defining_Entity (Unit (Parent (PO))));
end if;
@@ -10110,9 +10112,7 @@ package body Sem_Prag is
-- Contract_Cases --
--------------------
- -- pragma Contract_Cases (CONTRACT_CASE_LIST);
-
- -- CONTRACT_CASE_LIST ::= CONTRACT_CASE {, CONTRACT_CASE}
+ -- pragma Contract_Cases ((CONTRACT_CASE {, CONTRACT_CASE));
-- CONTRACT_CASE ::= CASE_GUARD => CONSEQUENCE