aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorThomas Quinot <quinot@adacore.com>2008-05-27 12:14:25 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2008-05-27 12:14:25 +0200
commite2baae4e1c8be8158233435d500f288a786a1121 (patch)
treef8477ecfb2c883ca1bd8ae86692e823bda30959f /gcc/ada
parentab8bfb6497bde60fdaa99b684e499e4748cffe49 (diff)
downloadgcc-e2baae4e1c8be8158233435d500f288a786a1121.zip
gcc-e2baae4e1c8be8158233435d500f288a786a1121.tar.gz
gcc-e2baae4e1c8be8158233435d500f288a786a1121.tar.bz2
(System.File_IO.{Close, Delete, Reset}): Change File parameter from "in out AFCB_Ptr" to "access AFCB_Ptr".
2008-05-27 Thomas Quinot <quinot@adacore.com> (System.File_IO.{Close, Delete, Reset}): Change File parameter from "in out AFCB_Ptr" to "access AFCB_Ptr". (Ada.*_IO.{Close, Delete, Reset, Set_Mode}): Pass File parameter by reference. From-SVN: r136002
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/a-direio.adb12
-rw-r--r--gcc/ada/a-direio.ads26
-rw-r--r--gcc/ada/a-sequio.adb22
-rw-r--r--gcc/ada/a-sequio.ads26
-rw-r--r--gcc/ada/a-ststio.adb17
-rw-r--r--gcc/ada/a-ststio.ads32
-rw-r--r--gcc/ada/a-textio.adb20
-rw-r--r--gcc/ada/a-textio.ads28
-rw-r--r--gcc/ada/a-witeio.adb20
-rw-r--r--gcc/ada/a-witeio.ads28
-rw-r--r--gcc/ada/a-ztexio.adb20
-rw-r--r--gcc/ada/a-ztexio.ads28
-rw-r--r--gcc/ada/s-direio.adb12
-rw-r--r--gcc/ada/s-direio.ads20
-rw-r--r--gcc/ada/s-fileio.adb22
-rw-r--r--gcc/ada/s-fileio.ads15
16 files changed, 300 insertions, 48 deletions
diff --git a/gcc/ada/a-direio.adb b/gcc/ada/a-direio.adb
index 44479ef..6947669 100644
--- a/gcc/ada/a-direio.adb
+++ b/gcc/ada/a-direio.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
@@ -73,8 +73,11 @@ package body Ada.Direct_IO is
-----------
procedure Close (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Close (AP (File));
+ FIO.Close (AFCB'Access);
end Close;
------------
@@ -97,8 +100,11 @@ package body Ada.Direct_IO is
------------
procedure Delete (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Delete (AP (File));
+ FIO.Delete (AFCB'Access);
end Delete;
-----------------
diff --git a/gcc/ada/a-direio.ads b/gcc/ada/a-direio.ads
index 6ac1a8a..70ff5ed 100644
--- a/gcc/ada/a-direio.ads
+++ b/gcc/ada/a-direio.ads
@@ -138,6 +138,32 @@ package Ada.Direct_IO is
Data_Error : exception renames IO_Exceptions.Data_Error;
private
+
+ -- The following procedures have a File_Type formal of mode IN OUT because
+ -- they may close the original file. The Close operation may raise an
+ -- exception, but in that case we want any assignment to the formal to
+ -- be effective anyway, so it must be passed by reference (or the caller
+ -- will be left with a dangling pointer).
+
+ pragma Export_Procedure
+ (Internal => Close,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Delete,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type),
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type, File_Mode),
+ Mechanism => (File => Reference));
+
type File_Type is new System.Direct_IO.File_Type;
Bytes : constant Interfaces.C_Streams.size_t :=
diff --git a/gcc/ada/a-sequio.adb b/gcc/ada/a-sequio.adb
index eb9e989..8624ee7 100644
--- a/gcc/ada/a-sequio.adb
+++ b/gcc/ada/a-sequio.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
@@ -66,8 +66,11 @@ package body Ada.Sequential_IO is
-----------
procedure Close (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Close (AP (File));
+ FIO.Close (AFCB'Access);
end Close;
------------
@@ -89,8 +92,11 @@ package body Ada.Sequential_IO is
------------
procedure Delete (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Delete (AP (File));
+ FIO.Delete (AFCB'Access);
end Delete;
-----------------
@@ -239,13 +245,19 @@ package body Ada.Sequential_IO is
-----------
procedure Reset (File : in out File_Type; Mode : File_Mode) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Reset (AP (File), To_FCB (Mode));
+ FIO.Reset (AFCB'Access, To_FCB (Mode));
end Reset;
procedure Reset (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Reset (AP (File));
+ FIO.Reset (AFCB'Access);
end Reset;
-----------
diff --git a/gcc/ada/a-sequio.ads b/gcc/ada/a-sequio.ads
index ece3ee1..bd685c2 100644
--- a/gcc/ada/a-sequio.ads
+++ b/gcc/ada/a-sequio.ads
@@ -114,6 +114,32 @@ package Ada.Sequential_IO is
Data_Error : exception renames IO_Exceptions.Data_Error;
private
+
+ -- The following procedures have a File_Type formal of mode IN OUT because
+ -- they may close the original file. The Close operation may raise an
+ -- exception, but in that case we want any assignment to the formal to
+ -- be effective anyway, so it must be passed by reference (or the caller
+ -- will be left with a dangling pointer).
+
+ pragma Export_Procedure
+ (Internal => Close,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Delete,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type),
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type, File_Mode),
+ Mechanism => (File => Reference));
+
type File_Type is new System.Sequential_IO.File_Type;
-- All subprograms are inlined
diff --git a/gcc/ada/a-ststio.adb b/gcc/ada/a-ststio.adb
index 6b83764..fd5e39a 100644
--- a/gcc/ada/a-ststio.adb
+++ b/gcc/ada/a-ststio.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
@@ -101,8 +101,11 @@ package body Ada.Streams.Stream_IO is
-----------
procedure Close (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Close (AP (File));
+ FIO.Close (AFCB'Access);
end Close;
------------
@@ -137,8 +140,11 @@ package body Ada.Streams.Stream_IO is
------------
procedure Delete (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Delete (AP (File));
+ FIO.Delete (AFCB'Access);
end Delete;
-----------------
@@ -351,6 +357,9 @@ package body Ada.Streams.Stream_IO is
--------------
procedure Set_Mode (File : in out File_Type; Mode : File_Mode) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
FIO.Check_File_Open (AP (File));
@@ -362,7 +371,7 @@ package body Ada.Streams.Stream_IO is
if ((File.Mode = FCB.In_File) /= (Mode = In_File))
and then not File.Update_Mode
then
- FIO.Reset (AP (File), FCB.Inout_File);
+ FIO.Reset (AFCB'Access, FCB.Inout_File);
File.Update_Mode := True;
end if;
diff --git a/gcc/ada/a-ststio.ads b/gcc/ada/a-ststio.ads
index edcec9a..cc2a6d4 100644
--- a/gcc/ada/a-ststio.ads
+++ b/gcc/ada/a-ststio.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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 --
@@ -144,6 +144,36 @@ package Ada.Streams.Stream_IO is
Data_Error : exception renames IO_Exceptions.Data_Error;
private
+
+ -- The following procedures have a File_Type formal of mode IN OUT because
+ -- they may close the original file. The Close operation may raise an
+ -- exception, but in that case we want any assignment to the formal to
+ -- be effective anyway, so it must be passed by reference (or the caller
+ -- will be left with a dangling pointer).
+
+ pragma Export_Procedure
+ (Internal => Close,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Delete,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type),
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type, File_Mode),
+ Mechanism => (File => Reference));
+ pragma Export_Procedure
+ (Internal => Set_Mode,
+ External => "",
+ Mechanism => (File => Reference));
+
package FCB renames System.File_Control_Block;
-----------------------------
diff --git a/gcc/ada/a-textio.adb b/gcc/ada/a-textio.adb
index 9247ba7..c2f0f8b 100644
--- a/gcc/ada/a-textio.adb
+++ b/gcc/ada/a-textio.adb
@@ -147,8 +147,11 @@ package body Ada.Text_IO is
-----------
procedure Close (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Close (AP (File));
+ FIO.Close (AFCB'Access);
end Close;
---------
@@ -246,8 +249,11 @@ package body Ada.Text_IO is
------------
procedure Delete (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Delete (AP (File));
+ FIO.Delete (AFCB'Access);
end Delete;
-----------------
@@ -1573,6 +1579,9 @@ package body Ada.Text_IO is
(File : in out File_Type;
Mode : File_Mode)
is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
-- Don't allow change of mode for current file (RM A.10.2(5))
@@ -1585,7 +1594,7 @@ package body Ada.Text_IO is
end if;
Terminate_Line (File);
- FIO.Reset (AP (File), To_FCB (Mode));
+ FIO.Reset (AFCB'Access, To_FCB (Mode));
File.Page := 1;
File.Line := 1;
File.Col := 1;
@@ -1596,9 +1605,12 @@ package body Ada.Text_IO is
end Reset;
procedure Reset (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
Terminate_Line (File);
- FIO.Reset (AP (File));
+ FIO.Reset (AFCB'Access);
File.Page := 1;
File.Line := 1;
File.Col := 1;
diff --git a/gcc/ada/a-textio.ads b/gcc/ada/a-textio.ads
index 45f422f..35cb516 100644
--- a/gcc/ada/a-textio.ads
+++ b/gcc/ada/a-textio.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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 --
@@ -301,6 +301,32 @@ package Ada.Text_IO is
Layout_Error : exception renames IO_Exceptions.Layout_Error;
private
+
+ -- The following procedures have a File_Type formal of mode IN OUT because
+ -- they may close the original file. The Close operation may raise an
+ -- exception, but in that case we want any assignment to the formal to
+ -- be effective anyway, so it must be passed by reference (or the caller
+ -- will be left with a dangling pointer).
+
+ pragma Export_Procedure
+ (Internal => Close,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Delete,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type),
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type, File_Mode),
+ Mechanism => (File => Reference));
+
-----------------------------------
-- Handling of Format Characters --
-----------------------------------
diff --git a/gcc/ada/a-witeio.adb b/gcc/ada/a-witeio.adb
index 25d265c..b30c6f5 100644
--- a/gcc/ada/a-witeio.adb
+++ b/gcc/ada/a-witeio.adb
@@ -133,8 +133,11 @@ package body Ada.Wide_Text_IO is
-----------
procedure Close (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Close (AP (File));
+ FIO.Close (AFCB'Access);
end Close;
---------
@@ -232,8 +235,11 @@ package body Ada.Wide_Text_IO is
------------
procedure Delete (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Delete (AP (File));
+ FIO.Delete (AFCB'Access);
end Delete;
-----------------
@@ -1308,6 +1314,9 @@ package body Ada.Wide_Text_IO is
(File : in out File_Type;
Mode : File_Mode)
is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
-- Don't allow change of mode for current file (RM A.10.2(5))
@@ -1320,7 +1329,7 @@ package body Ada.Wide_Text_IO is
end if;
Terminate_Line (File);
- FIO.Reset (AP (File), To_FCB (Mode));
+ FIO.Reset (AFCB'Access, To_FCB (Mode));
File.Page := 1;
File.Line := 1;
File.Col := 1;
@@ -1331,9 +1340,12 @@ package body Ada.Wide_Text_IO is
end Reset;
procedure Reset (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
Terminate_Line (File);
- FIO.Reset (AP (File));
+ FIO.Reset (AFCB'Access);
File.Page := 1;
File.Line := 1;
File.Col := 1;
diff --git a/gcc/ada/a-witeio.ads b/gcc/ada/a-witeio.ads
index 0ea32ce..d35de13 100644
--- a/gcc/ada/a-witeio.ads
+++ b/gcc/ada/a-witeio.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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 --
@@ -301,6 +301,32 @@ package Ada.Wide_Text_IO is
Layout_Error : exception renames IO_Exceptions.Layout_Error;
private
+
+ -- The following procedures have a File_Type formal of mode IN OUT because
+ -- they may close the original file. The Close operation may raise an
+ -- exception, but in that case we want any assignment to the formal to
+ -- be effective anyway, so it must be passed by reference (or the caller
+ -- will be left with a dangling pointer).
+
+ pragma Export_Procedure
+ (Internal => Close,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Delete,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type),
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type, File_Mode),
+ Mechanism => (File => Reference));
+
package WCh_Con renames System.WCh_Con;
-----------------------------------
diff --git a/gcc/ada/a-ztexio.adb b/gcc/ada/a-ztexio.adb
index a85cdb3..8db57b9 100644
--- a/gcc/ada/a-ztexio.adb
+++ b/gcc/ada/a-ztexio.adb
@@ -133,8 +133,11 @@ package body Ada.Wide_Wide_Text_IO is
-----------
procedure Close (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Close (AP (File));
+ FIO.Close (AFCB'Access);
end Close;
---------
@@ -232,8 +235,11 @@ package body Ada.Wide_Wide_Text_IO is
------------
procedure Delete (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Delete (AP (File));
+ FIO.Delete (AFCB'Access);
end Delete;
-----------------
@@ -1308,6 +1314,9 @@ package body Ada.Wide_Wide_Text_IO is
(File : in out File_Type;
Mode : File_Mode)
is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
-- Don't allow change of mode for current file (RM A.10.2(5))
@@ -1320,7 +1329,7 @@ package body Ada.Wide_Wide_Text_IO is
end if;
Terminate_Line (File);
- FIO.Reset (AP (File), To_FCB (Mode));
+ FIO.Reset (AFCB'Access, To_FCB (Mode));
File.Page := 1;
File.Line := 1;
File.Col := 1;
@@ -1331,9 +1340,12 @@ package body Ada.Wide_Wide_Text_IO is
end Reset;
procedure Reset (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
Terminate_Line (File);
- FIO.Reset (AP (File));
+ FIO.Reset (AFCB'Access);
File.Page := 1;
File.Line := 1;
File.Col := 1;
diff --git a/gcc/ada/a-ztexio.ads b/gcc/ada/a-ztexio.ads
index f915992..b1b50fc 100644
--- a/gcc/ada/a-ztexio.ads
+++ b/gcc/ada/a-ztexio.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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 --
@@ -301,6 +301,32 @@ package Ada.Wide_Wide_Text_IO is
Layout_Error : exception renames IO_Exceptions.Layout_Error;
private
+
+ -- The following procedures have a File_Type formal of mode IN OUT because
+ -- they may close the original file. The Close operation may raise an
+ -- exception, but in that case we want any assignment to the formal to
+ -- be effective anyway, so it must be passed by reference (or the caller
+ -- will be left with a dangling pointer).
+
+ pragma Export_Procedure
+ (Internal => Close,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Delete,
+ External => "",
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type),
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type, File_Mode),
+ Mechanism => (File => Reference));
+
package WCh_Con renames System.WCh_Con;
-----------------------------------
diff --git a/gcc/ada/s-direio.adb b/gcc/ada/s-direio.adb
index d7d9495..fc4bd8e 100644
--- a/gcc/ada/s-direio.adb
+++ b/gcc/ada/s-direio.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
@@ -251,15 +251,21 @@ package body System.Direct_IO is
-----------
procedure Reset (File : in out File_Type; Mode : FCB.File_Mode) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Reset (AP (File), Mode);
+ FIO.Reset (AFCB'Access, Mode);
File.Index := 1;
File.Last_Op := Op_Read;
end Reset;
procedure Reset (File : in out File_Type) is
+ AFCB : aliased AP;
+ for AFCB'Address use File'Address;
+ pragma Import (Ada, AFCB);
begin
- FIO.Reset (AP (File));
+ FIO.Reset (AFCB'Access);
File.Index := 1;
File.Last_Op := Op_Read;
end Reset;
diff --git a/gcc/ada/s-direio.ads b/gcc/ada/s-direio.ads
index a43ebb6..3e32c98 100644
--- a/gcc/ada/s-direio.ads
+++ b/gcc/ada/s-direio.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
@@ -111,7 +111,6 @@ package System.Direct_IO is
Size : Interfaces.C_Streams.size_t);
procedure Reset (File : in out File_Type; Mode : FCB.File_Mode);
-
procedure Reset (File : in out File_Type);
procedure Set_Index (File : File_Type; To : Positive_Count);
@@ -125,4 +124,21 @@ package System.Direct_IO is
Zeroes : System.Storage_Elements.Storage_Array);
-- Note: Zeroes is the buffer of zeroes used to fill out partial records
+ -- The following procedures have a File_Type formal of mode IN OUT because
+ -- they may close the original file. The Close operation may raise an
+ -- exception, but in that case we want any assignment to the formal to
+ -- be effective anyway, so it must be passed by reference (or the caller
+ -- will be left with a dangling pointer).
+
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type),
+ Mechanism => Reference);
+ pragma Export_Procedure
+ (Internal => Reset,
+ External => "",
+ Parameter_Types => (File_Type, FCB.File_Mode),
+ Mechanism => (File => Reference));
+
end System.Direct_IO;
diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb
index f34e68a..bfe7d6b 100644
--- a/gcc/ada/s-fileio.adb
+++ b/gcc/ada/s-fileio.adb
@@ -206,9 +206,10 @@ package body System.File_IO is
-- Close --
-----------
- procedure Close (File : in out AFCB_Ptr) is
+ procedure Close (File_Ptr : access AFCB_Ptr) is
Close_Status : int := 0;
Dup_Strm : Boolean := False;
+ File : AFCB_Ptr renames File_Ptr.all;
begin
-- Take a task lock, to protect the global data value Open_Files
@@ -296,7 +297,8 @@ package body System.File_IO is
-- Delete --
------------
- procedure Delete (File : in out AFCB_Ptr) is
+ procedure Delete (File_Ptr : access AFCB_Ptr) is
+ File : AFCB_Ptr renames File_Ptr.all;
begin
Check_File_Open (File);
@@ -308,7 +310,7 @@ package body System.File_IO is
Filename : aliased constant String := File.Name.all;
begin
- Close (File);
+ Close (File_Ptr);
-- Now unlink the external file. Note that we use the full name
-- in this unlink, because the working directory may have changed
@@ -354,7 +356,7 @@ package body System.File_IO is
procedure Finalize (V : in out File_IO_Clean_Up_Type) is
pragma Warnings (Off, V);
- Fptr1 : AFCB_Ptr;
+ Fptr1 : aliased AFCB_Ptr;
Fptr2 : AFCB_Ptr;
Discard : int;
@@ -371,7 +373,7 @@ package body System.File_IO is
Fptr1 := Open_Files;
while Fptr1 /= null loop
Fptr2 := Fptr1.Next;
- Close (Fptr1);
+ Close (Fptr1'Access);
Fptr1 := Fptr2;
end loop;
@@ -1058,17 +1060,19 @@ package body System.File_IO is
-- The reset which does not change the mode simply does a rewind
- procedure Reset (File : in out AFCB_Ptr) is
+ procedure Reset (File_Ptr : access AFCB_Ptr) is
+ File : AFCB_Ptr renames File_Ptr.all;
begin
Check_File_Open (File);
- Reset (File, File.Mode);
+ Reset (File_Ptr, File.Mode);
end Reset;
-- The reset with a change in mode is done using freopen, and is
-- not permitted except for regular files (since otherwise there
-- is no name for the freopen, and in any case it seems meaningless)
- procedure Reset (File : in out AFCB_Ptr; Mode : File_Mode) is
+ procedure Reset (File_Ptr : access AFCB_Ptr; Mode : File_Mode) is
+ File : AFCB_Ptr renames File_Ptr.all;
Fopstr : aliased Fopen_String;
begin
@@ -1106,7 +1110,7 @@ package body System.File_IO is
(File.Name.all'Address, Fopstr'Address, File.Stream, File.Encoding);
if File.Stream = NULL_Stream then
- Close (File);
+ Close (File_Ptr);
raise Use_Error;
else
diff --git a/gcc/ada/s-fileio.ads b/gcc/ada/s-fileio.ads
index 6cd7871..f69c580 100644
--- a/gcc/ada/s-fileio.ads
+++ b/gcc/ada/s-fileio.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
@@ -100,20 +100,23 @@ package System.File_IO is
-- this allocated file control block. If the open/create fails, then the
-- fields of File are undefined, and File_Ptr is unchanged.
- procedure Close (File : in out FCB.AFCB_Ptr);
+ procedure Close (File_Ptr : access FCB.AFCB_Ptr);
-- The file is closed, all storage associated with it is released, and
-- File is set to null. Note that this routine calls AFCB_Close to perform
-- any specialized close actions, then closes the file at the system level,
-- then frees the mode and form strings, and finally calls AFCB_Free to
- -- free the file control block itself, setting File to null.
+ -- free the file control block itself, setting File.all to null. Note that
+ -- for this assignment to be done in all cases, including those where
+ -- an exception is raised, we can't use an IN OUT parameter (which would
+ -- not be copied back in case of abnormal return).
- procedure Delete (File : in out FCB.AFCB_Ptr);
+ procedure Delete (File_Ptr : access FCB.AFCB_Ptr);
-- The indicated file is unlinked
- procedure Reset (File : in out FCB.AFCB_Ptr; Mode : FCB.File_Mode);
+ procedure Reset (File_Ptr : access FCB.AFCB_Ptr; Mode : FCB.File_Mode);
-- The file is reset, and the mode changed as indicated
- procedure Reset (File : in out FCB.AFCB_Ptr);
+ procedure Reset (File_Ptr : access FCB.AFCB_Ptr);
-- The files is reset, and the mode is unchanged
function Mode (File : FCB.AFCB_Ptr) return FCB.File_Mode;