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
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 --
--------------------
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
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.
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;
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
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
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
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
-- --
-- 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- --
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' =>
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);
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
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
projects / platform / upstream / linaro-gcc.git / commitdiff