Skip to content

R
riscv-gcc-1
Commit 3ffd18f1 by Arnaud Charlet
Options

[multiple changes] 

2012-01-23  Robert Dewar  <dewar@adacore.com>

	* sprint.ads, sprint.adb (Sprint_Node_List): Add New_Lines parameter
	(pg,po,ps): Make sure each entry starts on new line.

2012-01-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* a-calend.ads, a-calend.adb: Define types int and int_Pointer. Update
	the parameter profile of procedure localtime_tzoff and its associated
	comment.
	(Day_Of_Week): Do not treat the input date as historical
	with respect to time zones.
	(Split): Do not treat the input
	date as historical with respect to time zones.	(Time_Of): Do
	not treat the input constituents as forming a historical date
	with respect to time zones.
	(UTC_Time_Offset): Add new formal
	parameter Is_Historic. Add local variable Flag. Update the call
	to localtime_tzoff.
	* a-catizo.ads, a-catizo.adb (UTC_Time_Offset): New routine.
	(UTC_Time_Offset (Time)): Update the call to
	Time_Zone_Operations.UTC_Time_Offset.
	* sysdep.c (__gnat_localtime_tzoff): Update parameter
	profile. Split the processing of offsets on Windows into two - one
	part of historic time stamps and the other for the current time.

