OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2010-06-23  Jose Ruiz  <ruiz@adacore.com>

	* a-reatim.adb, a-retide.adb: Move the initialization of the tasking
	run time from Ada.Real_Time.Delays to Ada.Real_Time. This way, calls to
	Clock (without delays) use a run time which is properly initialized.

2010-06-23  Vincent Celier  <celier@adacore.com>

	* make.adb: Do not set Check_Readonly_Files when setting Must_Compile,
	when -f -u and a main is specified on the command line. However,
	attempt to compile even when the ALI file is read-only when
	Must_Compile is True.

2010-06-23  Thomas Quinot  <quinot@adacore.com>

	* checks.adb, g-pehage.adb, cstand.adb: Minor code factorization.

From-SVN: r161248
This commit is contained in:
Arnaud Charlet 2010-06-23 08:31:57 +02:00
parent b4d7b435e0
commit 5b599df4d1
7 changed files with 56 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gcc/ada/ChangeLog
View File

@ -1,3 +1,20 @@
2010-06-23 Jose Ruiz <ruiz@adacore.com>
* a-reatim.adb, a-retide.adb: Move the initialization of the tasking
run time from Ada.Real_Time.Delays to Ada.Real_Time. This way, calls to
Clock (without delays) use a run time which is properly initialized.
2010-06-23 Vincent Celier <celier@adacore.com>
* make.adb: Do not set Check_Readonly_Files when setting Must_Compile,
when -f -u and a main is specified on the command line. However,
attempt to compile even when the ALI file is read-only when
Must_Compile is True.
2010-06-23 Thomas Quinot <quinot@adacore.com>
* checks.adb, g-pehage.adb, cstand.adb: Minor code factorization.
2010-06-23 Javier Miranda <miranda@adacore.com> 2010-06-23 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Add_Internal_Interface_Entities): Generate internal * sem_ch3.adb (Add_Internal_Interface_Entities): Generate internal

8
gcc/ada/a-reatim.adb
View File

@ -32,7 +32,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with System.OS_Primitives; with System.Tasking;
package body Ada.Real_Time is package body Ada.Real_Time is
@ -245,5 +245,9 @@ package body Ada.Real_Time is
end To_Time_Span; end To_Time_Span;
begin begin
System.OS_Primitives.Initialize; -- Ensure that the tasking run time is initialized when using clock and/or
-- delay operations. The initialization routine has the required machinery
-- to prevent multiple calls to Initialize.
System.Tasking.Initialize;
end Ada.Real_Time; end Ada.Real_Time;

8
gcc/ada/a-retide.adb
View File

@ -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- --
@ -75,10 +75,4 @@ package body Ada.Real_Time.Delays is
return To_Duration (Time_Span (T)); return To_Duration (Time_Span (T));
end To_Duration; end To_Duration;
begin
-- Ensure that the tasking run time is initialized when using delay
-- operations. The initialization routine has the required machinery to
-- prevent multiple calls to Initialize.
System.Tasking.Initialize;
end Ada.Real_Time.Delays; end Ada.Real_Time.Delays;

42
gcc/ada/checks.adb
View File

