mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-02-26 06:45:29 +08:00
[multiple changes]
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. From-SVN: r164937
This commit is contained in:
parent
9db0b2326f
commit
39eb65425d
@ -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>
|
2010-10-04 Bob Duff <duff@adacore.com>
|
||||||
|
|
||||||
* sem_res.adb (Resolve_Type_Conversion): If a type conversion is needed
|
* sem_res.adb (Resolve_Type_Conversion): If a type conversion is needed
|
||||||
|
@ -173,7 +173,8 @@ package body Exp_CG is
|
|||||||
---------------------------
|
---------------------------
|
||||||
|
|
||||||
function Homonym_Suffix_Length (E : Entity_Id) return Natural 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;
|
H : Entity_Id;
|
||||||
Nr : Nat := 1;
|
Nr : Nat := 1;
|
||||||
@ -200,11 +201,13 @@ package body Exp_CG is
|
|||||||
else
|
else
|
||||||
declare
|
declare
|
||||||
Result : Natural := Prefix_Length + 1;
|
Result : Natural := Prefix_Length + 1;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
while Nr >= 10 loop
|
while Nr >= 10 loop
|
||||||
Result := Result + 1;
|
Result := Result + 1;
|
||||||
Nr := Nr / 10;
|
Nr := Nr / 10;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
return Result;
|
return Result;
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
@ -214,7 +217,7 @@ package body Exp_CG is
|
|||||||
-- Local variables
|
-- Local variables
|
||||||
|
|
||||||
Full_Name : constant String := Get_Name_String (Chars (E));
|
Full_Name : constant String := Get_Name_String (Chars (E));
|
||||||
Suffix_Length : Natural := Homonym_Suffix_Length (E);
|
Suffix_Length : Natural;
|
||||||
TSS_Name : TSS_Name_Type;
|
TSS_Name : TSS_Name_Type;
|
||||||
|
|
||||||
-- Start of processing for Is_Predefined_Dispatching_Operation
|
-- 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
|
-- 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
|
for J in reverse Full_Name'First + 2 .. Full_Name'Last loop
|
||||||
if Full_Name (J) = 'X' then
|
if Full_Name (J) = 'X' then
|
||||||
|
|
||||||
|
@ -1370,7 +1370,6 @@ package body Exp_Ch5 is
|
|||||||
|
|
||||||
begin
|
begin
|
||||||
Result := New_List;
|
Result := New_List;
|
||||||
|
|
||||||
Item := First (CI);
|
Item := First (CI);
|
||||||
while Present (Item) loop
|
while Present (Item) loop
|
||||||
|
|
||||||
|
@ -5280,15 +5280,20 @@ package body Prj.Nmsc is
|
|||||||
Recursive_Dirs.Reset (Visited);
|
Recursive_Dirs.Reset (Visited);
|
||||||
end Find_Source_Dirs;
|
end Find_Source_Dirs;
|
||||||
|
|
||||||
|
-- Local declarations
|
||||||
|
|
||||||
Dir_Exists : Boolean;
|
Dir_Exists : Boolean;
|
||||||
|
|
||||||
No_Sources : constant Boolean :=
|
No_Sources : constant Boolean :=
|
||||||
(((not Source_Files.Default) and then Source_Files.Values = Nil_String)
|
((not Source_Files.Default
|
||||||
or else
|
and then Source_Files.Values = Nil_String)
|
||||||
((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
|
or else
|
||||||
or else
|
(not Source_Dirs.Default
|
||||||
((not Languages.Default) and then Languages.Values = Nil_String))
|
and then Source_Dirs.Values = Nil_String)
|
||||||
and then Project.Extends = No_Project;
|
or else
|
||||||
|
(not Languages.Default
|
||||||
|
and then Languages.Values = Nil_String))
|
||||||
|
and then Project.Extends = No_Project;
|
||||||
|
|
||||||
-- Start of processing for Get_Directories
|
-- Start of processing for Get_Directories
|
||||||
|
|
||||||
@ -5318,6 +5323,7 @@ package body Prj.Nmsc is
|
|||||||
Object_Dir.Location, Project);
|
Object_Dir.Location, Project);
|
||||||
|
|
||||||
elsif not No_Sources then
|
elsif not No_Sources then
|
||||||
|
|
||||||
-- We check that the specified object directory does exist.
|
-- We check that the specified object directory does exist.
|
||||||
-- However, even when it doesn't exist, we set it to a default
|
-- However, even when it doesn't exist, we set it to a default
|
||||||
-- value. This is for the benefit of tools that recover from
|
-- value. This is for the benefit of tools that recover from
|
||||||
@ -5338,8 +5344,8 @@ package body Prj.Nmsc is
|
|||||||
if not Dir_Exists
|
if not Dir_Exists
|
||||||
and then not Project.Externally_Built
|
and then not Project.Externally_Built
|
||||||
then
|
then
|
||||||
-- The object directory does not exist, report an error if
|
-- The object directory does not exist, report an error if the
|
||||||
-- the project is not externally built.
|
-- project is not externally built.
|
||||||
|
|
||||||
Err_Vars.Error_Msg_File_1 :=
|
Err_Vars.Error_Msg_File_1 :=
|
||||||
File_Name_Type (Object_Dir.Value);
|
File_Name_Type (Object_Dir.Value);
|
||||||
@ -5389,6 +5395,7 @@ package body Prj.Nmsc is
|
|||||||
Exec_Dir.Location, Project);
|
Exec_Dir.Location, Project);
|
||||||
|
|
||||||
elsif not No_Sources then
|
elsif not No_Sources then
|
||||||
|
|
||||||
-- We check that the specified exec directory does exist
|
-- We check that the specified exec directory does exist
|
||||||
|
|
||||||
Locate_Directory
|
Locate_Directory
|
||||||
|
@ -6,7 +6,7 @@
|
|||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- 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;
|
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)
|
-- Step 3: set its priority (child has inherited priority from parent)
|
||||||
|
|
||||||
Set_Priority (T, Priority);
|
Set_Priority (T, Priority);
|
||||||
@ -927,8 +936,8 @@ package body System.Task_Primitives.Operations is
|
|||||||
or else Get_Policy (Priority) = 'F'
|
or else Get_Policy (Priority) = 'F'
|
||||||
then
|
then
|
||||||
-- Here we need Annex D semantics so we disable the NT priority
|
-- Here we need Annex D semantics so we disable the NT priority
|
||||||
-- boost. A priority boost is temporarily given by the system to a
|
-- boost. A priority boost is temporarily given by the system to
|
||||||
-- thread when it is taken out of a wait state.
|
-- a thread when it is taken out of a wait state.
|
||||||
|
|
||||||
SetThreadPriorityBoost (hTask, DisablePriorityBoost => Win32.TRUE);
|
SetThreadPriorityBoost (hTask, DisablePriorityBoost => Win32.TRUE);
|
||||||
end if;
|
end if;
|
||||||
@ -942,7 +951,7 @@ package body System.Task_Primitives.Operations is
|
|||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Step 5: Now, start it for good:
|
-- Step 5: Now, start it for good
|
||||||
|
|
||||||
Result := ResumeThread (hTask);
|
Result := ResumeThread (hTask);
|
||||||
pragma Assert (Result = 1);
|
pragma Assert (Result = 1);
|
||||||
@ -1122,6 +1131,7 @@ package body System.Task_Primitives.Operations is
|
|||||||
|
|
||||||
procedure Finalize (S : in out Suspension_Object) is
|
procedure Finalize (S : in out Suspension_Object) is
|
||||||
Result : BOOL;
|
Result : BOOL;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- Destroy internal mutex
|
-- Destroy internal mutex
|
||||||
|
|
||||||
@ -1200,6 +1210,7 @@ package body System.Task_Primitives.Operations is
|
|||||||
procedure Suspend_Until_True (S : in out Suspension_Object) is
|
procedure Suspend_Until_True (S : in out Suspension_Object) is
|
||||||
Result : DWORD;
|
Result : DWORD;
|
||||||
Result_Bool : BOOL;
|
Result_Bool : BOOL;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
SSL.Abort_Defer.all;
|
SSL.Abort_Defer.all;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user