+2011-08-04 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch7.adb: Minor reformatting.
+
+2011-08-04 Robert Dewar <dewar@adacore.com>
+
+ * exp_strm.adb: Minor reformatting.
+
+2011-08-04 Vadim Godunko <godunko@adacore.com>
+
+ * s-atocou.adb: Replace by dummy version and use on targets where atomic
+ operations are not supported.
+ * s-atocou-builtin.adb: Renamed from s-atocou.adb.
+ * s-atocou-x86.adb: New file.
+ * Makefile.rtl: Add s-atocou.o file
+
+2011-08-04 Arnaud Charlet <charlet@adacore.com>
+
+ * make.adb (Compile): Move setting of CodePeer_Mode to ...
+ (Compilation_Phase): ... here.
+ (Scan_Make_Arg): Now bind and link by default in CodePeer mode.
+
+2011-08-04 Thomas Quinot <quinot@adacore.com>
+
+ * Make-generated.in: Fix minor typo in comment.
+
2011-08-04 Thomas Quinot <quinot@adacore.com>
* gnatls.adb: Use Prj.Env.Initialize_Default_Project_Path to retrieve
./s-oscons-tmplt.exe > s-oscons-tmplt.s
else
-# GCC_FOR_TARGET has paths relative to the gcc directory, so we need to ajust
+# GCC_FOR_TARGET has paths relative to the gcc directory, so we need to adjust
# for running it from $(ADA_GEN_SUBDIR)/bldtools/oscons
OSCONS_CC=`echo "$(GCC_FOR_TARGET)" \
| sed -e 's^\./xgcc^../../../xgcc^' -e 's^-B./^-B../../../^'`
s-arit64$(objext) \
s-assert$(objext) \
s-atacco$(objext) \
+ s-atocou$(objext) \
s-auxdec$(objext) \
s-bitops$(objext) \
s-boarop$(objext) \
-- object.
Has_Tagged_Types : Boolean := False;
- -- A general flag which denotes whether N has at least one library-level
- -- tagged type declaration.
+ -- A general flag which indicates whether N has at least one library-
+ -- level tagged type declaration.
HSS : Node_Id := Empty;
-- The sequence of statements of N (if available)
then
Last_Top_Level_Ctrl_Construct := Decl;
end if;
+
else
Process_Tagged_Type_Declaration (Decl);
end if;
then
Last_Top_Level_Ctrl_Construct := Decl;
end if;
+
else
Process_Object_Declaration (Decl, Has_No_Init, Is_Protected);
end if;
-- cases, the finalizer must be created and carry the additional
-- statements.
- if Acts_As_Clean
- or else Has_Ctrl_Objs
- or else Has_Tagged_Types
- then
+ if Acts_As_Clean or Has_Ctrl_Objs or Has_Tagged_Types then
Build_Components;
end if;
-- The preprocessing has determined that the context has controlled
-- objects or library-level tagged types.
- if Has_Ctrl_Objs
- or else Has_Tagged_Types
- then
+ if Has_Ctrl_Objs or Has_Tagged_Types then
+
-- Private declarations are processed first in order to preserve
-- possible dependencies between public and private objects.
-- cases, the finalizer must be created and carry the additional
-- statements.
- if Acts_As_Clean
- or else Has_Ctrl_Objs
- or else Has_Tagged_Types
- then
+ if Acts_As_Clean or Has_Ctrl_Objs or Has_Tagged_Types then
Build_Components;
end if;
- if Has_Ctrl_Objs
- or else Has_Tagged_Types
- then
+ if Has_Ctrl_Objs or Has_Tagged_Types then
Process_Declarations (Stmts);
Process_Declarations (Decls);
end if;
-- Step 3: Finalizer creation
- if Acts_As_Clean
- or else Has_Ctrl_Objs
- or else Has_Tagged_Types
- then
+ if Acts_As_Clean or Has_Ctrl_Objs or Has_Tagged_Types then
Create_Finalizer;
end if;
end Build_Finalizer;
begin
Check_Restriction (No_Default_Stream_Attributes, N);
+ -- Are we sure following messages are issued in -gnatc mode ???
+
if Restriction_Active (No_Default_Stream_Attributes) then
Error_Msg_NE
("missing user-defined Input for type&", N, Etype (Targ));
Do_Bind_Step := False;
Do_Link_Step := False;
Syntax_Only := False;
-
- elsif Args (J).all = "-gnatC"
- or else Args (J).all = "-gnatcC"
- then
- -- If we compile with -gnatC, enable CodePeer globalize step
-
- CodePeer_Mode := True;
end if;
end loop;
return;
end if;
- -- If the objects were up-to-date check if the executable file
- -- is also up-to-date. For now always bind and link on the JVM
- -- since there is currently no simple way to check whether
- -- objects are up-to-date.
+ -- If the objects were up-to-date check if the executable file is also
+ -- up-to-date. For now always bind and link on the JVM since there is
+ -- currently no simple way to check whether objects are up-to-date wrt
+ -- the executable. Similarly in CodePeer mode where there is no
+ -- executable.
if Targparm.VM_Target /= JVM_Target
+ and then not CodePeer_Mode
and then First_Compiled_File = No_File
then
Executable_Stamp := File_Stamp (Executable);
Operating_Mode := Check_Semantics;
Check_Object_Consistency := False;
- if not CodePeer_Mode
- and then (Argv'Last < 7 or else Argv (7) /= 'C')
- then
+ if Argv'Last >= 7 and then Argv (7) = 'C' then
+ CodePeer_Mode := True;
+ else
Compile_Only := True;
Do_Bind_Step := False;
Do_Link_Step := False;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . A T O M I C _ C O U N T E R S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2011, 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- --
+-- 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/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides implementation of atomic counter for platforms where
+-- GCC supports __sync_add_and_fetch_4 and __sync_sub_and_fetch_4 builtins.
+
+package body System.Atomic_Counters is
+
+ procedure Sync_Add_And_Fetch
+ (Ptr : access Unsigned_32;
+ Value : Unsigned_32);
+ pragma Import (Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");
+
+ function Sync_Sub_And_Fetch
+ (Ptr : access Unsigned_32;
+ Value : Unsigned_32) return Unsigned_32;
+ pragma Import (Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");
+
+ ---------------
+ -- Decrement --
+ ---------------
+
+ function Decrement (Item : in out Atomic_Counter) return Boolean is
+ begin
+ return Sync_Sub_And_Fetch (Item.Value'Access, 1) = 0;
+ end Decrement;
+
+ ---------------
+ -- Increment --
+ ---------------
+
+ procedure Increment (Item : in out Atomic_Counter) is
+ begin
+ Sync_Add_And_Fetch (Item.Value'Access, 1);
+ end Increment;
+
+ ------------
+ -- Is_One --
+ ------------
+
+ function Is_One (Item : Atomic_Counter) return Boolean is
+ begin
+ return Item.Value = 1;
+ end Is_One;
+
+end System.Atomic_Counters;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . A T O M I C _ C O U N T E R S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2011, 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- --
+-- 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/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This implementation of the package for x86 processor. GCC can't generate
+-- code for atomic builtins for 386 CPU there only increment/decrement
+-- instructions are supported, thus implementaton use assembler code.
+
+with System.Machine_Code;
+
+package body System.Atomic_Counters is
+
+ ---------------
+ -- Decrement --
+ ---------------
+
+ function Decrement (Item : in out Atomic_Counter) return Boolean is
+ Aux : Boolean;
+
+ begin
+ System.Machine_Code.Asm
+ (Template =>
+ "lock decl" & ASCII.HT & "%0" & ASCII.LF & ASCII.HT
+ & "sete %1",
+ Outputs =>
+ (Unsigned_32'Asm_Output ("=m", Item.Value),
+ Boolean'Asm_Output ("=rm", Aux)),
+ Inputs => Unsigned_32'Asm_Input ("m", Item.Value),
+ Volatile => True);
+
+ return Aux;
+ end Decrement;
+
+ ---------------
+ -- Increment --
+ ---------------
+
+ procedure Increment (Item : in out Atomic_Counter) is
+ begin
+ System.Machine_Code.Asm
+ (Template => "lock incl" & ASCII.HT & "%0",
+ Outputs => Unsigned_32'Asm_Output ("=m", Item.Value),
+ Inputs => Unsigned_32'Asm_Input ("m", Item.Value),
+ Volatile => True);
+ end Increment;
+
+ ------------
+ -- Is_One --
+ ------------
+
+ function Is_One (Item : Atomic_Counter) return Boolean is
+ begin
+ return Item.Value = 1;
+ end Is_One;
+
+end System.Atomic_Counters;
-- --
------------------------------------------------------------------------------
--- This package provides implementation of atomic counter for platforms where
--- GCC supports __sync_add_and_fetch_4 and __sync_sub_and_fetch_4 builtins.
+-- This is dummy version of the package.
package body System.Atomic_Counters is
- procedure Sync_Add_And_Fetch
- (Ptr : access Unsigned_32;
- Value : Unsigned_32);
- pragma Import (Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");
-
- function Sync_Sub_And_Fetch
- (Ptr : access Unsigned_32;
- Value : Unsigned_32) return Unsigned_32;
- pragma Import (Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");
-
---------------
-- Decrement --
---------------
function Decrement (Item : in out Atomic_Counter) return Boolean is
begin
- return Sync_Sub_And_Fetch (Item.Value'Access, 1) = 0;
+ raise Program_Error;
+ return False;
end Decrement;
---------------
procedure Increment (Item : in out Atomic_Counter) is
begin
- Sync_Add_And_Fetch (Item.Value'Access, 1);
+ raise Program_Error;
end Increment;
------------
function Is_One (Item : Atomic_Counter) return Boolean is
begin
- return Item.Value = 1;
+ raise Program_Error;
+ return False;
end Is_One;
end System.Atomic_Counters;