Skip to content

R
riscv-gcc-1
Commit 39eb6542 by Arnaud Charlet
Options

[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
parent 9db0b232
Showing with 46 additions and 15 deletions
gcc/ada/ChangeLog
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
......
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
......
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
......
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
......
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;
......
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