Skip to content

R
riscv-gcc-1
Commit 88e7531b by Arnaud Charlet
Options

[multiple changes] 

2012-05-15  Robert Dewar  <dewar@adacore.com>

	* g-comlin.adb, g-comlin.ads: Minor reformatting.

2012-05-15  Vincent Pucci  <pucci@adacore.com>

	* aspects.adb, aspects.adb: Reordering of the Aspect_Idi list. New
	aspect Aspect_Lock_Free.
	* einfo.adb, einfo.ads: New flag Uses_Lock_Free (flag 188).
	(Set_Uses_Lock_Free): New routine.
	(Uses_Lock_Free): New routine.
	* exp_ch7.adb (Is_Simple_Protected_Type): Return False for
	lock-free implementation.
	* exp_ch9.adb (Allows_Lock_Free_Implementation): Moved to Sem_Ch9.
	(Build_Lock_Free_Unprotected_Subprogram_Body): Protected
	procedure uses __sync_synchronise. Check both Object_Size
	and Value_Size.
	(Expand_N_Protected_Body): Lock_Free_Active
	renames Lock_Free_On.
	(Expand_N_Protected_Type_Declaration):
	_Object field removed for lock-free implementation.
	(Install_Private_Data_Declarations): Protection object removed
	for lock-free implementation.
	(Make_Initialize_Protection):
	Protection object initialization removed for lock-free implementation.
	* rtsfind.ads: RE_Atomic_Synchronize and RE_Relaxed added.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Aspect_Lock_Free
	analysis added.
	* sem_ch9.adb (Allows_Lock_Free_Implementation): New routine.
	(Analyze_Protected_Body): Allows_Lock_Free_Implementation call added.
	(Analyze_Protected_Type_Declaration):
	Allows_Lock_Free_Implementation call added.
	(Analyze_Single_Protected_Declaration): Second analysis of
	aspects removed.
	* s-atopri.ads: Header added.
	(Atomic_Synchronize): New routine.

2012-05-15  Robert Dewar  <dewar@adacore.com>

	* exp_ch7.ads: Add comment.

