diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 27 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/memtrack.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/mlib-prj.adb | 213 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_eval.adb | 45 | ||||
| -rw-r--r-- | gcc/ada/sem_eval.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/utils.c | 2 |
9 files changed, 247 insertions, 81 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fc3b66d629e..ae15e9d0546 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index fb73a0b4970..6a54343c678 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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 diff --git a/gcc/ada/memtrack.adb b/gcc/ada/memtrack.adb index 75000b0421e..2531702cb7b 100644 --- a/gcc/ada/memtrack.adb +++ b/gcc/ada/memtrack.adb @@ -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"); diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 19149c0b99a..daaed1cd573 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -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); - - 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 @@ -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); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 51fd7c9c9c1..86e7b6a73e4 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 222355d1dc3..f884854f906 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -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 -- ------------------------ diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads index 02718850179..404ba58294d 100644 --- a/gcc/ada/sem_eval.ads +++ b/gcc/ada/sem_eval.ads @@ -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); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 5960a4d0cf8..59a98c56eae 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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; diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 579fa116397..b58ccde0ef4 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -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- * |