diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 28 | ||||
| -rw-r--r-- | gcc/ada/errno.c | 3 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 37 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 44 | ||||
| -rw-r--r-- | gcc/ada/s-rident.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/targparm.adb | 42 | ||||
| -rw-r--r-- | gcc/ada/targparm.ads | 7 |
8 files changed, 128 insertions, 38 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b3b0c90cfe6..750937b26ac 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,31 @@ +2004-02-09 Albert Lee <lee@gnat.com> + + * errno.c: define _SGI_MP_SOURCE for task-safe errno on IRIX + +2004-02-09 Ed Schonberg <schonberg@gnat.com> + + * exp_ch3.adb (Build_Slice_Assignment): Handle properly case of null + slices. + + * exp_ch6.adb (Expand_Call): Do not inline a call when the subprogram + is nested in an instance that is not frozen yet, to avoid + order-of-elaboration problems in gigi. + + * sem_attr.adb (Analyze_Attribute, case 'Access): Within an inlined + body the attribute is legal. + +2004-02-09 Robert Dewar <dewar@gnat.com> + + * s-rident.ads: Minor comment correction + + * targparm.adb: Remove dependence on uintp completely. There was + always a bug in Make in that it called Targparm before initializing + the Uint package. The old code appeared to get away with this, but + the new code did not! This caused an assertion error in gnatmake. + + * targparm.ads: Fix bad comment, restriction pragmas with parameters + are indeed fully supported. + 2004-02-06 Alan Modra <amodra@bigpond.net.au> * misc.c (default_pass_by_ref): Update INIT_CUMULATIVE_ARGS call. diff --git a/gcc/ada/errno.c b/gcc/ada/errno.c index fc6964b4ec2..ef69fd0da81 100644 --- a/gcc/ada/errno.c +++ b/gcc/ada/errno.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- * @@ -39,6 +39,7 @@ #define _REENTRANT #define _THREAD_SAFE +#define _SGI_MP_SOURCE #include <errno.h> int diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 8982343b8d9..55d90516215 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2505,16 +2505,20 @@ package body Exp_Ch3 is -- end if; -- loop + -- if Rev then + -- exit when Li1 < Left_Lo; + -- else + -- exit when Li1 > Left_Hi; + -- end if; + -- Target (Li1) := Source (Ri1); -- if Rev then - -- exit when Li2 = Left_Lo; - -- Li2 := Index'pred (Li2); - -- Ri2 := Index'pred (Ri2); + -- Li1 := Index'pred (Li1); + -- Ri1 := Index'pred (Ri1); -- else - -- exit when Li2 = Left_Hi; - -- Li2 := Index'succ (Li2); - -- Ri2 := Index'succ (Ri2); + -- Li1 := Index'succ (Li1); + -- Ri1 := Index'succ (Ri1); -- end if; -- end loop; -- end Assign; @@ -2561,7 +2565,6 @@ package body Exp_Ch3 is Stats : List_Id; begin - -- Build declarations for indices Decls := New_List; @@ -2630,7 +2633,7 @@ package body Exp_Ch3 is Expressions => New_List (New_Occurrence_Of (Rnn, Loc))))), End_Label => Empty); - -- Build the increment/decrement statements + -- Build exit condition. declare F_Ass : constant List_Id := New_List; @@ -2640,17 +2643,31 @@ package body Exp_Ch3 is Append_To (F_Ass, Make_Exit_Statement (Loc, Condition => - Make_Op_Eq (Loc, + Make_Op_Gt (Loc, Left_Opnd => New_Occurrence_Of (Lnn, Loc), Right_Opnd => New_Occurrence_Of (Left_Hi, Loc)))); Append_To (B_Ass, Make_Exit_Statement (Loc, Condition => - Make_Op_Eq (Loc, + Make_Op_Lt (Loc, Left_Opnd => New_Occurrence_Of (Lnn, Loc), Right_Opnd => New_Occurrence_Of (Left_Lo, Loc)))); + Prepend_To (Statements (Loops), + Make_If_Statement (Loc, + Condition => New_Occurrence_Of (Rev, Loc), + Then_Statements => B_Ass, + Else_Statements => F_Ass)); + end; + + -- Build the increment/decrement statements + + declare + F_Ass : constant List_Id := New_List; + B_Ass : constant List_Id := New_List; + + begin Append_To (F_Ass, Make_Assignment_Statement (Loc, Name => New_Occurrence_Of (Lnn, Loc), diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 49893a516ee..7632e29e0b7 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1915,12 +1915,43 @@ package body Exp_Ch6 is then if Is_Inlined (Subp) then - declare + Inlined_Subprogram : declare Bod : Node_Id; Must_Inline : Boolean := False; Spec : constant Node_Id := Unit_Declaration_Node (Subp); Scop : constant Entity_Id := Scope (Subp); + function In_Unfrozen_Instance return Boolean; + -- If the subprogram comes from an instance in the same + -- unit, and the instance is not yet frozen, inlining might + -- trigger order-of-elaboration problems in gigi. + + -------------------------- + -- In_Unfrozen_Instance -- + -------------------------- + + function In_Unfrozen_Instance return Boolean is + S : Entity_Id := Scop; + + begin + while Present (S) + and then S /= Standard_Standard + loop + if Is_Generic_Instance (S) + and then Present (Freeze_Node (S)) + and then not Analyzed (Freeze_Node (S)) + then + return True; + end if; + + S := Scope (S); + end loop; + + return False; + end In_Unfrozen_Instance; + + -- Start of processing for Inlined_Subprogram + begin -- Verify that the body to inline has already been seen, -- and that if the body is in the current unit the inlining @@ -1943,14 +1974,7 @@ package body Exp_Ch6 is then Must_Inline := False; - -- If the subprogram comes from an instance in the same - -- unit, and the instance is not yet frozen, inlining might - -- trigger order-of-elaboration problems in gigi. - - elsif Is_Generic_Instance (Scop) - and then Present (Freeze_Node (Scop)) - and then not Analyzed (Freeze_Node (Scop)) - then + elsif In_Unfrozen_Instance then Must_Inline := False; else @@ -1998,7 +2022,7 @@ package body Exp_Ch6 is N, Subp); end if; end if; - end; + end Inlined_Subprogram; end if; end if; diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index 6bc09ff3916..50229e82e6c 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -155,7 +155,6 @@ package System.Rident is -- Synonyms permitted for historical purposes of compatibility -- No_Requeue synonym for No_Requeue_Statements - -- No_Tasking synonym for Max_Tasks => 0 -- No_Task_Attributes synonym for No_Task_Attributes_Package subtype All_Restrictions is Restriction_Id range diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index d49be42b4c9..fe0389b6bf9 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -605,10 +605,14 @@ package body Sem_Attr is -- prefix may have been a tagged formal object, which is -- defined to be aliased even when the actual might not be -- (other instance cases will have been caught in the generic). + -- Similarly, within an inlined body we know that the attribute + -- is legal in the original subprogram, and therefore legal in + -- the expansion. if Aname /= Name_Unrestricted_Access and then not Is_Aliased_View (P) and then not In_Instance + and then not In_Inlined_Body then Error_Attr ("prefix of % attribute must be aliased", P); end if; diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index 65842b425db..4896da37f7e 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -29,7 +29,6 @@ with Namet; use Namet; with Opt; use Opt; with Osint; use Osint; with Output; use Output; -with Uintp; use Uintp; package body Targparm is use ASCII; @@ -193,7 +192,7 @@ package body Targparm is Source_Last : Source_Ptr) is P : Source_Ptr; - V : Uint; + -- Scans source buffer containing source of system.ads Fatal : Boolean := False; -- Set True if a fatal error is detected @@ -221,7 +220,7 @@ package body Targparm is elsif System_Text (P .. P + 20) = "pragma Restrictions (" then P := P + 21; - Rloop : for K in Partition_Boolean_Restrictions loop + Rloop : for K in All_Boolean_Restrictions loop declare Rname : constant String := Restriction_Id'Image (K); @@ -249,6 +248,9 @@ package body Targparm is Rname : constant String := All_Parameter_Restrictions'Image (K); + V : Natural; + -- Accumulates value + begin for J in Rname'Range loop if Fold_Upper (System_Text (P + Source_Ptr (J - 1))) @@ -262,22 +264,36 @@ package body Targparm is " => " then P := P + Rname'Length + 4; - V := Uint_0; + V := 0; loop if System_Text (P) in '0' .. '9' then - V := 10 * V + Character'Pos (System_Text (P)) - 48; + declare + pragma Unsuppress (Overflow_Check); + + begin + -- Accumulate next digit + + V := 10 * V + + Character'Pos (System_Text (P)) - + Character'Pos ('0'); + + exception + -- On overflow, we just ignore the pragma since + -- that is the standard handling in this case. + + when Constraint_Error => + goto Line_Loop_Continue; + end; + elsif System_Text (P) = '_' then null; + elsif System_Text (P) = ')' then - if UI_Is_In_Int_Range (V) then - Restrictions_On_Target.Value (K) := - Integer (UI_To_Int (V)); - Restrictions_On_Target.Set (K) := True; - goto Line_Loop_Continue; - else - exit Ploop; - end if; + Restrictions_On_Target.Value (K) := V; + Restrictions_On_Target.Set (K) := True; + goto Line_Loop_Continue; + else exit Ploop; end if; diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index 75251d2ff0d..01e8a15a6b8 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -104,9 +104,10 @@ package Targparm is -- if a pragma Suppress_Exception_Locations appears, then the flag -- Opt.Exception_Locations_Suppressed is set to True. - -- The only other pragma allowed is a pragma Restrictions that gives the - -- simple name of a restriction for which partition consistency is always - -- required (see definition of Rident.Restriction_Info). + -- The only other pragma allowed is a pragma Restrictions that specifies + -- a restriction that will be imposed on all units in the partition. Note + -- that in this context, only one restriction can be specified in a single + -- pragma, and the pragma must appear on its own on a single source line. Restrictions_On_Target : Restrictions_Info; -- Records restrictions specified by system.ads. Only the Set and Value |