From-SVN: r187505
parent db664118
Showing with 227 additions and 78 deletions
gcc/ada/ChangeLog
2012-05-15 Robert Dewar <dewar@adacore.com>
* g-comlin.adb, g-comlin.ads: Minor reformatting.
2012-05-15 Vincent Pucci <pucci@adacore.com>
* aspects.adb, aspects.adb: Reordering of the Aspect_Idi list. New
aspect Aspect_Lock_Free.
* einfo.adb, einfo.ads: New flag Uses_Lock_Free (flag 188).
(Set_Uses_Lock_Free): New routine.
(Uses_Lock_Free): New routine.
* exp_ch7.adb (Is_Simple_Protected_Type): Return False for
lock-free implementation.
* exp_ch9.adb (Allows_Lock_Free_Implementation): Moved to Sem_Ch9.
(Build_Lock_Free_Unprotected_Subprogram_Body): Protected
procedure uses __sync_synchronise. Check both Object_Size
and Value_Size.
(Expand_N_Protected_Body): Lock_Free_Active
renames Lock_Free_On.
(Expand_N_Protected_Type_Declaration):
_Object field removed for lock-free implementation.
(Install_Private_Data_Declarations): Protection object removed
for lock-free implementation.
(Make_Initialize_Protection):
Protection object initialization removed for lock-free implementation.
* rtsfind.ads: RE_Atomic_Synchronize and RE_Relaxed added.
* sem_ch13.adb (Analyze_Aspect_Specifications): Aspect_Lock_Free
analysis added.
* sem_ch9.adb (Allows_Lock_Free_Implementation): New routine.
(Analyze_Protected_Body): Allows_Lock_Free_Implementation call added.
(Analyze_Protected_Type_Declaration):
Allows_Lock_Free_Implementation call added.
(Analyze_Single_Protected_Declaration): Second analysis of
aspects removed.
* s-atopri.ads: Header added.
(Atomic_Synchronize): New routine.
2012-05-15 Robert Dewar <dewar@adacore.com>
* exp_ch7.ads: Add comment.
2012-05-15 Hristian Kirtchev <kirtchev@adacore.com>
* a-calend.adb (Day_Of_Week): The routine once again treats
......
gcc/ada/aspects.adb
......@@ -242,11 +242,13 @@ package body Aspects is
Aspect_Ada_2012 => Aspect_Ada_2005,
Aspect_Address => Aspect_Address,
Aspect_Alignment => Aspect_Alignment,
Aspect_All_Calls_Remote => Aspect_All_Calls_Remote,
Aspect_Asynchronous => Aspect_Asynchronous,
Aspect_Atomic => Aspect_Atomic,
Aspect_Atomic_Components => Aspect_Atomic_Components,
Aspect_Attach_Handler => Aspect_Attach_Handler,
Aspect_Bit_Order => Aspect_Bit_Order,
Aspect_Compiler_Unit => Aspect_Compiler_Unit,
Aspect_Component_Size => Aspect_Component_Size,
Aspect_Constant_Indexing => Aspect_Constant_Indexing,
Aspect_Contract_Case => Aspect_Contract_Case,
......@@ -259,6 +261,7 @@ package body Aspects is
Aspect_Discard_Names => Aspect_Discard_Names,
Aspect_Dispatching_Domain => Aspect_Dispatching_Domain,
Aspect_Dynamic_Predicate => Aspect_Predicate,
Aspect_Elaborate_Body => Aspect_Elaborate_Body,
Aspect_External_Tag => Aspect_External_Tag,
Aspect_Favor_Top_Level => Aspect_Favor_Top_Level,
Aspect_Implicit_Dereference => Aspect_Implicit_Dereference,
......@@ -266,24 +269,12 @@ package body Aspects is
Aspect_Independent_Components => Aspect_Independent_Components,
Aspect_Inline => Aspect_Inline,
Aspect_Inline_Always => Aspect_Inline,
Aspect_Input => Aspect_Input,
Aspect_Interrupt_Handler => Aspect_Interrupt_Handler,
Aspect_Interrupt_Priority => Aspect_Interrupt_Priority,
Aspect_Iterator_Element => Aspect_Iterator_Element,
Aspect_All_Calls_Remote => Aspect_All_Calls_Remote,
Aspect_Compiler_Unit => Aspect_Compiler_Unit,
Aspect_Elaborate_Body => Aspect_Elaborate_Body,
Aspect_Preelaborate => Aspect_Preelaborate,
Aspect_Preelaborate_05 => Aspect_Preelaborate_05,
Aspect_Pure => Aspect_Pure,
Aspect_Pure_05 => Aspect_Pure_05,
Aspect_Pure_12 => Aspect_Pure_12,
Aspect_Remote_Call_Interface => Aspect_Remote_Call_Interface,
Aspect_Remote_Types => Aspect_Remote_Types,
Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order,
Aspect_Shared_Passive => Aspect_Shared_Passive,
Aspect_Universal_Data => Aspect_Universal_Data,
Aspect_Input => Aspect_Input,
Aspect_Invariant => Aspect_Invariant,
Aspect_Iterator_Element => Aspect_Iterator_Element,
Aspect_Lock_Free => Aspect_Lock_Free,
Aspect_Machine_Radix => Aspect_Machine_Radix,
Aspect_No_Return => Aspect_No_Return,
Aspect_Object_Size => Aspect_Object_Size,
......@@ -295,12 +286,21 @@ package body Aspects is
Aspect_Pre => Aspect_Pre,
Aspect_Precondition => Aspect_Pre,
Aspect_Predicate => Aspect_Predicate,
Aspect_Preelaborate => Aspect_Preelaborate,
Aspect_Preelaborate_05 => Aspect_Preelaborate_05,
Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization,
Aspect_Priority => Aspect_Priority,
Aspect_Pure => Aspect_Pure,
Aspect_Pure_05 => Aspect_Pure_05,
Aspect_Pure_12 => Aspect_Pure_12,
Aspect_Pure_Function => Aspect_Pure_Function,
Aspect_Remote_Access_Type => Aspect_Remote_Access_Type,
Aspect_Remote_Call_Interface => Aspect_Remote_Call_Interface,
Aspect_Remote_Types => Aspect_Remote_Types,
Aspect_Read => Aspect_Read,
Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order,
Aspect_Shared => Aspect_Atomic,
Aspect_Shared_Passive => Aspect_Shared_Passive,
Aspect_Simple_Storage_Pool => Aspect_Simple_Storage_Pool,
Aspect_Simple_Storage_Pool_Type => Aspect_Simple_Storage_Pool_Type,
Aspect_Size => Aspect_Size,
......@@ -316,6 +316,7 @@ package body Aspects is
Aspect_Type_Invariant => Aspect_Invariant,
Aspect_Unchecked_Union => Aspect_Unchecked_Union,
Aspect_Universal_Aliasing => Aspect_Universal_Aliasing,
Aspect_Universal_Data => Aspect_Universal_Data,
Aspect_Unmodified => Aspect_Unmodified,
Aspect_Unreferenced => Aspect_Unreferenced,
Aspect_Unreferenced_Objects => Aspect_Unreferenced_Objects,
......
gcc/ada/aspects.ads
......@@ -142,7 +142,12 @@ package Aspects is
Aspect_Unreferenced, -- GNAT
Aspect_Unreferenced_Objects, -- GNAT
Aspect_Volatile,
Aspect_Volatile_Components);
Aspect_Volatile_Components,
-- Aspects that have a static boolean value but don't correspond to
-- pragmas
Aspect_Lock_Free);
-- The following array indicates aspects that accept 'Class
......@@ -182,6 +187,7 @@ package Aspects is
Aspect_Dimension_System => True,
Aspect_Favor_Top_Level => True,
Aspect_Inline_Always => True,
Aspect_Lock_Free => True,
Aspect_Object_Size => True,
Aspect_Persistent_BSS => True,
Aspect_Predicate => True,
......@@ -352,6 +358,7 @@ package Aspects is
Aspect_Interrupt_Priority => Name_Interrupt_Priority,
Aspect_Invariant => Name_Invariant,
Aspect_Iterator_Element => Name_Iterator_Element,
Aspect_Lock_Free => Name_Lock_Free,
Aspect_Machine_Radix => Name_Machine_Radix,
Aspect_No_Return => Name_No_Return,
Aspect_Object_Size => Name_Object_Size,
......
gcc/ada/einfo.adb
......@@ -452,6 +452,7 @@ package body Einfo is
-- Is_Ada_2005_Only Flag185
-- Is_Interface Flag186
-- Has_Constrained_Partial_View Flag187
-- Uses_Lock_Free Flag188
-- Is_Pure_Unit_Access_Type Flag189
-- Has_Specified_Stream_Input Flag190
......@@ -525,7 +526,6 @@ package body Einfo is
-- Has_Anonymous_Master Flag253
-- Is_Implementation_Defined Flag254
-- (unused) Flag188
-- (unused) Flag201
-----------------------
......@@ -2794,6 +2794,12 @@ package body Einfo is
return Flag222 (Id);
end Used_As_Generic_Actual;
function Uses_Lock_Free (Id : E) return B is
begin
pragma Assert (Is_Protected_Type (Id));
return Flag188 (Id);
end Uses_Lock_Free;
function Uses_Sec_Stack (Id : E) return B is
begin
return Flag95 (Id);
......@@ -5358,16 +5364,22 @@ package body Einfo is
Set_Node16 (Id, V);
end Set_Unset_Reference;
procedure Set_Uses_Sec_Stack (Id : E; V : B := True) is
begin
Set_Flag95 (Id, V);
end Set_Uses_Sec_Stack;
procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
begin
Set_Flag222 (Id, V);
end Set_Used_As_Generic_Actual;
procedure Set_Uses_Lock_Free (Id : E; V : B := True) is
begin
pragma Assert (Ekind (Id) = E_Protected_Type);
Set_Flag188 (Id, V);
end Set_Uses_Lock_Free;
procedure Set_Uses_Sec_Stack (Id : E; V : B := True) is
begin
Set_Flag95 (Id, V);
end Set_Uses_Sec_Stack;
procedure Set_Warnings_Off (Id : E; V : B := True) is
begin
Set_Flag96 (Id, V);
......
gcc/ada/einfo.ads
......@@ -3878,6 +3878,12 @@ package Einfo is
-- Present in all entities, set if the entity is used as an argument to
-- a generic instantiation. Used to tune certain warning messages.
-- Uses_Lock_Free (Flag188)
-- Present in protected type entities. Set to True when the Lock Free
-- implementation is used for the protected type. This implemenatation is
-- based on atomic transactions and doesn't require anymore the use of
-- Protection object (see System.Tasking.Protected_Objects).
-- Uses_Sec_Stack (Flag95)
-- Present in scope entities (blocks,functions, procedures, tasks,
-- entries). Set to True when secondary stack is used in this scope and
......@@ -5601,6 +5607,7 @@ package Einfo is
-- Stored_Constraint (Elist23)
-- Has_Interrupt_Handler (synth)
-- Sec_Stack_Needed_For_Return (Flag167) ???
-- Uses_Lock_Free (Flag188)
-- Uses_Sec_Stack (Flag95) ???
-- Has_Entries (synth)
-- Number_Entries (synth)
......@@ -6405,6 +6412,7 @@ package Einfo is
function Universal_Aliasing (Id : E) return B;
function Unset_Reference (Id : E) return N;
function Used_As_Generic_Actual (Id : E) return B;
function Uses_Lock_Free (Id : E) return B;
function Uses_Sec_Stack (Id : E) return B;
function Vax_Float (Id : E) return B;
function Warnings_Off (Id : E) return B;
......@@ -7001,6 +7009,7 @@ package Einfo is
procedure Set_Universal_Aliasing (Id : E; V : B := True);
procedure Set_Unset_Reference (Id : E; V : N);
procedure Set_Used_As_Generic_Actual (Id : E; V : B := True);
procedure Set_Uses_Lock_Free (Id : E; V : B := True);
procedure Set_Uses_Sec_Stack (Id : E; V : B := True);
procedure Set_Warnings_Off (Id : E; V : B := True);
procedure Set_Warnings_Off_Used (Id : E; V : B := True);
......@@ -7746,6 +7755,7 @@ package Einfo is
pragma Inline (Universal_Aliasing);
pragma Inline (Unset_Reference);
pragma Inline (Used_As_Generic_Actual);
pragma Inline (Uses_Lock_Free);
pragma Inline (Uses_Sec_Stack);
pragma Inline (Warnings_Off);
pragma Inline (Warnings_Off_Used);
......@@ -8148,6 +8158,7 @@ package Einfo is
pragma Inline (Set_Universal_Aliasing);
pragma Inline (Set_Unset_Reference);
pragma Inline (Set_Used_As_Generic_Actual);
pragma Inline (Set_Uses_Lock_Free);
pragma Inline (Set_Uses_Sec_Stack);
pragma Inline (Set_Warnings_Off);
pragma Inline (Set_Warnings_Off_Used);
......
gcc/ada/exp_ch7.adb
......@@ -4602,6 +4602,7 @@ package body Exp_Ch7 is
begin
return
Is_Protected_Type (T)
and then not Uses_Lock_Free (T)
and then not Has_Entries (T)
and then Is_RTE (Find_Protection_Type (T), RE_Protection);
end Is_Simple_Protected_Type;
......
gcc/ada/exp_ch7.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -272,6 +272,8 @@ package Exp_Ch7 is
function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
-- Determine whether T denotes a protected type without entires whose
-- _object field is of type System.Tasking.Protected_Objects.Protection.
-- Something wrong here, implementation was changed to test Lock_Free
-- but this spec does not mention that ???
--------------------------------
-- Transient Scope Management --
......
gcc/ada/g-comlin.adb
......@@ -1343,7 +1343,7 @@ package body GNAT.Command_Line is
begin
if Switch /= "" or else Long_Switch /= "" then
Initialize_Switch_Def
(Def, Switch, Long_Switch, Help, Section, Argument);
(Def, Switch, Long_Switch, Help, Section, Argument);
Add (Config, Def);
end if;
end Define_Switch;
......@@ -1390,7 +1390,7 @@ package body GNAT.Command_Line is
begin
if Switch /= "" or else Long_Switch /= "" then
Initialize_Switch_Def
(Def, Switch, Long_Switch, Help, Section, Argument);
(Def, Switch, Long_Switch, Help, Section, Argument);
Def.Integer_Output := Output.all'Unchecked_Access;
Def.Integer_Default := Default;
Def.Integer_Initial := Initial;
......@@ -1415,7 +1415,7 @@ package body GNAT.Command_Line is
begin
if Switch /= "" or else Long_Switch /= "" then
Initialize_Switch_Def
(Def, Switch, Long_Switch, Help, Section, Argument);
(Def, Switch, Long_Switch, Help, Section, Argument);
Def.String_Output := Output.all'Unchecked_Access;
Add (Config, Def);
end if;
......@@ -3233,7 +3233,9 @@ package body GNAT.Command_Line is
end if;
end if;
else -- Long_Switch necessarily not null
-- Def.Switch is null (Long_Switch must be non-null)
else
Decompose_Switch (Def.Long_Switch.all, P2, Last2);
Append (Result,
Def.Long_Switch (Def.Long_Switch'First .. Last2));
......
gcc/ada/g-comlin.ads
......@@ -181,16 +181,20 @@
-- ...
-- Specifying the help message is optional, but makes it easy to then call
-- the function
-- the function:
-- Display_Help (Config);
-- that will display a properly formatted help message for your application,
-- listing all possible switches. That way you have a single place in which
-- to maintain the list of switches and their meaning, rather than maintaining
-- both the string to pass to Getopt and a subprogram to display the help.
-- Both will properly stay synchronized.
-- Once you have this Config, you just have to call
-- Once you have this Config, you just have to call:
-- Getopt (Config, Callback'Access);
-- to parse the command line. The Callback will be called for each switch
-- found on the command line (in the case of our example, that is "-gnatwu"
-- and then "-gnatwv", not "-gnatwa" itself). This simplifies command line
......@@ -203,13 +207,13 @@
-- Optimization : aliased Integer;
-- Verbose : aliased Boolean;
--
-- Define_Switch (Config, Verbose'Access,
-- "-v", Long_Switch => "--verbose",
-- Help => "Output extra verbose information");
-- Define_Switch (Config, Optimization'Access,
-- "-O?", Help => "Optimization level");
--
-- Getopt (Config); -- No callback
-- Since all switches are handled automatically, we don't even need to pass
......@@ -263,8 +267,8 @@
-- Some command line arguments can have parameters, which on a command line
-- appear as a separate argument that must immediately follow the switch.
-- Since the subprograms in this package will reorganize the switches to group
-- them, you need to indicate what is a command line
-- parameter, and what is a switch argument.
-- them, you need to indicate what is a command line parameter, and what is a
-- switch argument.
-- This is done by passing an extra argument to Add_Switch, as in:
......@@ -308,18 +312,18 @@ package GNAT.Command_Line is
Stop_At_First_Non_Switch : Boolean := False;
Section_Delimiters : String := "");
-- The first procedure resets the internal state of the package to prepare
-- to rescan the parameters. It does not need to be called before the first
-- use of Getopt (but it could be), but it must be called if you want to
-- start rescanning the command line parameters from the start. The
-- optional parameter Switch_Char can be used to reset the switch
-- to rescan the parameters. It does not need to be called before the
-- first use of Getopt (but it could be), but it must be called if you
-- want to start rescanning the command line parameters from the start.
-- The optional parameter Switch_Char can be used to reset the switch
-- character, e.g. to '/' for use in DOS-like systems.
--
-- The second subprogram initializes a parser that takes its arguments from
-- an array of strings rather than directly from the command line. In this
-- case, the parser is responsible for freeing the strings stored in
-- The second subprogram initializes a parser that takes its arguments
-- from an array of strings rather than directly from the command line. In
-- this case, the parser is responsible for freeing the strings stored in
-- Command_Line. If you pass null to Command_Line, this will in fact create
-- a second parser for Ada.Command_Line, which doesn't share any data with
-- the default parser. This parser must be free-ed.
-- the default parser. This parser must be free'ed.
--
-- The optional parameter Stop_At_First_Non_Switch indicates if Getopt is
-- to look for switches on the whole command line, or if it has to stop as
......@@ -451,9 +455,9 @@ package GNAT.Command_Line is
-- spaces.
--
-- Example
-- Getopt ("a b", Concatenate => False)
-- If the command line is '-ab', exception Invalid_Switch will be
-- raised and Full_Switch will return "ab".
-- Getopt ("a b", Concatenate => False)
-- If the command line is '-ab', exception Invalid_Switch will be
-- raised and Full_Switch will return "ab".
function Get_Argument
(Do_Expansion : Boolean := False;
......@@ -559,8 +563,8 @@ package GNAT.Command_Line is
-- The section name should not include the leading '-'. So for instance in
-- the case of gnatmake we would use:
--
-- Define_Section (Config, "cargs");
-- Define_Section (Config, "bargs");
-- Define_Section (Config, "cargs");
-- Define_Section (Config, "bargs");
procedure Define_Alias
(Config : in out Command_Line_Configuration;
......@@ -609,9 +613,9 @@ package GNAT.Command_Line is
--
-- Switch and Long_Switch (when specified) are aliases and can be used
-- interchangeably. There is no check that they both take an argument or
-- both take no argument.
-- Switch can be set to "*" to indicate that any switch is supported (in
-- which case Getopt will return '*', see its documentation).
-- both take no argument. Switch can be set to "*" to indicate that any
-- switch is supported (in which case Getopt will return '*', see its
-- documentation).
--
-- Help is used by the Display_Help procedure to describe the supported
-- switches.
......@@ -633,11 +637,13 @@ package GNAT.Command_Line is
-- See Define_Switch for a description of the parameters.
-- When the switch is found on the command line, Getopt will set
-- Output.all to Value.
--
-- Output is always initially set to "not Value", so that if the switch is
-- not found on the command line, Output still has a valid value.
-- The switch must not take any parameter.
-- Output must exist at least as long as Config, otherwise erroneous memory
-- access may happen.
--
-- Output must exist at least as long as Config, otherwise an erroneous
-- memory access may occur.
procedure Define_Switch
(Config : in out Command_Line_Configuration;
......@@ -649,14 +655,14 @@ package GNAT.Command_Line is
Initial : Integer := 0;
Default : Integer := 1;
Argument : String := "ARG");
-- See Define_Switch for a description of the parameters.
-- When the switch is found on the command line, Getopt will set
-- Output.all to the value of the switch's parameter. If the parameter is
-- not an integer, Invalid_Parameter is raised.
-- See Define_Switch for a description of the parameters. When the
-- switch is found on the command line, Getopt will set Output.all to the
-- value of the switch's parameter. If the parameter is not an integer,
-- Invalid_Parameter is raised.
-- Output is always initialized to Initial. If the switch has an optional
-- argument which isn't specified by the user, then Output will be set to
-- Default.
-- The switch must accept an argument.
-- Default. The switch must accept an argument.
procedure Define_Switch
(Config : in out Command_Line_Configuration;
......@@ -667,11 +673,10 @@ package GNAT.Command_Line is
Section : String := "";
Argument : String := "ARG");
-- Set Output to the value of the switch's parameter when the switch is
-- found on the command line.
-- Output is always initialized to the empty string if it does not have
-- a value already (otherwise it is left as is so that you can specify the
-- default value directly in the declaration of the variable).
-- The switch must accept an argument.
-- found on the command line. Output is always initialized to the empty
-- string if it does not have a value already (otherwise it is left as is
-- so that you can specify the default value directly in the declaration
-- of the variable). The switch must accept an argument.
procedure Set_Usage
(Config : in out Command_Line_Configuration;
......@@ -705,15 +710,14 @@ package GNAT.Command_Line is
(Switch : String;
Parameter : String;
Section : String);
-- Called when a switch is found on the command line.
-- [Switch] includes any leading '-' that was specified in Define_Switch.
-- This is slightly different from the functional version of Getopt above,
-- for which Full_Switch omits the first leading '-'.
-- Called when a switch is found on the command line. Switch includes
-- any leading '-' that was specified in Define_Switch. This is slightly
-- different from the functional version of Getopt above, for which
-- Full_Switch omits the first leading '-'.
Exit_From_Command_Line : exception;
-- Emitted when the program should exit.
-- This is called when Getopt below has seen -h, --help or an invalid
-- switch.
-- Emitted when the program should exit. This is called when Getopt below
-- has seen -h, --help or an invalid switch.
procedure Getopt
(Config : Command_Line_Configuration;
......@@ -823,7 +827,7 @@ package GNAT.Command_Line is
-- If the command line has sections (such as -bargs -cargs), then they
-- should be listed in the Sections parameter (as "-bargs -cargs").
--
-- This function can be used to reset Cmd by passing an empty string.
-- This function can be used to reset Cmd by passing an empty string
--
-- If an invalid switch is found on the command line (ie wasn't defined in
-- the configuration via Define_Switch), and the configuration wasn't set
......@@ -947,6 +951,7 @@ package GNAT.Command_Line is
---------------
-- Iteration --
---------------
-- When a command line was created with the above, you can then iterate
-- over its contents using the following iterator.
......@@ -992,6 +997,7 @@ package GNAT.Command_Line is
-- create an Opt_Parser.
--
-- Args must be freed by the caller.
--
-- Expanded has the same meaning as in Start.
private
......
gcc/ada/rtsfind.ads
......@@ -739,6 +739,8 @@ package Rtsfind is
RE_Atomic_Load_16, -- System.Atomic_Primitives
RE_Atomic_Load_32, -- System.Atomic_Primitives
RE_Atomic_Load_64, -- System.Atomic_Primitives
RE_Atomic_Synchronize, -- System.Atomic_Primitives
RE_Relaxed, -- System.Atomic_Primitives
RE_Uint8, -- System.Atomic_Primitives
RE_Uint16, -- System.Atomic_Primitives
RE_Uint32, -- System.Atomic_Primitives
......@@ -1960,6 +1962,8 @@ package Rtsfind is
RE_Atomic_Load_16 => System_Atomic_Primitives,
RE_Atomic_Load_32 => System_Atomic_Primitives,
RE_Atomic_Load_64 => System_Atomic_Primitives,
RE_Atomic_Synchronize => System_Atomic_Primitives,
RE_Relaxed => System_Atomic_Primitives,
RE_Uint8 => System_Atomic_Primitives,
RE_Uint16 => System_Atomic_Primitives,
RE_Uint32 => System_Atomic_Primitives,
......
gcc/ada/s-atopri.ads
......@@ -29,7 +29,10 @@
-- --
------------------------------------------------------------------------------
-- ??? Need header saying what this unit is!!!
-- This package contains atomic primitives defined from gcc built-in functions
-- For now, these operations are only used by the compiler to generate the
-- lock-free implementation of protected objects.
package System.Atomic_Primitives is
pragma Preelaborate;
......@@ -119,4 +122,6 @@ package System.Atomic_Primitives is
Model : Mem_Model := Seq_Cst) return uint64;
pragma Import (Intrinsic, Atomic_Load_64, "__atomic_load_8");
procedure Atomic_Synchronize;
pragma Import (Intrinsic, Atomic_Synchronize, "__sync_synchronize");
end System.Atomic_Primitives;
gcc/ada/sem_ch13.adb
......@@ -926,16 +926,40 @@ package body Sem_Ch13 is
when No_Aspect =>
raise Program_Error;
-- Aspects taking an optional boolean argument. For all of
-- these we just create a matching pragma and insert it, if
-- the expression is missing or set to True. If the expression
-- is False, we can ignore the aspect with the exception that
-- in the case of a derived type, we must check for an illegal
-- attempt to cancel an inherited aspect.
-- Aspects taking an optional boolean argument
when Boolean_Aspects =>
Set_Is_Boolean_Aspect (Aspect);
-- Special treatment for Aspect_Lock_Free since it is the
-- only Boolean_Aspect that doesn't correspond to a pragma.
if A_Id = Aspect_Lock_Free then
if Ekind (E) /= E_Protected_Type then
Error_Msg_N
("aspect % only applies to protected objects",
Aspect);
end if;
-- Set the Uses_Lock_Free flag to True if there is no
-- expression or if the expression is True.
if No (Expr)
or else Is_True (Static_Boolean (Expr))
then
Set_Uses_Lock_Free (E);
end if;
goto Continue;
end if;
-- For all of these aspects we just create a matching pragma
-- and insert it, if the expression is missing or set to
-- True. If the expression is False, we can ignore the
-- aspect with the exception that in the case of a derived
-- type, we must check for an illegal attempt to cancel an
-- inherited aspect.
if Present (Expr)
and then Is_False (Static_Boolean (Expr))
then
......
gcc/ada/sem_ch9.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
with Table;
with Types; use Types;
package Sem_Ch9 is
......@@ -52,4 +53,35 @@ package Sem_Ch9 is
procedure Analyze_Terminate_Alternative (N : Node_Id);
procedure Analyze_Timed_Entry_Call (N : Node_Id);
procedure Analyze_Triggering_Alternative (N : Node_Id);
------------------------------
-- Lock Free Data Structure --
------------------------------
-- A lock-free subprogram is a protected routine which references a unique
-- protected scalar component and does not contain statements that cause
-- side effects. Due to this restricted behavior, all references to shared
-- data from within the subprogram can be synchronized through the use of
-- atomic operations rather than relying on locks.
type Lock_Free_Subprogram is record
Sub_Body : Node_Id;
-- Reference to the body of a protected subprogram which meets the lock-
-- free requirements.
Comp_Id : Entity_Id;
-- Reference to the scalar component referenced from within Sub_Body
end record;
-- This table establishes a relation between a protected subprogram body
-- and a unique component it references. The table is used when building
-- the lock-free versions of a protected subprogram body.
package Lock_Free_Subprogram_Table is new Table.Table (
Table_Component_Type => Lock_Free_Subprogram,
Table_Index_Type => Nat,
Table_Low_Bound => 1,
Table_Initial => 5,
Table_Increment => 5,
Table_Name => "Lock_Free_Subprogram_Table");
end Sem_Ch9;
gcc/ada/snames.ads-tmpl
......@@ -142,6 +142,7 @@ package Snames is
Name_Dimension : constant Name_Id := N + $;
Name_Dimension_System : constant Name_Id := N + $;
Name_Dynamic_Predicate : constant Name_Id := N + $;
Name_Lock_Free : constant Name_Id := N + $;
Name_Post : constant Name_Id := N + $;
Name_Pre : constant Name_Id := N + $;
Name_Static_Predicate : constant Name_Id := N + $;
......
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