diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 25 | ||||
| -rw-r--r-- | gcc/ada/restrict.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.adb | 88 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.ads | 27 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 67 |
5 files changed, 167 insertions, 52 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 59151eb..b21f3c5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2001-10-11 Robert Dewar <dewar@gnat.com> + + * restrict.adb (Disallow in No_Run_Time_Mode): Properly specialize + the error message for high integrity mode. + + * rtsfind.adb (RTE): Give message if we try to find an entity that + is not available in high integrity mode. + + * rtsfind.ads: + (OK_To_Use_In_HIE_Mode): New array. + (RTE): May return Empty in high integrity mode. + + * rtsfind.ads (OK_To_Use_In_No_Run_Time_Mode): New name for + OK_To_Use_In_HIE_Mode, now includes System_FAT_xxx. + + * sem_ch6.adb (Analyze_Subprogram_Body): Kill body in predefined + unit if not inlined always and in no runtime mode. Fixes problem + caused by new Rtsfind changes. + + * sem_ch6.adb (Analyze_Subrogram_Body): Do not Check_References if + body is deleted. + + * rtsfind.adb (RTE): Make sure we do not try to load unit after + giving message for entity not available in high integrity mode. + 2001-10-11 Pascal Obry <obry@gnat.com> * impunit.adb: Add GNAT.CRC32. diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index a284cd4..0514088 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.37 $ +-- $Revision$ -- -- -- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- -- -- @@ -37,6 +37,7 @@ with Namet; use Namet; with Nmake; use Nmake; with Opt; use Opt; with Stand; use Stand; +with Targparm; use Targparm; with Uname; use Uname; package body Restrict is @@ -266,8 +267,13 @@ package body Restrict is procedure Disallow_In_No_Run_Time_Mode (Enode : Node_Id) is begin if No_Run_Time then - Error_Msg_N - ("this construct not allowed in No_Run_Time mode", Enode); + if High_Integrity_Mode_On_Target then + Error_Msg_N + ("this construct not allowed in high integrity mode", Enode); + else + Error_Msg_N + ("this construct not allowed in No_Run_Time mode", Enode); + end if; end if; end Disallow_In_No_Run_Time_Mode; diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 1299e1e..08b6e5e 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.96 $ +-- $Revision$ -- -- -- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- -- -- @@ -26,30 +26,30 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; -with Casing; use Casing; -with Csets; use Csets; -with Debug; use Debug; -with Einfo; use Einfo; -with Elists; use Elists; -with Fname; use Fname; -with Fname.UF; use Fname.UF; -with Lib; use Lib; -with Lib.Load; use Lib.Load; -with Namet; use Namet; -with Nlists; use Nlists; -with Nmake; use Nmake; -with Output; use Output; -with Opt; use Opt; -with Restrict; use Restrict; -with Sem; use Sem; -with Sem_Ch7; use Sem_Ch7; -with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; -with Stand; use Stand; -with Snames; use Snames; -with Tbuild; use Tbuild; -with Uname; use Uname; +with Atree; use Atree; +with Casing; use Casing; +with Csets; use Csets; +with Debug; use Debug; +with Einfo; use Einfo; +with Elists; use Elists; +with Fname; use Fname; +with Fname.UF; use Fname.UF; +with Lib; use Lib; +with Lib.Load; use Lib.Load; +with Namet; use Namet; +with Nlists; use Nlists; +with Nmake; use Nmake; +with Output; use Output; +with Opt; use Opt; +with Restrict; use Restrict; +with Sem; use Sem; +with Sem_Ch7; use Sem_Ch7; +with Sem_Util; use Sem_Util; +with Sinfo; use Sinfo; +with Stand; use Stand; +with Snames; use Snames; +with Tbuild; use Tbuild; +with Uname; use Uname; package body Rtsfind is @@ -581,7 +581,6 @@ package body Rtsfind is Lib_Unit : Node_Id; Pkg_Ent : Entity_Id; Ename : Name_Id; - Enode : Node_Id; procedure Check_RPC; -- Reject programs that make use of distribution features not supported @@ -713,6 +712,15 @@ package body Rtsfind is -- Start of processing for RTE begin + -- Check violation of no run time mode + + if No_Run_Time + and then not OK_To_Use_In_No_Run_Time_Mode (U_Id) + then + Disallow_In_No_Run_Time_Mode (Current_Error_Node); + return Empty; + end if; + -- Doing a rtsfind in system.ads is special, as we cannot do this -- when compiling System itself. So if we are compiling system then -- we should already have acquired and processed the declaration @@ -731,8 +739,6 @@ package body Rtsfind is return Find_Local_Entity (E); end if; - Enode := Current_Error_Node; - -- Load unit if unit not previously loaded if No (RE_Table (E)) then @@ -769,10 +775,21 @@ package body Rtsfind is Next_Entity (Pkg_Ent); end loop; - -- If we didn't find the unit we want, something is wrong! + -- If we didn't find the unit we want, something is wrong + -- although in no run time mode, we already gave a suitable + -- message, and so we simply return Empty, and the caller must + -- be prepared to handle this if the RTE call is otherwise + -- possible in high integrity mode. + + if No_Run_Time + and then not OK_To_Use_In_No_Run_Time_Mode (U_Id) + then + return Empty; - Load_Fail ("entity not in package", U_Id, RE_Id'Image (E)); - raise Program_Error; + else + Load_Fail ("entity not in package", U_Id, RE_Id'Image (E)); + raise Program_Error; + end if; end if; end if; @@ -809,7 +826,7 @@ package body Rtsfind is end; end if; - -- We can now obtain the entity. Check that the No_Run_Time condition + -- We can now obtain the entity. Check that the no run time condition -- is not violated. Note that we do not signal the error if we detect -- it in a runtime unit. This can only arise if the user explicitly -- with'ed the runtime unit (or another runtime unit that uses it @@ -822,11 +839,12 @@ package body Rtsfind is if Is_Subprogram (Ent) and then not Is_Inlined (Ent) - and then Sloc (Enode) /= Standard_Location + and then Sloc (Current_Error_Node) /= Standard_Location and then not - Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (Enode))) + Is_Predefined_File_Name + (Unit_File_Name (Get_Source_Unit (Current_Error_Node))) then - Disallow_In_No_Run_Time_Mode (Enode); + Disallow_In_No_Run_Time_Mode (Current_Error_Node); end if; return Ent; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 11304f6..6b30cf1 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- $Revision: 1.216 $ +-- $Revision$ -- -- -- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- -- -- @@ -376,6 +376,23 @@ package Rtsfind is System_Tasking_Async_Delays_Enqueue_RT; -- Range of values for children of System.Tasking.Async_Delays + OK_To_Use_In_No_Run_Time_Mode : array (RTU_Id) of Boolean := + (Ada_Tags => True, + Interfaces => True, + System => True, + System_Fat_Flt => True, + System_Fat_LFlt => True, + System_Fat_LLF => True, + System_Fat_SFlt => True, + System_Machine_Code => True, + System_Storage_Elements => True, + System_Unsigned_Types => True, + others => False); + -- This array defines the set of packages that can legitimately be + -- accessed by Rtsfind in No_Run_Time mode. Any attempt to load + -- any other package in this mode will result in a message noting + -- use of a feature not supported in high integrity mode. + -------------------------- -- Runtime Entity Table -- -------------------------- @@ -2291,7 +2308,13 @@ package Rtsfind is -- expanding) its spec if the unit has not already been loaded. If the -- unit cannot be found, or if it does not contain the specified entity, -- then an appropriate error message is output ("run-time configuration - -- error") and an Unrecoverable_Error exception is raised. + -- error") and an Unrecoverable_Error exception is raised. There is one + -- situation in which RTE can generate an error message, and that is if + -- an unuathorized entity is accessed in high integrity mode. If this + -- occurs, the result returned may be Empty, and the caller must deal + -- with this possibility if the call to RTE may occur in high integrity + -- mode (often this will have been ruled out by specific checks for + -- high integrity mode prior to the RTE call). function Is_RTE (Ent : Entity_Id; E : RE_Id) return Boolean; -- This function determines if the given entity corresponds to the entity diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index f8e0b4f..dcec5ba 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.508 $ +-- $Revision$ -- -- -- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- -- -- @@ -34,6 +34,7 @@ with Elists; use Elists; with Errout; use Errout; with Expander; use Expander; with Exp_Ch7; use Exp_Ch7; +with Fname; use Fname; with Freeze; use Freeze; with Lib.Xref; use Lib.Xref; with Namet; use Namet; @@ -816,23 +817,25 @@ package body Sem_Ch6 is -- the subprogram, or to perform conformance checks. procedure Analyze_Subprogram_Body (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); Body_Spec : constant Node_Id := Specification (N); Body_Id : Entity_Id := Defining_Entity (Body_Spec); Prev_Id : constant Entity_Id := Current_Entity_In_Scope (Body_Id); - HSS : Node_Id; - Spec_Id : Entity_Id; - Spec_Decl : Node_Id := Empty; - Last_Formal : Entity_Id := Empty; - Conformant : Boolean; - Missing_Ret : Boolean; + HSS : Node_Id; + Spec_Id : Entity_Id; + Spec_Decl : Node_Id := Empty; + Last_Formal : Entity_Id := Empty; + Conformant : Boolean; + Missing_Ret : Boolean; + Body_Deleted : Boolean := False; begin if Debug_Flag_C then Write_Str ("==== Compiling subprogram body "); Write_Name (Chars (Body_Id)); Write_Str (" from "); - Write_Location (Sloc (N)); + Write_Location (Loc); Write_Eol; end if; @@ -922,7 +925,6 @@ package body Sem_Ch6 is -- the protected subprogram that will be used in internal calls. declare - Loc : constant Source_Ptr := Sloc (N); Decl : Node_Id; Plist : List_Id; Formal : Entity_Id; @@ -1158,7 +1160,40 @@ package body Sem_Ch6 is end if; end if; - -- Here we have a real body, not a stub + -- Here we have a real body, not a stub. First step is to null out + -- the subprogram body if we have the special case of no run time + -- mode with a predefined unit, and the subprogram is not marked + -- as Inline_Always. The reason is that we should never call such + -- a routine in no run time mode, and it may in general have some + -- statements that we cannot handle in no run time mode. + + -- ASIS note: we do a replace here, because we are really NOT going + -- to analyze the original body and declarations at all, so it is + -- useless to keep them around, we really are obliterating the body, + -- basically creating a specialized no run time version on the fly + -- in which the bodies *are* null. + + if No_Run_Time + and then Present (Spec_Id) + and then Is_Predefined_File_Name + (Unit_File_Name (Get_Source_Unit (Loc))) + and then not Is_Always_Inlined (Spec_Id) + then + Replace (N, + Make_Subprogram_Body (Loc, + Specification => Specification (N), + Declarations => Empty_List, + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List ( + Make_Null_Statement (Loc)), + End_Label => + End_Label (Handled_Statement_Sequence (N))))); + Set_Corresponding_Spec (N, Spec_Id); + Body_Deleted := True; + end if; + + -- Now we can go on to analyze the body HSS := Handled_Statement_Sequence (N); Set_Actual_Subtypes (N, Current_Scope); @@ -1223,7 +1258,9 @@ package body Sem_Ch6 is Set_Has_Missing_Return (Id); end if; - elsif not Is_Machine_Code_Subprogram (Id) then + elsif not Is_Machine_Code_Subprogram (Id) + and then not Body_Deleted + then Error_Msg_N ("missing RETURN statement in function body", N); end if; end; @@ -1293,7 +1330,13 @@ package body Sem_Ch6 is end loop; end if; - Check_References (Body_Id); + -- Check references in body unless it was deleted. Note that the + -- check of Body_Deleted here is not just for efficiency, it is + -- necessary to avoid junk warnings on formal parameters. + + if not Body_Deleted then + Check_References (Body_Id); + end if; end; end Analyze_Subprogram_Body; |