diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 20 | ||||
| -rw-r--r-- | gcc/ada/ali.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/ali.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/bcheck.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/gnatbind.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/lib-load.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/lib-writ.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/lib-writ.ads | 11 | ||||
| -rw-r--r-- | gcc/ada/lib.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/lib.ads | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 47 |
11 files changed, 153 insertions, 15 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index eb440cec55a..20901345741 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2010-10-08 Robert Dewar <dewar@adacore.com> + + * ali.adb: Set Allocator_In_Body if AB parameter present on M line + * ali.ads (Allocator_In_Body): New flag + * bcheck.adb (Check_Consistent_Restrictions): Handle case of main + program violating No_Allocators_After_Elaboration restriction. + * gnatbind.adb (No_Restriction_List): Add entries for + No_Anonymous_Allocators, and No_Allocators_After_Elaboration. + * lib-load.adb: Initialize Has_Allocator flag + * lib-writ.adb: Initialize Has_Allocator flag + (M_Parameters): Set AB switch if Has_Allocator flag set + * lib-writ.ads: Document AB flag on M line + * lib.adb (Has_Allocator): New function + (Set_Has_Allocator): New procedure + * lib.ads (Has_Allocator): New function + (Set_Has_Allocator): New procedure + (Has_Allocator): New flag in Unit_Record + * sem_ch4.adb (Analyze_Allocator): Add processing for + No_Allocators_After_Elaboration. + 2010-10-08 Geert Bosch <bosch@adacore.com> * a-textio.adb (Get_Line): Rewrite to use fgets instead of fgetc. diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index eb45dcaca50..bf7ace87a45 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -828,6 +828,7 @@ package body ALI is Sfile => No_File, Task_Dispatching_Policy => ' ', Time_Slice_Value => -1, + Allocator_In_Body => False, WC_Encoding => 'b', Unit_Exception_Table => False, Ver => (others => ' '), @@ -910,6 +911,14 @@ package body ALI is Skip_Space; + if Nextc = 'A' then + P := P + 1; + Checkc ('B'); + ALIs.Table (Id).Allocator_In_Body := True; + end if; + + Skip_Space; + Checkc ('W'); Checkc ('='); ALIs.Table (Id).WC_Encoding := Getc; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 74aeaed026d..062652c4820 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -136,6 +136,10 @@ package ALI is -- line. A value of -1 indicates that no T=xxx parameter was found, or -- no M line was present. Not set if 'M' appears in Ignore_Lines. + Allocator_In_Body : Boolean; + -- Set True if an AB switch appears on the main program line. False + -- if no M line, or AB not present, or 'M appears in Ignore_Lines. + WC_Encoding : Character; -- Wide character encoding if main procedure. Otherwise not relevant. -- Not set if 'M' appears in Ignore_Lines. diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index 084ce199dda..796627e0d52 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -854,6 +854,22 @@ package body Bcheck is -- Start of processing for Check_Consistent_Restrictions begin + -- A special test, if we have a main program, then if it has an + -- allocator in the body, this is considered to be a violation of + -- the restriction No_Allocators_After_Elaboration. We just mark + -- this restriction and then the normal circuit will flag it. + + if Bind_Main_Program + and then ALIs.Table (ALIs.First).Main_Program /= None + and then not No_Main_Subprogram + and then ALIs.Table (ALIs.First).Allocator_In_Body + then + Cumulative_Restrictions.Violated + (No_Allocators_After_Elaboration) := True; + ALIs.Table (ALIs.First).Restrictions.Violated + (No_Allocators_After_Elaboration) := True; + end if; + -- Loop through all restriction violations for R in All_Restrictions loop diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 9285aa96264..de3084f0267 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -143,34 +143,40 @@ procedure Gnatbind is -- should not be listed. No_Restriction_List : constant array (All_Restrictions) of Boolean := - (No_Exception_Propagation => True, + (No_Allocators_After_Elaboration => True, + -- This involves run-time conditions not checkable at compile time + + No_Anonymous_Allocators => True, + -- Premature, since we have not implemented this yet + + No_Exception_Propagation => True, -- Modifies code resulting in different exception semantics - No_Exceptions => True, + No_Exceptions => True, -- Has unexpected Suppress (All_Checks) effect - No_Implicit_Conditionals => True, + No_Implicit_Conditionals => True, -- This could modify and pessimize generated code - No_Implicit_Dynamic_Code => True, + No_Implicit_Dynamic_Code => True, -- This could modify and pessimize generated code - No_Implicit_Loops => True, + No_Implicit_Loops => True, -- This could modify and pessimize generated code - No_Recursion => True, + No_Recursion => True, -- Not checkable at compile time - No_Reentrancy => True, + No_Reentrancy => True, -- Not checkable at compile time - Max_Entry_Queue_Length => True, + Max_Entry_Queue_Length => True, -- Not checkable at compile time - Max_Storage_At_Blocking => True, + Max_Storage_At_Blocking => True, -- Not checkable at compile time - others => False); + others => False); Additional_Restrictions_Listed : Boolean := False; -- Set True if we have listed header for restrictions diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index 4b39c0a4913..328bbeb6d03 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -214,6 +214,7 @@ package body Lib.Load is Expected_Unit => Spec_Name, Fatal_Error => True, Generate_Code => False, + Has_Allocator => False, Has_RACW => False, Is_Compiler_Unit => False, Ident_String => Empty, @@ -318,6 +319,7 @@ package body Lib.Load is Expected_Unit => No_Unit_Name, Fatal_Error => False, Generate_Code => False, + Has_Allocator => False, Has_RACW => False, Is_Compiler_Unit => False, Ident_String => Empty, @@ -647,6 +649,7 @@ package body Lib.Load is Expected_Unit => Uname_Actual, Fatal_Error => False, Generate_Code => False, + Has_Allocator => False, Has_RACW => False, Is_Compiler_Unit => False, Ident_String => Empty, diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 8912dfa48e9..b7bc2cfcf59 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -80,6 +80,7 @@ package body Lib.Writ is Dynamic_Elab => False, Fatal_Error => False, Generate_Code => False, + Has_Allocator => False, Has_RACW => False, Is_Compiler_Unit => False, Ident_String => Empty, @@ -135,6 +136,7 @@ package body Lib.Writ is Dynamic_Elab => False, Fatal_Error => False, Generate_Code => False, + Has_Allocator => False, Has_RACW => False, Is_Compiler_Unit => False, Ident_String => Empty, @@ -925,6 +927,10 @@ package body Lib.Writ is Write_Info_Nat (Opt.Time_Slice_Value); end if; + if Has_Allocator (Main_Unit) then + Write_Info_Str (" AB"); + end if; + Write_Info_Str (" W="); Write_Info_Char (WC_Encoding_Letters (Wide_Character_Encoding_Method)); diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads index 54514325229..b3ea32d1282 100644 --- a/gcc/ada/lib-writ.ads +++ b/gcc/ada/lib-writ.ads @@ -116,7 +116,7 @@ package Lib.Writ is -- -- M Main Program -- -- --------------------- - -- M type [priority] [T=time-slice] W=? + -- M type [priority] [T=time-slice] [AB] W=? -- This line appears only if the main unit for this file is suitable -- for use as a main program. The parameters are: @@ -141,6 +141,15 @@ package Lib.Writ is -- milliseconds. The actual significance of this parameter is -- target dependent. + -- AB + + -- Present if there is an allocator in the body of the procedure + -- after the BEGIN. This will be a violation of the restriction + -- No_Allocators_After_Elaboration if it is present, and this + -- unit is used as a main program (only the binder can find the + -- violation, since only the binder knows the main program). + -- + -- W=? -- This parameter indicates the wide character encoding method used diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 893c4cfbbb2..90577e481af 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -113,6 +113,11 @@ package body Lib is return Units.Table (U).Generate_Code; end Generate_Code; + function Has_Allocator (U : Unit_Number_Type) return Boolean is + begin + return Units.Table (U).Has_Allocator; + end Has_Allocator; + function Has_RACW (U : Unit_Number_Type) return Boolean is begin return Units.Table (U).Has_RACW; @@ -198,6 +203,11 @@ package body Lib is Units.Table (U).Generate_Code := B; end Set_Generate_Code; + procedure Set_Has_Allocator (U : Unit_Number_Type; B : Boolean := True) is + begin + Units.Table (U).Has_Allocator := B; + end Set_Has_Allocator; + procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True) is begin Units.Table (U).Has_RACW := B; diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index 28e2ec064cd..13962528e3e 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -357,6 +357,10 @@ package Lib is -- that the default priority is to be used (and is also used for -- entries that do not correspond to possible main programs). + -- Has_Allocator + -- This flag is set if a subprogram unit has an allocator after the + -- BEGIN (it is used to set the AB flag in the M ALI line). + -- OA_Setting -- This is a character field containing L if Optimize_Alignment mode -- was set locally, and O/T/S for Off/Time/Space default if not. @@ -397,6 +401,7 @@ package Lib is function Fatal_Error (U : Unit_Number_Type) return Boolean; function Generate_Code (U : Unit_Number_Type) return Boolean; function Ident_String (U : Unit_Number_Type) return Node_Id; + function Has_Allocator (U : Unit_Number_Type) return Boolean; function Has_RACW (U : Unit_Number_Type) return Boolean; function Is_Compiler_Unit (U : Unit_Number_Type) return Boolean; function Loading (U : Unit_Number_Type) return Boolean; @@ -415,6 +420,7 @@ package Lib is procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True); procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True); procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True); + procedure Set_Has_Allocator (U : Unit_Number_Type; B : Boolean := True); procedure Set_Is_Compiler_Unit (U : Unit_Number_Type; B : Boolean := True); procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id); procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True); @@ -653,6 +659,7 @@ private pragma Inline (Dependency_Num); pragma Inline (Fatal_Error); pragma Inline (Generate_Code); + pragma Inline (Has_Allocator); pragma Inline (Has_RACW); pragma Inline (Is_Compiler_Unit); pragma Inline (Increment_Serial_Number); @@ -664,6 +671,7 @@ private pragma Inline (Set_Cunit_Entity); pragma Inline (Set_Fatal_Error); pragma Inline (Set_Generate_Code); + pragma Inline (Set_Has_Allocator); pragma Inline (Set_Has_RACW); pragma Inline (Set_Loading); pragma Inline (Set_Main_Priority); @@ -693,6 +701,7 @@ private Is_Compiler_Unit : Boolean; Dynamic_Elab : Boolean; Loading : Boolean; + Has_Allocator : Boolean; OA_Setting : Character; end record; @@ -720,7 +729,8 @@ private Dynamic_Elab at 55 range 0 .. 7; Is_Compiler_Unit at 56 range 0 .. 7; OA_Setting at 57 range 0 .. 7; - Loading at 58 range 0 .. 15; + Loading at 58 range 0 .. 7; + Has_Allocator at 59 range 0 .. 7; end record; for Unit_Record'Size use 60 * 8; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 154b5d3376d..183de2d36ed 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -364,15 +364,60 @@ package body Sem_Ch4 is E : Node_Id := Expression (N); Acc_Type : Entity_Id; Type_Id : Entity_Id; + P : Node_Id; + C : Node_Id; begin + -- Deal with allocator restrictions + -- In accordance with H.4(7), the No_Allocators restriction only applies - -- to user-written allocators. + -- to user-written allocators. The same consideration applies to the + -- No_Allocators_Before_Elaboration restriction. if Comes_From_Source (N) then Check_Restriction (No_Allocators, N); + + -- Processing for No_Allocators_After_Elaboration, loop to look at + -- enclosing context, checking task case and main subprogram case. + + C := N; + P := Parent (C); + while Present (P) loop + + -- In both cases we need a handled sequence of statements, where + -- the occurrence of the allocator is within the statements. + + if Nkind (P) = N_Handled_Sequence_Of_Statements + and then Is_List_Member (C) + and then List_Containing (C) = Statements (P) + then + -- Check for allocator within task body, this is a definite + -- violation of No_Allocators_After_Elaboration we can detect. + + if Nkind (Original_Node (Parent (P))) = N_Task_Body then + Check_Restriction (No_Allocators_After_Elaboration, N); + exit; + end if; + + -- The other case is appearence in a subprogram body. This may + -- be a violation if this is a library level subprogram, and it + -- turns out to be used as the main program, but only the + -- binder knows that, so just record the occurrence. + + if Nkind (Original_Node (Parent (P))) = N_Subprogram_Body + and then Nkind (Parent (Parent (P))) = N_Compilation_Unit + then + Set_Has_Allocator (Current_Sem_Unit); + end if; + end if; + + C := P; + P := Parent (C); + end loop; end if; + -- Analyze the allocator + if Nkind (E) = N_Qualified_Expression then Acc_Type := Create_Itype (E_Allocator_Type, N); Set_Etype (Acc_Type, Acc_Type); |