Skip to content

R
riscv-gcc-1
Commit 24228312 by Arnaud Charlet
Options

[multiple changes] 

2014-08-01  Arnaud Charlet  <charlet@adacore.com>

	* ug_words, xgnatugn.adb, gcc-interface/Make-lang.in: Remove
	xgnatugn.adb and ug_words.

2014-08-01  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference): Check whether
	expansion can be avoid for Machine, Model and Rounding.
	(Is_Inline_Floating_Point_Attribute): Return true for Machine
	& Model, as well as Rounding if wrapped in a conversion to an
	integer type.
	* sem_res.adb (Simplify_Type_Conversion): Deal with Rounding as well.
	* gcc-interface/gigi.h (fp_arith_may_widen): Declare.
	* gcc-interface/utils.c (fp_arith_may_widen): New global variable.
	* gcc-interface/misc.c (enumerate_modes): Compute it.
	* gcc-interface/trans.c (FP_ARITH_MAY_WIDEN): Delete.
	(lvalue_required_for_attribute_p): Deal with Descriptor_Size,
	Machine and Model.
	(Attribute_to_gnu) <Attr_Model>: New case.
	<Attr_Machine>): Likewise.
	(convert_with_check): Test
	fp_arith_may_widen variable.

2014-08-01  Pascal Obry  <obry@adacore.com>

	* adaint.h (GNAT_FOPEN): New definition for Windows.
	(GNAT_OPEN): Likewise.
	(GNAT_STAT): Likewise.
	(GNAT_FSTAT): Likewise.
	(GNAT_LSTAT): Likewise.
	(GNAT_STRUCT_STAT): Likewise.
	* adaint.c (__gnat_stat): Fix computation of file size for
	Windows.

2014-08-01  Vincent Celier  <celier@adacore.com>

	* Makefile.rtl: Minor comment update.

2014-08-01  Vincent Celier  <celier@adacore.com>

	* Make-generated.in: Remove dependencies for vms-help.

