(System.File_IO.{Close, Delete, Reset}): Change File parameter from "in out AFCB_Ptr...
authorThomas Quinot <quinot@adacore.com>
Tue, 27 May 2008 10:14:25 +0000 (12:14 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 27 May 2008 10:14:25 +0000 (12:14 +0200)
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

16 files changed:
gcc/ada/a-direio.adb
gcc/ada/a-direio.ads
gcc/ada/a-sequio.adb
gcc/ada/a-sequio.ads
gcc/ada/a-ststio.adb
gcc/ada/a-ststio.ads
gcc/ada/a-textio.adb
gcc/ada/a-textio.ads
gcc/ada/a-witeio.adb
gcc/ada/a-witeio.ads
gcc/ada/a-ztexio.adb
gcc/ada/a-ztexio.ads
gcc/ada/s-direio.adb
gcc/ada/s-direio.ads
gcc/ada/s-fileio.adb
gcc/ada/s-fileio.ads

index 44479efedfdcb9956fe29fae972c2d2a81ffedbc..69476696a6c1bf58b5a6d9174a1f5aaa34ef69e4 100644 (file)
@@ -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;
 
    -----------------
index 6ac1a8a95b61a48906819d2781701ee746318831..70ff5ed3ca9a3642090323331d9ac49ba84e1cc6 100644 (file)
@@ -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 :=
index eb9e989c65bc287fe709ef0a8d112b0d1679597e..8624ee76c0517ffbdc0cfdb4a5dbe595a1590feb 100644 (file)
@@ -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;
 
    -----------
index ece3ee13ea626c5a7daf08c55e5f689dde0de812..bd685c22e48e3b96ead2e687b95d94ae21663199 100644 (file)
@@ -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
index 6b8376489ad94c24e65d5a572a8c3233b21b85fa..fd5e39a7a322962c66c8e253c1cff14dc1c40ef7 100644 (file)
@@ -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;
 
index edcec9a139a89440fab63dd3a7a2be091de335ac..cc2a6d4e24af9fda2912c778ce81954de9effbb8 100644 (file)
@@ -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;
 
    -----------------------------
index 9247ba7f7aa22aaf2b4cb31e3c9de81b13d4cd50..c2f0f8b470e48ebcad4d11f74f081641d7239e6b 100644 (file)
@@ -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;
index 45f422f7bf1840fc6c0cab94bc6ad5bfd4cddab4..35cb5162f71b7804421d06103b50c470b0d33ebd 100644 (file)
@@ -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 --
    -----------------------------------
index 25d265c218ea16e95e8c7f3fed3f18b12f3bb699..b30c6f52753ab40e3e06eb2dd89e3c090a7e4143 100644 (file)
@@ -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;
index 0ea32ce2b0c3d393ccb1b447b6652f5c24de5fe0..d35de1327d21786ea64c1829d5d2043a5a968ff6 100644 (file)
@@ -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;
 
    -----------------------------------
index a85cdb30998dd129e2dad0f3c272a8bdc0518833..8db57b9468951c9697a73db770ecaa1db4e37060 100644 (file)
@@ -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;
index f91599295a41cf3bc54980e19b864c10c1bf4bdd..b1b50fc59a793305720a517f30fe82678fe1991a 100644 (file)
@@ -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;
 
    -----------------------------------
index d7d94957c0b4df041e84583884172d867a59e954..fc4bd8e9d9af7cebde9be289b334de30c5379d6a 100644 (file)
@@ -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;
index a43ebb67fc7d64f0258e74449d4f5c1fd12448c3..3e32c982d42b1d0a6fcff61103566f0253036f24 100644 (file)
@@ -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;
index f34e68ab69609f0bc52119a2cab57442acc9b465..bfe7d6b0cc502ba950dedd905ff0e62ce80e341a 100644 (file)
@@ -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
index 6cd787104d10b2283858b2b1160cd1cc6d8e0287..f69c580856bf9f040244a6da63b256c10d62b1f5 100644 (file)
@@ -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;