procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2004-01-19  Arnaud Charlet  <charlet@act-europe.fr>

	* utils.c: Update copyright notice, missed in previous change.

2004-01-19  Vincent Celier  <celier@gnat.com>

	* mlib-prj.adb (Build_Library.Add_ALI_For): Only add the ALI to the
	args if Bind is True. Set First_ALI, if not already done.
	(Build_Library): For Stand Alone Libraries, extract from one ALI file
	an eventual --RTS switch, for gnatbind, and all backend switches +
	--RTS, for linking.

2004-01-19  Robert Dewar  <dewar@gnat.com>

	* sem_attr.adb, memtrack.adb: Minor reformatting

2004-01-19  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch6.adb (Expand_Call): Remove code to fold calls to functions
	that rename enumeration literals. This is properly done in sem_eval.

	* sem_eval.ads, sem_eval.adb (Eval_Call): New procedure to fold calls
	to functions that rename enumeration literals.

	* sem_res.adb (Resolve_Call): Use Eval_Call to fold static calls to
	functions that rename enumeration literals.

From-SVN: r76146
This commit is contained in:
Arnaud Charlet 2004-01-19 11:37:59 +01:00
parent 5c9948f4e8
commit c01a939151
9 changed files with 245 additions and 79 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
gcc/ada/ChangeLog
View file

@ -1,3 +1,30 @@
2004-01-19 Arnaud Charlet <charlet@act-europe.fr>
* utils.c: Update copyright notice, missed in previous change.
2004-01-19 Vincent Celier <celier@gnat.com>
* mlib-prj.adb (Build_Library.Add_ALI_For): Only add the ALI to the
args if Bind is True. Set First_ALI, if not already done.
(Build_Library): For Stand Alone Libraries, extract from one ALI file
an eventual --RTS switch, for gnatbind, and all backend switches +
--RTS, for linking.
2004-01-19 Robert Dewar <dewar@gnat.com>
* sem_attr.adb, memtrack.adb: Minor reformatting
2004-01-19 Ed Schonberg <schonberg@gnat.com>
* exp_ch6.adb (Expand_Call): Remove code to fold calls to functions
that rename enumeration literals. This is properly done in sem_eval.
* sem_eval.ads, sem_eval.adb (Eval_Call): New procedure to fold calls
to functions that rename enumeration literals.
* sem_res.adb (Resolve_Call): Use Eval_Call to fold static calls to
functions that rename enumeration literals.
2004-01-16 Kazu Hirata <kazu@cs.umass.edu>
* Make-lang.in (utils.o): Depend on target.h.

26
gcc/ada/exp_ch6.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004, 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- --
@ -1828,32 +1828,10 @@ package body Exp_Ch6 is
Check_Restriction (No_Abort_Statements, N);
end if;
-- Some more special cases for cases other than explicit dereference
if Nkind (Name (N)) /= N_Explicit_Dereference then
-- Calls to an enumeration literal are replaced by the literal
-- This case occurs only when we have a call to a function that
-- is a renaming of an enumeration literal. The normal case of
-- a direct reference to an enumeration literal has already been
-- been dealt with by Resolve_Call. If the function is itself
-- inherited (see 7423-001) the literal of the parent type must
-- be explicitly converted to the return type of the function.
if Ekind (Subp) = E_Enumeration_Literal then
if Base_Type (Etype (Subp)) /= Base_Type (Etype (N)) then
Rewrite
(N, Convert_To (Etype (N), New_Occurrence_Of (Subp, Loc)));
else
Rewrite (N, New_Occurrence_Of (Subp, Loc));
end if;
Resolve (N);
end if;
if Nkind (Name (N)) = N_Explicit_Dereference then
-- Handle case of access to protected subprogram type
else
if Ekind (Base_Type (Etype (Prefix (Name (N))))) =
E_Access_Protected_Subprogram_Type
then

5
gcc/ada/memtrack.adb
View file

