+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.
-- --
-- B o d y --
-- --
--- $Revision: 1.37 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
with Nmake; use Nmake;
with Opt; use Opt;
with Stand; use Stand;
+with Targparm; use Targparm;
with Uname; use Uname;
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;
-- --
-- B o d y --
-- --
--- $Revision: 1.96 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
-- --
------------------------------------------------------------------------------
-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
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
-- 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
return Find_Local_Entity (E);
end if;
- Enode := Current_Error_Node;
-
-- Load unit if unit not previously loaded
if No (RE_Table (E)) then
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;
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
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;
-- --
-- S p e c --
-- --
--- $Revision: 1.216 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
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 --
--------------------------
-- 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
-- --
-- B o d y --
-- --
--- $Revision: 1.508 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
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;
-- 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;
-- 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;
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);
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;
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;
projects / platform / upstream / linaro-gcc.git / commitdiff