diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-10-10 12:47:59 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-10-10 12:47:59 +0200 |
commit | 0c5dba7ff5ca748346488e651641e4b93eb53a17 (patch) | |
tree | aef1bc519fb72a6d3e5a3e8a0d806e1fdf2b1d32 /gcc/ada | |
parent | cd38efa560f565cb02cba62fe919e591dc110b74 (diff) | |
download | gcc-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/ChangeLog | 32 | ||||
-rw-r--r-- | gcc/ada/a-coinho-shared.adb | 358 | ||||
-rw-r--r-- | gcc/ada/a-coinho-shared.ads | 115 | ||||
-rw-r--r-- | gcc/ada/debug.adb | 12 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/Makefile.in | 9 | ||||
-rw-r--r-- | gcc/ada/gnatlink.adb | 112 | ||||
-rw-r--r-- | gcc/ada/opt.ads | 12 | ||||
-rw-r--r-- | gcc/ada/s-atocou-builtin.adb | 11 | ||||
-rw-r--r-- | gcc/ada/s-atocou-x86.adb | 11 | ||||
-rw-r--r-- | gcc/ada/s-atocou.adb | 11 | ||||
-rw-r--r-- | gcc/ada/s-atocou.ads | 8 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 10 |
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 |