@ -3351,7 +3351,7 @@ package body Checks is
Indx := Next_Index (Indx); Indx := Next_Index (Indx);
end loop; end loop;
-- if The index type is a formal type, or derived from -- If the index type is a formal type or derived from
-- one, the bounds are not static. -- one, the bounds are not static.
if Is_Generic_Type (Root_Type (Etype (Indx))) then if Is_Generic_Type (Root_Type (Etype (Indx))) then
@ -3378,8 +3378,8 @@ package body Checks is
-- For constrained arrays, the minimum value for -- For constrained arrays, the minimum value for
-- Length is taken from the actual value of the -- Length is taken from the actual value of the
-- bounds, since the index will be exactly of -- bounds, since the index will be exactly of this
-- this subtype. -- subtype.
if Is_Constrained (Atyp) then if Is_Constrained (Atyp) then
Lor := UI_Max (Uint_0, UL - LU + 1); Lor := UI_Max (Uint_0, UL - LU + 1);
@ -3395,7 +3395,7 @@ package body Checks is
end; end;
-- No special handling for other attributes -- No special handling for other attributes
-- Probably more opportunities exist here ??? -- Probably more opportunities exist here???
when others => when others =>
OK1 := False; OK1 := False;
@ -3416,33 +3416,31 @@ package body Checks is
Hir := No_Uint; Hir := No_Uint;
end case; end case;
-- At this stage, if OK1 is true, then we know that the actual -- At this stage, if OK1 is true, then we know that the actual result of
-- result of the computed expression is in the range Lor .. Hir. -- the computed expression is in the range Lor .. Hir. We can use this
-- We can use this to restrict the possible range of results. -- to restrict the possible range of results.
if OK1 then if OK1 then
-- If the refined value of the low bound is greater than the -- If the refined value of the low bound is greater than the type
-- type high bound, then reset it to the more restrictive -- high bound, then reset it to the more restrictive value. However,
-- value. However, we do NOT do this for the case of a modular -- we do NOT do this for the case of a modular type where the
-- type where the possible upper bound on the value is above the -- possible upper bound on the value is above the base type high
-- base type high bound, because that means the result could wrap. -- bound, because that means the result could wrap.
if Lor > Lo if Lor > Lo
and then not (Is_Modular_Integer_Type (Typ) and then not (Is_Modular_Integer_Type (Typ) and then Hir > Hbound)
and then Hir > Hbound)
then then
Lo := Lor; Lo := Lor;
end if; end if;
-- Similarly, if the refined value of the high bound is less -- Similarly, if the refined value of the high bound is less than the
-- than the value so far, then reset it to the more restrictive -- value so far, then reset it to the more restrictive value. Again,
-- value. Again, we do not do this if the refined low bound is -- we do not do this if the refined low bound is negative for a
-- negative for a modular type, since this would wrap. -- modular type, since this would wrap.
if Hir < Hi if Hir < Hi
and then not (Is_Modular_Integer_Type (Typ) and then not (Is_Modular_Integer_Type (Typ) and then Lor < Uint_0)
and then Lor < Uint_0)
then then
Hi := Hir; Hi := Hir;
end if; end if;
@ -3456,8 +3454,8 @@ package body Checks is
Determine_Range_Cache_Hi (Cindex) := Hi; Determine_Range_Cache_Hi (Cindex) := Hi;
return; return;
-- If any exception occurs, it means that we have some bug in the compiler -- If any exception occurs, it means that we have some bug in the compiler,
-- possibly triggered by a previous error, or by some unforseen peculiar -- possibly triggered by a previous error, or by some unforeseen peculiar
-- occurrence. However, this is only an optimization attempt, so there is -- occurrence. However, this is only an optimization attempt, so there is
-- really no point in crashing the compiler. Instead we just decide, too -- really no point in crashing the compiler. Instead we just decide, too
-- bad, we can't figure out a range in this case after all. -- bad, we can't figure out a range in this case after all.

7
gcc/ada/cstand.adb
View File

@ -324,7 +324,8 @@ package body CStand is
-- Procedure to declare given entity as an exception -- Procedure to declare given entity as an exception
procedure Pack_String_Type (String_Type : Entity_Id); procedure Pack_String_Type (String_Type : Entity_Id);
-- Generate proper tree for pragma Pack that applies to given type -- Generate proper tree for pragma Pack that applies to given type, and
-- mark type as having the pragma.
--------------------- ---------------------
-- Build_Exception -- -- Build_Exception --
@ -359,6 +360,7 @@ package body CStand is
begin begin
Append (Prag, Decl_S); Append (Prag, Decl_S);
Record_Rep_Item (String_Type, Prag); Record_Rep_Item (String_Type, Prag);
Set_Has_Pragma_Pack (String_Type, True);
end Pack_String_Type; end Pack_String_Type;
-- Start of processing for Create_Standard -- Start of processing for Create_Standard
@ -714,7 +716,6 @@ package body CStand is
Set_Component_Size (Standard_String, Uint_8); Set_Component_Size (Standard_String, Uint_8);
Init_Size_Align (Standard_String); Init_Size_Align (Standard_String);
Set_Alignment (Standard_String, Uint_1); Set_Alignment (Standard_String, Uint_1);
Set_Has_Pragma_Pack (Standard_String, True);
Pack_String_Type (Standard_String); Pack_String_Type (Standard_String);
-- On targets where a storage unit is larger than a byte (such as AAMP), -- On targets where a storage unit is larger than a byte (such as AAMP),
@ -758,7 +759,6 @@ package body CStand is
Set_Component_Type (Standard_Wide_String, Standard_Wide_Character); Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
Set_Component_Size (Standard_Wide_String, Uint_16); Set_Component_Size (Standard_Wide_String, Uint_16);
Init_Size_Align (Standard_Wide_String); Init_Size_Align (Standard_Wide_String);
Set_Has_Pragma_Pack (Standard_Wide_String, True);
Pack_String_Type (Standard_Wide_String); Pack_String_Type (Standard_Wide_String);
-- Set index type of Wide_String -- Set index type of Wide_String
@ -796,7 +796,6 @@ package body CStand is
Set_Component_Size (Standard_Wide_Wide_String, Uint_32); Set_Component_Size (Standard_Wide_Wide_String, Uint_32);
Init_Size_Align (Standard_Wide_Wide_String); Init_Size_Align (Standard_Wide_Wide_String);
Set_Is_Ada_2005_Only (Standard_Wide_Wide_String); Set_Is_Ada_2005_Only (Standard_Wide_Wide_String);
Set_Has_Pragma_Pack (Standard_Wide_Wide_String, True);
Pack_String_Type (Standard_Wide_Wide_String); Pack_String_Type (Standard_Wide_Wide_String);
-- Set index type of Wide_Wide_String -- Set index type of Wide_Wide_String

