From 0bfc9a64c3b167a8d3f1b9b1ab0caced30ca554e Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 29 Aug 2011 10:52:00 +0200 Subject: [PATCH] [multiple changes] 2011-08-29 Thomas Quinot * get_scos.adb: Ignore chaining indicators not currently supported by Ada. 2011-08-29 Arnaud Charlet * system.ads: Minor editing. 2011-08-29 Arnaud Charlet * bindgen.adb (Gen_Elab_Calls): Generate calls to subp'Elab_Subp_Body in CodePeer mode. * sem_attr.ads, sem_attr.adb, exp_Attr.adb, sem_ch6.adb: Add handling of Attribute_Elab_Subp_Body. * snames.ads-tmpl (Attribute_Elab_Subp_Body, Name_Elab_Subp_Body): New. * sem_util.adb: Update comments. From-SVN: r178165 --- gcc/ada/ChangeLog | 18 ++++++++++++++++++ gcc/ada/bindgen.adb | 22 +++++++++++++++------- gcc/ada/exp_attr.adb | 7 ++++--- gcc/ada/get_scos.adb | 12 ++++++++++++ gcc/ada/sem_attr.adb | 8 +++++++- gcc/ada/sem_attr.ads | 13 ++++++++++++- gcc/ada/sem_ch6.adb | 5 +++-- gcc/ada/sem_util.adb | 6 +++--- gcc/ada/snames.ads-tmpl | 2 ++ gcc/ada/system.ads | 10 +++++----- 10 files changed, 81 insertions(+), 22 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 971cb8f1fb3..e888daba69c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2011-08-29 Thomas Quinot + + * get_scos.adb: Ignore chaining indicators not currently supported + by Ada. + +2011-08-29 Arnaud Charlet + + * system.ads: Minor editing. + +2011-08-29 Arnaud Charlet + + * bindgen.adb (Gen_Elab_Calls): Generate calls to subp'Elab_Subp_Body in + CodePeer mode. + * sem_attr.ads, sem_attr.adb, exp_Attr.adb, sem_ch6.adb: Add handling of + Attribute_Elab_Subp_Body. + * snames.ads-tmpl (Attribute_Elab_Subp_Body, Name_Elab_Subp_Body): New. + * sem_util.adb: Update comments. + 2011-08-29 Thomas Quinot * par_sco.adb, scos.adb, scos.ads, put_scos.adb, get_scos.adb: Record diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 78c077cc11f..6e0d5bdef36 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -984,7 +984,12 @@ package body Bindgen is -- Case of no elaboration code - elsif U.No_Elab then + elsif U.No_Elab + and then (not CodePeer_Mode + or else U.Utype = Is_Spec + or else U.Utype = Is_Spec_Only + or else U.Unit_Kind /= 's') + then -- The only case in which we have to do something is if this -- is a body, with a separate spec, where the separate spec @@ -1019,10 +1024,7 @@ package body Bindgen is -- The uname_E increment is skipped if this is a separate spec, -- since it will be done when we process the body. - -- Ignore subprograms in CodePeer mode, since no useful - -- elaboration subprogram is needed by CodePeer. - - elsif U.Unit_Kind /= 's' or else not CodePeer_Mode then + else Check_Elab_Flag := not CodePeer_Mode and then (Force_Checking_Of_Elaboration_Flags @@ -1055,12 +1057,18 @@ package body Bindgen is if Name_Buffer (Name_Len) = 's' then Name_Buffer (Name_Len - 1 .. Name_Len + 8) := "'elab_spec"; + Name_Len := Name_Len + 8; + + elsif U.Unit_Kind = 's' and CodePeer_Mode then + Name_Buffer (Name_Len - 1 .. Name_Len + 13) := + "'elab_subp_body"; + Name_Len := Name_Len + 13; + else Name_Buffer (Name_Len - 1 .. Name_Len + 8) := "'elab_body"; + Name_Len := Name_Len + 8; end if; - - Name_Len := Name_Len + 8; end if; Set_Casing (U.Icasing); diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index c6d396ddccd..21703d8df68 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1813,13 +1813,14 @@ package body Exp_Attr is -- and then the Elab_Body/Spec attribute is replaced by a reference -- to this defining identifier. - when Attribute_Elab_Body | - Attribute_Elab_Spec => + when Attribute_Elab_Body | + Attribute_Elab_Subp_Body | + Attribute_Elab_Spec => -- Leave attribute unexpanded in CodePeer mode: the gnat2scil -- back-end knows how to handle this attribute directly. - if CodePeer_Mode then + if CodePeer_Mode or else Id = Attribute_Elab_Subp_Body then return; end if; diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb index 1cc0706cec6..43c27b570a7 100644 --- a/gcc/ada/get_scos.adb +++ b/gcc/ada/get_scos.adb @@ -387,6 +387,18 @@ begin elsif C = ' ' then Skip_Spaces; + elsif C = 'T' or else C = 'F' then + + -- Chaining indicator: skip for now??? + + declare + Loc1, Loc2 : Source_Location; + pragma Unreferenced (Loc1, Loc2); + begin + Skipc; + Get_Source_Location_Range (Loc1, Loc2); + end; + else raise Data_Error; end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 5195e4f3a88..12fce9508f9 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1945,6 +1945,8 @@ package body Sem_Attr is and then Aname /= Name_Elab_Spec and then + Aname /= Name_Elab_Subp_Body + and then Aname /= Name_UET_Address and then Aname /= Name_Enabled @@ -3014,7 +3016,10 @@ package body Sem_Attr is -- Also handles processing for Elab_Spec - when Attribute_Elab_Body | Attribute_Elab_Spec => + when Attribute_Elab_Body | + Attribute_Elab_Spec | + Attribute_Elab_Subp_Body => + Check_E0; Check_Unit_Name (P); Set_Etype (N, Standard_Void_Type); @@ -7712,6 +7717,7 @@ package body Sem_Attr is Attribute_Elaborated | Attribute_Elab_Body | Attribute_Elab_Spec | + Attribute_Elab_Subp_Body | Attribute_Enabled | Attribute_External_Tag | Attribute_Fast_Math | diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index 6db8949be33..0e8561ae729 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -172,6 +172,17 @@ package Sem_Attr is -- Ada code, e.g. if it is necessary to do selective reelaboration to -- fix some error. + -------------------- + -- Elab_Subp_Body -- + -------------------- + + Attribute_Elab_Subp_Body => True, + -- This attribute can only be applied to a library level subprogram + -- name and is only relevant in CodePeer mode. It returns the entity + -- for the corresponding elaboration procedure for elaborating the body + -- of the referenced subprogram unit. This is used in the main generated + -- elaboration procedure by the binder in CodePeer mode only. + --------------- -- Elab_Spec -- --------------- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 55566fb5e27..f4934547ad0 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1156,11 +1156,12 @@ package body Sem_Ch6 is end loop; end if; - -- Special processing for Elab_Spec and Elab_Body calls + -- Special processing for Elab_Spec, Elab_Body and Elab_Subp_Body calls if Nkind (P) = N_Attribute_Reference and then (Attribute_Name (P) = Name_Elab_Spec - or else Attribute_Name (P) = Name_Elab_Body) + or else Attribute_Name (P) = Name_Elab_Body + or else Attribute_Name (P) = Name_Elab_Subp_Body) then if Present (Actuals) then Error_Msg_N diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 5a07a4f77b6..9c8d9c5b181 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -7584,9 +7584,9 @@ package body Sem_Util is begin -- Verify that prefix is analyzed and has the proper form. Note that - -- the attributes Elab_Spec, Elab_Body, and UET_Address, which also - -- produce the address of an entity, do not analyze their prefix - -- because they denote entities that are not necessarily visible. + -- the attributes Elab_Spec, Elab_Body, Elab_Subp_Body and UET_Address, + -- which also produce the address of an entity, do not analyze their + -- prefix because they denote entities that are not necessarily visible. -- Neither of them can apply to a protected type. return Ada_Version >= Ada_2005 diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 69e53dbc982..6df207703ac 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -882,6 +882,7 @@ package Snames is First_Entity_Attribute_Name : constant Name_Id := N + $; Name_Elab_Body : constant Name_Id := N + $; -- GNAT Name_Elab_Spec : constant Name_Id := N + $; -- GNAT + Name_Elab_Subp_Body : constant Name_Id := N + $; -- GNAT Name_Storage_Pool : constant Name_Id := N + $; -- These attributes are the ones that return types @@ -1414,6 +1415,7 @@ package Snames is Attribute_Elab_Body, Attribute_Elab_Spec, + Attribute_Elab_Subp_Body, Attribute_Storage_Pool, -- Type attributes diff --git a/gcc/ada/system.ads b/gcc/ada/system.ads index 10d4ccf4474..437afbc9a59 100644 --- a/gcc/ada/system.ads +++ b/gcc/ada/system.ads @@ -123,11 +123,11 @@ private -- System Implementation Parameters -- -------------------------------------- - -- These parameters provide information about the target that is used - -- by the compiler. They are in the private part of System, where they - -- can be accessed using the special circuitry in the Targparm unit - -- whose source should be consulted for more detailed descriptions - -- of the individual switch values. + -- These parameters provide information about the target that is used by + -- the compiler. They are in the private part of System, where they can be + -- accessed using the special circuitry in the Targparm unit whose source + -- should be consulted for more detailed descriptions of the individual + -- switch values. -- This version of system.ads is used only for building the compiler. -- We really ought to use the proper target system (i.e. the one that -- 2.30.2