[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
This commit is contained in:
Arnaud Charlet
parent
cd38efa560
commit
0c5dba7ff5
12 changed files with 625 additions and 76 deletions
|
|
@ -1,3 +1,35 @@
|
|||
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.
|
||||
|
|
|
|||
358
gcc/ada/a-coinho-shared.adb
Normal file
358
gcc/ada/a-coinho-shared.adb
Normal file
|
|
@ -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;
|
||||
115
gcc/ada/a-coinho-shared.ads
Normal file
115
gcc/ada/a-coinho-shared.ads
Normal file
|
|
@ -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;
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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=\
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 --
|
||||
------------
|
||||
|
|
|
|||
|
|
@ -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 --
|
||||
------------
|
||||
|
|
|
|||
|
|
@ -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 --
|
||||
------------
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue