Skip to content

R
riscv-gcc-1
Commit fdfcc663 by Arnaud Charlet
Options

[multiple changes] 

2009-10-27  Vincent Celier  <celier@adacore.com>

	* makeutl.adb (Check_Source_Info_In_ALI): Do not recompile if a subunit
	from the runtime is found, except if gnatmake switch -a is used and this
	subunit cannot be found.

2009-10-27  Ed Schonberg  <schonberg@adacore.com>

	* gnatbind.adb (gnatbind): When the -R option is selected, list subunits
	as well, for tools that need the complete closure of the main program.

2009-10-27  Sergey Rybin  <rybin@adacore.com>

	* gnat_ugn.texi: Minor updates.

2009-10-27  Emmanuel Briot  <briot@adacore.com>

	* prj-tree.adb (Free): Fix memory leak.

2009-10-27  Vasiliy Fofanov  <fofanov@adacore.com>

	* adaint.c, s-os_lib.adb (__gnat_create_output_file_new): New function
	that ensures the file that is created is new. Use this function to make
	sure there is no race condition if several processes are creating temp
	files concurrently.

	* s-os_lib.ads: Update comment.

2009-10-27  Thomas Quinot  <quinot@adacore.com>

	* sem_ch12.adb: Minor reformatting

2009-10-27  Javier Miranda  <miranda@adacore.com>

	* exp_ch4.ads (Integer_Promotion_Possible): New subprogram.
	* exp_ch4.adb (Integer_Promotion_Possible): New subprogram.
	(Expand_N_Type_Conversion): Replace code that checks if the integer
	promotion of the operands is possible by a call to the new function
	Integer_Promotion_Possible. Minor reformating because an enclosing
	block is now not needed.
	* checks.adb (Apply_Arithmetic_Overflow_Check): Add missing check to
	see if the integer promotion is possible; in such case the runtime
	checks are not generated.

