From e9f80612564876fc089ae96504e0ceaa0c33e0e8 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 2 Jan 2013 11:59:38 +0100 Subject: [PATCH] [multiple changes] 2013-01-02 Thomas Quinot * sem_ch3.adb: Minor reformatting. 2013-01-02 Pascal Obry * cstreams.c (__gnat_ftell64): New routine. Use _ftelli64 on Win64 and default to ftell on other platforms. (__gnat_fsek64): Likewise. * i-cstrea.ads: Add fssek64 and ftell64 specs. * s-crtl.ads: Likewise. * a-ststio.adb, s-direio.adb (Size): Use 64 bits version when required. (Set_Position): Likewise. From-SVN: r194797 --- gcc/ada/ChangeLog | 14 ++++++++++++++ gcc/ada/a-ststio.adb | 34 ++++++++++++++++++++++++++++------ gcc/ada/cstreams.c | 29 +++++++++++++++++++++++++++++ gcc/ada/i-cstrea.ads | 10 ++++++++++ gcc/ada/s-crtl.ads | 9 +++++++++ gcc/ada/s-direio.adb | 36 +++++++++++++++++++++++++++--------- gcc/ada/sem_ch3.adb | 4 ++-- 7 files changed, 119 insertions(+), 17 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6753ce4a1d5..f595d4949e3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2013-01-02 Thomas Quinot + + * sem_ch3.adb: Minor reformatting. + +2013-01-02 Pascal Obry + + * cstreams.c (__gnat_ftell64): New routine. Use _ftelli64 on + Win64 and default to ftell on other platforms. + (__gnat_fsek64): Likewise. + * i-cstrea.ads: Add fssek64 and ftell64 specs. + * s-crtl.ads: Likewise. + * a-ststio.adb, s-direio.adb (Size): Use 64 bits version when required. + (Set_Position): Likewise. + 2013-01-02 Thomas Quinot * par_sco.adb: Generate X SCOs for default expressions in diff --git a/gcc/ada/a-ststio.adb b/gcc/ada/a-ststio.adb index c5da571495f..91e1ef249e0 100644 --- a/gcc/ada/a-ststio.adb +++ b/gcc/ada/a-ststio.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- 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- -- @@ -367,7 +367,13 @@ package body Ada.Streams.Stream_IO is FIO.Append_Set (AP (File)); if File.Mode = FCB.Append_File then - File.Index := Count (ftell (File.Stream)) + 1; + pragma Warnings (Off, "*condition is always*"); + if Standard'Address_Size = 64 then + File.Index := Count (ftell64 (File.Stream)) + 1; + else + File.Index := Count (ftell (File.Stream)) + 1; + end if; + pragma Warnings (On, "*condition is always*"); end if; File.Last_Op := Op_Other; @@ -379,10 +385,20 @@ package body Ada.Streams.Stream_IO is procedure Set_Position (File : File_Type) is use type System.CRTL.long; + use type System.CRTL.ssize_t; + R : int; begin - if fseek (File.Stream, - System.CRTL.long (File.Index) - 1, SEEK_SET) /= 0 - then + pragma Warnings (Off, "*condition is always*"); + if Standard'Address_Size = 64 then + R := fseek64 (File.Stream, + System.CRTL.ssize_t (File.Index) - 1, SEEK_SET); + else + R := fseek (File.Stream, + System.CRTL.long (File.Index) - 1, SEEK_SET); + end if; + pragma Warnings (On, "*condition is always*"); + + if R /= 0 then raise Use_Error; end if; end Set_Position; @@ -402,7 +418,13 @@ package body Ada.Streams.Stream_IO is raise Device_Error; end if; - File.File_Size := Stream_Element_Offset (ftell (File.Stream)); + pragma Warnings (Off, "*condition is always*"); + if Standard'Address_Size = 64 then + File.File_Size := Stream_Element_Offset (ftell64 (File.Stream)); + else + File.File_Size := Stream_Element_Offset (ftell (File.Stream)); + end if; + pragma Warnings (On, "*condition is always*"); end if; return Count (File.File_Size); diff --git a/gcc/ada/cstreams.c b/gcc/ada/cstreams.c index b82fcdfa755..25a867a768f 100644 --- a/gcc/ada/cstreams.c +++ b/gcc/ada/cstreams.c @@ -257,6 +257,35 @@ __gnat_full_name (char *nam, char *buffer) return buffer; } +#ifdef _WIN64 + /* On Windows 64 we want to use the fseek/fteel supporting large files. This + issue is due to the fact that a long on Win64 is still a 32 bits value */ +__int64 +__gnat_ftell64 (FILE *stream) +{ + return _ftelli64 (stream); +} + +int +__gnat_fseek64 (FILE *stream, __int64 offset, int origin) +{ + return _fseeki64 (stream, offset, origin); +} + +#else +long +__gnat_ftell64 (FILE *stream) +{ + return ftell (stream); +} + +int +__gnat_fseek64 (FILE *stream, long offset, int origin) +{ + return fseek (stream, offset, origin); +} +#endif + #ifdef __cplusplus } #endif diff --git a/gcc/ada/i-cstrea.ads b/gcc/ada/i-cstrea.ads index 8882a7d3de6..1a7e76a713b 100644 --- a/gcc/ada/i-cstrea.ads +++ b/gcc/ada/i-cstrea.ads @@ -42,6 +42,7 @@ package Interfaces.C_Streams is subtype int is System.CRTL.int; subtype long is System.CRTL.long; subtype size_t is System.CRTL.size_t; + subtype ssize_t is System.CRTL.ssize_t; subtype voids is System.Address; NULL_Stream : constant FILEs; @@ -153,9 +154,18 @@ package Interfaces.C_Streams is origin : int) return int renames System.CRTL.fseek; + function fseek64 + (stream : FILEs; + offset : ssize_t; + origin : int) return int + renames System.CRTL.fseek64; + function ftell (stream : FILEs) return long renames System.CRTL.ftell; + function ftell64 (stream : FILEs) return ssize_t + renames System.CRTL.ftell64; + function fwrite (buffer : voids; size : size_t; diff --git a/gcc/ada/s-crtl.ads b/gcc/ada/s-crtl.ads index a763d606b70..18c43c42a64 100644 --- a/gcc/ada/s-crtl.ads +++ b/gcc/ada/s-crtl.ads @@ -122,9 +122,18 @@ package System.CRTL is origin : int) return int; pragma Import (C, fseek, "fseek"); + function fseek64 + (stream : FILEs; + offset : ssize_t; + origin : int) return int; + pragma Import (C, fseek64, "__gnat_fseek64"); + function ftell (stream : FILEs) return long; pragma Import (C, ftell, "ftell"); + function ftell64 (stream : FILEs) return ssize_t; + pragma Import (C, ftell64, "__gnat_ftell64"); + function getenv (S : String) return System.Address; pragma Import (C, getenv, "getenv"); diff --git a/gcc/ada/s-direio.adb b/gcc/ada/s-direio.adb index ef4c3ea9cf1..f7db2e2b262 100644 --- a/gcc/ada/s-direio.adb +++ b/gcc/ada/s-direio.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- 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- -- @@ -29,13 +29,13 @@ -- -- ------------------------------------------------------------------------------ -with Ada.IO_Exceptions; use Ada.IO_Exceptions; -with Interfaces.C_Streams; use Interfaces.C_Streams; -with System; use System; +with Ada.IO_Exceptions; use Ada.IO_Exceptions; +with Ada.Unchecked_Deallocation; +with Interfaces.C_Streams; use Interfaces.C_Streams; +with System; use System; with System.CRTL; with System.File_IO; with System.Soft_Links; -with Ada.Unchecked_Deallocation; package body System.Direct_IO is @@ -280,11 +280,22 @@ package body System.Direct_IO is ------------------ procedure Set_Position (File : File_Type) is + use type System.CRTL.ssize_t; + R : int; begin - if fseek + pragma Warnings (Off, "*condition is always*"); + if Standard'Address_Size = 64 then + R := fseek64 + (File.Stream, ssize_t (File.Bytes) * + ssize_t (File.Index - 1), SEEK_SET); + else + R := fseek (File.Stream, long (File.Bytes) * - long (File.Index - 1), SEEK_SET) /= 0 - then + long (File.Index - 1), SEEK_SET); + end if; + pragma Warnings (On, "*condition is always*"); + + if R /= 0 then raise Use_Error; end if; end Set_Position; @@ -294,6 +305,7 @@ package body System.Direct_IO is ---------- function Size (File : File_Type) return Count is + use type System.CRTL.ssize_t; begin FIO.Check_File_Open (AP (File)); File.Last_Op := Op_Other; @@ -302,7 +314,13 @@ package body System.Direct_IO is raise Device_Error; end if; - return Count (ftell (File.Stream) / long (File.Bytes)); + pragma Warnings (Off, "*condition is always*"); + if Standard'Address_Size = 64 then + return Count (ftell64 (File.Stream) / ssize_t (File.Bytes)); + else + return Count (ftell (File.Stream) / long (File.Bytes)); + end if; + pragma Warnings (On, "*condition is always*"); end Size; ----------- diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 5b67e26aa84..5764223cd06 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5056,8 +5056,8 @@ package body Sem_Ch3 is -- In ASIS mode, analyze the profile on the original node, because -- the separate copy does not provide enough links to recover the -- original tree. Analysis is limited to type annotations, within - -- a temporary scope that serves as an anonnymous subprogram to - -- collect otherwise useless temporaries and itypes. + -- a temporary scope that serves as an anonymous subprogram to collect + -- otherwise useless temporaries and itypes. if ASIS_Mode then declare