+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.
-- --
-- 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- --
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
procedure Free (Ptr : System.Address) is
Addr : aliased constant System.Address := Ptr;
+
begin
Lock_Task.all;
c_free (Ptr);
First_Call := True;
-
end if;
Unlock_Task.all;
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;
(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");
-- --
-- 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- --
with Prj.Util; use Prj.Util;
with Sinput.P;
with Snames; use Snames;
+with Switch; use Switch;
with Table;
with Types; use Types;
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.
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;
---------------
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);
-
- if Unit.File_Names (Body_Part).Name /= No_Name
- and then Unit.File_Names (Body_Part).Path /= Slash
+ 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
+ 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;
-
- begin
- Src_Ind := Sinput.P.Load_Project_File
- (Get_Name_String
- (Unit.File_Names
- (Body_Part).Path));
+ 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));
+
+ -- 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);
+ exit when not Bind;
+ end if;
+ end;
+
+ else
+ Add_ALI_For (Unit.File_Names (Body_Part).Name);
+ exit when not Bind;
+ end if;
+ end if;
- -- Add the ALI file only if it is not a subunit
+ 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;
- if
- not Sinput.P.Source_File_Is_Subunit (Src_Ind)
- then
- Add_ALI_For
- (Unit.File_Names (Body_Part).Name);
- end if;
- end;
+ end;
- else
- Add_ALI_For (Unit.File_Names (Body_Part).Name);
- end if;
- end if;
+ -- Continue setup and call gnatbind if Bind is True
- 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);
+ 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 loop;
- end;
+ end;
+ end if;
-- Set the paths
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);
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;
-- --
-- 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- --
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 --
------------------------
-- --
-- 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- --
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);
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;
* *
* 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- *
projects / gcc.git / commitdiff