diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/ada/exp_cg.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-mingw.adb | 19 |
5 files changed, 46 insertions, 15 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c06dd652e2a..b389fed7e3a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2010-10-04 Arnaud Charlet <charlet@adacore.com> + + * s-taprop-mingw.adb (Create_Task): Initialize Thread_Id field to 0. + +2010-10-04 Robert Dewar <dewar@adacore.com> + + * exp_cg.adb: Minor code reorganization + Minor reformatting. + * exp_ch5.adb, prj-nmsc.adb: Minor reformatting. + 2010-10-04 Bob Duff <duff@adacore.com> * sem_res.adb (Resolve_Type_Conversion): If a type conversion is needed diff --git a/gcc/ada/exp_cg.adb b/gcc/ada/exp_cg.adb index 004cf449572..6db3929b68f 100644 --- a/gcc/ada/exp_cg.adb +++ b/gcc/ada/exp_cg.adb @@ -173,7 +173,8 @@ package body Exp_CG is --------------------------- function Homonym_Suffix_Length (E : Entity_Id) return Natural is - Prefix_Length : constant := 2; -- Length of prefix "__" + Prefix_Length : constant := 2; + -- Length of prefix "__" H : Entity_Id; Nr : Nat := 1; @@ -200,11 +201,13 @@ package body Exp_CG is else declare Result : Natural := Prefix_Length + 1; + begin while Nr >= 10 loop Result := Result + 1; Nr := Nr / 10; end loop; + return Result; end; end if; @@ -214,7 +217,7 @@ package body Exp_CG is -- Local variables Full_Name : constant String := Get_Name_String (Chars (E)); - Suffix_Length : Natural := Homonym_Suffix_Length (E); + Suffix_Length : Natural; TSS_Name : TSS_Name_Type; -- Start of processing for Is_Predefined_Dispatching_Operation @@ -226,6 +229,7 @@ package body Exp_CG is -- Search for and strip suffix for body-nested package entities + Suffix_Length := Homonym_Suffix_Length (E); for J in reverse Full_Name'First + 2 .. Full_Name'Last loop if Full_Name (J) = 'X' then diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 7eaa30eda58..18bda5d5b3f 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1370,7 +1370,6 @@ package body Exp_Ch5 is begin Result := New_List; - Item := First (CI); while Present (Item) loop diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index babb17d69b4..68c1849fa62 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -5280,15 +5280,20 @@ package body Prj.Nmsc is Recursive_Dirs.Reset (Visited); end Find_Source_Dirs; + -- Local declarations + Dir_Exists : Boolean; No_Sources : constant Boolean := - (((not Source_Files.Default) and then Source_Files.Values = Nil_String) - or else - ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String) - or else - ((not Languages.Default) and then Languages.Values = Nil_String)) - and then Project.Extends = No_Project; + ((not Source_Files.Default + and then Source_Files.Values = Nil_String) + or else + (not Source_Dirs.Default + and then Source_Dirs.Values = Nil_String) + or else + (not Languages.Default + and then Languages.Values = Nil_String)) + and then Project.Extends = No_Project; -- Start of processing for Get_Directories @@ -5318,6 +5323,7 @@ package body Prj.Nmsc is Object_Dir.Location, Project); elsif not No_Sources then + -- We check that the specified object directory does exist. -- However, even when it doesn't exist, we set it to a default -- value. This is for the benefit of tools that recover from @@ -5338,8 +5344,8 @@ package body Prj.Nmsc is if not Dir_Exists and then not Project.Externally_Built then - -- The object directory does not exist, report an error if - -- the project is not externally built. + -- The object directory does not exist, report an error if the + -- project is not externally built. Err_Vars.Error_Msg_File_1 := File_Name_Type (Object_Dir.Value); @@ -5389,6 +5395,7 @@ package body Prj.Nmsc is Exec_Dir.Location, Project); elsif not No_Sources then + -- We check that the specified exec directory does exist Locate_Directory diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index a3b19ab5c5d..2339e528cdd 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -918,6 +918,15 @@ package body System.Task_Primitives.Operations is T.Common.LL.Thread := hTask; + -- Note: it would be useful to initialize Thread_Id right away to avoid + -- a race condition in gdb where Thread_ID may not have the right value + -- yet, but GetThreadId is a Vista specific API, not available under XP: + -- T.Common.LL.Thread_Id := GetThreadId (hTask); so instead we set the + -- field to 0 to avoid having a random value. Thread_Id is initialized + -- in Enter_Task anyway. + + T.Common.LL.Thread_Id := 0; + -- Step 3: set its priority (child has inherited priority from parent) Set_Priority (T, Priority); @@ -927,8 +936,8 @@ package body System.Task_Primitives.Operations is or else Get_Policy (Priority) = 'F' then -- Here we need Annex D semantics so we disable the NT priority - -- boost. A priority boost is temporarily given by the system to a - -- thread when it is taken out of a wait state. + -- boost. A priority boost is temporarily given by the system to + -- a thread when it is taken out of a wait state. SetThreadPriorityBoost (hTask, DisablePriorityBoost => Win32.TRUE); end if; @@ -942,7 +951,7 @@ package body System.Task_Primitives.Operations is end if; end if; - -- Step 5: Now, start it for good: + -- Step 5: Now, start it for good Result := ResumeThread (hTask); pragma Assert (Result = 1); @@ -1122,6 +1131,7 @@ package body System.Task_Primitives.Operations is procedure Finalize (S : in out Suspension_Object) is Result : BOOL; + begin -- Destroy internal mutex @@ -1200,6 +1210,7 @@ package body System.Task_Primitives.Operations is procedure Suspend_Until_True (S : in out Suspension_Object) is Result : DWORD; Result_Bool : BOOL; + begin SSL.Abort_Defer.all; |