2
gcc/ada/g-pehage.adb
View File

@ -146,7 +146,7 @@ package body GNAT.Perfect_Hash_Generators is
-- leading spaces if required by width W. -- leading spaces if required by width W.
function Trim_Trailing_Nuls (Str : String) return String; function Trim_Trailing_Nuls (Str : String) return String;
-- Return Str, but with trailing NUL characters removed. -- Return Str with trailing NUL characters removed
Output : File_Descriptor renames GNAT.OS_Lib.Standout; Output : File_Descriptor renames GNAT.OS_Lib.Standout;
-- Shortcuts -- Shortcuts

18
gcc/ada/make.adb
View File

@ -2448,8 +2448,8 @@ package body Make is
-- Info on the mapping file -- Info on the mapping file
Need_To_Check_Standard_Library : Boolean := Need_To_Check_Standard_Library : Boolean :=
Check_Readonly_Files (Check_Readonly_Files or Must_Compile)
and not Unique_Compile; and Unique_Compile;
procedure Add_Process procedure Add_Process
(Pid : Process_Id; (Pid : Process_Id;
@ -2905,7 +2905,7 @@ package body Make is
begin begin
if Is_Predefined_File_Name (Fname, False) then if Is_Predefined_File_Name (Fname, False) then
if Check_Readonly_Files then if Check_Readonly_Files or else Must_Compile then
Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) := Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) :=
Comp_Args (Comp_Args'First + 1 .. Comp_Last); Comp_Args (Comp_Args'First + 1 .. Comp_Last);
Comp_Last := Comp_Last + 1; Comp_Last := Comp_Last + 1;
@ -3103,7 +3103,7 @@ package body Make is
if Is_Marked (Sfile, Source_Index) then if Is_Marked (Sfile, Source_Index) then
Debug_Msg ("Skipping marked file:", Sfile); Debug_Msg ("Skipping marked file:", Sfile);
elsif not Check_Readonly_Files elsif not (Check_Readonly_Files or Must_Compile)
and then Is_Internal_File_Name (Sfile, False) and then Is_Internal_File_Name (Sfile, False)
then then
Debug_Msg ("Skipping internal file:", Sfile); Debug_Msg ("Skipping internal file:", Sfile);
@ -3283,16 +3283,15 @@ package body Make is
Executable_Obsolete := True; Executable_Obsolete := True;
end if; end if;
In_Lib_Dir := not Check_Readonly_Files In_Lib_Dir := Full_Lib_File /= No_File
and then Full_Lib_File /= No_File and then In_Ada_Lib_Dir (Full_Lib_File);
and then In_Ada_Lib_Dir (Full_Lib_File);
-- Since the following requires a system call, we precompute it -- Since the following requires a system call, we precompute it
-- when needed. -- when needed.
if not In_Lib_Dir then if not In_Lib_Dir then
if Full_Lib_File /= No_File if Full_Lib_File /= No_File
and then not Check_Readonly_Files and then not (Check_Readonly_Files or else Must_Compile)
then then
Get_Name_String (Full_Lib_File); Get_Name_String (Full_Lib_File);
Name_Buffer (Name_Len + 1) := ASCII.NUL; Name_Buffer (Name_Len + 1) := ASCII.NUL;
@ -3334,7 +3333,7 @@ package body Make is
-- Source and library files can be located but are internal -- Source and library files can be located but are internal
-- files. -- files.
elsif not Check_Readonly_Files elsif not (Check_Readonly_Files or else Must_Compile)
and then Full_Lib_File /= No_File and then Full_Lib_File /= No_File
and then Is_Internal_File_Name (Source_File, False) and then Is_Internal_File_Name (Source_File, False)
then then
@ -5196,7 +5195,6 @@ package body Make is
and then not Unique_Compile_All_Projects and then not Unique_Compile_All_Projects
and then Main_On_Command_Line and then Main_On_Command_Line
then then
Check_Readonly_Files := True;
Must_Compile := True; Must_Compile := True;
end if; end if;