@ -235,6 +235,7 @@ package body System.Memory is
procedure Free (Ptr : System.Address) is
Addr : aliased constant System.Address := Ptr;
begin
Lock_Task.all;
@ -265,7 +266,6 @@ package body System.Memory is
c_free (Ptr);
First_Call := True;
end if;
Unlock_Task.all;
@ -280,10 +280,12 @@ package body System.Memory is
if Needs_Init then
Needs_Init := False;
Gmemfile := fopen (Gmemfname, "wb" & ASCII.NUL);
if Gmemfile = System.Null_Address then
Put_Line ("Couldn't open gnatmem log file for writing");
OS_Exit (255);
end if;
fwrite ("GMEM DUMP" & ASCII.LF, 10, 1, Gmemfile);
end if;
end Gmem_Initialize;
@ -296,6 +298,7 @@ package body System.Memory is
(Ptr : System.Address; Size : size_t) return System.Address
is
Result : System.Address;
begin
if Size = size_t'Last then
Raise_Exception (Storage_Error'Identity, "object too large");

209
gcc/ada/mlib-prj.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2003, Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2004, Ada Core Technologies, 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- --
@ -39,6 +39,7 @@ with Prj.Env; use Prj.Env;
with Prj.Util; use Prj.Util;
with Sinput.P;
with Snames; use Snames;
with Switch; use Switch;
with Table;
with Types; use Types;
@ -353,6 +354,9 @@ package body MLib.Prj is
Copy_Dir : Name_Id;
-- Directory where to copy ALI files and possibly interface sources
First_ALI : Name_Id := No_Name;
-- Store the ALI file name of a source of the library (the first found)
procedure Add_ALI_For (Source : Name_Id);
-- Add the name of the ALI file corresponding to Source to the
-- Arguments.
@ -386,14 +390,27 @@ package body MLib.Prj is
procedure Add_ALI_For (Source : Name_Id) is
ALI : constant String := ALI_File_Name (Get_Name_String (Source));
ALI_Id : Name_Id;
begin
Add_Argument (ALI);
-- Add the ALI file name to the library ALIs
if Bind then
Add_Argument (ALI);
end if;
Name_Len := 0;
Add_Str_To_Name_Buffer (S => ALI);
Library_ALIs.Set (Name_Find, True);
ALI_Id := Name_Find;
-- Add the ALI file name to the library ALIs
if Bind then
Library_ALIs.Set (ALI_Id, True);
end if;
-- Set First_ALI, if not already done
if First_ALI = No_Name then
First_ALI := ALI_Id;
end if;
end Add_ALI_For;
---------------
@ -850,59 +867,111 @@ package body MLib.Prj is
end;
end if;
end;
end if;
-- Get all the ALI files of the project file
-- Get all the ALI files of the project file. We do that even if
-- Bind is False, so that First_ALI is set.
declare
Unit : Unit_Data;
declare
Unit : Unit_Data;
begin
Library_ALIs.Reset;
Interface_ALIs.Reset;
Processed_ALIs.Reset;
for Source in 1 .. Com.Units.Last loop
Unit := Com.Units.Table (Source);
begin
Library_ALIs.Reset;
Interface_ALIs.Reset;
Processed_ALIs.Reset;
for Source in 1 .. Com.Units.Last loop
Unit := Com.Units.Table (Source);
if Unit.File_Names (Body_Part).Name /= No_Name
and then Unit.File_Names (Body_Part).Path /= Slash
if Unit.File_Names (Body_Part).Name /= No_Name
and then Unit.File_Names (Body_Part).Path /= Slash
then
if
Check_Project (Unit.File_Names (Body_Part).Project)
then
if
Check_Project (Unit.File_Names (Body_Part).Project)
then
if Unit.File_Names (Specification).Name = No_Name then
declare
Src_Ind : Source_File_Index;
if Unit.File_Names (Specification).Name = No_Name then
declare
Src_Ind : Source_File_Index;
begin
Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String
(Unit.File_Names
(Body_Part).Path));
begin
Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String
(Unit.File_Names
(Body_Part).Path));
-- Add the ALI file only if it is not a subunit
-- Add the ALI file only if it is not a subunit
if
not Sinput.P.Source_File_Is_Subunit (Src_Ind)
then
Add_ALI_For
(Unit.File_Names (Body_Part).Name);
end if;
end;
if
not Sinput.P.Source_File_Is_Subunit (Src_Ind)
then
Add_ALI_For
(Unit.File_Names (Body_Part).Name);
exit when not Bind;
end if;
end;
else
Add_ALI_For (Unit.File_Names (Body_Part).Name);
end if;
else
Add_ALI_For (Unit.File_Names (Body_Part).Name);
exit when not Bind;
end if;
elsif Unit.File_Names (Specification).Name /= No_Name
and then Unit.File_Names (Specification).Path /= Slash
and then Check_Project
(Unit.File_Names (Specification).Project)
then
Add_ALI_For (Unit.File_Names (Specification).Name);
end if;
end loop;
end;
elsif Unit.File_Names (Specification).Name /= No_Name
and then Unit.File_Names (Specification).Path /= Slash
and then Check_Project
(Unit.File_Names (Specification).Project)
then
Add_ALI_For (Unit.File_Names (Specification).Name);
exit when not Bind;
end if;
end loop;
end;
-- Continue setup and call gnatbind if Bind is True
if Bind then
-- Get an eventual --RTS from the ALI file
if First_ALI /= No_Name then
declare
use Types;
T : Text_Buffer_Ptr;
A : ALI_Id;
begin
-- Load the ALI file
T := Read_Library_Info (First_ALI, True);
-- Read it
A := Scan_ALI
(First_ALI, T, Ignore_ED => False, Err => False);
if A /= No_ALI_Id then
for Index in
ALI.Units.Table
(ALI.ALIs.Table (A).First_Unit).First_Arg ..
ALI.Units.Table
(ALI.ALIs.Table (A).First_Unit).Last_Arg
loop
-- Look for --RTS. If found, add the switch to call
-- gnatbind.
declare
Arg : String_Ptr renames Args.Table (Index);
begin
if
Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
then
Add_Argument (Arg.all);
exit;
end if;
end;
end loop;
end if;
end;
end if;
-- Set the paths
@ -958,6 +1027,52 @@ package body MLib.Prj is
Add_Argument (PIC_Option);
end if;
-- Get the back-end switches and --RTS from the ALI file
if First_ALI /= No_Name then
declare
use Types;
T : Text_Buffer_Ptr;
A : ALI_Id;
begin
-- Load the ALI file
T := Read_Library_Info (First_ALI, True);
-- Read it
A := Scan_ALI
(First_ALI, T, Ignore_ED => False, Err => False);
if A /= No_ALI_Id then
for Index in
ALI.Units.Table
(ALI.ALIs.Table (A).First_Unit).First_Arg ..
ALI.Units.Table
(ALI.ALIs.Table (A).First_Unit).Last_Arg
loop
-- Do not compile with the front end switches except
-- for --RTS.
declare
Arg : String_Ptr renames Args.Table (Index);
begin
if not Is_Front_End_Switch (Arg.all)
or else
Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
then
Add_Argument (Arg.all);
end if;
end;
end loop;
end if;
end;
end if;
-- Now that all the arguments are set, compile the binder
-- generated file.
Display (Gcc);
GNAT.OS_Lib.Spawn
(Gcc_Path.all, Arguments (1 .. Argument_Number), Success);

