[multiple changes]
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
parent
5c9948f4e8
commit
c01a939151
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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");
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 --
|
||||
------------------------
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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- *
|
||||
|
|
|
|||
Loading…
Reference in New Issue