+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.
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- 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
-- 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
-- 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
# 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 \
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=\
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;
------------------
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.
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
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;
procedure Store_File_Context is
use type System.CRTL.long;
+
begin
RB_Next_Line := Next_Line;
RB_Nfirst := Nfirst;
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;
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
-- 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.
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);
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;
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
declare
Path : String (1 .. File_Path'Length + 15);
+
Path_Last : constant Natural :=
File_Path'Length;
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.
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) :=
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
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
-- 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
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);
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:" &
(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;
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
-- 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) :=
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;
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
-- --
-- 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- --
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 --
------------
-- --
-- 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- --
Volatile => True);
end Increment;
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize (Item : out Atomic_Counter) is
+ begin
+ Item.Value := 1;
+ end Initialize;
+
------------
-- Is_One --
------------
-- --
-- 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- --
raise Program_Error;
end Increment;
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize (Item : out Atomic_Counter) is
+ begin
+ raise Program_Error;
+ end Initialize;
+
------------
-- Is_One --
------------
-- --
-- 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- --
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;
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;
-- 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
projects / thirdparty / gcc.git / commitdiff