4
gcc/ada/sem_attr.adb
View file

@ -4464,8 +4464,8 @@ package body Sem_Attr is
and then Raises_Constraint_Error (N)
then
Rewrite (N,
Make_Raise_Program_Error (Loc,
Reason => PE_Accessibility_Check_Failed));
Make_Raise_Program_Error (Loc,
Reason => PE_Accessibility_Check_Failed));
Set_Etype (N, C_Type);
return;

45
gcc/ada/sem_eval.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 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- --
@ -1180,6 +1180,49 @@ package body Sem_Eval is
null;
end Eval_Character_Literal;
---------------
-- Eval_Call --
---------------
-- Static function calls are either calls to predefined operators
-- with static arguments, or calls to functions that rename a literal.
-- Only the latter case is handled here, predefined operators are
-- constant-folded elsewhere.
-- If the function is itself inherited (see 7423-001) the literal of
-- the parent type must be explicitly converted to the return type
-- of the function.
procedure Eval_Call (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
Lit : Entity_Id;
begin
if Nkind (N) = N_Function_Call
and then No (Parameter_Associations (N))
and then Is_Entity_Name (Name (N))
and then Present (Alias (Entity (Name (N))))
and then Is_Enumeration_Type (Base_Type (Typ))
then
Lit := Alias (Entity (Name (N)));
while Present (Alias (Lit)) loop
Lit := Alias (Lit);
end loop;
if Ekind (Lit) = E_Enumeration_Literal then
if Base_Type (Etype (Lit)) /= Base_Type (Typ) then
Rewrite
(N, Convert_To (Typ, New_Occurrence_Of (Lit, Loc)));
else
Rewrite (N, New_Occurrence_Of (Lit, Loc));
end if;
Resolve (N, Typ);
end if;
end if;
end Eval_Call;
------------------------
-- Eval_Concatenation --
------------------------

3
gcc/ada/sem_eval.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 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- --
@ -268,6 +268,7 @@ package Sem_Eval is
procedure Eval_Actual (N : Node_Id);
procedure Eval_Allocator (N : Node_Id);
procedure Eval_Arithmetic_Op (N : Node_Id);
procedure Eval_Call (N : Node_Id);
procedure Eval_Character_Literal (N : Node_Id);
procedure Eval_Concatenation (N : Node_Id);
procedure Eval_Conditional_Expression (N : Node_Id);

3
gcc/ada/sem_res.adb
View file

@ -3807,8 +3807,7 @@ package body Sem_Res is
Check_Intrinsic_Call (N);
end if;
-- If we fall through we definitely have a non-static call
Eval_Call (N);
Check_Elab_Call (N);
end Resolve_Call;

2
gcc/ada/utils.c
View file

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2003, Free Software Foundation, Inc. *
* Copyright (C) 1992-2004, 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- *