Skip to content

R
riscv-gcc-1
Commit 0c5dba7f by Arnaud Charlet
Options

[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
parent cd38efa5
Showing with 625 additions and 76 deletions
gcc/ada/ChangeLog
2013-10-10 Robert Dewar <dewar@adacore.com> 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. * sem_ch3.adb: Minor reformatting.
2013-10-10 Robert Dewar <dewar@adacore.com> 2013-10-10 Robert Dewar <dewar@adacore.com>
......
gcc/ada/a-coinho-shared.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/a-coinho-shared.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/debug.adb
...@@ -122,13 +122,13 @@ package body Debug is ...@@ -122,13 +122,13 @@ package body Debug is
-- d.B -- d.B
-- d.C Generate concatenation call, do not generate inline code -- d.C Generate concatenation call, do not generate inline code
-- d.D SPARK strict mode -- d.D SPARK strict mode
-- d.E Force SPARK mode for gnat2why -- d.E
-- d.F SPARK mode -- d.F SPARK mode
-- d.G Frame condition mode for gnat2why -- d.G Frame condition mode for gnat2why
-- d.H Standard package only mode for gnat2why -- d.H Standard package only mode for gnat2why
-- d.I Do not ignore enum representation clauses in CodePeer mode -- d.I Do not ignore enum representation clauses in CodePeer mode
-- d.J Disable parallel SCIL generation 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.L Depend on back end for limited types in if and case expressions
-- d.M Relaxed RM semantics -- d.M Relaxed RM semantics
-- d.N Add node to all entities -- d.N Add node to all entities
...@@ -597,10 +597,6 @@ package body Debug is ...@@ -597,10 +597,6 @@ package body Debug is
-- d.D SPARK strict mode. Interpret compiler permissions as strictly as -- d.D SPARK strict mode. Interpret compiler permissions as strictly as
-- possible in SPARK mode. -- 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 -- d.F SPARK mode. Generate AST in a form suitable for formal
-- verification, as well as additional cross reference information in -- verification, as well as additional cross reference information in
-- ALI files to compute effects of subprograms. Note that ALI files -- ALI files to compute effects of subprograms. Note that ALI files
...@@ -624,8 +620,8 @@ package body Debug is ...@@ -624,8 +620,8 @@ package body Debug is
-- done in parallel to speed processing. This switch disables this -- done in parallel to speed processing. This switch disables this
-- behavior. -- behavior.
-- d.K SPARK detection only mode for gnat2why. In this mode, gnat2why -- d.K SPARK check mode for gnat2why. In this mode, gnat2why does not
-- does not generate Why code. -- generate Why code.
-- d.L Normally the front end generates special expansion for conditional -- d.L Normally the front end generates special expansion for conditional
-- expressions of a limited type. This debug flag removes this special -- expressions of a limited type. This debug flag removes this special
......
gcc/ada/gcc-interface/Makefile.in
...@@ -408,6 +408,8 @@ DUMMY_SOCKETS_TARGET_PAIRS = \ ...@@ -408,6 +408,8 @@ DUMMY_SOCKETS_TARGET_PAIRS = \
# special version of Ada.Strings.Unbounded package can be used. # special version of Ada.Strings.Unbounded package can be used.
ATOMICS_TARGET_PAIRS = \ 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-stunau.adb<a-stunau-shared.adb \
a-suteio.adb<a-suteio-shared.adb \ a-suteio.adb<a-suteio-shared.adb \
a-strunb.ads<a-strunb-shared.ads \ a-strunb.ads<a-strunb-shared.ads \
...@@ -1581,6 +1583,13 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(target_ ...@@ -1581,6 +1583,13 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(target_
LIBRARY_VERSION := $(subst .,_,$(LIB_VERSION)) LIBRARY_VERSION := $(subst .,_,$(LIB_VERSION))
endif 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 # *-elf, *-eabi or *-eabispe
ifeq ($(strip $(filter-out elf eabi eabispe,$(target_os))),) ifeq ($(strip $(filter-out elf eabi eabispe,$(target_os))),)
TOOLS_TARGET_PAIRS=\ TOOLS_TARGET_PAIRS=\
......
gcc/ada/gnatlink.adb
...@@ -265,9 +265,7 @@ procedure Gnatlink is ...@@ -265,9 +265,7 @@ procedure Gnatlink is
end loop; end loop;
Findex2 := File_Name'Last; Findex2 := File_Name'Last;
while Findex2 > Findex1 while Findex2 > Findex1 and then File_Name (Findex2) /= '.' loop
and then File_Name (Findex2) /= '.'
loop
Findex2 := Findex2 - 1; Findex2 := Findex2 - 1;
end loop; end loop;
...@@ -343,7 +341,8 @@ procedure Gnatlink is ...@@ -343,7 +341,8 @@ procedure Gnatlink is
------------------ ------------------
procedure Process_Args is procedure Process_Args is
Next_Arg : Integer; Next_Arg : Integer;
Skip_Next : Boolean := False; Skip_Next : Boolean := False;
-- Set to true if the next argument is to be added into the list of -- Set to true if the next argument is to be added into the list of
-- linker's argument without parsing it. -- linker's argument without parsing it.
...@@ -637,8 +636,8 @@ procedure Gnatlink is ...@@ -637,8 +636,8 @@ procedure Gnatlink is
Linker_Objects.Table (Linker_Objects.Last) := Linker_Objects.Table (Linker_Objects.Last) :=
new String'(Arg); new String'(Arg);
-- If host object file, record object file -- If host object file, record object file e.g. accept foo.o
-- e.g. accept foo.o as well as foo.obj on VMS target -- as well as foo.obj on VMS target.
elsif Arg'Length > Get_Object_Suffix.all'Length elsif Arg'Length > Get_Object_Suffix.all'Length
and then Arg and then Arg
...@@ -684,8 +683,8 @@ procedure Gnatlink is ...@@ -684,8 +683,8 @@ procedure Gnatlink is
and then Linker_Options.Last >= Linker_Options.First and then Linker_Options.Last >= Linker_Options.First
then then
Ali_File_Name := Ali_File_Name :=
new String'(Linker_Options.Table (Linker_Options.First).all & new String'(Linker_Options.Table (Linker_Options.First).all
".ali"); & ".ali");
end if; end if;
end Process_Args; end Process_Args;
...@@ -895,6 +894,7 @@ procedure Gnatlink is ...@@ -895,6 +894,7 @@ procedure Gnatlink is
procedure Store_File_Context is procedure Store_File_Context is
use type System.CRTL.long; use type System.CRTL.long;
begin begin
RB_Next_Line := Next_Line; RB_Next_Line := Next_Line;
RB_Nfirst := Nfirst; RB_Nfirst := Nfirst;
...@@ -995,9 +995,10 @@ procedure Gnatlink is ...@@ -995,9 +995,10 @@ procedure Gnatlink is
Linker_Objects.Table (Linker_Objects.Last) := Linker_Objects.Table (Linker_Objects.Last) :=
new String'(Next_Line (Nfirst .. Nlast)); 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 -- Nlast - Nfirst + 1, for the size, plus one for the space between
-- each arguments. -- each arguments.
Link_Bytes := Link_Bytes + Nlast - Nfirst + 2;
end loop; end loop;
Objs_End := Linker_Objects.Last; Objs_End := Linker_Objects.Last;
...@@ -1127,10 +1128,12 @@ procedure Gnatlink is ...@@ -1127,10 +1128,12 @@ procedure Gnatlink is
elsif Next_Line (Nfirst .. Nlast) = "-ldecgnat" elsif Next_Line (Nfirst .. Nlast) = "-ldecgnat"
or else Next_Line (Nfirst .. Nlast) = "-lgnarl" or else Next_Line (Nfirst .. Nlast) = "-lgnarl"
or else Next_Line (Nfirst .. Nlast) = "-lgnat" or else Next_Line (Nfirst .. Nlast) = "-lgnat"
or else Next_Line or else
Next_Line
(1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) = (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) =
Shared_Lib ("gnarl") Shared_Lib ("gnarl")
or else Next_Line or else
Next_Line
(1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) = (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) =
Shared_Lib ("gnat") Shared_Lib ("gnat")
then then
...@@ -1138,8 +1141,8 @@ procedure Gnatlink is ...@@ -1138,8 +1141,8 @@ procedure Gnatlink is
-- We will be looking for the static version of the library -- We will be looking for the static version of the library
-- as it is in the same directory as the shared version. -- as it is in the same directory as the shared version.
if Next_Line (Nlast - Library_Version'Length + 1 .. Nlast) if Next_Line (Nlast - Library_Version'Length + 1 .. Nlast) =
= Library_Version Library_Version
then then
-- Set Last to point to last character before the -- Set Last to point to last character before the
-- library version. -- library version.
...@@ -1159,11 +1162,10 @@ procedure Gnatlink is ...@@ -1159,11 +1162,10 @@ procedure Gnatlink is
File_Path : String_Access; File_Path : String_Access;
Object_Lib_Extension : constant String := Object_Lib_Extension : constant String :=
Value (Object_Library_Ext_Ptr); Value (Object_Library_Ext_Ptr);
File_Name : constant String := "lib" & File_Name : constant String := "lib" &
Next_Line (Nfirst + 2 .. Last) & Next_Line (Nfirst + 2 .. Last) & Object_Lib_Extension;
Object_Lib_Extension;
Run_Path_Opt : constant String := Run_Path_Opt : constant String :=
Value (Run_Path_Option_Ptr); Value (Run_Path_Option_Ptr);
...@@ -1179,9 +1181,9 @@ procedure Gnatlink is ...@@ -1179,9 +1181,9 @@ procedure Gnatlink is
if File_Path /= null then if File_Path /= null then
if GNAT_Static then if GNAT_Static then
-- If static gnatlib found, explicitly -- If static gnatlib found, explicitly specify to
-- specify to overcome possible linker -- overcome possible linker default usage of shared
-- default usage of shared version. -- version.
Linker_Options.Increment_Last; Linker_Options.Increment_Last;
...@@ -1191,9 +1193,9 @@ procedure Gnatlink is ...@@ -1191,9 +1193,9 @@ procedure Gnatlink is
elsif GNAT_Shared then elsif GNAT_Shared then
if Opt.Run_Path_Option then if Opt.Run_Path_Option then
-- If shared gnatlib desired, add the -- If shared gnatlib desired, add appropriate
-- appropriate system specific switch -- system specific switch so that it can be
-- so that it can be located at runtime. -- located at runtime.
if Run_Path_Opt'Length /= 0 then if Run_Path_Opt'Length /= 0 then
...@@ -1204,6 +1206,7 @@ procedure Gnatlink is ...@@ -1204,6 +1206,7 @@ procedure Gnatlink is
declare declare
Path : String (1 .. File_Path'Length + 15); Path : String (1 .. File_Path'Length + 15);
Path_Last : constant Natural := Path_Last : constant Natural :=
File_Path'Length; File_Path'Length;
...@@ -1299,9 +1302,9 @@ procedure Gnatlink is ...@@ -1299,9 +1302,9 @@ procedure Gnatlink is
Run_Path_Opt Run_Path_Opt
then then
-- We have found an already -- We have found an already
-- specified run_path_option: we -- specified run_path_option:
-- will add to this switch, -- we will add to this
-- because only one -- switch, because only one
-- run_path_option should be -- run_path_option should be
-- specified. -- specified.
...@@ -1378,9 +1381,8 @@ procedure Gnatlink is ...@@ -1378,9 +1381,8 @@ procedure Gnatlink is
end if; end if;
else else
-- If gnatlib library not found, then -- If gnatlib library not found, then add it anyway in
-- add it anyway in case some other -- case some other mechanism may find it.
-- mechanism may find it.
Linker_Options.Increment_Last; Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) := Linker_Options.Table (Linker_Options.Last) :=
...@@ -1872,8 +1874,9 @@ begin ...@@ -1872,8 +1874,9 @@ begin
if Compile_Bind_File then if Compile_Bind_File then
Bind_Step : declare Bind_Step : declare
Success : Boolean; 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 begin
for J in 1 .. Binder_Options_From_ALI.Last loop for J in 1 .. Binder_Options_From_ALI.Last loop
...@@ -1954,8 +1957,7 @@ begin ...@@ -1954,8 +1957,7 @@ begin
elsif RTX_RTSS_Kernel_Module_On_Target then elsif RTX_RTSS_Kernel_Module_On_Target then
-- Remove flags not relevant for Microsoft linker and adapt some -- Remove irrelevant flags for Microsoft linker, adapt some others
-- others.
for J in reverse Linker_Options.First .. Linker_Options.Last loop for J in reverse Linker_Options.First .. Linker_Options.Last loop
...@@ -1976,12 +1978,13 @@ begin ...@@ -1976,12 +1978,13 @@ begin
-- Replace "-L" by its counterpart "/LIBPATH:" and UNIX "/" by -- Replace "-L" by its counterpart "/LIBPATH:" and UNIX "/" by
-- Windows "\". -- Windows "\".
elsif Linker_Options.Table (J) (1 .. 2) = "-L" then elsif Linker_Options.Table (J) (1 .. 2) = "-L" then
declare declare
Libpath_Option : constant String_Access := new String' Libpath_Option : constant String_Access := new String'
("/LIBPATH:" & ("/LIBPATH:" &
Linker_Options.Table (J) Linker_Options.Table
(3 .. Linker_Options.Table (J).all'Last)); (J) (3 .. Linker_Options.Table (J).all'Last));
begin begin
for Index in 10 .. Libpath_Option'Last loop for Index in 10 .. Libpath_Option'Last loop
if Libpath_Option (Index) = '/' then if Libpath_Option (Index) = '/' then
...@@ -1993,10 +1996,12 @@ begin ...@@ -1993,10 +1996,12 @@ begin
end; end;
-- Replace "-g" by "/DEBUG" -- Replace "-g" by "/DEBUG"
elsif Linker_Options.Table (J) (1 .. 2) = "-g" then elsif Linker_Options.Table (J) (1 .. 2) = "-g" then
Linker_Options.Table (J) := new String'("/DEBUG"); Linker_Options.Table (J) := new String'("/DEBUG");
-- Replace "-o" by "/OUT:" -- Replace "-o" by "/OUT:"
elsif Linker_Options.Table (J) (1 .. 2) = "-o" then elsif Linker_Options.Table (J) (1 .. 2) = "-o" then
Linker_Options.Table (J + 1) := new String' Linker_Options.Table (J + 1) := new String'
("/OUT:" & Linker_Options.Table (J + 1).all); ("/OUT:" & Linker_Options.Table (J + 1).all);
...@@ -2007,6 +2012,7 @@ begin ...@@ -2007,6 +2012,7 @@ begin
Num_Args := Num_Args - 1; Num_Args := Num_Args - 1;
-- Replace "--stack=" by "/STACK:" -- Replace "--stack=" by "/STACK:"
elsif Linker_Options.Table (J) (1 .. 8) = "--stack=" then elsif Linker_Options.Table (J) (1 .. 8) = "--stack=" then
Linker_Options.Table (J) := new String' Linker_Options.Table (J) := new String'
("/STACK:" & ("/STACK:" &
...@@ -2014,6 +2020,7 @@ begin ...@@ -2014,6 +2020,7 @@ begin
(9 .. Linker_Options.Table (J).all'Last)); (9 .. Linker_Options.Table (J).all'Last));
-- Replace "-v" by its counterpart "/VERBOSE" -- Replace "-v" by its counterpart "/VERBOSE"
elsif Linker_Options.Table (J) (1 .. 2) = "-v" then elsif Linker_Options.Table (J) (1 .. 2) = "-v" then
Linker_Options.Table (J) := new String'("/VERBOSE"); Linker_Options.Table (J) := new String'("/VERBOSE");
end if; end if;
...@@ -2069,30 +2076,30 @@ begin ...@@ -2069,30 +2076,30 @@ begin
end; end;
end if; end if;
-- Remove duplicate stack size setting from the Linker_Options -- Remove duplicate stack size setting from the Linker_Options table.
-- table. The stack setting option "-Xlinker --stack=R,C" can be -- The stack setting option "-Xlinker --stack=R,C" can be found
-- found in one line when set by a pragma Linker_Options or in two -- in one line when set by a pragma Linker_Options or in two lines
-- lines ("-Xlinker" then "--stack=R,C") when set on the command -- ("-Xlinker" then "--stack=R,C") when set on the command line. We
-- line. We also check for the "-Wl,--stack=R" style option. -- also check for the "-Wl,--stack=R" style option.
-- We must remove the second stack setting option instance -- We must remove the second stack setting option instance because
-- because the one on the command line will always be the first -- the one on the command line will always be the first one. And any
-- one. And any subsequent stack setting option will overwrite the -- subsequent stack setting option will overwrite the previous one.
-- previous one. This is done especially for GNAT/NT where we set -- This is done especially for GNAT/NT where we set the stack size
-- the stack size for tasking programs by a pragma in the NT -- for tasking programs by a pragma in the NT specific tasking
-- specific tasking package System.Task_Primitives.Operations. -- package System.Task_Primitives.Operations.
-- Note: This is not a FOR loop that runs from Linker_Options.First -- Note: This is not a FOR loop that runs from Linker_Options.First
-- to Linker_Options.Last, since operations within the loop can -- to Linker_Options.Last, since operations within the loop can
-- modify the length of the table. -- modify the length of the table.
Clean_Link_Option_Set : declare Clean_Link_Option_Set : declare
J : Natural := Linker_Options.First; J : Natural;
Shared_Libgcc_Seen : Boolean := False; Shared_Libgcc_Seen : Boolean := False;
begin begin
J := Linker_Options.First;
while J <= Linker_Options.Last loop while J <= Linker_Options.Last loop
if Linker_Options.Table (J).all = "-Xlinker" if Linker_Options.Table (J).all = "-Xlinker"
and then J < Linker_Options.Last and then J < Linker_Options.Last
and then Linker_Options.Table (J + 1)'Length > 8 and then Linker_Options.Table (J + 1)'Length > 8
...@@ -2128,12 +2135,12 @@ begin ...@@ -2128,12 +2135,12 @@ begin
-- pragma Linker_Options set in the NT runtime. -- pragma Linker_Options set in the NT runtime.
if (Linker_Options.Table (J)'Length > 17 if (Linker_Options.Table (J)'Length > 17
and then Linker_Options.Table (J) (1 .. 17) and then Linker_Options.Table (J) (1 .. 17) =
= "-Xlinker --stack=") "-Xlinker --stack=")
or else or else
(Linker_Options.Table (J)'Length > 12 (Linker_Options.Table (J)'Length > 12
and then Linker_Options.Table (J) (1 .. 12) and then Linker_Options.Table (J) (1 .. 12) =
= "-Wl,--stack=") "-Wl,--stack=")
then then
if Stack_Op then if Stack_Op then
Linker_Options.Table (J .. Linker_Options.Last - 1) := Linker_Options.Table (J .. Linker_Options.Last - 1) :=
...@@ -2245,8 +2252,7 @@ begin ...@@ -2245,8 +2252,7 @@ begin
Write_Eol; Write_Eol;
for J in for J in
Response_File_Objects.First .. Response_File_Objects.First .. Response_File_Objects.Last
Response_File_Objects.Last
loop loop
Write_Str (Response_File_Objects.Table (J).all); Write_Str (Response_File_Objects.Table (J).all);
Write_Eol; Write_Eol;
......
gcc/ada/opt.ads
...@@ -1734,12 +1734,12 @@ package Opt is ...@@ -1734,12 +1734,12 @@ package Opt is
Ada_Version_Config : Ada_Version_Type; Ada_Version_Config : Ada_Version_Type;
-- GNAT -- GNAT
-- This is the value of the configuration switch for the Ada 83 mode, as -- 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 -- set by the command line switches -gnat83/95/2005/2012, and possibly
-- the use of configuration pragmas Ada_*. This switch is used to set the -- modified by the use of configuration pragmas Ada_*. This switch is used
-- initial value for Ada_Version mode at the start of analysis of a unit. -- to set the initial value for Ada_Version mode at the start of analysis
-- Note however that the setting of this flag is ignored for internal and -- of a unit. Note however that the setting of this flag is ignored for
-- predefined units (which are always compiled in the most up to date -- internal and predefined units (which are always compiled in the most up
-- version of Ada). -- to date version of Ada).
Ada_Version_Pragma_Config : Node_Id; Ada_Version_Pragma_Config : Node_Id;
-- This will be set non empty if it is set by a configuration pragma -- This will be set non empty if it is set by a configuration pragma
......
gcc/ada/s-atocou-builtin.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -72,6 +72,15 @@ package body System.Atomic_Counters is ...@@ -72,6 +72,15 @@ package body System.Atomic_Counters is
Sync_Add_And_Fetch (Item.Value'Unrestricted_Access, 1); Sync_Add_And_Fetch (Item.Value'Unrestricted_Access, 1);
end Increment; end Increment;
----------------
-- Initialize --
----------------
procedure Initialize (Item : out Atomic_Counter) is
begin
Item.Value := 1;
end Initialize;
------------ ------------
-- Is_One -- -- Is_One --
------------ ------------
......
gcc/ada/s-atocou-x86.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -74,6 +74,15 @@ package body System.Atomic_Counters is ...@@ -74,6 +74,15 @@ package body System.Atomic_Counters is
Volatile => True); Volatile => True);
end Increment; end Increment;
----------------
-- Initialize --
----------------
procedure Initialize (Item : out Atomic_Counter) is
begin
Item.Value := 1;
end Initialize;
------------ ------------
-- Is_One -- -- Is_One --
------------ ------------
......
gcc/ada/s-atocou.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -57,6 +57,15 @@ package body System.Atomic_Counters is ...@@ -57,6 +57,15 @@ package body System.Atomic_Counters is
raise Program_Error; raise Program_Error;
end Increment; end Increment;
----------------
-- Initialize --
----------------
procedure Initialize (Item : out Atomic_Counter) is
begin
raise Program_Error;
end Initialize;
------------ ------------
-- Is_One -- -- Is_One --
------------ ------------
......
gcc/ada/s-atocou.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -65,6 +65,12 @@ package System.Atomic_Counters is ...@@ -65,6 +65,12 @@ package System.Atomic_Counters is
pragma Inline_Always (Is_One); pragma Inline_Always (Is_One);
-- Returns True when value of the atomic counter 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 private
type Unsigned_32 is mod 2 ** 32; type Unsigned_32 is mod 2 ** 32;
......
gcc/ada/sem_prag.adb
...@@ -3654,9 +3654,11 @@ package body Sem_Prag is ...@@ -3654,9 +3654,11 @@ package body Sem_Prag is
elsif Nkind (PO) = N_Compilation_Unit_Aux then elsif Nkind (PO) = N_Compilation_Unit_Aux then
-- In formal verification mode, analyze pragma expression for -- 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 Analyze_PPC_In_Decl_Part
(N, Defining_Entity (Unit (Parent (PO)))); (N, Defining_Entity (Unit (Parent (PO))));
end if; end if;
...@@ -10110,9 +10112,7 @@ package body Sem_Prag is ...@@ -10110,9 +10112,7 @@ package body Sem_Prag is
-- Contract_Cases -- -- Contract_Cases --
-------------------- --------------------
-- pragma Contract_Cases (CONTRACT_CASE_LIST); -- pragma Contract_Cases ((CONTRACT_CASE {, CONTRACT_CASE));
-- CONTRACT_CASE_LIST ::= CONTRACT_CASE {, CONTRACT_CASE}
-- CONTRACT_CASE ::= CASE_GUARD => CONSEQUENCE -- CONTRACT_CASE ::= CASE_GUARD => CONSEQUENCE
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment