Commit e3d9f448 by Arnaud Charlet

[multiple changes]

2015-10-16  Arnaud Charlet  <charlet@adacore.com>

	* usage.adb, debug.adb, a-except.adb, a-except.ads, a-except-2005.adb,
	a-except-2005.ads, s-imgrea.adb: Minor code clean ups related to
	jgnat/dotnet removal.

2015-10-16  Arnaud Charlet  <charlet@adacore.com>

	* s-osprim-vxworks.adb, s-osprim-darwin.adb, s-tadeca.adb,
	s-osprim-unix.adb, s-osprim-solaris.adb, s-osprim-posix.adb,
	s-osprim.ads (Monotonic_Clock): Removed, unused.

2015-10-16  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Try_Object_Operation, Try_One_Interpretation):
	Do not reset the Obj_Type of the prefix if an interpretation
	involves an untagged type, to prevent a crash when analyzing an
	illegal program in All_Errors mode.

2015-10-16  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_N_Expression_With_Actions):
	Force the evaluation of the expression when its type is Boolean.
	(Force_Boolean_Evaluation): New routine.

2015-10-16  Bob Duff  <duff@adacore.com>

	* sem_util.adb (Has_Discrim_Dep_Array): Remove
	this function, and the call. No longer needed now that the back
	end can handle such things. Should result in further speedups
	in some cases.

2015-10-16  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Build_Predicate_Functions): If expression for
	predicate is side-effect free, indicate that the predicate
	function is pure, to allow for optimization of redundant
	predicate checks.

From-SVN: r228881
parent 57d3adcd
2015-10-16 Arnaud Charlet <charlet@adacore.com>
* usage.adb, debug.adb, a-except.adb, a-except.ads, a-except-2005.adb,
a-except-2005.ads, s-imgrea.adb: Minor code clean ups related to
jgnat/dotnet removal.
2015-10-16 Arnaud Charlet <charlet@adacore.com>
* s-osprim-vxworks.adb, s-osprim-darwin.adb, s-tadeca.adb,
s-osprim-unix.adb, s-osprim-solaris.adb, s-osprim-posix.adb,
s-osprim.ads (Monotonic_Clock): Removed, unused.
2015-10-16 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Try_Object_Operation, Try_One_Interpretation):
Do not reset the Obj_Type of the prefix if an interpretation
involves an untagged type, to prevent a crash when analyzing an
illegal program in All_Errors mode.
2015-10-16 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Expand_N_Expression_With_Actions):
Force the evaluation of the expression when its type is Boolean.
(Force_Boolean_Evaluation): New routine.
2015-10-16 Bob Duff <duff@adacore.com>
* sem_util.adb (Has_Discrim_Dep_Array): Remove
this function, and the call. No longer needed now that the back
end can handle such things. Should result in further speedups
in some cases.
2015-10-16 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Build_Predicate_Functions): If expression for
predicate is side-effect free, indicate that the predicate
function is pure, to allow for optimization of redundant
predicate checks.
2015-10-16 Arnaud Charlet <charlet@adacore.com>
* checks.adb: Fix typo.
* s-osinte-linux.ads: Add header.
* projects.texi: Removed, no longer used.
......
......@@ -694,15 +694,6 @@ package body Ada.Exceptions is
-- The actual Call_Chain routine is separate, so that it can easily
-- be dummied out when no exception traceback information is needed.
------------------------------
-- Current_Target_Exception --
------------------------------
function Current_Target_Exception return Exception_Occurrence is
begin
return Null_Occurrence;
end Current_Target_Exception;
-------------------
-- EId_To_String --
-------------------
......
......@@ -177,18 +177,6 @@ private
-- Private Subprograms --
-------------------------
function Current_Target_Exception return Exception_Occurrence;
pragma Export
(Ada, Current_Target_Exception,
"__gnat_current_target_exception");
-- This routine should return the current raised exception on targets which
-- have built-in exception handling such as the Java Virtual Machine. For
-- other targets this routine is simply ignored. Currently, only JGNAT
-- uses this. See 4jexcept.ads for details. The pragma Export allows this
-- routine to be accessed elsewhere in the run-time, even though it is in
-- the private part of this package (it is not allowed to be in the visible
-- part, since this is set by the reference manual).
function Exception_Name_Simple (X : Exception_Occurrence) return String;
-- Like Exception_Name, but returns the simple non-qualified name of the
-- exception. This is used to implement the Exception_Name function in
......
......@@ -727,15 +727,6 @@ package body Ada.Exceptions is
-- The actual polling routine is separate, so that it can easily be
-- replaced with a target dependent version.
------------------------------
-- Current_Target_Exception --
------------------------------
function Current_Target_Exception return Exception_Occurrence is
begin
return Null_Occurrence;
end Current_Target_Exception;
-------------------
-- EId_To_String --
-------------------
......
......@@ -154,18 +154,6 @@ private
-- Private Subprograms --
-------------------------
function Current_Target_Exception return Exception_Occurrence;
pragma Export
(Ada, Current_Target_Exception,
"__gnat_current_target_exception");
-- This routine should return the current raised exception on targets
-- which have built-in exception handling such as the Java Virtual
-- Machine. For other targets this routine is simply ignored. Currently,
-- only JGNAT uses this. See 4jexcept.ads for details. The pragma Export
-- allows this routine to be accessed elsewhere in the run-time, even
-- though it is in the private part of this package (it is not allowed
-- to be in the visible part, since this is set by the reference manual).
function Exception_Name_Simple (X : Exception_Occurrence) return String;
-- Like Exception_Name, but returns the simple non-qualified name of the
-- exception. This is used to implement the Exception_Name function in
......
......@@ -73,7 +73,7 @@ package body Debug is
-- dG Generate all warnings including those normally suppressed
-- dH Hold (kill) call to gigi
-- dI Inhibit internal name numbering in gnatG listing
-- dJ Output debugging trace info for JGNAT (Java VM version of GNAT)
-- dJ
-- dK Kill all error messages
-- dL Output trace information on elaboration checking
-- dM Assume all variables are modified (no current values)
......@@ -399,11 +399,6 @@ package body Debug is
-- is used in the fixed bugs run to minimize system and version
-- dependency in filed -gnatD or -gnatG output.
-- dJ Generate debugging trace output for the JGNAT back end. This
-- consists of symbolic Java Byte Code sequences for all generated
-- classes plus additional information to indicate local variables
-- and methods.
-- dK Kill all error messages. This debug flag suppresses the output
-- of all error messages. It is used in regression tests where the
-- error messages are target dependent and irrelevant.
......
......@@ -5039,12 +5039,49 @@ package body Exp_Ch4 is
--------------------------------------
procedure Expand_N_Expression_With_Actions (N : Node_Id) is
Acts : constant List_Id := Actions (N);
procedure Force_Boolean_Evaluation (Expr : Node_Id);
-- Force the evaluation of Boolean expression Expr
function Process_Action (Act : Node_Id) return Traverse_Result;
-- Inspect and process a single action of an expression_with_actions for
-- transient controlled objects. If such objects are found, the routine
-- generates code to clean them up when the context of the expression is
-- evaluated or elaborated.
------------------------------
-- Force_Boolean_Evaluation --
------------------------------
procedure Force_Boolean_Evaluation (Expr : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Flag_Decl : Node_Id;
Flag_Id : Entity_Id;
begin
-- Relocate the expression to the actions list by capturing its value
-- in a Boolean flag. Generate:
-- Flag : constant Boolean := Expr;
Flag_Id := Make_Temporary (Loc, 'F');
Flag_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Flag_Id,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc),
Expression => Relocate_Node (Expr));
Append (Flag_Decl, Acts);
Analyze (Flag_Decl);
-- Replace the expression with a reference to the flag
Rewrite (Expression (N), New_Occurrence_Of (Flag_Id, Loc));
Analyze (Expression (N));
end Force_Boolean_Evaluation;
--------------------
-- Process_Action --
--------------------
......@@ -5077,9 +5114,7 @@ package body Exp_Ch4 is
-- Local variables
Acts : constant List_Id := Actions (N);
Expr : constant Node_Id := Expression (N);
Act : Node_Id;
Act : Node_Id;
-- Start of processing for Expand_N_Expression_With_Actions
......@@ -5087,7 +5122,7 @@ package body Exp_Ch4 is
-- Do not evaluate the expression when it denotes an entity because the
-- expression_with_actions node will be replaced by the reference.
if Is_Entity_Name (Expr) then
if Is_Entity_Name (Expression (N)) then
null;
-- Do not evaluate the expression when there are no actions because the
......@@ -5117,11 +5152,23 @@ package body Exp_Ch4 is
-- <finalize Trans_Id>
-- in Val end;
-- It is now safe to finalize the transient controlled object at the end
-- of the actions list.
-- Once this transformation is performed, it is safe to finalize the
-- transient controlled object at the end of the actions list.
-- Note that Force_Evaluation does not remove side effects in operators
-- because it assumes that all operands are evaluated and side effect
-- free. This is not the case when an operand depends implicitly on the
-- transient controlled object through the use of access types.
elsif Is_Boolean_Type (Etype (Expression (N))) then
Force_Boolean_Evaluation (Expression (N));
-- The expression of an expression_with_actions node may not necessarely
-- be Boolean when the node appears in an if expression. In this case do
-- the usual forced evaluation to encapsulate potential aliasing.
else
Force_Evaluation (Expr);
Force_Evaluation (Expression (N));
end if;
-- Process all transient controlled objects found within the actions of
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
......@@ -147,12 +147,7 @@ package body System.Img_Real is
is
NFrac : constant Natural := Natural'Max (Aft, 1);
Sign : Character;
X : aliased Long_Long_Float;
-- This is declared aliased because the expansion of X'Valid passes
-- X by access and JGNAT requires all access parameters to be aliased.
-- The Valid attribute probably needs to be handled via a different
-- expansion for JGNAT, and this use of aliased should be removed
-- once Valid is handled properly. ???
X : Long_Long_Float;
Scale : Integer;
Expon : Integer;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2015, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -90,12 +90,6 @@ package body System.OS_Primitives is
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end Clock;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration renames Clock;
-----------------
-- To_Timespec --
-----------------
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2015, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -93,12 +93,6 @@ package body System.OS_Primitives is
return Duration (sec) + Duration (usec) / Micro;
end Clock;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration renames Clock;
-----------------
-- To_Timespec --
-----------------
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2015, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -70,12 +70,6 @@ package body System.OS_Primitives is
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end Clock;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration renames Clock;
-----------------
-- Timed_Delay --
-----------------
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2015, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -70,12 +70,6 @@ package body System.OS_Primitives is
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end Clock;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration renames Clock;
-----------------
-- Timed_Delay --
-----------------
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2015, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -102,12 +102,6 @@ package body System.OS_Primitives is
return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
end Clock;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration renames Clock;
-----------------
-- Timed_Delay --
-----------------
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2015, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -63,12 +63,6 @@ package System.OS_Primitives is
-- Epoch", which is Jan 1, 1970 00:00:00 UTC on UNIX systems. This
-- implementation is affected by system's clock changes.
function Monotonic_Clock return Duration;
pragma Inline (Monotonic_Clock);
-- Returns "absolute" time, represented as an offset relative to "the Unix
-- Epoch", which is Jan 1, 1970 00:00:00 UTC. This clock implementation is
-- immune to the system's clock changes.
Relative : constant := 0;
Absolute_Calendar : constant := 1;
Absolute_RT : constant := 2;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2015, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -66,7 +66,7 @@ begin
if SOSC.CLOCK_RT_Ada /= SOSC.CLOCK_REALTIME then
pragma Warnings (On);
RT_T := RT_T - OS_Primitives.Monotonic_Clock + STPO.Monotonic_Clock;
RT_T := RT_T - OS_Primitives.Clock + STPO.Monotonic_Clock;
end if;
System.Tasking.Initialization.Defer_Abort
......
......@@ -8702,6 +8702,16 @@ package body Sem_Ch13 is
Insert_Before_And_Analyze (N, FDecl);
Insert_After_And_Analyze (N, FBody);
-- Static predicate functions are always side-effect free, and
-- in most cases dynamic predicate functions are as well. Mark
-- them as such whenever possible, so redundant predicate checks
-- can be optimized.
if Expander_Active then
Set_Is_Pure (SId, Side_Effect_Free (Expr));
Set_Is_Inlined (SId);
end if;
end;
-- Test for raise expressions present and if so build M version
......
......@@ -8135,6 +8135,12 @@ package body Sem_Ch4 is
-----------------------------------
procedure Try_One_Prefix_Interpretation (T : Entity_Id) is
-- If the interpretation does not have a valid candidate type,
-- preserve current value of Obj_Type for subsequent errors.
Prev_Obj_Type : constant Entity_Id := Obj_Type;
begin
Obj_Type := T;
......@@ -8167,6 +8173,10 @@ package body Sem_Ch4 is
if not Is_Tagged_Type (Obj_Type)
or else Is_Incomplete_Type (Obj_Type)
then
-- Restore previous type if current one is not legal candidate.
Obj_Type := Prev_Obj_Type;
return;
end if;
......
......@@ -17020,11 +17020,6 @@ package body Sem_Util is
-- could be nested inside some other record that is constrained by
-- nondiscriminants). That is, the recursive calls are too conservative.
function Has_Discrim_Dep_Array (Typ : Entity_Id) return Boolean;
-- True if we find certain discriminant-dependent array subcomponents.
-- This shouldn't be necessary, but without this check, we crash in
-- gimplify. ???
------------------------------
-- Caller_Known_Size_Record --
------------------------------
......@@ -17077,52 +17072,6 @@ package body Sem_Util is
return True;
end Caller_Known_Size_Record;
---------------------------
-- Has_Discrim_Dep_Array --
---------------------------
function Has_Discrim_Dep_Array (Typ : Entity_Id) return Boolean is
pragma Assert (Typ = Underlying_Type (Typ));
begin
if Is_Array_Type (Typ) then
return Size_Depends_On_Discriminant (Typ);
end if;
if Is_Record_Type (Typ)
or else
Is_Protected_Type (Typ)
then
declare
Comp : Entity_Id;
begin
Comp := First_Entity (Typ);
while Present (Comp) loop
-- Only look at E_Component entities. No need to look at
-- E_Discriminant entities, and we must ignore internal
-- subtypes generated for constrained components.
if Ekind (Comp) = E_Component then
declare
Comp_Type : constant Entity_Id :=
Underlying_Type (Etype (Comp));
begin
if Has_Discrim_Dep_Array (Comp_Type) then
return True;
end if;
end;
end if;
Next_Entity (Comp);
end loop;
end;
end if;
return False;
end Has_Discrim_Dep_Array;
-- Local declarations
Typ : constant Entity_Id := Underlying_Type (Id);
......@@ -17170,14 +17119,6 @@ package body Sem_Util is
-- discriminants.
elsif Is_Definite_Subtype (Typ) or else Is_Task_Type (Typ) then
if Is_Record_Type (Typ) or else Is_Protected_Type (Typ) then
if not Has_Discriminants (Typ) then
if Has_Discrim_Dep_Array (Typ) then
return True; -- ???Shouldn't be necessary
end if;
end if;
end if;
return False;
-- Indefinite (discriminated) untagged record or protected type
......
......@@ -104,7 +104,7 @@ begin
Write_Line ("Preserve control flow for coverage analysis");
end if;
-- Common switches available to both GCC and JGNAT
-- Common switches available everywhere
Write_Switch_Char ("g ", "");
Write_Line ("Generate debugging information");
......
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