From-SVN: r213429
parent d77cfab2
Showing with 177 additions and 128 deletions
gcc/ada/ChangeLog
2014-08-01 Arnaud Charlet <charlet@adacore.com>
* ug_words, xgnatugn.adb, gcc-interface/Make-lang.in: Remove
xgnatugn.adb and ug_words.
2014-08-01 Eric Botcazou <ebotcazou@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference): Check whether
expansion can be avoid for Machine, Model and Rounding.
(Is_Inline_Floating_Point_Attribute): Return true for Machine
& Model, as well as Rounding if wrapped in a conversion to an
integer type.
* sem_res.adb (Simplify_Type_Conversion): Deal with Rounding as well.
* gcc-interface/gigi.h (fp_arith_may_widen): Declare.
* gcc-interface/utils.c (fp_arith_may_widen): New global variable.
* gcc-interface/misc.c (enumerate_modes): Compute it.
* gcc-interface/trans.c (FP_ARITH_MAY_WIDEN): Delete.
(lvalue_required_for_attribute_p): Deal with Descriptor_Size,
Machine and Model.
(Attribute_to_gnu) <Attr_Model>: New case.
<Attr_Machine>): Likewise.
(convert_with_check): Test
fp_arith_may_widen variable.
2014-08-01 Pascal Obry <obry@adacore.com>
* adaint.h (GNAT_FOPEN): New definition for Windows.
(GNAT_OPEN): Likewise.
(GNAT_STAT): Likewise.
(GNAT_FSTAT): Likewise.
(GNAT_LSTAT): Likewise.
(GNAT_STRUCT_STAT): Likewise.
* adaint.c (__gnat_stat): Fix computation of file size for
Windows.
2014-08-01 Vincent Celier <celier@adacore.com>
* Makefile.rtl: Minor comment update.
2014-08-01 Vincent Celier <celier@adacore.com>
* Make-generated.in: Remove dependencies for vms-help.
2014-08-01 Gary Dismukes <dismukes@adacore.com>
* makeutl.ads, opt.ads: Minor grammar fixes.
......
gcc/ada/Make-generated.in
......@@ -95,11 +95,3 @@ $(ADA_GEN_SUBDIR)/stamp-sdefault : $(srcdir)/version.c Makefile
$(ECHO) "end Sdefault;" >> tmp-sdefault.adb
$(MOVE_IF_CHANGE) tmp-sdefault.adb $(ADA_GEN_SUBDIR)/sdefault.adb
touch $(ADA_GEN_SUBDIR)/stamp-sdefault
$(ADA_GEN_SUBDIR)/gnat.hlp : $(ADA_GEN_SUBDIR)/vms_help.adb $(ADA_GEN_SUBDIR)/vms_cmds.ads $(ADA_GEN_SUBDIR)/gnat.help_in $(ADA_GEN_SUBDIR)/vms_data.ads
-$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/gnat_hlp
$(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/gnat_hlp/,$(notdir $^))
$(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/gnat_hlp
(cd $(ADA_GEN_SUBDIR)/bldtools/gnat_hlp; \
gnatmake -q vms_help; \
./vms_help$(build_exeext) gnat.help_in vms_data.ads ../../gnat.hlp)
gcc/ada/Makefile.rtl
......@@ -18,7 +18,7 @@
#<http://www.gnu.org/licenses/>.
# This makefile fragment is included in the ada Makefile (both Unix
# and NT and VMS versions).
# and Windows).
# Its purpose is to allow the separate maintainence of the list of
# GNATRTL objects, which frequently changes.
......
gcc/ada/adaint.c
......@@ -1946,7 +1946,8 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
f2t (&fad.ftLastWriteTime, &statbuf->st_mtime);
f2t (&fad.ftLastAccessTime, &statbuf->st_atime);
statbuf->st_size = (off_t)fad.nFileSizeLow;
statbuf->st_size =
(__int64)fad.nFileSizeLow | (__int64)fad.nFileSizeHigh << 32;
/* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
statbuf->st_mode = S_IREAD;
......
gcc/ada/adaint.h
......@@ -58,6 +58,15 @@ extern "C" {
#define GNAT_FSTAT fstat64
#define GNAT_LSTAT lstat64
#define GNAT_STRUCT_STAT struct stat64
#elif defined(_WIN32)
#define GNAT_FOPEN fopen64
#define GNAT_OPEN open
#define GNAT_STAT stat64
#define GNAT_FSTAT fstat64
#define GNAT_LSTAT lstat
#define GNAT_STRUCT_STAT struct stat64
#else
#define GNAT_FOPEN fopen
#define GNAT_OPEN open
......
gcc/ada/exp_attr.adb
......@@ -4068,10 +4068,13 @@ package body Exp_Attr is
-------------
-- Transforms 'Machine into a call to the floating-point attribute
-- function Machine in Fat_xxx (where xxx is the root type)
-- function Machine in Fat_xxx (where xxx is the root type).
-- Expansion is avoided for cases the back end can handle directly.
when Attribute_Machine =>
Expand_Fpt_Attribute_R (N);
if not Is_Inline_Floating_Point_Attribute (N) then
Expand_Fpt_Attribute_R (N);
end if;
----------------------
-- Machine_Rounding --
......@@ -4335,10 +4338,13 @@ package body Exp_Attr is
-----------
-- Transforms 'Model into a call to the floating-point attribute
-- function Model in Fat_xxx (where xxx is the root type)
-- function Model in Fat_xxx (where xxx is the root type).
-- Expansion is avoided for cases the back end can handle directly.
when Attribute_Model =>
Expand_Fpt_Attribute_R (N);
if not Is_Inline_Floating_Point_Attribute (N) then
Expand_Fpt_Attribute_R (N);
end if;
-----------------
-- Object_Size --
......@@ -5411,9 +5417,12 @@ package body Exp_Attr is
-- Transforms 'Rounding into a call to the floating-point attribute
-- function Rounding in Fat_xxx (where xxx is the root type)
-- Expansion is avoided for cases the back end can handle directly.
when Attribute_Rounding =>
Expand_Fpt_Attribute_R (N);
if not Is_Inline_Floating_Point_Attribute (N) then
Expand_Fpt_Attribute_R (N);
end if;
-------------
-- Scaling --
......@@ -7946,7 +7955,10 @@ package body Exp_Attr is
Id : constant Attribute_Id := Get_Attribute_Id (Attribute_Name (N));
begin
if Nkind (Parent (N)) /= N_Type_Conversion
if Id = Attribute_Machine or else Id = Attribute_Model then
return True;
elsif Nkind (Parent (N)) /= N_Type_Conversion
or else not Is_Integer_Type (Etype (Parent (N)))
then
return False;
......@@ -7955,7 +7967,7 @@ package body Exp_Attr is
-- Should also support 'Machine_Rounding and 'Unbiased_Rounding, but
-- required back end support has not been implemented yet ???
return Id = Attribute_Truncation;
return Id = Attribute_Rounding or else Id = Attribute_Truncation;
end Is_Inline_Floating_Point_Attribute;
end Exp_Attr;
gcc/ada/gcc-interface/Make-lang.in
......@@ -654,26 +654,7 @@ ada.tags: force
# Generate documentation.
ada/doctools/xgnatugn$(build_exeext): ada/xgnatugn.adb
-$(MKDIR) ada/doctools
$(CP) $^ ada/doctools
cd ada/doctools && gnatmake -q xgnatugn
# Note that doc/gnat_ugn.texi and doc/projects.texi do not depend on
# xgnatugn being built so we can distribute a pregenerated doc/gnat_ugn.info
doc/gnat_ugn.texi: $(srcdir)/ada/gnat_ugn.texi $(srcdir)/ada/ug_words \
doc/projects.texi $(gcc_docdir)/include/gcc-common.texi gcc-vers.texi
$(MAKE) ada/doctools/xgnatugn$(build_exeext)
ada/doctools/xgnatugn unw $(srcdir)/ada/gnat_ugn.texi \
$(srcdir)/ada/ug_words doc/gnat_ugn.texi
doc/projects.texi: $(srcdir)/ada/projects.texi
$(MAKE) ada/doctools/xgnatugn$(build_exeext)
ada/doctools/xgnatugn unw $(srcdir)/ada/projects.texi \
$(srcdir)/ada/ug_words doc/projects.texi
doc/gnat_ugn.info: doc/gnat_ugn.texi \
doc/gnat_ugn.info: ada/gnat_ugn.texi ada/projects.texi \
$(gcc_docdir)/include/fdl.texi $(gcc_docdir)/include/gcc-common.texi \
gcc-vers.texi
if [ x$(BUILD_INFO) = xinfo ]; then \
......@@ -698,8 +679,7 @@ doc/gnat-style.info: ada/gnat-style.texi $(gcc_docdir)/include/fdl.texi \
-I$(srcdir)/ada -o $@ $<; \
else true; fi
ADA_INFOFILES = doc/gnat_ugn.info doc/gnat_ugn.texi \
doc/gnat_rm.info doc/gnat-style.info
ADA_INFOFILES = doc/gnat_ugn.info doc/gnat_rm.info doc/gnat-style.info
ada.info: $(ADA_INFOFILES)
......@@ -732,7 +712,8 @@ ada.html:
ada.install-html:
doc/gnat_ugn.dvi: doc/gnat_ugn.texi $(gcc_docdir)/include/fdl.texi \
doc/gnat_ugn.dvi: ada/gnat_ugn.texi ada/projects.texi \
$(gcc_docdir)/include/fdl.texi \
$(gcc_docdir)/include/gcc-common.texi gcc-vers.texi
$(TEXI2DVI) -c -I $(abs_docdir)/include -o $@ $<
......@@ -743,7 +724,8 @@ doc/gnat_rm.dvi: ada/gnat_rm.texi $(gcc_docdir)/include/fdl.texi \
doc/gnat-style.dvi: ada/gnat-style.texi $(gcc_docdir)/include/fdl.texi
$(TEXI2DVI) -c -I $(abs_docdir)/include -o $@ $<
doc/gnat_ugn.pdf: doc/gnat_ugn.texi $(gcc_docdir)/include/fdl.texi \
doc/gnat_ugn.pdf: ada/gnat_ugn.texi ada/projects.texi \
$(gcc_docdir)/include/fdl.texi \
$(gcc_docdir)/include/gcc-common.texi gcc-vers.texi
$(TEXI2PDF) -c -I $(abs_docdir)/include -o $@ $<
......
gcc/ada/gcc-interface/gigi.h
......@@ -335,6 +335,9 @@ extern int double_float_alignment;
types whose size is greater or equal to 64 bits, or 0 if this alignment
is not specifically capped. */
extern int double_scalar_alignment;
/* True if floating-point arithmetics may use wider intermediate results. */
extern bool fp_arith_may_widen;
/* Data structures used to represent attributes. */
......
gcc/ada/gcc-interface/misc.c
......@@ -717,6 +717,9 @@ enumerate_modes (void (*f) (const char *, int, int, int, int, int, int, int))
= { "float", "double", "long double" };
int iloop;
/* We are going to compute it below. */
fp_arith_may_widen = false;
for (iloop = 0; iloop < NUM_MACHINE_MODES; iloop++)
{
enum machine_mode i = (enum machine_mode) iloop;
......@@ -766,6 +769,15 @@ enumerate_modes (void (*f) (const char *, int, int, int, int, int, int, int))
if (!fmt)
continue;
/* Be conservative and consider that floating-point arithmetics may
use wider intermediate results as soon as there is an extended
Motorola or Intel mode supported by the machine. */
if (fmt == &ieee_extended_motorola_format
|| fmt == &ieee_extended_intel_96_format
|| fmt == &ieee_extended_intel_96_round_53_format
|| fmt == &ieee_extended_intel_128_format)
fp_arith_may_widen = true;
if (fmt->b == 2)
digs = (fmt->p - 1) * 1233 / 4096; /* scale by log (2) */
......
gcc/ada/gcc-interface/trans.c
......@@ -76,18 +76,6 @@ static location_t block_end_locus_sink;
#define BLOCK_SOURCE_END_LOCATION(BLOCK) block_end_locus_sink
#endif
/* For efficient float-to-int rounding, it is necessary to know whether
floating-point arithmetic may use wider intermediate results. When
FP_ARITH_MAY_WIDEN is not defined, be conservative and only assume
that arithmetic does not widen if double precision is emulated. */
#ifndef FP_ARITH_MAY_WIDEN
#if defined(HAVE_extendsfdf2)
#define FP_ARITH_MAY_WIDEN HAVE_extendsfdf2
#else
#define FP_ARITH_MAY_WIDEN 0
#endif
#endif
/* Pointers to front-end tables accessed through macros. */
struct Node *Nodes_Ptr;
struct Flags *Flags_Ptr;
......@@ -804,12 +792,15 @@ lvalue_required_for_attribute_p (Node_Id gnat_node)
case Attr_Object_Size:
case Attr_Value_Size:
case Attr_Component_Size:
case Attr_Descriptor_Size:
case Attr_Max_Size_In_Storage_Elements:
case Attr_Min:
case Attr_Max:
case Attr_Null_Parameter:
case Attr_Passed_By_Reference:
case Attr_Mechanism_Code:
case Attr_Machine:
case Attr_Model:
return 0;
case Attr_Address:
......@@ -2334,6 +2325,54 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
}
break;
case Attr_Model:
/* We treat Model as identical to Machine. This is true for at least
IEEE and some other nice floating-point systems. */
/* ... fall through ... */
case Attr_Machine:
/* The trick is to force the compiler to store the result in memory so
that we do not have extra precision used. But do this only when this
is necessary, i.e. for a type that is not the longest floating-point
type and if FP_ARITH_MAY_WIDEN is true. */
prefix_unused = true;
gnu_expr = gnat_to_gnu (First (Expressions (gnat_node)));
gnu_result_type = get_unpadded_type (Etype (gnat_node));
gnu_result = convert (gnu_result_type, gnu_expr);
if (gnu_result_type != longest_float_type_node && fp_arith_may_widen)
{
tree rec_type = make_node (RECORD_TYPE);
tree field
= create_field_decl (get_identifier ("OBJ"), gnu_result_type,
rec_type, NULL_TREE, NULL_TREE, 0, 0);
tree rec_val, asm_expr;
finish_record_type (rec_type, field, 0, false);
rec_val = build_constructor_single (rec_type, field, gnu_result);
rec_val = save_expr (rec_val);
asm_expr
= build5 (ASM_EXPR, void_type_node,
build_string (0, ""),
tree_cons (build_tree_list (NULL_TREE,
build_string (2, "=m")),
rec_val, NULL_TREE),
tree_cons (build_tree_list (NULL_TREE,
build_string (1, "m")),
rec_val, NULL_TREE),
NULL_TREE, NULL_TREE);
ASM_VOLATILE_P (asm_expr) = 1;
gnu_result
= build_compound_expr (gnu_result_type, asm_expr,
build_component_ref (rec_val, NULL_TREE,
field, false));
}
break;
default:
/* This abort means that we have an unimplemented attribute. */
gcc_unreachable ();
......@@ -2347,7 +2386,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
&& TREE_SIDE_EFFECTS (gnu_prefix)
&& !Is_Entity_Name (gnat_prefix))
gnu_result
= build_compound_expr (TREE_TYPE (gnu_result), gnu_prefix, gnu_result);
= build_compound_expr (TREE_TYPE (gnu_result), gnu_prefix, gnu_result);
*gnu_result_type_p = gnu_result_type;
return gnu_result;
......@@ -8675,7 +8714,8 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
/* Now convert to the result base type. If this is a non-truncating
float-to-integer conversion, round. */
if (INTEGRAL_TYPE_P (gnu_base_type) && FLOAT_TYPE_P (gnu_in_basetype)
if (INTEGRAL_TYPE_P (gnu_base_type)
&& FLOAT_TYPE_P (gnu_in_basetype)
&& !truncatep)
{
REAL_VALUE_TYPE half_minus_pred_half, pred_half;
......@@ -8684,11 +8724,11 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
const struct real_format *fmt;
/* The following calculations depend on proper rounding to even
of each arithmetic operation. In order to prevent excess
of each arithmetic operation. In order to prevent excess
precision from spoiling this property, use the widest hardware
floating-point type if FP_ARITH_MAY_WIDEN is true. */
calc_type
= FP_ARITH_MAY_WIDEN ? longest_float_type_node : gnu_in_basetype;
= fp_arith_may_widen ? longest_float_type_node : gnu_in_basetype;
/* FIXME: Should not have padding in the first place. */
if (TYPE_IS_PADDING_P (calc_type))
......
gcc/ada/gcc-interface/utils.c
......@@ -76,6 +76,9 @@ int double_float_alignment;
is not specifically capped. */
int double_scalar_alignment;
/* True if floating-point arithmetics may use wider intermediate results. */
bool fp_arith_may_widen = true;
/* Tree nodes for the various types and decls we create. */
tree gnat_std_decls[(int) ADT_LAST];
......
gcc/ada/sem_res.adb
......@@ -259,7 +259,7 @@ package body Sem_Res is
procedure Simplify_Type_Conversion (N : Node_Id);
-- Called after N has been resolved and evaluated, but before range checks
-- have been applied. Currently simplifies a combination of floating-point
-- to integer conversion and Truncation attribute.
-- to integer conversion and Rounding or Truncation attribute.
function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
-- A universal_fixed expression in an universal context is unambiguous if
......@@ -11082,29 +11082,36 @@ package body Sem_Res is
Opnd_Typ : constant Entity_Id := Etype (Operand);
begin
if Is_Floating_Point_Type (Opnd_Typ)
and then
(Is_Integer_Type (Target_Typ)
or else (Is_Fixed_Point_Type (Target_Typ)
and then Conversion_OK (N)))
and then Nkind (Operand) = N_Attribute_Reference
and then Attribute_Name (Operand) = Name_Truncation
-- Special processing if the conversion is the expression of a
-- Rounding or Truncation attribute reference. In this case we
-- replace:
-- Special processing required if the conversion is the expression
-- of a Truncation attribute reference. In this case we replace:
-- ityp (ftyp'Truncation (x))
-- ityp (ftyp'Rounding (x)) or ityp (ftyp'Truncation (x))
-- by
-- ityp (x)
-- with the Float_Truncate flag set, which is more efficient.
-- with the Float_Truncate flag set to False or True respectively,
-- which is more efficient.
if Is_Floating_Point_Type (Opnd_Typ)
and then
(Is_Integer_Type (Target_Typ)
or else (Is_Fixed_Point_Type (Target_Typ)
and then Conversion_OK (N)))
and then Nkind (Operand) = N_Attribute_Reference
and then (Attribute_Name (Operand) = Name_Rounding
or else Attribute_Name (Operand) = Name_Truncation)
then
Rewrite (Operand,
Relocate_Node (First (Expressions (Operand))));
Set_Float_Truncate (N, True);
declare
Truncate : constant Boolean :=
Attribute_Name (Operand) = Name_Truncation;
begin
Rewrite (Operand,
Relocate_Node (First (Expressions (Operand))));
Set_Float_Truncate (N, Truncate);
end;
end if;
end;
end if;
......
gcc/ada/xgnatugn.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT SYSTEM UTILITIES --
-- --
-- X G N A T U G N --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2014, 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
------------------------------------------------------------------------------
-- This is a temporary version whose only purpose is to work with
-- Makefile.gnat6
-- Its main previous purpose (to handle VMS-specific wording in
-- gnat_ugn.texi and projects.texi) is not applicable, since there is
-- no longer a VMS-specific version of the User's Guide.
-- The program is invoked as follows:
-- xgnatugn <target> <in-file> <word-list> <out-file>
-- In this temporary version, the program simply copies <in-file>
-- to <out-file> and ignores the <target> and <word-list> arguments
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;
procedure Xgnatugn is
Max_Line_Length : constant := 5000;
Line : String (1 .. Max_Line_Length);
Last : Natural;
File1, File2 : File_Type;
begin
Open (File1, Mode => In_File, Name => Argument (2));
Create (File2, Mode => Out_File, Name => Argument (4));
while not End_Of_File (File1) loop
Get_Line (File1, Line, Last);
Put_Line (File2, Line (1 .. Last));
end loop;
end Xgnatugn;
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