OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2013-01-02  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb: Minor reformatting.

2013-01-02  Pascal Obry  <obry@adacore.com>

	* 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
This commit is contained in:
Arnaud Charlet 2013-01-02 11:59:38 +01:00
parent 2c28c7a7b5
commit e9f8061256
7 changed files with 119 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/ChangeLog
View File

@ -1,3 +1,17 @@
2013-01-02 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb: Minor reformatting.
2013-01-02 Pascal Obry <obry@adacore.com>
* 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 <quinot@adacore.com>
* par_sco.adb: Generate X SCOs for default expressions in

34
gcc/ada/a-ststio.adb
View File

@ -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);

29
gcc/ada/cstreams.c
View File

@ -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

10
gcc/ada/i-cstrea.ads
View File

@ -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;

9
gcc/ada/s-crtl.ads
View File

@ -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");

36
gcc/ada/s-direio.adb
View File

@ -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;
-----------

4
gcc/ada/sem_ch3.adb
View File

@ -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