Skip to content

R
riscv-gcc-1
Commit 0868e09c by Robert Dewar Committed by Geert Bosch
Options

restrict.adb (Disallow in No_Run_Time_Mode): Properly specialize the error… 

restrict.adb (Disallow in No_Run_Time_Mode): Properly specialize the error message for high integrity mode.

	* 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.

From-SVN: r46214
parent 934abf9c
Showing with 132 additions and 17 deletions
gcc/ada/ChangeLog
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.
......
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,9 +267,14 @@ package body Restrict is
procedure Disallow_In_No_Run_Time_Mode (Enode : Node_Id) is
begin
if No_Run_Time then
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;
------------------------
......
gcc/ada/rtsfind.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.96 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
......@@ -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,12 +775,23 @@ 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;
else
Load_Fail ("entity not in package", U_Id, RE_Id'Image (E));
raise Program_Error;
end if;
end if;
end if;
-- See if we have to generate a with for this entity. We generate
-- a with if the current unit is part of the extended main code
......@@ -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;
......
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
......
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,6 +817,7 @@ 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);
......@@ -826,13 +828,14 @@ package body Sem_Ch6 is
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 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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment