From 83a0ab2a2fd2930fe97279844d6999d51a8b0d94 Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 31 Aug 2011 08:40:22 +0000 Subject: [PATCH] 2011-08-31 Robert Dewar * s-taprop-vxworks.adb, sem_ch5.adb, s-taprop-tru64.adb, exp_alfa.adb, s-taprop-vms.adb, bindgen.adb, s-mudido.adb, s-mudido.ads, sem_res.adb, expander.adb, s-taprop-mingw.adb, s-taprop-linux.adb, s-taprop-solaris.adb, s-mudido-affinity.adb, vms_conv.adb, s-taprop-irix.adb, s-taprop.ads, s-taskin.adb, s-taskin.ads, s-taprop-hpux-dce.adb, a-chtgbo.adb, s-taprop-posix.adb: Minor reformatting. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178357 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 10 + gcc/ada/a-chtgbo.adb | 8 + gcc/ada/bindgen.adb | 8 +- gcc/ada/exp_alfa.adb | 5 +- gcc/ada/expander.adb | 482 +++++++++++++++++++++--------------------- gcc/ada/s-mudido-affinity.adb | 40 ++-- gcc/ada/s-mudido.adb | 21 +- gcc/ada/s-mudido.ads | 16 +- gcc/ada/s-taprop-hpux-dce.adb | 1 + gcc/ada/s-taprop-irix.adb | 1 + gcc/ada/s-taprop-linux.adb | 14 +- gcc/ada/s-taprop-mingw.adb | 24 ++- gcc/ada/s-taprop-posix.adb | 1 + gcc/ada/s-taprop-solaris.adb | 20 +- gcc/ada/s-taprop-tru64.adb | 1 + gcc/ada/s-taprop-vms.adb | 1 + gcc/ada/s-taprop-vxworks.adb | 23 +- gcc/ada/s-taprop.ads | 3 +- gcc/ada/s-taskin.adb | 6 +- gcc/ada/s-taskin.ads | 12 +- gcc/ada/sem_ch5.adb | 10 +- gcc/ada/sem_res.adb | 4 +- gcc/ada/vms_conv.adb | 87 ++++---- 23 files changed, 410 insertions(+), 388 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 06d9091..a1a2009 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2011-08-31 Robert Dewar + + * s-taprop-vxworks.adb, sem_ch5.adb, s-taprop-tru64.adb, exp_alfa.adb, + s-taprop-vms.adb, bindgen.adb, s-mudido.adb, s-mudido.ads, + sem_res.adb, expander.adb, s-taprop-mingw.adb, s-taprop-linux.adb, + s-taprop-solaris.adb, s-mudido-affinity.adb, vms_conv.adb, + s-taprop-irix.adb, s-taprop.ads, s-taskin.adb, s-taskin.ads, + s-taprop-hpux-dce.adb, a-chtgbo.adb, s-taprop-posix.adb: Minor + reformatting. + 2011-08-31 Hristian Kirtchev * sem_ch12 (Check_Private_View): Revert previous change. diff --git a/gcc/ada/a-chtgbo.adb b/gcc/ada/a-chtgbo.adb index a9c0c8a..9e7da11 100644 --- a/gcc/ada/a-chtgbo.adb +++ b/gcc/ada/a-chtgbo.adb @@ -139,6 +139,14 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is N : Nodes_Type renames HT.Nodes; begin + -- This subprogram "deallocates" a node by relinking the node off of the + -- active list and onto the free list. Previously it would flag index + -- value 0 as an error. The precondition was weakened, so that index + -- value 0 is now allowed, and this value is interpreted to mean "do + -- nothing". This makes its behavior analogous to the behavior of + -- Ada.Unchecked_Conversion, and allows callers to avoid having to add + -- special-case checks at the point of call. + if X = 0 then return; end if; diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 618e9ce..f5a2bdc 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -240,7 +240,9 @@ package body Bindgen is -- Local Subprograms -- ----------------------- - procedure Check_File_In_Partition (File_Name : String; Flag : out Boolean); + procedure Check_File_In_Partition + (File_Name : String; + Flag : out Boolean); -- If the file indicated by File_Name is in the partition the Flag is set -- to True, False otherwise. @@ -401,7 +403,9 @@ package body Bindgen is ----------------------------- procedure Check_File_In_Partition - (File_Name : String; Flag : out Boolean) is + (File_Name : String; + Flag : out Boolean) + is begin for J in Units.First .. Units.Last loop if Get_Name_String (Units.Table (J).Sfile) = File_Name then diff --git a/gcc/ada/exp_alfa.adb b/gcc/ada/exp_alfa.adb index 5d2bb66..f0bdc80 100644 --- a/gcc/ada/exp_alfa.adb +++ b/gcc/ada/exp_alfa.adb @@ -45,8 +45,8 @@ package body Exp_Alfa is procedure Expand_Alfa_Call (N : Node_Id); -- This procedure contains common processing for function and procedure -- calls: - -- * expansion of actuals to introduce necessary temporaries - -- * replacement of renaming by subprogram renamed + -- * expansion of actuals to introduce necessary temporaries + -- * replacement of renaming by subprogram renamed procedure Expand_Alfa_N_Attribute_Reference (N : Node_Id); -- Expand attributes 'Old and 'Result only @@ -89,7 +89,6 @@ package body Exp_Alfa is when others => null; - end case; end Expand_Alfa; diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb index f14fca0..65d6efb 100644 --- a/gcc/ada/expander.adb +++ b/gcc/ada/expander.adb @@ -23,30 +23,30 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; -with Debug_A; use Debug_A; -with Errout; use Errout; -with Exp_Aggr; use Exp_Aggr; -with Exp_Alfa; use Exp_Alfa; -with Exp_Attr; use Exp_Attr; -with Exp_Ch2; use Exp_Ch2; -with Exp_Ch3; use Exp_Ch3; -with Exp_Ch4; use Exp_Ch4; -with Exp_Ch5; use Exp_Ch5; -with Exp_Ch6; use Exp_Ch6; -with Exp_Ch7; use Exp_Ch7; -with Exp_Ch8; use Exp_Ch8; -with Exp_Ch9; use Exp_Ch9; -with Exp_Ch11; use Exp_Ch11; -with Exp_Ch12; use Exp_Ch12; -with Exp_Ch13; use Exp_Ch13; -with Exp_Prag; use Exp_Prag; -with Opt; use Opt; -with Rtsfind; use Rtsfind; -with Sem; use Sem; -with Sem_Ch8; use Sem_Ch8; -with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Atree; use Atree; +with Debug_A; use Debug_A; +with Errout; use Errout; +with Exp_Aggr; use Exp_Aggr; +with Exp_Alfa; use Exp_Alfa; +with Exp_Attr; use Exp_Attr; +with Exp_Ch2; use Exp_Ch2; +with Exp_Ch3; use Exp_Ch3; +with Exp_Ch4; use Exp_Ch4; +with Exp_Ch5; use Exp_Ch5; +with Exp_Ch6; use Exp_Ch6; +with Exp_Ch7; use Exp_Ch7; +with Exp_Ch8; use Exp_Ch8; +with Exp_Ch9; use Exp_Ch9; +with Exp_Ch11; use Exp_Ch11; +with Exp_Ch12; use Exp_Ch12; +with Exp_Ch13; use Exp_Ch13; +with Exp_Prag; use Exp_Prag; +with Opt; use Opt; +with Rtsfind; use Rtsfind; +with Sem; use Sem; +with Sem_Ch8; use Sem_Ch8; +with Sem_Util; use Sem_Util; +with Sinfo; use Sinfo; with Table; package body Expander is @@ -127,336 +127,340 @@ package body Expander is else Debug_A_Entry ("expanding ", N); - -- Processing depends on node kind. For full details on the expansion - -- activity required in each case, see bodies of corresponding expand - -- routines. - begin + -- In ALFA mode we only need a very limited subset of the usual + -- expansions. This limited subset is implemented in Expand_Alfa. + if ALFA_Mode then Expand_Alfa (N); + -- Here for normal non-ALFA mode + else + -- Processing depends on node kind. For full details on the + -- expansion activity required in each case, see bodies of + -- corresponding expand routines. case Nkind (N) is - when N_Abort_Statement => - Expand_N_Abort_Statement (N); + when N_Abort_Statement => + Expand_N_Abort_Statement (N); - when N_Accept_Statement => - Expand_N_Accept_Statement (N); + when N_Accept_Statement => + Expand_N_Accept_Statement (N); - when N_Aggregate => - Expand_N_Aggregate (N); + when N_Aggregate => + Expand_N_Aggregate (N); - when N_Allocator => - Expand_N_Allocator (N); + when N_Allocator => + Expand_N_Allocator (N); - when N_And_Then => - Expand_N_And_Then (N); + when N_And_Then => + Expand_N_And_Then (N); - when N_Assignment_Statement => - Expand_N_Assignment_Statement (N); + when N_Assignment_Statement => + Expand_N_Assignment_Statement (N); - when N_Asynchronous_Select => - Expand_N_Asynchronous_Select (N); + when N_Asynchronous_Select => + Expand_N_Asynchronous_Select (N); - when N_Attribute_Definition_Clause => - Expand_N_Attribute_Definition_Clause (N); + when N_Attribute_Definition_Clause => + Expand_N_Attribute_Definition_Clause (N); - when N_Attribute_Reference => - Expand_N_Attribute_Reference (N); + when N_Attribute_Reference => + Expand_N_Attribute_Reference (N); - when N_Block_Statement => - Expand_N_Block_Statement (N); + when N_Block_Statement => + Expand_N_Block_Statement (N); - when N_Case_Expression => - Expand_N_Case_Expression (N); + when N_Case_Expression => + Expand_N_Case_Expression (N); - when N_Case_Statement => - Expand_N_Case_Statement (N); + when N_Case_Statement => + Expand_N_Case_Statement (N); - when N_Conditional_Entry_Call => - Expand_N_Conditional_Entry_Call (N); + when N_Conditional_Entry_Call => + Expand_N_Conditional_Entry_Call (N); - when N_Conditional_Expression => - Expand_N_Conditional_Expression (N); + when N_Conditional_Expression => + Expand_N_Conditional_Expression (N); - when N_Delay_Relative_Statement => - Expand_N_Delay_Relative_Statement (N); + when N_Delay_Relative_Statement => + Expand_N_Delay_Relative_Statement (N); - when N_Delay_Until_Statement => - Expand_N_Delay_Until_Statement (N); + when N_Delay_Until_Statement => + Expand_N_Delay_Until_Statement (N); - when N_Entry_Body => - Expand_N_Entry_Body (N); + when N_Entry_Body => + Expand_N_Entry_Body (N); - when N_Entry_Call_Statement => - Expand_N_Entry_Call_Statement (N); + when N_Entry_Call_Statement => + Expand_N_Entry_Call_Statement (N); - when N_Entry_Declaration => - Expand_N_Entry_Declaration (N); + when N_Entry_Declaration => + Expand_N_Entry_Declaration (N); - when N_Exception_Declaration => - Expand_N_Exception_Declaration (N); + when N_Exception_Declaration => + Expand_N_Exception_Declaration (N); - when N_Exception_Renaming_Declaration => - Expand_N_Exception_Renaming_Declaration (N); + when N_Exception_Renaming_Declaration => + Expand_N_Exception_Renaming_Declaration (N); - when N_Exit_Statement => - Expand_N_Exit_Statement (N); + when N_Exit_Statement => + Expand_N_Exit_Statement (N); - when N_Expanded_Name => - Expand_N_Expanded_Name (N); + when N_Expanded_Name => + Expand_N_Expanded_Name (N); - when N_Explicit_Dereference => - Expand_N_Explicit_Dereference (N); + when N_Explicit_Dereference => + Expand_N_Explicit_Dereference (N); - when N_Expression_With_Actions => - Expand_N_Expression_With_Actions (N); + when N_Expression_With_Actions => + Expand_N_Expression_With_Actions (N); - when N_Extended_Return_Statement => - Expand_N_Extended_Return_Statement (N); + when N_Extended_Return_Statement => + Expand_N_Extended_Return_Statement (N); - when N_Extension_Aggregate => - Expand_N_Extension_Aggregate (N); + when N_Extension_Aggregate => + Expand_N_Extension_Aggregate (N); - when N_Free_Statement => - Expand_N_Free_Statement (N); + when N_Free_Statement => + Expand_N_Free_Statement (N); - when N_Freeze_Entity => - Expand_N_Freeze_Entity (N); + when N_Freeze_Entity => + Expand_N_Freeze_Entity (N); - when N_Full_Type_Declaration => - Expand_N_Full_Type_Declaration (N); + when N_Full_Type_Declaration => + Expand_N_Full_Type_Declaration (N); - when N_Function_Call => - Expand_N_Function_Call (N); + when N_Function_Call => + Expand_N_Function_Call (N); - when N_Generic_Instantiation => - Expand_N_Generic_Instantiation (N); + when N_Generic_Instantiation => + Expand_N_Generic_Instantiation (N); - when N_Goto_Statement => - Expand_N_Goto_Statement (N); + when N_Goto_Statement => + Expand_N_Goto_Statement (N); - when N_Handled_Sequence_Of_Statements => - Expand_N_Handled_Sequence_Of_Statements (N); + when N_Handled_Sequence_Of_Statements => + Expand_N_Handled_Sequence_Of_Statements (N); - when N_Identifier => - Expand_N_Identifier (N); + when N_Identifier => + Expand_N_Identifier (N); - when N_Indexed_Component => - Expand_N_Indexed_Component (N); + when N_Indexed_Component => + Expand_N_Indexed_Component (N); - when N_If_Statement => - Expand_N_If_Statement (N); + when N_If_Statement => + Expand_N_If_Statement (N); - when N_In => - Expand_N_In (N); + when N_In => + Expand_N_In (N); - when N_Loop_Statement => - Expand_N_Loop_Statement (N); + when N_Loop_Statement => + Expand_N_Loop_Statement (N); - when N_Not_In => - Expand_N_Not_In (N); + when N_Not_In => + Expand_N_Not_In (N); - when N_Null => - Expand_N_Null (N); + when N_Null => + Expand_N_Null (N); - when N_Object_Declaration => - Expand_N_Object_Declaration (N); + when N_Object_Declaration => + Expand_N_Object_Declaration (N); - when N_Object_Renaming_Declaration => - Expand_N_Object_Renaming_Declaration (N); + when N_Object_Renaming_Declaration => + Expand_N_Object_Renaming_Declaration (N); - when N_Op_Add => - Expand_N_Op_Add (N); + when N_Op_Add => + Expand_N_Op_Add (N); - when N_Op_Abs => - Expand_N_Op_Abs (N); + when N_Op_Abs => + Expand_N_Op_Abs (N); - when N_Op_And => - Expand_N_Op_And (N); + when N_Op_And => + Expand_N_Op_And (N); - when N_Op_Concat => - Expand_N_Op_Concat (N); + when N_Op_Concat => + Expand_N_Op_Concat (N); - when N_Op_Divide => - Expand_N_Op_Divide (N); + when N_Op_Divide => + Expand_N_Op_Divide (N); - when N_Op_Eq => - Expand_N_Op_Eq (N); + when N_Op_Eq => + Expand_N_Op_Eq (N); - when N_Op_Expon => - Expand_N_Op_Expon (N); + when N_Op_Expon => + Expand_N_Op_Expon (N); - when N_Op_Ge => - Expand_N_Op_Ge (N); + when N_Op_Ge => + Expand_N_Op_Ge (N); - when N_Op_Gt => - Expand_N_Op_Gt (N); + when N_Op_Gt => + Expand_N_Op_Gt (N); - when N_Op_Le => - Expand_N_Op_Le (N); + when N_Op_Le => + Expand_N_Op_Le (N); - when N_Op_Lt => - Expand_N_Op_Lt (N); + when N_Op_Lt => + Expand_N_Op_Lt (N); - when N_Op_Minus => - Expand_N_Op_Minus (N); + when N_Op_Minus => + Expand_N_Op_Minus (N); - when N_Op_Mod => - Expand_N_Op_Mod (N); + when N_Op_Mod => + Expand_N_Op_Mod (N); - when N_Op_Multiply => - Expand_N_Op_Multiply (N); + when N_Op_Multiply => + Expand_N_Op_Multiply (N); - when N_Op_Ne => - Expand_N_Op_Ne (N); + when N_Op_Ne => + Expand_N_Op_Ne (N); - when N_Op_Not => - Expand_N_Op_Not (N); + when N_Op_Not => + Expand_N_Op_Not (N); - when N_Op_Or => - Expand_N_Op_Or (N); + when N_Op_Or => + Expand_N_Op_Or (N); - when N_Op_Plus => - Expand_N_Op_Plus (N); + when N_Op_Plus => + Expand_N_Op_Plus (N); - when N_Op_Rem => - Expand_N_Op_Rem (N); + when N_Op_Rem => + Expand_N_Op_Rem (N); - when N_Op_Rotate_Left => - Expand_N_Op_Rotate_Left (N); + when N_Op_Rotate_Left => + Expand_N_Op_Rotate_Left (N); - when N_Op_Rotate_Right => - Expand_N_Op_Rotate_Right (N); + when N_Op_Rotate_Right => + Expand_N_Op_Rotate_Right (N); - when N_Op_Shift_Left => - Expand_N_Op_Shift_Left (N); + when N_Op_Shift_Left => + Expand_N_Op_Shift_Left (N); - when N_Op_Shift_Right => - Expand_N_Op_Shift_Right (N); + when N_Op_Shift_Right => + Expand_N_Op_Shift_Right (N); - when N_Op_Shift_Right_Arithmetic => - Expand_N_Op_Shift_Right_Arithmetic (N); + when N_Op_Shift_Right_Arithmetic => + Expand_N_Op_Shift_Right_Arithmetic (N); - when N_Op_Subtract => - Expand_N_Op_Subtract (N); + when N_Op_Subtract => + Expand_N_Op_Subtract (N); - when N_Op_Xor => - Expand_N_Op_Xor (N); + when N_Op_Xor => + Expand_N_Op_Xor (N); - when N_Or_Else => - Expand_N_Or_Else (N); + when N_Or_Else => + Expand_N_Or_Else (N); - when N_Package_Body => - Expand_N_Package_Body (N); + when N_Package_Body => + Expand_N_Package_Body (N); - when N_Package_Declaration => - Expand_N_Package_Declaration (N); + when N_Package_Declaration => + Expand_N_Package_Declaration (N); - when N_Package_Renaming_Declaration => - Expand_N_Package_Renaming_Declaration (N); + when N_Package_Renaming_Declaration => + Expand_N_Package_Renaming_Declaration (N); - when N_Subprogram_Renaming_Declaration => - Expand_N_Subprogram_Renaming_Declaration (N); + when N_Subprogram_Renaming_Declaration => + Expand_N_Subprogram_Renaming_Declaration (N); - when N_Pragma => - Expand_N_Pragma (N); + when N_Pragma => + Expand_N_Pragma (N); - when N_Procedure_Call_Statement => - Expand_N_Procedure_Call_Statement (N); + when N_Procedure_Call_Statement => + Expand_N_Procedure_Call_Statement (N); - when N_Protected_Type_Declaration => - Expand_N_Protected_Type_Declaration (N); + when N_Protected_Type_Declaration => + Expand_N_Protected_Type_Declaration (N); - when N_Protected_Body => - Expand_N_Protected_Body (N); + when N_Protected_Body => + Expand_N_Protected_Body (N); - when N_Qualified_Expression => - Expand_N_Qualified_Expression (N); + when N_Qualified_Expression => + Expand_N_Qualified_Expression (N); - when N_Quantified_Expression => - Expand_N_Quantified_Expression (N); + when N_Quantified_Expression => + Expand_N_Quantified_Expression (N); - when N_Raise_Statement => - Expand_N_Raise_Statement (N); + when N_Raise_Statement => + Expand_N_Raise_Statement (N); - when N_Raise_Constraint_Error => - Expand_N_Raise_Constraint_Error (N); + when N_Raise_Constraint_Error => + Expand_N_Raise_Constraint_Error (N); - when N_Raise_Program_Error => - Expand_N_Raise_Program_Error (N); + when N_Raise_Program_Error => + Expand_N_Raise_Program_Error (N); - when N_Raise_Storage_Error => - Expand_N_Raise_Storage_Error (N); + when N_Raise_Storage_Error => + Expand_N_Raise_Storage_Error (N); - when N_Real_Literal => - Expand_N_Real_Literal (N); + when N_Real_Literal => + Expand_N_Real_Literal (N); - when N_Record_Representation_Clause => - Expand_N_Record_Representation_Clause (N); + when N_Record_Representation_Clause => + Expand_N_Record_Representation_Clause (N); - when N_Requeue_Statement => - Expand_N_Requeue_Statement (N); + when N_Requeue_Statement => + Expand_N_Requeue_Statement (N); - when N_Simple_Return_Statement => - Expand_N_Simple_Return_Statement (N); + when N_Simple_Return_Statement => + Expand_N_Simple_Return_Statement (N); - when N_Selected_Component => - Expand_N_Selected_Component (N); + when N_Selected_Component => + Expand_N_Selected_Component (N); - when N_Selective_Accept => - Expand_N_Selective_Accept (N); + when N_Selective_Accept => + Expand_N_Selective_Accept (N); - when N_Single_Task_Declaration => - Expand_N_Single_Task_Declaration (N); + when N_Single_Task_Declaration => + Expand_N_Single_Task_Declaration (N); - when N_Slice => - Expand_N_Slice (N); + when N_Slice => + Expand_N_Slice (N); - when N_Subtype_Indication => - Expand_N_Subtype_Indication (N); + when N_Subtype_Indication => + Expand_N_Subtype_Indication (N); - when N_Subprogram_Body => - Expand_N_Subprogram_Body (N); + when N_Subprogram_Body => + Expand_N_Subprogram_Body (N); - when N_Subprogram_Body_Stub => - Expand_N_Subprogram_Body_Stub (N); + when N_Subprogram_Body_Stub => + Expand_N_Subprogram_Body_Stub (N); - when N_Subprogram_Declaration => - Expand_N_Subprogram_Declaration (N); + when N_Subprogram_Declaration => + Expand_N_Subprogram_Declaration (N); - when N_Subprogram_Info => - Expand_N_Subprogram_Info (N); + when N_Subprogram_Info => + Expand_N_Subprogram_Info (N); - when N_Task_Body => - Expand_N_Task_Body (N); + when N_Task_Body => + Expand_N_Task_Body (N); - when N_Task_Type_Declaration => - Expand_N_Task_Type_Declaration (N); + when N_Task_Type_Declaration => + Expand_N_Task_Type_Declaration (N); - when N_Timed_Entry_Call => - Expand_N_Timed_Entry_Call (N); + when N_Timed_Entry_Call => + Expand_N_Timed_Entry_Call (N); - when N_Type_Conversion => - Expand_N_Type_Conversion (N); + when N_Type_Conversion => + Expand_N_Type_Conversion (N); - when N_Unchecked_Expression => - Expand_N_Unchecked_Expression (N); + when N_Unchecked_Expression => + Expand_N_Unchecked_Expression (N); - when N_Unchecked_Type_Conversion => - Expand_N_Unchecked_Type_Conversion (N); + when N_Unchecked_Type_Conversion => + Expand_N_Unchecked_Type_Conversion (N); - when N_Variant_Part => - Expand_N_Variant_Part (N); + when N_Variant_Part => + Expand_N_Variant_Part (N); - -- For all other node kinds, no expansion activity is required + -- For all other node kinds, no expansion activity required - when others => null; + when others => + null; end case; - end if; exception diff --git a/gcc/ada/s-mudido-affinity.adb b/gcc/ada/s-mudido-affinity.adb index 1c1d865..aa92773 100644 --- a/gcc/ada/s-mudido-affinity.adb +++ b/gcc/ada/s-mudido-affinity.adb @@ -45,8 +45,8 @@ package body System.Multiprocessors.Dispatching_Domains is -- Local data -- ---------------- - Dispatching_Domain_Tasks : - array (CPU'First .. Number_Of_CPUs) of Natural := (others => 0); + Dispatching_Domain_Tasks : array (CPU'First .. Number_Of_CPUs) of Natural := + (others => 0); -- We need to store whether there are tasks allocated to concrete -- processors in the default system dispatching domain because we need to -- check it before creating a new dispatching domain. @@ -88,7 +88,7 @@ package body System.Multiprocessors.Dispatching_Domains is (Domain : in out Dispatching_Domain; CPU : CPU_Range := Not_A_Specific_CPU; T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) + Ada.Task_Identification.Current_Task) is Target : constant ST.Task_Id := Convert_Ids (T); @@ -135,13 +135,15 @@ package body System.Multiprocessors.Dispatching_Domains is use type System.Tasking.Task_Id; Valid_System_Domain : constant Boolean := - (First > CPU'First and then - not (System_Dispatching_Domain (CPU'First .. First - 1) = - (CPU'First .. First - 1 => False))) - or else - (Last < Number_Of_CPUs and then - not (System_Dispatching_Domain (Last + 1 .. Number_Of_CPUs) = - (Last + 1 .. Number_Of_CPUs => False))); + (First > CPU'First + and then + not (System_Dispatching_Domain (CPU'First .. First - 1) = + (CPU'First .. First - 1 => False))) + or else (Last < Number_Of_CPUs + and then not + (System_Dispatching_Domain + (Last + 1 .. Number_Of_CPUs) = + (Last + 1 .. Number_Of_CPUs => False))); -- Constant that indicates whether there would exist a non-empty system -- dispatching domain after the creation of this dispatching domain. @@ -231,7 +233,9 @@ package body System.Multiprocessors.Dispatching_Domains is ----------------------------- procedure Delay_Until_And_Set_CPU - (Delay_Until_Time : Ada.Real_Time.Time; CPU : CPU_Range) is + (Delay_Until_Time : Ada.Real_Time.Time; + CPU : CPU_Range) + is begin -- Not supported atomically by the underlying operating systems. -- Operating systems use to migrate the task immediately after the call @@ -258,8 +262,8 @@ package body System.Multiprocessors.Dispatching_Domains is function Get_CPU (T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) - return CPU_Range is + Ada.Task_Identification.Current_Task) return CPU_Range + is begin return Convert_Ids (T).Common.Base_CPU; end Get_CPU; @@ -270,8 +274,8 @@ package body System.Multiprocessors.Dispatching_Domains is function Get_Dispatching_Domain (T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) - return Dispatching_Domain is + Ada.Task_Identification.Current_Task) return Dispatching_Domain + is begin return Dispatching_Domain (Convert_Ids (T).Common.Domain); end Get_Dispatching_Domain; @@ -317,7 +321,7 @@ package body System.Multiprocessors.Dispatching_Domains is procedure Set_CPU (CPU : CPU_Range; T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) + Ada.Task_Identification.Current_Task) is Target : constant ST.Task_Id := Convert_Ids (T); @@ -366,8 +370,8 @@ package body System.Multiprocessors.Dispatching_Domains is -- Change the number of tasks attached to a given task in the system -- domain if needed. - if not Dispatching_Domains_Frozen and then - (Domain = null or else Domain = ST.System_Domain) + if not Dispatching_Domains_Frozen + and then (Domain = null or else Domain = ST.System_Domain) then -- Reduce the number of tasks attached to the CPU from which this -- task is being moved, if needed. diff --git a/gcc/ada/s-mudido.adb b/gcc/ada/s-mudido.adb index caba742..990a7bc 100644 --- a/gcc/ada/s-mudido.adb +++ b/gcc/ada/s-mudido.adb @@ -54,10 +54,9 @@ package body System.Multiprocessors.Dispatching_Domains is (Domain : in out Dispatching_Domain; CPU : CPU_Range := Not_A_Specific_CPU; T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) + Ada.Task_Identification.Current_Task) is pragma Unreferenced (Domain, CPU, T); - begin raise Dispatching_Domain_Error with "dispatching domains not supported"; end Assign_Task; @@ -68,7 +67,6 @@ package body System.Multiprocessors.Dispatching_Domains is function Create (First, Last : CPU) return Dispatching_Domain is pragma Unreferenced (First, Last); - begin raise Dispatching_Domain_Error with "dispatching domains not supported"; return System_Dispatching_Domain; @@ -79,10 +77,10 @@ package body System.Multiprocessors.Dispatching_Domains is ----------------------------- procedure Delay_Until_And_Set_CPU - (Delay_Until_Time : Ada.Real_Time.Time; CPU : CPU_Range) + (Delay_Until_Time : Ada.Real_Time.Time; + CPU : CPU_Range) is pragma Unreferenced (Delay_Until_Time, CPU); - begin raise Dispatching_Domain_Error with "dispatching domains not supported"; end Delay_Until_And_Set_CPU; @@ -102,11 +100,9 @@ package body System.Multiprocessors.Dispatching_Domains is function Get_CPU (T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) - return CPU_Range + Ada.Task_Identification.Current_Task) return CPU_Range is pragma Unreferenced (T); - begin return Not_A_Specific_CPU; end Get_CPU; @@ -117,11 +113,9 @@ package body System.Multiprocessors.Dispatching_Domains is function Get_Dispatching_Domain (T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) - return Dispatching_Domain + Ada.Task_Identification.Current_Task) return Dispatching_Domain is pragma Unreferenced (T); - begin return System_Dispatching_Domain; end Get_Dispatching_Domain; @@ -132,7 +126,6 @@ package body System.Multiprocessors.Dispatching_Domains is function Get_First_CPU (Domain : Dispatching_Domain) return CPU is pragma Unreferenced (Domain); - begin return CPU'First; end Get_First_CPU; @@ -143,7 +136,6 @@ package body System.Multiprocessors.Dispatching_Domains is function Get_Last_CPU (Domain : Dispatching_Domain) return CPU is pragma Unreferenced (Domain); - begin return Number_Of_CPUs; end Get_Last_CPU; @@ -155,10 +147,9 @@ package body System.Multiprocessors.Dispatching_Domains is procedure Set_CPU (CPU : CPU_Range; T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) + Ada.Task_Identification.Current_Task) is pragma Unreferenced (CPU, T); - begin raise Dispatching_Domain_Error with "dispatching domains not supported"; end Set_CPU; diff --git a/gcc/ada/s-mudido.ads b/gcc/ada/s-mudido.ads index 62cc01d..635a847 100644 --- a/gcc/ada/s-mudido.ads +++ b/gcc/ada/s-mudido.ads @@ -39,31 +39,31 @@ package System.Multiprocessors.Dispatching_Domains is function Get_Dispatching_Domain (T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) - return Dispatching_Domain; + Ada.Task_Identification.Current_Task) return Dispatching_Domain; procedure Assign_Task (Domain : in out Dispatching_Domain; CPU : CPU_Range := Not_A_Specific_CPU; T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task); + Ada.Task_Identification.Current_Task); procedure Set_CPU (CPU : CPU_Range; T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task); + Ada.Task_Identification.Current_Task); function Get_CPU (T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) - return CPU_Range; + Ada.Task_Identification.Current_Task) return CPU_Range; procedure Delay_Until_And_Set_CPU - (Delay_Until_Time : Ada.Real_Time.Time; CPU : CPU_Range); + (Delay_Until_Time : Ada.Real_Time.Time; + CPU : CPU_Range); private type Dispatching_Domain is new System.Tasking.Dispatching_Domain_Access; System_Dispatching_Domain : constant Dispatching_Domain := - Dispatching_Domain (System.Tasking.System_Domain); + Dispatching_Domain + (System.Tasking.System_Domain); end System.Multiprocessors.Dispatching_Domains; diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb index ca059c9..6bc89fc 100644 --- a/gcc/ada/s-taprop-hpux-dce.adb +++ b/gcc/ada/s-taprop-hpux-dce.adb @@ -1247,6 +1247,7 @@ package body System.Task_Primitives.Operations is procedure Set_Task_Affinity (T : ST.Task_Id) is pragma Unreferenced (T); + begin -- Setting task affinity is not supported by the underlying system diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb index 9eb766c..bfa425e 100644 --- a/gcc/ada/s-taprop-irix.adb +++ b/gcc/ada/s-taprop-irix.adb @@ -1348,6 +1348,7 @@ package body System.Task_Primitives.Operations is procedure Set_Task_Affinity (T : ST.Task_Id) is pragma Unreferenced (T); + begin -- Setting task affinity is not supported by the underlying system diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index 7296ca1..6b3eb0b 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -885,6 +885,7 @@ package body System.Task_Primitives.Operations is elsif T.Common.Domain /= null then declare CPU_Set : aliased cpu_set_t := (bits => (others => False)); + begin -- Set the affinity to all the processors belonging to the -- dispatching domain. @@ -1365,7 +1366,6 @@ package body System.Task_Primitives.Operations is if pthread_setaffinity_np'Address /= System.Null_Address then declare CPU_Set : access cpu_set_t := null; - Result : Interfaces.C.int; begin @@ -1374,6 +1374,7 @@ package body System.Task_Primitives.Operations is -- domain, if any. if T.Common.Base_CPU /= Multiprocessors.Not_A_Specific_CPU then + -- Set the affinity to an unique CPU CPU_Set := new cpu_set_t'(bits => (others => False)); @@ -1389,9 +1390,10 @@ package body System.Task_Primitives.Operations is -- Handle dispatching domains elsif T.Common.Domain /= null and then - (T.Common.Domain /= ST.System_Domain or else - T.Common.Domain.all /= (Multiprocessors.CPU'First .. - Multiprocessors.Number_Of_CPUs => True)) + (T.Common.Domain /= ST.System_Domain + or else T.Common.Domain.all /= + (Multiprocessors.CPU'First .. + Multiprocessors.Number_Of_CPUs => True)) then -- Set the affinity to all the processors belonging to the -- dispatching domain. To avoid changing CPU affinities when @@ -1414,9 +1416,7 @@ package body System.Task_Primitives.Operations is if CPU_Set /= null then Result := pthread_setaffinity_np - (T.Common.LL.Thread, - CPU_SETSIZE / 8, - CPU_Set); + (T.Common.LL.Thread, CPU_SETSIZE / 8, CPU_Set); pragma Assert (Result = 0); end if; end; diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index a770a6a..4d31ca1 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -1187,6 +1187,7 @@ package body System.Task_Primitives.Operations is procedure Set_True (S : in out Suspension_Object) is Result : BOOL; + begin SSL.Abort_Defer.all; @@ -1203,6 +1204,7 @@ package body System.Task_Primitives.Operations is Result := SetEvent (S.CV); pragma Assert (Result = Win32.TRUE); + else S.State := True; end if; @@ -1226,6 +1228,7 @@ package body System.Task_Primitives.Operations is EnterCriticalSection (S.L'Access); if S.Waiting then + -- Program_Error must be raised upon calling Suspend_Until_True -- if another task is already waiting on that suspension object -- (ARM D.10 par. 10). @@ -1235,6 +1238,7 @@ package body System.Task_Primitives.Operations is SSL.Abort_Undefer.all; raise Program_Error; + else -- Suspend the task if the state is False. Otherwise, the task -- continues its execution, and the state of the suspension object @@ -1246,6 +1250,7 @@ package body System.Task_Primitives.Operations is LeaveCriticalSection (S.L'Access); SSL.Abort_Undefer.all; + else S.Waiting := True; @@ -1268,8 +1273,7 @@ package body System.Task_Primitives.Operations is -- Check_Exit -- ---------------- - -- Dummy versions. The only currently working versions is for solaris - -- (native). + -- Dummy versions, currently this only works for solaris (native) function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); @@ -1365,8 +1369,9 @@ package body System.Task_Primitives.Operations is -- The CPU numbering in pragma CPU starts at 1 while the subprogram -- to set the affinity starts at 0, therefore we must substract 1. - Result := SetThreadIdealProcessor - (T.Common.LL.Thread, ProcessorId (T.Common.Base_CPU) - 1); + Result := + SetThreadIdealProcessor + (T.Common.LL.Thread, ProcessorId (T.Common.Base_CPU) - 1); pragma Assert (Result = 1); -- Task_Info @@ -1381,10 +1386,12 @@ package body System.Task_Primitives.Operations is -- Dispatching domains - elsif T.Common.Domain /= null and then - (T.Common.Domain /= ST.System_Domain or else - T.Common.Domain.all /= (Multiprocessors.CPU'First .. - Multiprocessors.Number_Of_CPUs => True)) + elsif T.Common.Domain /= null + and then (T.Common.Domain /= ST.System_Domain + or else + T.Common.Domain.all /= + (Multiprocessors.CPU'First .. + Multiprocessors.Number_Of_CPUs => True)) then declare CPU_Set : DWORD := 0; @@ -1392,6 +1399,7 @@ package body System.Task_Primitives.Operations is begin for Proc in T.Common.Domain'Range loop if T.Common.Domain (Proc) then + -- The thread affinity mask is a bit vector in which each -- bit represents a logical processor. diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index b367915..440d941 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/gcc/ada/s-taprop-posix.adb @@ -1455,6 +1455,7 @@ package body System.Task_Primitives.Operations is procedure Set_Task_Affinity (T : ST.Task_Id) is pragma Unreferenced (T); + begin -- Setting task affinity is not supported by the underlying system diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index 31862fa..278b32c 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/gcc/ada/s-taprop-solaris.adb @@ -1947,7 +1947,7 @@ package body System.Task_Primitives.Operations is -- pragma CPU if T.Common.Base_CPU /= - System.Multiprocessors.Not_A_Specific_CPU + System.Multiprocessors.Not_A_Specific_CPU then -- The CPU numbering in pragma CPU starts at 1 while the subprogram -- to set the affinity starts at 0, therefore we must substract 1. @@ -1968,6 +1968,7 @@ package body System.Task_Primitives.Operations is if T.Common.Task_Info.CPU = ANY_CPU then Result := 0; + Proc := 0; while Proc < Last_Proc loop Result := p_online (Proc, PR_STATUS); @@ -1988,6 +1989,7 @@ package body System.Task_Primitives.Operations is then raise Invalid_CPU_Number; end if; + Result := processor_bind (P_LWPID, id_t (T.Common.LL.LWP), @@ -1998,15 +2000,15 @@ package body System.Task_Primitives.Operations is -- Handle dispatching domains - elsif T.Common.Domain /= null and then - (T.Common.Domain /= ST.System_Domain or else - T.Common.Domain.all /= (Multiprocessors.CPU'First .. - Multiprocessors.Number_Of_CPUs => True)) + elsif T.Common.Domain /= null + and then (T.Common.Domain /= ST.System_Domain + or else T.Common.Domain.all /= + (Multiprocessors.CPU'First .. + Multiprocessors.Number_Of_CPUs => True)) then declare CPU_Set : aliased psetid_t; - - Result : int; + Result : int; begin Result := pset_create (CPU_Set'Access); @@ -2016,9 +2018,9 @@ package body System.Task_Primitives.Operations is -- dispatching domain. for Proc in T.Common.Domain'Range loop + -- The Ada CPU numbering starts at 1 while the subprogram to - -- set the affinity starts at 0, therefore we must substract - -- 1. + -- set the affinity starts at 0, therefore we must substract 1. if T.Common.Domain (Proc) then Result := diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb index 55c4bd4..2fe2441 100644 --- a/gcc/ada/s-taprop-tru64.adb +++ b/gcc/ada/s-taprop-tru64.adb @@ -1361,6 +1361,7 @@ package body System.Task_Primitives.Operations is procedure Set_Task_Affinity (T : ST.Task_Id) is pragma Unreferenced (T); + begin -- Setting task affinity is not supported by the underlying system diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb index dbb84db..1cfafbb 100644 --- a/gcc/ada/s-taprop-vms.adb +++ b/gcc/ada/s-taprop-vms.adb @@ -1260,6 +1260,7 @@ package body System.Task_Primitives.Operations is procedure Set_Task_Affinity (T : ST.Task_Id) is pragma Unreferenced (T); + begin -- Setting task affinity is not supported by the underlying system diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index b1c88f3..068e5eb 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -1411,9 +1411,9 @@ package body System.Task_Primitives.Operations is -- pragma CPU if T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then - -- Ada 2012 pragma CPU uses CPU numbers starting from 1, while - -- on VxWorks the first CPU is identified by a 0, so we need to - -- adjust. + + -- Ada 2012 pragma CPU uses CPU numbers starting from 1, while on + -- VxWorks the first CPU is identified by a 0, so we need to adjust. Result := taskCpuAffinitySet @@ -1422,24 +1422,26 @@ package body System.Task_Primitives.Operations is -- Task_Info elsif T.Common.Task_Info /= Unspecified_Task_Info then - Result := - taskCpuAffinitySet (T.Common.LL.Thread, T.Common.Task_Info); + Result := taskCpuAffinitySet (T.Common.LL.Thread, T.Common.Task_Info); -- Handle dispatching domains - elsif T.Common.Domain /= null and then - (T.Common.Domain /= ST.System_Domain or else - T.Common.Domain.all /= (Multiprocessors.CPU'First .. - Multiprocessors.Number_Of_CPUs => True)) + elsif T.Common.Domain /= null + and then (T.Common.Domain /= ST.System_Domain + or else T.Common.Domain.all /= + (Multiprocessors.CPU'First .. + Multiprocessors.Number_Of_CPUs => True)) then declare CPU_Set : unsigned := 0; + begin -- Set the affinity to all the processors belonging to the -- dispatching domain. for Proc in T.Common.Domain'Range loop if T.Common.Domain (Proc) then + -- The thread affinity mask is a bit vector in which each -- bit represents a logical processor. @@ -1447,8 +1449,7 @@ package body System.Task_Primitives.Operations is end if; end loop; - Result := - taskMaskAffinitySet (T.Common.LL.Thread, CPU_Set); + Result := taskMaskAffinitySet (T.Common.LL.Thread, CPU_Set); end; end if; end Set_Task_Affinity; diff --git a/gcc/ada/s-taprop.ads b/gcc/ada/s-taprop.ads index e413b12..feb6f55 100644 --- a/gcc/ada/s-taprop.ads +++ b/gcc/ada/s-taprop.ads @@ -549,6 +549,7 @@ package System.Task_Primitives.Operations is procedure Set_Task_Affinity (T : ST.Task_Id); -- Enforce at the operating system level the task affinity defined in the - -- Ada Task Control Block. + -- Ada Task Control Block. Has no effect if the underlying operating system + -- does not support this capability. end System.Task_Primitives.Operations; diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index c79171b..01a4a46 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -224,8 +224,10 @@ package body System.Tasking is -- into account. Use Number_Of_CPUs to know the exact number of -- processors in the system at execution time. - System_Domain := new Dispatching_Domain' - (Multiprocessors.CPU'First .. Multiprocessors.Number_Of_CPUs => True); + System_Domain := + new Dispatching_Domain' + (Multiprocessors.CPU'First .. Multiprocessors.Number_Of_CPUs => + True); T.Common.Domain := System_Domain; diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index 743ca58..47d9cac 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -394,8 +394,7 @@ package System.Tasking is type Dispatching_Domain_Access is access Dispatching_Domain; System_Domain : Dispatching_Domain_Access; - -- All processors belong to the default system dispatching domain at start - -- up. + -- All processors belong to default system dispatching domain at start up ------------------------------------ -- Task related other definitions -- @@ -419,9 +418,8 @@ package System.Tasking is function Storage_Size (T : Task_Id) return System.Parameters.Size_Type; -- Retrieve from the TCB of the task the allocated size of its stack, - -- either the system default or the size specified by a pragma. This - -- is in general a non-static value that can depend on discriminants - -- of the task. + -- either the system default or the size specified by a pragma. This is in + -- general a non-static value that can depend on discriminants of the task. type Bit_Array is array (Integer range <>) of Boolean; pragma Pack (Bit_Array); @@ -429,8 +427,8 @@ package System.Tasking is subtype Debug_Event_Array is Bit_Array (1 .. 16); Global_Task_Debug_Event_Set : Boolean := False; - -- Set True when running under debugger control and a task debug - -- event signal has been requested. + -- Set True when running under debugger control and a task debug event + -- signal has been requested. ---------------------------------------------- -- Ada_Task_Control_Block (ATCB) definition -- diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index b576ba8..951f218 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2250,15 +2250,13 @@ package body Sem_Ch5 is Analyze (Subt); end if; - -- If the domain of iteration is an expression, create a declaration - -- for it, so that finalization actions are introduced outside of the - -- loop. + -- If domain of iteration is an expression, create a declaration for it, + -- so that finalization actions are introduced outside of the loop. if not Is_Entity_Name (Iter_Name) then declare - Id : constant Entity_Id := Make_Temporary (Loc, 'R', Iter_Name); - - Decl : Node_Id; + Id : constant Entity_Id := Make_Temporary (Loc, 'R', Iter_Name); + Decl : Node_Id; begin Typ := Etype (Iter_Name); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index c2aa404..3ef284e 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -8101,8 +8101,8 @@ package body Sem_Res is Resolve (Condition (N), Typ); Expander_Mode_Restore; - -- In ALFA mode, we need expansion in order to introduce properly the - -- necessary transient scopes. + -- In ALFA mode, we need normal expansion in order to properly introduce + -- the necessary transient scopes. else Resolve (Condition (N), Typ); diff --git a/gcc/ada/vms_conv.adb b/gcc/ada/vms_conv.adb index e0e2901..5cde2a2 100644 --- a/gcc/ada/vms_conv.adb +++ b/gcc/ada/vms_conv.adb @@ -1804,8 +1804,8 @@ package body VMS_Conv is -- because the corresponding switch --unchecked... is -- for gnatmake, not for the compiler. - if Cargs and then - Sw.Name.all = "/UNCHECKED_SHARED_LIB_IMPORTS" + if Cargs + and then Sw.Name.all = "/UNCHECKED_SHARED_LIB_IMPORTS" then Cargs := False; end if; @@ -1825,6 +1825,7 @@ package body VMS_Conv is case Sw.Translation is when T_Direct => Place_Unix_Switches (Sw.Unix_String); + if SwP < Arg'Last and then Arg (SwP + 1) = '=' then @@ -1863,8 +1864,8 @@ package body VMS_Conv is Arg_Idx := Argv'First; Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx); - Arg := new String' - (Argv (Arg_Idx .. Next_Arg_Idx)); + Arg := + new String'(Argv (Arg_Idx .. Next_Arg_Idx)); goto Tryagain_After_Coalesce; end if; @@ -1892,9 +1893,8 @@ package body VMS_Conv is while P2 < Endp and then Arg (P2 + 1) /= ',' loop - -- A wildcard directory spec on - -- VMS will contain either * or - -- % or ... + -- A wildcard directory spec on VMS will + -- contain either * or % or ... if Arg (P2) = '*' then Dir_Is_Wild := True; @@ -1928,15 +1928,12 @@ package body VMS_Conv is (Arg (SwP .. P2), True); for J in Dir_List.all'Range loop - Place_Unix_Switches - (Sw.Unix_String); - Place_Lower - (Dir_List.all (J).all); + Place_Unix_Switches (Sw.Unix_String); + Place_Lower (Dir_List.all (J).all); end loop; else - Place_Unix_Switches - (Sw.Unix_String); + Place_Unix_Switches (Sw.Unix_String); Place_Lower (To_Canonical_Dir_Spec (Arg (SwP .. P2), False).all); @@ -1956,37 +1953,33 @@ package body VMS_Conv is else Place_Unix_Switches (Sw.Unix_String); - -- Some switches end in "=". No space - -- here + -- Some switches end in "=", no space here if Sw.Unix_String - (Sw.Unix_String'Last) /= '=' + (Sw.Unix_String'Last) /= '=' then Place (' '); end if; Place_Lower (To_Canonical_Dir_Spec - (Arg (SwP + 2 .. Arg'Last), - False).all); + (Arg (SwP + 2 .. Arg'Last), False).all); end if; when T_File | T_No_Space_File => if SwP + 2 > Arg'Last then - Put (Standard_Error, - "missing file for: "); + Put (Standard_Error, "missing file for: "); Put_Line (Standard_Error, Arg.all); Errors := Errors + 1; else Place_Unix_Switches (Sw.Unix_String); - -- Some switches end in "=". No space - -- here. + -- Some switches end in "=", no space here. if Sw.Translation = T_File and then Sw.Unix_String - (Sw.Unix_String'Last) /= '=' + (Sw.Unix_String'Last) /= '=' then Place (' '); end if; @@ -2004,14 +1997,13 @@ package body VMS_Conv is else Put (Standard_Error, "argument for "); Put (Standard_Error, Sw.Name.all); - Put_Line - (Standard_Error, " must be numeric"); + Put_Line (Standard_Error, " must be numeric"); Errors := Errors + 1; end if; when T_Alphanumplus => if OK_Alphanumerplus - (Arg (SwP + 2 .. Arg'Last)) + (Arg (SwP + 2 .. Arg'Last)) then Place_Unix_Switches (Sw.Unix_String); Place (Arg (SwP + 2 .. Arg'Last)); @@ -2026,28 +2018,28 @@ package body VMS_Conv is when T_String => - -- A String value must be extended to the - -- end of the Argv, otherwise strings like - -- "foo/bar" get split at the slash. + -- A String value must be extended to the end of + -- the Argv, otherwise strings like "foo/bar" get + -- split at the slash. - -- The beginning and ending of the string - -- are flagged with embedded nulls which - -- are removed when building the Spawn - -- call. Nulls are use because they won't - -- show up in a /? output. Quotes aren't - -- used because that would make it + -- The beginning and ending of the string are + -- flagged with embedded nulls which are removed + -- when building the Spawn call. Nulls are use + -- because they won't show up in a /? output. + -- Quotes aren't used because that would make it -- difficult to embed them. Place_Unix_Switches (Sw.Unix_String); if Next_Arg_Idx /= Argv'Last then Next_Arg_Idx := Argv'Last; - Arg := new String' - (Argv (Arg_Idx .. Next_Arg_Idx)); + Arg := + new String'(Argv (Arg_Idx .. Next_Arg_Idx)); SwP := Arg'First; - while SwP < Arg'Last and then - Arg (SwP + 1) /= '=' loop + while SwP < Arg'Last + and then Arg (SwP + 1) /= '=' + loop SwP := SwP + 1; end loop; end if; @@ -2072,10 +2064,9 @@ package body VMS_Conv is Make_Commands_Active := null; else - -- Set source of new commands, also - -- setting this non-null indicates that - -- we are in the special commands mode - -- for processing the -xargs case. + -- Set source of new commands, also setting this + -- non-null indicates that we are in the special + -- commands mode for processing the -xargs case. Make_Commands_Active := Matching_Name @@ -2087,8 +2078,7 @@ package body VMS_Conv is when T_Options => if SwP + 1 > Arg'Last then - Place_Unix_Switches - (Sw.Options.Unix_String); + Place_Unix_Switches (Sw.Options.Unix_String); SwP := Endp + 1; elsif Arg (SwP + 2) /= '(' then @@ -2109,7 +2099,6 @@ package body VMS_Conv is while SwP <= Endp loop P2 := SwP; - while P2 < Endp and then Arg (P2 + 1) /= ',' loop @@ -2122,8 +2111,7 @@ package body VMS_Conv is Sw.Options); if Opt /= null then - Place_Unix_Switches - (Opt.Unix_String); + Place_Unix_Switches (Opt.Unix_String); end if; SwP := P2 + 2; @@ -2131,8 +2119,7 @@ package body VMS_Conv is when T_Other => Place_Unix_Switches - (new String'(Sw.Unix_String.all & - Arg.all)); + (new String'(Sw.Unix_String.all & Arg.all)); end case; end if; -- 2.7.4