From 0319cacc3928720fda058dc7e6c60f575169f576 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 4 Aug 2011 17:39:29 +0200 Subject: [PATCH] [multiple changes] 2011-08-04 Robert Dewar * exp_ch7.adb: Minor reformatting. 2011-08-04 Robert Dewar * exp_strm.adb: Minor reformatting. 2011-08-04 Vadim Godunko * 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 * 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 * Make-generated.in: Fix minor typo in comment. From-SVN: r177403 --- gcc/ada/ChangeLog | 26 +++++++++++ gcc/ada/Make-generated.in | 2 +- gcc/ada/Makefile.rtl | 1 + gcc/ada/exp_ch7.adb | 30 +++++-------- gcc/ada/exp_strm.adb | 2 + gcc/ada/make.adb | 23 ++++------ gcc/ada/s-atocou-builtin.adb | 74 ++++++++++++++++++++++++++++++++ gcc/ada/s-atocou-x86.adb | 83 ++++++++++++++++++++++++++++++++++++ gcc/ada/s-atocou.adb | 21 +++------ 9 files changed, 212 insertions(+), 50 deletions(-) create mode 100644 gcc/ada/s-atocou-builtin.adb create mode 100644 gcc/ada/s-atocou-x86.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4611e705ced..2b513970420 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,29 @@ +2011-08-04 Robert Dewar + + * exp_ch7.adb: Minor reformatting. + +2011-08-04 Robert Dewar + + * exp_strm.adb: Minor reformatting. + +2011-08-04 Vadim Godunko + + * 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 + + * 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 + + * Make-generated.in: Fix minor typo in comment. + 2011-08-04 Thomas Quinot * gnatls.adb: Use Prj.Env.Initialize_Default_Project_Path to retrieve diff --git a/gcc/ada/Make-generated.in b/gcc/ada/Make-generated.in index 30ce14e916d..74536191483 100644 --- a/gcc/ada/Make-generated.in +++ b/gcc/ada/Make-generated.in @@ -74,7 +74,7 @@ OSCONS_EXTRACT=../../../$(DECC) -DNATIVE \ ./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../../../^'` diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index a03aeaf48a4..4f5cb48b13d 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -446,6 +446,7 @@ GNATRTL_NONTASKING_OBJS= \ s-arit64$(objext) \ s-assert$(objext) \ s-atacco$(objext) \ + s-atocou$(objext) \ s-auxdec$(objext) \ s-bitops$(objext) \ s-boarop$(objext) \ diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 40499bc7c79..8343d2af0b4 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -1130,8 +1130,8 @@ package body Exp_Ch7 is -- 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) @@ -1741,6 +1741,7 @@ package body Exp_Ch7 is then Last_Top_Level_Ctrl_Construct := Decl; end if; + else Process_Tagged_Type_Declaration (Decl); end if; @@ -1757,6 +1758,7 @@ package body Exp_Ch7 is then Last_Top_Level_Ctrl_Construct := Decl; end if; + else Process_Object_Declaration (Decl, Has_No_Init, Is_Protected); end if; @@ -2774,19 +2776,15 @@ package body Exp_Ch7 is -- 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. @@ -2820,16 +2818,11 @@ package body Exp_Ch7 is -- 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; @@ -2837,10 +2830,7 @@ package body Exp_Ch7 is -- 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; diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index 907c32add5c..cc697bf8270 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -477,6 +477,8 @@ package body Exp_Strm is 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)); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index b2f39de056c..f6f889d3cb0 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -2908,13 +2908,6 @@ package body Make is 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; @@ -4879,12 +4872,14 @@ package body Make is 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); @@ -7838,9 +7833,9 @@ package body Make is 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; diff --git a/gcc/ada/s-atocou-builtin.adb b/gcc/ada/s-atocou-builtin.adb new file mode 100644 index 00000000000..38ef24a202b --- /dev/null +++ b/gcc/ada/s-atocou-builtin.adb @@ -0,0 +1,74 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/s-atocou-x86.adb b/gcc/ada/s-atocou-x86.adb new file mode 100644 index 00000000000..8f0c7fb8e05 --- /dev/null +++ b/gcc/ada/s-atocou-x86.adb @@ -0,0 +1,83 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/s-atocou.adb b/gcc/ada/s-atocou.adb index 38ef24a202b..709d3889e04 100644 --- a/gcc/ada/s-atocou.adb +++ b/gcc/ada/s-atocou.adb @@ -29,28 +29,18 @@ -- -- ------------------------------------------------------------------------------ --- 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; --------------- @@ -59,7 +49,7 @@ package body System.Atomic_Counters is procedure Increment (Item : in out Atomic_Counter) is begin - Sync_Add_And_Fetch (Item.Value'Access, 1); + raise Program_Error; end Increment; ------------ @@ -68,7 +58,8 @@ package body System.Atomic_Counters is 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; -- 2.30.2