Commit 015bee83 by Arnaud Charlet

[multiple changes]

2012-11-06  Robert Dewar  <dewar@adacore.com>

	* err_vars.ads, atree.ads: Minor reformatting.

2012-11-06  Arnaud Charlet  <charlet@adacore.com>

	* gcc-interface/Make-lang.in: Update dependencies.
	* gcc-interface/Makefile.in: Add runtime pairs for Android.
	Rework handling of s-oscons.ads.
	* s-osinte-android.ads, s-osinte-android.adb: New files.

2012-11-06  Tristan Gingold  <gingold@adacore.com>

	* gcc-interface/trans.c (gnat_to_gnu): For N_Real_Literal, create the
	binary representation of vax floats.

From-SVN: r193238
parent 540d7a77
2012-11-06 Robert Dewar <dewar@adacore.com>
* err_vars.ads, atree.ads: Minor reformatting.
2012-11-06 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Make-lang.in: Update dependencies.
* gcc-interface/Makefile.in: Add runtime pairs for Android.
Rework handling of s-oscons.ads.
* s-osinte-android.ads, s-osinte-android.adb: New files.
2012-11-06 Tristan Gingold <gingold@adacore.com>
* gcc-interface/trans.c (gnat_to_gnu): For N_Real_Literal, create the
binary representation of vax floats.
2012-11-06 Tristan Gingold <gingold@adacore.com>
* sem_ch9.adb (Analyze_Protected_Type_Declaration): Fix thinko
......
......@@ -281,7 +281,10 @@ package Atree is
------------------
-- The following variables denote the count of errors of various kinds
-- detected in the tree.
-- detected in the tree. Note that these might be more logically located
-- in Err_Vars, but we put it to deal with licensing issues (we need this
-- to have the GPL exception licensing, since Check_Error_Detected can
-- be called from units with this licensing).
Serious_Errors_Detected : Nat := 0;
-- This is a count of errors that are serious enough to stop expansion,
......
......@@ -38,6 +38,12 @@ package Err_Vars is
-- been initialized, so we initialize some variables to avoid exceptions
-- from invalid values in such cases.
-- Note on error counts (Serious_Errors_Detected, Total_Errors_Detected,
-- Warnings_Detected). These counts might more logically appear in this
-- unit, but we place them in atree.adb, because of licensing issues. We
-- need to be able to access these counts from units that have the more
-- general licensing conditions.
----------------------------------
-- Error Message Mode Variables --
----------------------------------
......
......@@ -984,6 +984,33 @@ ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),)
EXTRA_LIBGNAT_OBJS+=vx_stack_info.o
endif
ifeq ($(strip $(filter-out arm% linux-androideabi,$(arch) $(osys)-$(word 4,$(targ)))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-linux.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-linux.ads<s-linux.ads \
s-osinte.adb<s-osinte-android.adb \
s-osinte.ads<s-osinte-android.ads \
s-osprim.adb<s-osprim-posix.adb \
s-taprop.adb<s-taprop-posix.adb \
s-taspri.ads<s-taspri-posix-noaltstack.ads \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
system.ads<system-linux-armel.ads \
$(DUMMY_SOCKETS_TARGET_PAIRS)
TOOLS_TARGET_PAIRS = \
mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
indepsw.adb<indepsw-gnu.adb
GNATRTL_SOCKETS_OBJS =
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
EH_MECHANISM=
THREADSLIB =
GNATLIB_SHARED = gnatlib-shared-dual
LIBRARY_VERSION := $(LIB_VERSION)
endif
# Sparc Solaris
ifeq ($(strip $(filter-out sparc% sun solaris%,$(targ))),)
LIBGNAT_TARGET_PAIRS_COMMON = \
......@@ -2577,13 +2604,14 @@ install-gnatlib: ../stamp-gnatlib-$(RTSDIR)
$(RTSDIR)/$(word 1,$(subst <, ,$(PAIR)));)
# Copy tsystem.h
$(CP) $(srcdir)/tsystem.h $(RTSDIR)
# Copy generated target dependent sources
$(RM) $(RTSDIR)/s-oscons.ads
(cd $(RTSDIR); $(LN_S) ../s-oscons.ads s-oscons.ads)
$(RM) ../stamp-gnatlib-$(RTSDIR)
touch ../stamp-gnatlib1-$(RTSDIR)
gnatlib: ../stamp-gnatlib1-$(RTSDIR) ../stamp-gnatlib2-$(RTSDIR)
$(RTSDIR)/s-oscons.ads: ../stamp-gnatlib1-$(RTSDIR)
$(RM) $(RTSDIR)/s-oscons.ads
(cd $(RTSDIR); $(LN_S) ../s-oscons.ads s-oscons.ads)
gnatlib: ../stamp-gnatlib1-$(RTSDIR) ../stamp-gnatlib2-$(RTSDIR) $(RTSDIR)/s-oscons.ads
# C files
$(MAKE) -C $(RTSDIR) \
CC="`echo \"$(GCC_FOR_TARGET)\" \
......
......@@ -5136,62 +5136,54 @@ gnat_to_gnu (Node_Id gnat_node)
break;
case N_Real_Literal:
gnu_result_type = get_unpadded_type (Etype (gnat_node));
/* If this is of a fixed-point type, the value we want is the
value of the corresponding integer. */
if (IN (Ekind (Underlying_Type (Etype (gnat_node))), Fixed_Point_Kind))
{
gnu_result_type = get_unpadded_type (Etype (gnat_node));
gnu_result = UI_To_gnu (Corresponding_Integer_Value (gnat_node),
gnu_result_type);
gcc_assert (!TREE_OVERFLOW (gnu_result));
}
/* We should never see a Vax_Float type literal, since the front end
is supposed to transform these using appropriate conversions. */
/* Convert the Ureal to a vax float (represented on a signed type). */
else if (Vax_Float (Underlying_Type (Etype (gnat_node))))
gcc_unreachable ();
{
gnu_result = UI_To_gnu (Get_Vax_Real_Literal_As_Signed (gnat_node),
gnu_result_type);
}
else
{
Ureal ur_realval = Realval (gnat_node);
gnu_result_type = get_unpadded_type (Etype (gnat_node));
/* First convert the real value to a machine number if it isn't
already. That forces BASE to 2 for non-zero values and simplifies
the rest of our logic. */
if (!Is_Machine_Number (gnat_node))
ur_realval
= Machine (Base_Type (Underlying_Type (Etype (gnat_node))),
ur_realval, Round_Even, gnat_node);
/* If the real value is zero, so is the result. Otherwise,
convert it to a machine number if it isn't already. That
forces BASE to 0 or 2 and simplifies the rest of our logic. */
if (UR_Is_Zero (ur_realval))
gnu_result = convert (gnu_result_type, integer_zero_node);
else
{
if (!Is_Machine_Number (gnat_node))
ur_realval
= Machine (Base_Type (Underlying_Type (Etype (gnat_node))),
ur_realval, Round_Even, gnat_node);
REAL_VALUE_TYPE tmp;
gnu_result
= UI_To_gnu (Numerator (ur_realval), gnu_result_type);
/* If we have a base of zero, divide by the denominator.
Otherwise, the base must be 2 and we scale the value, which
we know can fit in the mantissa of the type (hence the use
of that type above). */
if (No (Rbase (ur_realval)))
gnu_result
= build_binary_op (RDIV_EXPR,
get_base_type (gnu_result_type),
gnu_result,
UI_To_gnu (Denominator (ur_realval),
gnu_result_type));
else
{
REAL_VALUE_TYPE tmp;
/* The base must be 2 as Machine guarantees this, so we scale
the value, which we know can fit in the mantissa of the type
(hence the use of that type above). */
gcc_assert (Rbase (ur_realval) == 2);
real_ldexp (&tmp, &TREE_REAL_CST (gnu_result),
- UI_To_Int (Denominator (ur_realval)));
gnu_result = build_real (gnu_result_type, tmp);
}
gcc_assert (Rbase (ur_realval) == 2);
real_ldexp (&tmp, &TREE_REAL_CST (gnu_result),
- UI_To_Int (Denominator (ur_realval)));
gnu_result = build_real (gnu_result_type, tmp);
}
/* Now see if we need to negate the result. Do it this way to
......
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . O S _ I N T E R F A C E --
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2012, AdaCore --
-- --
-- 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- This is an Android version of this package.
pragma Polling (Off);
-- Turn off polling, we do not want ATC polling to take place during
-- tasking operations. It causes infinite loops and other problems.
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
with Interfaces.C; use Interfaces.C;
package body System.OS_Interface is
-----------------
-- To_Duration --
-----------------
function To_Duration (TS : timespec) return Duration is
begin
return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
end To_Duration;
-----------------
-- To_Timespec --
-----------------
function To_Timespec (D : Duration) return timespec is
S : time_t;
F : Duration;
begin
S := time_t (Long_Long_Integer (D));
F := D - Duration (S);
-- If F has negative value due to a round-up, adjust for positive F
-- value.
if F < 0.0 then
S := S - 1;
F := F + 1.0;
end if;
return timespec'(tv_sec => S,
tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
end To_Timespec;
-------------------
-- clock_gettime --
-------------------
function clock_gettime
(clock_id : clockid_t;
tp : access timespec) return int
is
pragma Unreferenced (clock_id);
-- Android/Linux don't have clock_gettime, so use gettimeofday
use Interfaces;
type timeval is array (1 .. 2) of C.long;
procedure timeval_to_duration
(T : not null access timeval;
sec : not null access C.long;
usec : not null access C.long);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6;
sec : aliased C.long;
usec : aliased C.long;
TV : aliased timeval;
Result : int;
function gettimeofday
(Tv : access timeval;
Tz : System.Address := System.Null_Address) return int;
pragma Import (C, gettimeofday, "gettimeofday");
begin
Result := gettimeofday (TV'Access, System.Null_Address);
pragma Assert (Result = 0);
timeval_to_duration (TV'Access, sec'Access, usec'Access);
tp.all := To_Timespec (Duration (sec) + Duration (usec) / Micro);
return Result;
end clock_gettime;
end System.OS_Interface;
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