Commit 0319cacc by Arnaud Charlet

[multiple changes]

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.

From-SVN: r177403
parent 26e7e1a0
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> 2011-08-04 Thomas Quinot <quinot@adacore.com>
* gnatls.adb: Use Prj.Env.Initialize_Default_Project_Path to retrieve * gnatls.adb: Use Prj.Env.Initialize_Default_Project_Path to retrieve
......
...@@ -74,7 +74,7 @@ OSCONS_EXTRACT=../../../$(DECC) -DNATIVE \ ...@@ -74,7 +74,7 @@ OSCONS_EXTRACT=../../../$(DECC) -DNATIVE \
./s-oscons-tmplt.exe > s-oscons-tmplt.s ./s-oscons-tmplt.exe > s-oscons-tmplt.s
else 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 # for running it from $(ADA_GEN_SUBDIR)/bldtools/oscons
OSCONS_CC=`echo "$(GCC_FOR_TARGET)" \ OSCONS_CC=`echo "$(GCC_FOR_TARGET)" \
| sed -e 's^\./xgcc^../../../xgcc^' -e 's^-B./^-B../../../^'` | sed -e 's^\./xgcc^../../../xgcc^' -e 's^-B./^-B../../../^'`
......
...@@ -446,6 +446,7 @@ GNATRTL_NONTASKING_OBJS= \ ...@@ -446,6 +446,7 @@ GNATRTL_NONTASKING_OBJS= \
s-arit64$(objext) \ s-arit64$(objext) \
s-assert$(objext) \ s-assert$(objext) \
s-atacco$(objext) \ s-atacco$(objext) \
s-atocou$(objext) \
s-auxdec$(objext) \ s-auxdec$(objext) \
s-bitops$(objext) \ s-bitops$(objext) \
s-boarop$(objext) \ s-boarop$(objext) \
......
...@@ -1130,8 +1130,8 @@ package body Exp_Ch7 is ...@@ -1130,8 +1130,8 @@ package body Exp_Ch7 is
-- object. -- object.
Has_Tagged_Types : Boolean := False; Has_Tagged_Types : Boolean := False;
-- A general flag which denotes whether N has at least one library-level -- A general flag which indicates whether N has at least one library-
-- tagged type declaration. -- level tagged type declaration.
HSS : Node_Id := Empty; HSS : Node_Id := Empty;
-- The sequence of statements of N (if available) -- The sequence of statements of N (if available)
...@@ -1741,6 +1741,7 @@ package body Exp_Ch7 is ...@@ -1741,6 +1741,7 @@ package body Exp_Ch7 is
then then
Last_Top_Level_Ctrl_Construct := Decl; Last_Top_Level_Ctrl_Construct := Decl;
end if; end if;
else else
Process_Tagged_Type_Declaration (Decl); Process_Tagged_Type_Declaration (Decl);
end if; end if;
...@@ -1757,6 +1758,7 @@ package body Exp_Ch7 is ...@@ -1757,6 +1758,7 @@ package body Exp_Ch7 is
then then
Last_Top_Level_Ctrl_Construct := Decl; Last_Top_Level_Ctrl_Construct := Decl;
end if; end if;
else else
Process_Object_Declaration (Decl, Has_No_Init, Is_Protected); Process_Object_Declaration (Decl, Has_No_Init, Is_Protected);
end if; end if;
...@@ -2774,19 +2776,15 @@ package body Exp_Ch7 is ...@@ -2774,19 +2776,15 @@ package body Exp_Ch7 is
-- cases, the finalizer must be created and carry the additional -- cases, the finalizer must be created and carry the additional
-- statements. -- statements.
if Acts_As_Clean if Acts_As_Clean or Has_Ctrl_Objs or Has_Tagged_Types then
or else Has_Ctrl_Objs
or else Has_Tagged_Types
then
Build_Components; Build_Components;
end if; end if;
-- The preprocessing has determined that the context has controlled -- The preprocessing has determined that the context has controlled
-- objects or library-level tagged types. -- objects or library-level tagged types.
if Has_Ctrl_Objs if Has_Ctrl_Objs or Has_Tagged_Types then
or else Has_Tagged_Types
then
-- Private declarations are processed first in order to preserve -- Private declarations are processed first in order to preserve
-- possible dependencies between public and private objects. -- possible dependencies between public and private objects.
...@@ -2820,16 +2818,11 @@ package body Exp_Ch7 is ...@@ -2820,16 +2818,11 @@ package body Exp_Ch7 is
-- cases, the finalizer must be created and carry the additional -- cases, the finalizer must be created and carry the additional
-- statements. -- statements.
if Acts_As_Clean if Acts_As_Clean or Has_Ctrl_Objs or Has_Tagged_Types then
or else Has_Ctrl_Objs
or else Has_Tagged_Types
then
Build_Components; Build_Components;
end if; end if;
if Has_Ctrl_Objs if Has_Ctrl_Objs or Has_Tagged_Types then
or else Has_Tagged_Types
then
Process_Declarations (Stmts); Process_Declarations (Stmts);
Process_Declarations (Decls); Process_Declarations (Decls);
end if; end if;
...@@ -2837,10 +2830,7 @@ package body Exp_Ch7 is ...@@ -2837,10 +2830,7 @@ package body Exp_Ch7 is
-- Step 3: Finalizer creation -- Step 3: Finalizer creation
if Acts_As_Clean if Acts_As_Clean or Has_Ctrl_Objs or Has_Tagged_Types then
or else Has_Ctrl_Objs
or else Has_Tagged_Types
then
Create_Finalizer; Create_Finalizer;
end if; end if;
end Build_Finalizer; end Build_Finalizer;
......
...@@ -477,6 +477,8 @@ package body Exp_Strm is ...@@ -477,6 +477,8 @@ package body Exp_Strm is
begin begin
Check_Restriction (No_Default_Stream_Attributes, N); 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 if Restriction_Active (No_Default_Stream_Attributes) then
Error_Msg_NE Error_Msg_NE
("missing user-defined Input for type&", N, Etype (Targ)); ("missing user-defined Input for type&", N, Etype (Targ));
......
...@@ -2908,13 +2908,6 @@ package body Make is ...@@ -2908,13 +2908,6 @@ package body Make is
Do_Bind_Step := False; Do_Bind_Step := False;
Do_Link_Step := False; Do_Link_Step := False;
Syntax_Only := 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 if;
end loop; end loop;
...@@ -4879,12 +4872,14 @@ package body Make is ...@@ -4879,12 +4872,14 @@ package body Make is
return; return;
end if; end if;
-- If the objects were up-to-date check if the executable file -- If the objects were up-to-date check if the executable file is also
-- is also up-to-date. For now always bind and link on the JVM -- up-to-date. For now always bind and link on the JVM since there is
-- since there is currently no simple way to check whether -- currently no simple way to check whether objects are up-to-date wrt
-- objects are up-to-date. -- the executable. Similarly in CodePeer mode where there is no
-- executable.
if Targparm.VM_Target /= JVM_Target if Targparm.VM_Target /= JVM_Target
and then not CodePeer_Mode
and then First_Compiled_File = No_File and then First_Compiled_File = No_File
then then
Executable_Stamp := File_Stamp (Executable); Executable_Stamp := File_Stamp (Executable);
...@@ -7838,9 +7833,9 @@ package body Make is ...@@ -7838,9 +7833,9 @@ package body Make is
Operating_Mode := Check_Semantics; Operating_Mode := Check_Semantics;
Check_Object_Consistency := False; Check_Object_Consistency := False;
if not CodePeer_Mode if Argv'Last >= 7 and then Argv (7) = 'C' then
and then (Argv'Last < 7 or else Argv (7) /= 'C') CodePeer_Mode := True;
then else
Compile_Only := True; Compile_Only := True;
Do_Bind_Step := False; Do_Bind_Step := False;
Do_Link_Step := False; Do_Link_Step := False;
......
------------------------------------------------------------------------------
-- --
-- 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;
------------------------------------------------------------------------------
-- --
-- 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;
...@@ -29,28 +29,18 @@ ...@@ -29,28 +29,18 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package provides implementation of atomic counter for platforms where -- This is dummy version of the package.
-- GCC supports __sync_add_and_fetch_4 and __sync_sub_and_fetch_4 builtins.
package body System.Atomic_Counters is 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 -- -- Decrement --
--------------- ---------------
function Decrement (Item : in out Atomic_Counter) return Boolean is function Decrement (Item : in out Atomic_Counter) return Boolean is
begin begin
return Sync_Sub_And_Fetch (Item.Value'Access, 1) = 0; raise Program_Error;
return False;
end Decrement; end Decrement;
--------------- ---------------
...@@ -59,7 +49,7 @@ package body System.Atomic_Counters is ...@@ -59,7 +49,7 @@ package body System.Atomic_Counters is
procedure Increment (Item : in out Atomic_Counter) is procedure Increment (Item : in out Atomic_Counter) is
begin begin
Sync_Add_And_Fetch (Item.Value'Access, 1); raise Program_Error;
end Increment; end Increment;
------------ ------------
...@@ -68,7 +58,8 @@ package body System.Atomic_Counters is ...@@ -68,7 +58,8 @@ package body System.Atomic_Counters is
function Is_One (Item : Atomic_Counter) return Boolean is function Is_One (Item : Atomic_Counter) return Boolean is
begin begin
return Item.Value = 1; raise Program_Error;
return False;
end Is_One; end Is_One;
end System.Atomic_Counters; end System.Atomic_Counters;
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