From-SVN: r183413
parent ce20f35b
Showing with 200 additions and 80 deletions
gcc/ada/ChangeLog
2012-01-23 Robert Dewar <dewar@adacore.com>
* sprint.ads, sprint.adb (Sprint_Node_List): Add New_Lines parameter
(pg,po,ps): Make sure each entry starts on new line.
2012-01-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-calend.ads, a-calend.adb: Define types int and int_Pointer. Update
the parameter profile of procedure localtime_tzoff and its associated
comment.
(Day_Of_Week): Do not treat the input date as historical
with respect to time zones.
(Split): Do not treat the input
date as historical with respect to time zones. (Time_Of): Do
not treat the input constituents as forming a historical date
with respect to time zones.
(UTC_Time_Offset): Add new formal
parameter Is_Historic. Add local variable Flag. Update the call
to localtime_tzoff.
* a-catizo.ads, a-catizo.adb (UTC_Time_Offset): New routine.
(UTC_Time_Offset (Time)): Update the call to
Time_Zone_Operations.UTC_Time_Offset.
* sysdep.c (__gnat_localtime_tzoff): Update parameter
profile. Split the processing of offsets on Windows into two - one
part of historic time stamps and the other for the current time.
2012-01-23 Robert Dewar <dewar@adacore.com>
* a-calend.adb: Minor reformatting.
2012-01-23 Ed Schonberg <schonberg@adacore.com>
......
gcc/ada/a-calend.adb
......@@ -1025,7 +1025,10 @@ package body Ada.Calendar is
function Day_Of_Week (Date : Time) return Integer is
Date_N : constant Time_Rep := Time_Rep (Date);
Time_Zone : constant Long_Integer :=
Time_Zones_Operations.UTC_Time_Offset (Date);
Time_Zones_Operations.UTC_Time_Offset
(Date => Date,
Is_Historic => False);
Ada_Low_N : Time_Rep;
Day_Count : Long_Integer;
Day_Dur : Time_Dur;
......@@ -1138,7 +1141,9 @@ package body Ada.Calendar is
else
declare
Off : constant Long_Integer :=
Time_Zones_Operations.UTC_Time_Offset (Time (Date_N));
Time_Zones_Operations.UTC_Time_Offset
(Date => Time (Date_N),
Is_Historic => False);
begin
Date_N := Date_N + Time_Rep (Off) * Nano;
end;
......@@ -1360,12 +1365,14 @@ package body Ada.Calendar is
declare
Current_Off : constant Long_Integer :=
Time_Zones_Operations.UTC_Time_Offset
(Time (Res_N));
(Date => Time (Res_N),
Is_Historic => False);
Current_Res_N : constant Time_Rep :=
Res_N - Time_Rep (Current_Off) * Nano;
Off : constant Long_Integer :=
Time_Zones_Operations.UTC_Time_Offset
(Time (Current_Res_N));
(Date => Time (Current_Res_N),
Is_Historic => False);
begin
Res_N := Res_N - Time_Rep (Off) * Nano;
end;
......@@ -1438,7 +1445,9 @@ package body Ada.Calendar is
Nanos_In_56_Years : constant := (14 * 366 + 42 * 365) * Nanos_In_Day;
subtype long is Long_Integer;
subtype int is Integer;
type long_Pointer is access all long;
type int_Pointer is access all int;
type time_t is
range -(2 ** (Standard'Address_Size - Integer'(1))) ..
......@@ -1446,21 +1455,28 @@ package body Ada.Calendar is
type time_t_Pointer is access all time_t;
procedure localtime_tzoff
(timer : time_t_Pointer;
off : long_Pointer);
(timer : time_t_Pointer;
is_historic : int_Pointer;
off : long_Pointer);
pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff");
-- This is a lightweight wrapper around the system library function
-- localtime_r. Parameter 'off' captures the UTC offset which is either
-- retrieved from the tm struct or calculated from the 'timezone' extern
-- and the tm_isdst flag in the tm struct.
-- and the tm_isdst flag in the tm struct. Flag 'is_historic' denotes
-- whether 'timer' is a historical time stamp. If this is not the case,
-- the routine returns the offset of the local time zone.
---------------------
-- UTC_Time_Offset --
---------------------
function UTC_Time_Offset (Date : Time) return Long_Integer is
function UTC_Time_Offset
(Date : Time;
Is_Historic : Boolean := True) return Long_Integer
is
Adj_Cent : Integer;
Date_N : Time_Rep;
Flag : aliased int;
Offset : aliased long;
Secs_T : aliased time_t;
......@@ -1499,8 +1515,13 @@ package body Ada.Calendar is
Secs_T := time_t (Date_N / Nano);
-- Determine whether to treat the input date as historical or not
Flag := (if Is_Historic then 1 else 0);
localtime_tzoff
(Secs_T'Unchecked_Access,
Flag'Unchecked_Access,
Offset'Unchecked_Access);
return Offset;
......@@ -1512,4 +1533,5 @@ package body Ada.Calendar is
begin
System.OS_Primitives.Initialize;
end Ada.Calendar;
gcc/ada/a-calend.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -350,8 +350,12 @@ private
package Time_Zones_Operations is
function UTC_Time_Offset (Date : Time) return Long_Integer;
-- Return the offset in seconds from UTC
function UTC_Time_Offset
(Date : Time;
Is_Historic : Boolean := True) return Long_Integer;
-- Return the offset in seconds from UTC of an arbitrary date. If flag
-- Is_Historic is set to False, then return the local time zone offset
-- regardless of what Date designates.
end Time_Zones_Operations;
......
gcc/ada/a-catizo.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2009, Free Software Foundation, Inc. --
-- Copyright (C) 2009-2012, 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- --
......@@ -42,9 +42,41 @@ package body Ada.Calendar.Time_Zones is
-- UTC_Time_Offset --
---------------------
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset is
function UTC_Time_Offset return Time_Offset is
Offset_L : constant Long_Integer :=
Time_Zones_Operations.UTC_Time_Offset (Date);
Time_Zones_Operations.UTC_Time_Offset
(Date => Clock,
Is_Historic => False);
Offset : Time_Offset;
begin
if Offset_L = Invalid_Time_Zone_Offset then
raise Unknown_Zone_Error;
end if;
-- The offset returned by Time_Zones_Operations.UTC_Time_Offset is in
-- seconds, the returned value needs to be in minutes.
Offset := Time_Offset (Offset_L / 60);
-- Validity checks
if not Offset'Valid then
raise Unknown_Zone_Error;
end if;
return Offset;
end UTC_Time_Offset;
---------------------
-- UTC_Time_Offset --
---------------------
function UTC_Time_Offset (Date : Time) return Time_Offset is
Offset_L : constant Long_Integer :=
Time_Zones_Operations.UTC_Time_Offset
(Date => Date,
Is_Historic => True);
Offset : Time_Offset;
begin
......
gcc/ada/a-catizo.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2005-2008, Free Software Foundation, Inc. --
-- Copyright (C) 2005-2012, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
......@@ -26,7 +26,12 @@ package Ada.Calendar.Time_Zones is
Unknown_Zone_Error : exception;
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset;
function UTC_Time_Offset return Time_Offset;
-- Returns (in minutes), the difference between the implementation-defined
-- time zone of Calendar, and UTC time. If the time zone of the Calendar
-- implementation is unknown, raises Unknown_Zone_Error.
function UTC_Time_Offset (Date : Time) return Time_Offset;
-- Returns (in minutes), the difference between the implementation-defined
-- time zone of Calendar, and UTC time, at the time Date. If the time zone
-- of the Calendar implementation is unknown, raises Unknown_Zone_Error.
......
gcc/ada/sprint.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -420,7 +420,7 @@ package body Sprint is
Current_Source_File := No_Source_File;
if Arg in List_Range then
Sprint_Node_List (List_Id (Arg));
Sprint_Node_List (List_Id (Arg), New_Lines => True);
elsif Arg in Node_Range then
Sprint_Node (Node_Id (Arg));
......@@ -443,7 +443,7 @@ package body Sprint is
Current_Source_File := No_Source_File;
if Arg in List_Range then
Sprint_Node_List (List_Id (Arg));
Sprint_Node_List (List_Id (Arg), New_Lines => True);
elsif Arg in Node_Range then
Sprint_Node (Node_Id (Arg));
......@@ -490,7 +490,7 @@ package body Sprint is
Current_Source_File := No_Source_File;
if Arg in List_Range then
Sprint_Node_List (List_Id (Arg));
Sprint_Node_List (List_Id (Arg), New_Lines => True);
elsif Arg in Node_Range then
Sprint_Node (Node_Id (Arg));
......@@ -3263,7 +3263,7 @@ package body Sprint is
-- Sprint_Node_List --
----------------------
procedure Sprint_Node_List (List : List_Id) is
procedure Sprint_Node_List (List : List_Id; New_Lines : Boolean := False) is
Node : Node_Id;
begin
......@@ -3276,6 +3276,10 @@ package body Sprint is
exit when Node = Empty;
end loop;
end if;
if New_Lines and then Column /= 1 then
Write_Eol;
end if;
end Sprint_Node_List;
----------------------
......
gcc/ada/sprint.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -118,11 +118,13 @@ package Sprint is
-- blank is output if List is non-empty, and nothing at all is printed it
-- the argument is No_List.
procedure Sprint_Node_List (List : List_Id);
procedure Sprint_Node_List (List : List_Id; New_Lines : Boolean := False);
-- Prints the nodes in a list with no separating characters. This is used
-- in the case of lists of items which are printed on separate lines using
-- the current indentation amount. Note that Sprint_Node_List itself
-- does not generate any New_Line calls.
-- the current indentation amount. New_Lines controls the generation of
-- New_Line calls. If False, no New_Line calls are generated. If True,
-- then New_Line calls are generated as needed to ensure that each list
-- item starts at the beginning of a line.
procedure Sprint_Opt_Node_List (List : List_Id);
-- Like Sprint_Node_List, but prints nothing if List = No_List
......@@ -151,11 +153,13 @@ package Sprint is
procedure po (Arg : Union_Id);
pragma Export (Ada, po);
-- Like pg, but prints original source for the argument (like -gnatdo
-- output). Intended only for use from gdb for debugging purposes.
-- output). Intended only for use from gdb for debugging purposes. In
-- the list case, an end of line is output to separate list elements.
procedure ps (Arg : Union_Id);
pragma Export (Ada, ps);
-- Like pg, but prints generated and original source for the argument (like
-- -gnatds output). Intended only for use from gdb for debugging purposes.
-- In the list case, an end of line is output to separate list elements.
end Sprint;
gcc/ada/sysdep.c
......@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2011, Free Software Foundation, Inc. *
* Copyright (C) 1992-2012, 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- *
......@@ -644,71 +644,94 @@ extern void (*Unlock_Task) (void);
/* Reentrant localtime for Windows. */
extern void
__gnat_localtime_tzoff (const time_t *, long *);
__gnat_localtime_tzoff (const time_t *, const int *, long *);
static const unsigned long long w32_epoch_offset = 11644473600ULL;
void
__gnat_localtime_tzoff (const time_t *timer, long *off)
__gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
{
union
{
FILETIME ft_time;
unsigned long long ull_time;
} utc_time, local_time;
SYSTEMTIME utc_sys_time, local_sys_time;
TIME_ZONE_INFORMATION tzi;
BOOL status = 1;
BOOL rtx_active;
DWORD tzi_status;
(*Lock_Task) ();
#ifdef RTX
rtx_active = 1;
#else
rtx_active = 0;
#endif
(*Lock_Task) ();
tzi_status = GetTimeZoneInformation (&tzi);
*off = tzi.Bias;
if (tzi_status == TIME_ZONE_ID_STANDARD)
/* The system is operating in the range covered by the StandardDate
member. */
*off = *off + tzi.StandardBias;
else if (tzi_status == TIME_ZONE_ID_DAYLIGHT)
/* The system is operating in the range covered by the DaylightDate
member. */
*off = *off + tzi.DaylightBias;
*off = *off * -60;
#else
/* Processing for RTX targets or cases where we simply want to extract the
offset of the current time zone, regardless of the date. */
/* First convert unix time_t structure to windows FILETIME format. */
utc_time.ull_time = ((unsigned long long) *timer + w32_epoch_offset)
* 10000000ULL;
if (rtx_active || !is_historic) {
*off = tzi.Bias;
tzi_status = GetTimeZoneInformation (&tzi);
/* The system is operating in the range covered by the StandardDate
member. */
if (tzi_status == TIME_ZONE_ID_STANDARD) {
*off = *off + tzi.StandardBias;
}
/* If GetTimeZoneInformation does not return a value between 0 and 2 then
it means that we were not able to retrieve timezone informations.
Note that we cannot use here FileTimeToLocalFileTime as Windows will use
in always in this case the current timezone setting. As suggested on
MSDN we use the following three system calls to get the right information.
Note also that starting with Windows Vista new functions are provided to
get timezone settings that depend on the year. We cannot use them as we
still support Windows XP and Windows 2003. */
status = (tzi_status >= 0 && tzi_status <= 2)
&& FileTimeToSystemTime (&utc_time.ft_time, &utc_sys_time)
&& SystemTimeToTzSpecificLocalTime (&tzi, &utc_sys_time, &local_sys_time)
&& SystemTimeToFileTime (&local_sys_time, &local_time.ft_time);
if (!status)
/* An error occurs so return invalid_tzoff. */
*off = __gnat_invalid_tzoff;
else
if (local_time.ull_time > utc_time.ull_time)
*off = (long) ((local_time.ull_time - utc_time.ull_time) / 10000000ULL);
else
*off = - (long) ((utc_time.ull_time - local_time.ull_time) / 10000000ULL);
/* The system is operating in the range covered by the DaylightDate
member. */
else if (tzi_status == TIME_ZONE_ID_DAYLIGHT) {
*off = *off + tzi.DaylightBias;
}
#endif
*off = *off * -60;
}
/* Time zone offset calculations for a historic or future date */
else {
union
{
FILETIME ft_time;
unsigned long long ull_time;
} utc_time, local_time;
SYSTEMTIME utc_sys_time, local_sys_time;
BOOL status;
/* First convert unix time_t structure to windows FILETIME format. */
utc_time.ull_time = ((unsigned long long) *timer + w32_epoch_offset)
* 10000000ULL;
/* If GetTimeZoneInformation does not return a value between 0 and 2 then
it means that we were not able to retrieve timezone informations. Note
that we cannot use here FileTimeToLocalFileTime as Windows will use in
always in this case the current timezone setting. As suggested on MSDN
we use the following three system calls to get the right information.
Note also that starting with Windows Vista new functions are provided
to get timezone settings that depend on the year. We cannot use them as
we still support Windows XP and Windows 2003. */
status = (tzi_status >= 0 && tzi_status <= 2)
&& FileTimeToSystemTime (&utc_time.ft_time, &utc_sys_time)
&& SystemTimeToTzSpecificLocalTime (&tzi, &utc_sys_time, &local_sys_time)
&& SystemTimeToFileTime (&local_sys_time, &local_time.ft_time);
/* An error has occured, return invalid_tzoff */
if (!status) {
*off = __gnat_invalid_tzoff;
}
else {
if (local_time.ull_time > utc_time.ull_time) {
*off = (long) ((local_time.ull_time - utc_time.ull_time)
/ 10000000ULL);
}
else {
*off = - (long) ((utc_time.ull_time - local_time.ull_time)
/ 10000000ULL);
}
}
}
(*Unlock_Task) ();
}
......@@ -726,10 +749,10 @@ __gnat_localtime_tzoff (const time_t *timer, long *off)
the Lynx convention when building against the legacy API. */
extern void
__gnat_localtime_tzoff (const time_t *, long *);
__gnat_localtime_tzoff (const time_t *, const int *, long *);
void
__gnat_localtime_tzoff (const time_t *timer, long *off)
__gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
{
*off = 0;
}
......@@ -751,10 +774,10 @@ extern void (*Lock_Task) (void);
extern void (*Unlock_Task) (void);
extern void
__gnat_localtime_tzoff (const time_t *, long *);
__gnat_localtime_tzoff (const time_t *, const int *, long *);
void
__gnat_localtime_tzoff (const time_t *timer, long *off)
__gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
{
struct tm tp;
......
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