Commit 14e33999 by Arnaud Charlet

[multiple changes]

2009-06-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Valid_Conversion, Full_Designated_Type): Use
	Available_View only when designated type of an anonymous access type
	is  limited view.

2009-06-23  Robert Dewar  <dewar@adacore.com>

	* sem_ch10.adb: Minor reformatting

	* gnat1drv.adb (Adjust_Global_Switches): New procedure (take care of
	turning off inlining if ASIS mode active).
	
	* switch-c.adb: Remove fiddling with Inspector_Mode and ASIS_Mode
	This belongs in gnat1drv.adb after switches are scanned.

From-SVN: r148846
parent b6d83244
2009-06-23 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Valid_Conversion, Full_Designated_Type): Use
Available_View only when designated type of an anonymous access type
is limited view.
2009-06-23 Robert Dewar <dewar@adacore.com>
* sem_ch10.adb: Minor reformatting
* gnat1drv.adb (Adjust_Global_Switches): New procedure (take care of
turning off inlining if ASIS mode active).
* switch-c.adb: Remove fiddling with Inspector_Mode and ASIS_Mode
This belongs in gnat1drv.adb after switches are scanned.
2009-06-23 Hristian Kirtchev <kirtchev@adacore.com>
* sem_attr.adb: Add with and use clauses for Sem_Ch10.
......
......@@ -83,6 +83,13 @@ procedure Gnat1drv is
Back_End_Mode : Back_End.Back_End_Mode_Type;
-- Record back end mode
procedure Adjust_Global_Switches;
-- There are various interactions between front end switch settings,
-- including debug switch settings and target dependent parameters.
-- This procedure takes care of properly handling these interactions.
-- We do it after scanning out all the switches, that way we are not
-- depending on the order in which switches appear.
procedure Check_Bad_Body;
-- Called to check if the unit we are compiling has a bad body
......@@ -95,6 +102,121 @@ procedure Gnat1drv is
pragma Warnings (Off, Check_Library_Items);
-- In case the call below is commented out
----------------------------
-- Adjust_Global_Switches --
----------------------------
procedure Adjust_Global_Switches is
begin
-- Set ASIS mode if -gnatt and -gnatc are set
if Operating_Mode = Check_Semantics and then Tree_Output then
ASIS_Mode := True;
-- Turn off inlining in ASIS mode, since ASIS cannot handle the extra
-- information in the trees caused by inlining being active.
-- More specifically, the tree seems to malformed from the ASIS point
-- of view if -gnatc and -gnatn appear together ???
Inline_Active := False;
-- Turn off inspector mode in ASIS mode. For reasons that need
-- clearer documentation, Inspector cannot function in this mode ???
Inspector_Mode := False;
end if;
-- Inspeector mode requires back-end rep info and also needs to disable
-- front-end inlining (but -gnatn does not need to be disabled).
if Inspector_Mode then
Back_Annotate_Rep_Info := True;
Front_End_Inlining := False;
end if;
-- Set Configurable_Run_Time mode if system.ads flag set
if Targparm.Configurable_Run_Time_On_Target or Debug_Flag_YY then
Configurable_Run_Time_Mode := True;
end if;
-- Set -gnatR3m mode if debug flag A set
if Debug_Flag_AA then
Back_Annotate_Rep_Info := True;
List_Representation_Info := 1;
List_Representation_Info_Mechanisms := True;
end if;
-- Force Target_Strict_Alignment true if debug flag -gnatd.a is set
if Debug_Flag_Dot_A then
Ttypes.Target_Strict_Alignment := True;
end if;
-- Disable static allocation of dispatch tables if -gnatd.t or if layout
-- is enabled. The front end's layout phase currently treats types that
-- have discriminant-dependent arrays as not being static even when a
-- discriminant constraint on the type is static, and this leads to
-- problems with subtypes of type Ada.Tags.Dispatch_Table_Wrapper. ???
if Debug_Flag_Dot_T or else Frontend_Layout_On_Target then
Static_Dispatch_Tables := False;
end if;
-- Flip endian mode if -gnatd8 set
if Debug_Flag_8 then
Ttypes.Bytes_Big_Endian := not Ttypes.Bytes_Big_Endian;
end if;
-- Deal with forcing OpenVMS switches True if debug flag M is set, but
-- record the setting of Targparm.Open_VMS_On_Target in True_VMS_Target
-- before doing this, so we know if we are in real openVMS or not!
Opt.True_VMS_Target := Targparm.OpenVMS_On_Target;
if Debug_Flag_M then
Targparm.OpenVMS_On_Target := True;
Hostparm.OpenVMS := True;
end if;
-- Activate front end layout if debug flag -gnatdF is set
if Debug_Flag_FF then
Targparm.Frontend_Layout_On_Target := True;
end if;
-- Set and check exception mechnism
if Targparm.ZCX_By_Default_On_Target then
if Targparm.GCC_ZCX_Support_On_Target then
Exception_Mechanism := Back_End_Exceptions;
else
Osint.Fail ("Zero Cost Exceptions not supported on this target");
end if;
end if;
-- Set proper status for overflow checks. We turn on overflow checks
-- if -gnatp was not specified, and either -gnato is set or the back
-- end takes care of overflow checks. Otherwise we suppress overflow
-- checks by default (since front end checks are expensive).
if not Opt.Suppress_Checks
and then (Opt.Enable_Overflow_Checks
or else
(Targparm.Backend_Divide_Checks_On_Target
and
Targparm.Backend_Overflow_Checks_On_Target))
then
Suppress_Options (Overflow_Check) := False;
else
Suppress_Options (Overflow_Check) := True;
end if;
end Adjust_Global_Switches;
--------------------
-- Check_Bad_Body --
--------------------
......@@ -359,35 +481,7 @@ begin
Restrict.Restrictions := Targparm.Restrictions_On_Target;
end;
-- Set Configurable_Run_Time mode if system.ads flag set
if Targparm.Configurable_Run_Time_On_Target or Debug_Flag_YY then
Configurable_Run_Time_Mode := True;
end if;
-- Set -gnatR3m mode if debug flag A set
if Debug_Flag_AA then
Back_Annotate_Rep_Info := True;
List_Representation_Info := 1;
List_Representation_Info_Mechanisms := True;
end if;
-- Force Target_Strict_Alignment true if debug flag -gnatd.a is set
if Debug_Flag_Dot_A then
Ttypes.Target_Strict_Alignment := True;
end if;
-- Disable static allocation of dispatch tables if -gnatd.t or if layout
-- is enabled. The front end's layout phase currently treats types that
-- have discriminant-dependent arrays as not being static even when a
-- discriminant constraint on the type is static, and this leads to
-- problems with subtypes of type Ada.Tags.Dispatch_Table_Wrapper. ???
if Debug_Flag_Dot_T or else Frontend_Layout_On_Target then
Static_Dispatch_Tables := False;
end if;
Adjust_Global_Switches;
-- Output copyright notice if full list mode unless we have a list
-- file, in which case we defer this so that it is output in the file
......@@ -405,55 +499,6 @@ begin
Write_Eol;
end if;
-- Before we do anything else, adjust certain global values for
-- debug switches which modify their normal natural settings.
if Debug_Flag_8 then
Ttypes.Bytes_Big_Endian := not Ttypes.Bytes_Big_Endian;
end if;
-- Deal with forcing OpenVMS switches Ture if debug flag M is set, but
-- record the setting of Targparm.Open_VMS_On_Target in True_VMS_Target
-- before doing this.
Opt.True_VMS_Target := Targparm.OpenVMS_On_Target;
if Debug_Flag_M then
Targparm.OpenVMS_On_Target := True;
Hostparm.OpenVMS := True;
end if;
if Debug_Flag_FF then
Targparm.Frontend_Layout_On_Target := True;
end if;
-- We take the default exception mechanism into account
if Targparm.ZCX_By_Default_On_Target then
if Targparm.GCC_ZCX_Support_On_Target then
Exception_Mechanism := Back_End_Exceptions;
else
Osint.Fail ("Zero Cost Exceptions not supported on this target");
end if;
end if;
-- Set proper status for overflow checks. We turn on overflow checks
-- if -gnatp was not specified, and either -gnato is set or the back
-- end takes care of overflow checks. Otherwise we suppress overflow
-- checks by default (since front end checks are expensive).
if not Opt.Suppress_Checks
and then (Opt.Enable_Overflow_Checks
or else
(Targparm.Backend_Divide_Checks_On_Target
and
Targparm.Backend_Overflow_Checks_On_Target))
then
Suppress_Options (Overflow_Check) := False;
else
Suppress_Options (Overflow_Check) := True;
end if;
-- Check we do not have more than one source file, this happens only in
-- the case where the driver is called directly, it cannot happen when
-- gnat1 is invoked from gcc in the normal case.
......
......@@ -4915,7 +4915,6 @@ package body Sem_Ch10 is
function Is_Legal_Shadow_Entity_In_Body (T : Entity_Id) return Boolean is
C_Unit : constant Node_Id := Cunit (Current_Sem_Unit);
begin
return Nkind (Unit (C_Unit)) = N_Package_Body
and then Has_With_Clause (C_Unit,
......
......@@ -57,7 +57,6 @@ with Sem_Cat; use Sem_Cat;
with Sem_Ch4; use Sem_Ch4;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch10; use Sem_Ch10;
with Sem_Ch13; use Sem_Ch13;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
......@@ -9609,9 +9608,10 @@ package body Sem_Res is
end if;
end if;
-- Need some comments here, and a name for this block ???
-- In the presence of limited_with clauses we have to use non-limited
-- views, if available.
declare
Check_Limited : declare
function Full_Designated_Type (T : Entity_Id) return Entity_Id;
-- Helper function to handle limited views
......@@ -9623,17 +9623,23 @@ package body Sem_Res is
Desig : Entity_Id := Designated_Type (T);
begin
-- Detect a legal use of a shadow entity
if Is_Incomplete_Type (Desig)
and then From_With_Type (Desig)
and then Present (Non_Limited_View (Desig))
and then Is_Legal_Shadow_Entity_In_Body (Desig)
then
Desig := Non_Limited_View (Desig);
-- The shadow entity's non-limited view may designate an
-- incomplete type.
if Is_Incomplete_Type (Desig)
and then Present (Full_View (Desig))
then
Desig := Full_View (Desig);
end if;
end if;
return Available_View (Desig);
return Desig;
end Full_Designated_Type;
-- Local Declarations
......@@ -9644,7 +9650,7 @@ package body Sem_Res is
Same_Base : constant Boolean :=
Base_Type (Target) = Base_Type (Opnd);
-- Start of processing for ???
-- Start of processing for Check_Limited
begin
if Is_Tagged_Type (Target) then
......@@ -9698,7 +9704,7 @@ package body Sem_Res is
return False;
end if;
end if;
end;
end Check_Limited;
-- Access to subprogram types. If the operand is an access parameter,
-- the type has a deeper accessibility that any master, and cannot
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2009, 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- --
......@@ -228,11 +228,6 @@ package body Switch.C is
Ptr := Ptr + 1;
Operating_Mode := Check_Semantics;
if Tree_Output then
ASIS_Mode := True;
Inspector_Mode := False;
end if;
-- Processing for d switch
when 'd' =>
......@@ -257,25 +252,6 @@ package body Switch.C is
if Dot then
Set_Dotted_Debug_Flag (C);
Store_Compilation_Switch ("-gnatd." & C);
-- ??? Change this when we use a non debug flag to
-- enable inspector mode.
if C = 'I' then
if ASIS_Mode then
-- Do not enable inspector mode in ASIS mode,
-- since the two switches are incompatible.
Inspector_Mode := False;
else
-- In inspector mode, we need back-end rep info
-- annotations and disable front-end inlining.
Back_Annotate_Rep_Info := True;
Front_End_Inlining := False;
end if;
end if;
else
Set_Debug_Flag (C);
Store_Compilation_Switch ("-gnatd" & C);
......@@ -652,14 +628,7 @@ package body Switch.C is
when 'N' =>
Ptr := Ptr + 1;
Inline_Active := True;
-- Do not enable front-end inlining in inspector mode, to
-- generate trees that can be converted to SCIL. We still
-- enable back-end inlining which is fine.
if not Inspector_Mode then
Front_End_Inlining := True;
end if;
Front_End_Inlining := True;
-- Processing for o switch
......@@ -769,12 +738,6 @@ package body Switch.C is
when 't' =>
Ptr := Ptr + 1;
Tree_Output := True;
if Operating_Mode = Check_Semantics then
ASIS_Mode := True;
Inspector_Mode := False;
end if;
Back_Annotate_Rep_Info := True;
-- Processing for T switch
......
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