From-SVN: r153592
parent 477b99b6
Showing with 192 additions and 95 deletions
gcc/ada/adaint.c
......@@ -923,6 +923,28 @@ __gnat_create_output_file (char *path)
}
int
__gnat_create_output_file_new (char *path)
{
int fd;
#if defined (VMS)
fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM,
"rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
"shr=del,get,put,upd");
#elif defined (__MINGW32__)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
}
#else
fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
#endif
return fd < 0 ? -1 : fd;
}
int
__gnat_open_append (char *path, int fmode)
{
int fd;
......
gcc/ada/checks.adb
......@@ -28,6 +28,7 @@ with Debug; use Debug;
with Einfo; use Einfo;
with Errout; use Errout;
with Exp_Ch2; use Exp_Ch2;
with Exp_Ch4; use Exp_Ch4;
with Exp_Ch11; use Exp_Ch11;
with Exp_Pakd; use Exp_Pakd;
with Exp_Util; use Exp_Util;
......@@ -844,7 +845,10 @@ package body Checks is
begin
-- Skip check if back end does overflow checks, or the overflow flag
-- is not set anyway, or we are not doing code expansion.
-- is not set anyway, or we are not doing code expansion, or the
-- parent node is a type conversion whose operand is an arithmetic
-- operation on signed integers on which the expander can promote
-- later the operands to type integer (see Expand_N_Type_Conversion).
-- Special case CLI target, where arithmetic overflow checks can be
-- performed for integer and long_integer
......@@ -852,6 +856,9 @@ package body Checks is
if Backend_Overflow_Checks_On_Target
or else not Do_Overflow_Check (N)
or else not Expander_Active
or else (Present (Parent (N))
and then Nkind (Parent (N)) = N_Type_Conversion
and then Integer_Promotion_Possible (Parent (N)))
or else
(VM_Target = CLI_Target and then Siz >= Standard_Integer_Size)
then
......
gcc/ada/exp_ch4.adb
......@@ -8042,88 +8042,54 @@ package body Exp_Ch4 is
-- have to be sure not to generate junk overflow checks in the first
-- place, since it would be trick to remove them here!
declare
Root_Operand_Type : constant Entity_Id := Root_Type (Operand_Type);
begin
-- Enable transformation if all conditions are met
if Integer_Promotion_Possible (N) then
if
-- We only do this transformation for source constructs. We assume
-- that the expander knows what it is doing when it generates code.
Comes_From_Source (N)
-- All conditions met, go ahead with transformation
-- If the operand type is Short_Integer or Short_Short_Integer,
-- then we will promote to Integer, which is available on all
-- targets, and is sufficient to ensure no intermediate overflow.
-- Furthermore it is likely to be as efficient or more efficient
-- than using the smaller type for the computation so we do this
-- unconditionally.
and then
(Root_Operand_Type = Base_Type (Standard_Short_Integer)
or else
Root_Operand_Type = Base_Type (Standard_Short_Short_Integer))
-- Test for interesting operation, which includes addition,
-- division, exponentiation, multiplication, subtraction, and
-- unary negation.
declare
Opnd : Node_Id;
L, R : Node_Id;
and then Nkind_In (Operand, N_Op_Add,
N_Op_Divide,
N_Op_Expon,
N_Op_Minus,
N_Op_Multiply,
N_Op_Subtract)
then
-- All conditions met, go ahead with transformation
begin
R :=
Make_Type_Conversion (Loc,
Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
Expression => Relocate_Node (Right_Opnd (Operand)));
declare
Opnd : Node_Id;
L, R : Node_Id;
if Nkind (Operand) = N_Op_Minus then
Opnd := Make_Op_Minus (Loc, Right_Opnd => R);
begin
R :=
else
L :=
Make_Type_Conversion (Loc,
Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
Expression => Relocate_Node (Right_Opnd (Operand)));
if Nkind (Operand) = N_Op_Minus then
Opnd := Make_Op_Minus (Loc, Right_Opnd => R);
else
L :=
Make_Type_Conversion (Loc,
Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
Expression => Relocate_Node (Left_Opnd (Operand)));
case Nkind (Operand) is
when N_Op_Add =>
Opnd := Make_Op_Add (Loc, L, R);
when N_Op_Divide =>
Opnd := Make_Op_Divide (Loc, L, R);
when N_Op_Expon =>
Opnd := Make_Op_Expon (Loc, L, R);
when N_Op_Multiply =>
Opnd := Make_Op_Multiply (Loc, L, R);
when N_Op_Subtract =>
Opnd := Make_Op_Subtract (Loc, L, R);
when others =>
raise Program_Error;
end case;
Expression => Relocate_Node (Left_Opnd (Operand)));
case Nkind (Operand) is
when N_Op_Add =>
Opnd := Make_Op_Add (Loc, L, R);
when N_Op_Divide =>
Opnd := Make_Op_Divide (Loc, L, R);
when N_Op_Expon =>
Opnd := Make_Op_Expon (Loc, L, R);
when N_Op_Multiply =>
Opnd := Make_Op_Multiply (Loc, L, R);
when N_Op_Subtract =>
Opnd := Make_Op_Subtract (Loc, L, R);
when others =>
raise Program_Error;
end case;
Rewrite (N,
Make_Type_Conversion (Loc,
Subtype_Mark => Relocate_Node (Subtype_Mark (N)),
Expression => Opnd));
Rewrite (N,
Make_Type_Conversion (Loc,
Subtype_Mark => Relocate_Node (Subtype_Mark (N)),
Expression => Opnd));
Analyze_And_Resolve (N, Target_Type);
return;
end if;
end;
end if;
end;
Analyze_And_Resolve (N, Target_Type);
return;
end if;
end;
end if;
-- Do validity check if validity checking operands
......@@ -9187,6 +9153,49 @@ package body Exp_Ch4 is
return;
end Insert_Dereference_Action;
--------------------------------
-- Integer_Promotion_Possible --
--------------------------------
function Integer_Promotion_Possible (N : Node_Id) return Boolean is
Operand : constant Node_Id := Expression (N);
Operand_Type : constant Entity_Id := Etype (Operand);
Root_Operand_Type : constant Entity_Id := Root_Type (Operand_Type);
begin
pragma Assert (Nkind (N) = N_Type_Conversion);
return
-- We only do the transformation for source constructs. We assume
-- that the expander knows what it is doing when it generates code.
Comes_From_Source (N)
-- If the operand type is Short_Integer or Short_Short_Integer,
-- then we will promote to Integer, which is available on all
-- targets, and is sufficient to ensure no intermediate overflow.
-- Furthermore it is likely to be as efficient or more efficient
-- than using the smaller type for the computation so we do this
-- unconditionally.
and then
(Root_Operand_Type = Base_Type (Standard_Short_Integer)
or else
Root_Operand_Type = Base_Type (Standard_Short_Short_Integer))
-- Test for interesting operation, which includes addition,
-- division, exponentiation, multiplication, subtraction, and
-- unary negation.
and then Nkind_In (Operand, N_Op_Add,
N_Op_Divide,
N_Op_Expon,
N_Op_Minus,
N_Op_Multiply,
N_Op_Subtract);
end Integer_Promotion_Possible;
------------------------------
-- Make_Array_Comparison_Op --
------------------------------
......
gcc/ada/exp_ch4.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
......@@ -88,4 +88,11 @@ package Exp_Ch4 is
-- to insert those bodies at the right place. Nod provides the Sloc
-- value for generated code.
function Integer_Promotion_Possible (N : Node_Id) return Boolean;
-- Returns true if the node is a type conversion whose operand is an
-- arithmetic operation on signed integers, and the base type of the
-- signed integer type is smaller than Standard.Integer. In such case we
-- have special circuitry in Expand_N_Type_Conversion to promote both of
-- the operands to type Integer.
end Exp_Ch4;
gcc/ada/gnat_ugn.texi
......@@ -20659,7 +20659,7 @@ Invoking @command{gnatcheck} on the command line has the form:
@smallexample
$ gnatcheck @ovar{switches} @{@var{filename}@}
@r{[}^-files^/FILES^=@{@var{arg_list_filename}@}@r{]}
@r{[}-cargs @var{gcc_switches}@r{]} @r{[}-rules @var{rule_options}@r{]}
@r{[}-cargs @var{gcc_switches}@r{]} -rules @var{rule_options}
@end smallexample
@noindent
gcc/ada/gnatbind.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
......@@ -838,6 +838,27 @@ begin
end if;
end loop;
-- Subunits do not appear in the elaboration table because
-- they are subsumed by their parent units, but we need to
-- list them for other tools. For now they are listed after
-- other files, rather than following immediately their parent,
-- because there is no cheap link between the elaboration table
-- and the ALIs table.
for J in Sdep.First .. Sdep.Last loop
if Sdep.Table (J).Subunit_Name /= No_Name
and then not Is_Internal_File_Name (Sdep.Table (J).Sfile)
then
if not Zero_Formatting then
Write_Str (" ");
end if;
Write_Str
(Get_Name_String (Sdep.Table (J).Sfile));
Write_Eol;
end if;
end loop;
if not Zero_Formatting then
Write_Eol;
end if;
......
gcc/ada/makeutl.adb
......@@ -25,6 +25,7 @@
with ALI; use ALI;
with Debug;
with Fname;
with Osint; use Osint;
with Output; use Output;
with Opt; use Opt;
......@@ -213,28 +214,31 @@ package body Makeutl is
if Unit_Name /= No_Name then
-- For separates, the file is no longer associated with the
-- unit ("proc-sep.adb" is not associated with unit "proc.sep".
-- So we need to check whether the source file still exists in
-- unit ("proc-sep.adb" is not associated with unit "proc.sep")
-- so we need to check whether the source file still exists in
-- the source tree: it will if it matches the naming scheme
-- (and then will be for the same unit).
if Find_Source
(In_Tree => Project_Tree,
Project => No_Project,
(In_Tree => Project_Tree,
Project => No_Project,
Base_Name => SD.Sfile) = No_Source
then
-- If this is not a runtime file (when using -a) ? Otherwise
-- we get complaints about a-except.adb, which uses
-- separates.
if not Check_Readonly_Files
or else Find_File (SD.Sfile, Osint.Source) = No_File
-- If this is not a runtime file or if, when gnatmake switch
-- -a is used, we are not able to find this subunit in the
-- source directories, then recompilation is needed.
if not Fname.Is_Internal_File_Name (SD.Sfile)
or else
(Check_Readonly_Files and then
Find_File (SD.Sfile, Osint.Source) = No_File)
then
if Verbose_Mode then
Write_Line
("While parsing ALI file: Sdep associates "
("While parsing ALI file, file "
& Get_Name_String (SD.Sfile)
& " with unit " & Get_Name_String (Unit_Name)
& " is indicated as containing subunit "
& Get_Name_String (Unit_Name)
& " but this does not match what was found while"
& " parsing the project. Will recompile");
end if;
......
gcc/ada/prj-tree.adb
......@@ -1000,6 +1000,7 @@ package body Prj.Tree is
if Proj /= null then
Project_Node_Table.Free (Proj.Project_Nodes);
Projects_Htable.Reset (Proj.Projects_HT);
Free (Proj.Project_Path);
Unchecked_Free (Proj);
end if;
end Free;
......
gcc/ada/s-os_lib.adb
......@@ -783,6 +783,32 @@ package body System.OS_Lib is
Attempts : Natural := 0;
Current : String (Current_Temp_File_Name'Range);
---------------------------------
-- Create_New_Output_Text_File --
---------------------------------
function Create_New_Output_Text_File
(Name : String) return File_Descriptor;
-- Similar to Create_Output_Text_File, except it fails if the file
-- already exists. We need this behavior to ensure we don't accidentally
-- open a temp file that has just been created by a concurrently running
-- process. There is no point exposing this function, as it's generally
-- not particularly useful.
function Create_New_Output_Text_File
(Name : String) return File_Descriptor is
function C_Create_File
(Name : C_File_Name) return File_Descriptor;
pragma Import (C, C_Create_File, "__gnat_create_output_file_new");
C_Name : String (1 .. Name'Length + 1);
begin
C_Name (1 .. Name'Length) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
return C_Create_File (C_Name (C_Name'First)'Address);
end Create_New_Output_Text_File;
begin
-- Loop until a new temp file can be created
......@@ -845,9 +871,9 @@ package body System.OS_Lib is
-- Attempt to create the file
if Stdout then
FD := Create_Output_Text_File (Current);
FD := Create_New_Output_Text_File (Current);
else
FD := Create_File (Current, Binary);
FD := Create_New_File (Current, Binary);
end if;
if FD /= Invalid_FD then
......
gcc/ada/s-os_lib.ads
......@@ -265,7 +265,7 @@ package System.OS_Lib is
-- It is the responsibility of the caller to deallocate the access value
-- returned in Name.
--
-- The file is opened in the mode specified by the With_Mode parameter.
-- The file is opened in text mode.
--
-- This procedure will always succeed if the current working directory is
-- writable. If the current working directory is not writable, then
......
gcc/ada/sem_ch12.adb
......@@ -1701,18 +1701,18 @@ package body Sem_Ch12 is
Lo :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_First,
Prefix => New_Reference_To (T, Loc));
Prefix => New_Reference_To (T, Loc));
Set_Etype (Lo, T);
Hi :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Last,
Prefix => New_Reference_To (T, Loc));
Prefix => New_Reference_To (T, Loc));
Set_Etype (Hi, T);
Set_Scalar_Range (T,
Make_Range (Loc,
Low_Bound => Lo,
Low_Bound => Lo,
High_Bound => Hi));
Set_Ekind (Base, E_Enumeration_Type);
......
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