Commit e2baae4e by Thomas Quinot Committed by Arnaud Charlet

(System.File_IO.{Close, Delete, Reset}): Change File parameter from "in out…

(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
parent ab8bfb64
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -73,8 +73,11 @@ package body Ada.Direct_IO is ...@@ -73,8 +73,11 @@ package body Ada.Direct_IO is
----------- -----------
procedure Close (File : in out File_Type) is procedure Close (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Close (AP (File)); FIO.Close (AFCB'Access);
end Close; end Close;
------------ ------------
...@@ -97,8 +100,11 @@ package body Ada.Direct_IO is ...@@ -97,8 +100,11 @@ package body Ada.Direct_IO is
------------ ------------
procedure Delete (File : in out File_Type) is procedure Delete (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Delete (AP (File)); FIO.Delete (AFCB'Access);
end Delete; end Delete;
----------------- -----------------
......
...@@ -138,6 +138,32 @@ package Ada.Direct_IO is ...@@ -138,6 +138,32 @@ package Ada.Direct_IO is
Data_Error : exception renames IO_Exceptions.Data_Error; Data_Error : exception renames IO_Exceptions.Data_Error;
private 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; type File_Type is new System.Direct_IO.File_Type;
Bytes : constant Interfaces.C_Streams.size_t := Bytes : constant Interfaces.C_Streams.size_t :=
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -66,8 +66,11 @@ package body Ada.Sequential_IO is ...@@ -66,8 +66,11 @@ package body Ada.Sequential_IO is
----------- -----------
procedure Close (File : in out File_Type) is procedure Close (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Close (AP (File)); FIO.Close (AFCB'Access);
end Close; end Close;
------------ ------------
...@@ -89,8 +92,11 @@ package body Ada.Sequential_IO is ...@@ -89,8 +92,11 @@ package body Ada.Sequential_IO is
------------ ------------
procedure Delete (File : in out File_Type) is procedure Delete (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Delete (AP (File)); FIO.Delete (AFCB'Access);
end Delete; end Delete;
----------------- -----------------
...@@ -239,13 +245,19 @@ package body Ada.Sequential_IO is ...@@ -239,13 +245,19 @@ package body Ada.Sequential_IO is
----------- -----------
procedure Reset (File : in out File_Type; Mode : File_Mode) 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 begin
FIO.Reset (AP (File), To_FCB (Mode)); FIO.Reset (AFCB'Access, To_FCB (Mode));
end Reset; end Reset;
procedure Reset (File : in out File_Type) is procedure Reset (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Reset (AP (File)); FIO.Reset (AFCB'Access);
end Reset; end Reset;
----------- -----------
......
...@@ -114,6 +114,32 @@ package Ada.Sequential_IO is ...@@ -114,6 +114,32 @@ package Ada.Sequential_IO is
Data_Error : exception renames IO_Exceptions.Data_Error; Data_Error : exception renames IO_Exceptions.Data_Error;
private 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; type File_Type is new System.Sequential_IO.File_Type;
-- All subprograms are inlined -- All subprograms are inlined
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -101,8 +101,11 @@ package body Ada.Streams.Stream_IO is ...@@ -101,8 +101,11 @@ package body Ada.Streams.Stream_IO is
----------- -----------
procedure Close (File : in out File_Type) is procedure Close (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Close (AP (File)); FIO.Close (AFCB'Access);
end Close; end Close;
------------ ------------
...@@ -137,8 +140,11 @@ package body Ada.Streams.Stream_IO is ...@@ -137,8 +140,11 @@ package body Ada.Streams.Stream_IO is
------------ ------------
procedure Delete (File : in out File_Type) is procedure Delete (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Delete (AP (File)); FIO.Delete (AFCB'Access);
end Delete; end Delete;
----------------- -----------------
...@@ -351,6 +357,9 @@ package body Ada.Streams.Stream_IO is ...@@ -351,6 +357,9 @@ package body Ada.Streams.Stream_IO is
-------------- --------------
procedure Set_Mode (File : in out File_Type; Mode : File_Mode) 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 begin
FIO.Check_File_Open (AP (File)); FIO.Check_File_Open (AP (File));
...@@ -362,7 +371,7 @@ package body Ada.Streams.Stream_IO is ...@@ -362,7 +371,7 @@ package body Ada.Streams.Stream_IO is
if ((File.Mode = FCB.In_File) /= (Mode = In_File)) if ((File.Mode = FCB.In_File) /= (Mode = In_File))
and then not File.Update_Mode and then not File.Update_Mode
then then
FIO.Reset (AP (File), FCB.Inout_File); FIO.Reset (AFCB'Access, FCB.Inout_File);
File.Update_Mode := True; File.Update_Mode := True;
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -144,6 +144,36 @@ package Ada.Streams.Stream_IO is ...@@ -144,6 +144,36 @@ package Ada.Streams.Stream_IO is
Data_Error : exception renames IO_Exceptions.Data_Error; Data_Error : exception renames IO_Exceptions.Data_Error;
private 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; package FCB renames System.File_Control_Block;
----------------------------- -----------------------------
......
...@@ -147,8 +147,11 @@ package body Ada.Text_IO is ...@@ -147,8 +147,11 @@ package body Ada.Text_IO is
----------- -----------
procedure Close (File : in out File_Type) is procedure Close (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Close (AP (File)); FIO.Close (AFCB'Access);
end Close; end Close;
--------- ---------
...@@ -246,8 +249,11 @@ package body Ada.Text_IO is ...@@ -246,8 +249,11 @@ package body Ada.Text_IO is
------------ ------------
procedure Delete (File : in out File_Type) is procedure Delete (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Delete (AP (File)); FIO.Delete (AFCB'Access);
end Delete; end Delete;
----------------- -----------------
...@@ -1573,6 +1579,9 @@ package body Ada.Text_IO is ...@@ -1573,6 +1579,9 @@ package body Ada.Text_IO is
(File : in out File_Type; (File : in out File_Type;
Mode : File_Mode) Mode : File_Mode)
is is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
-- Don't allow change of mode for current file (RM A.10.2(5)) -- Don't allow change of mode for current file (RM A.10.2(5))
...@@ -1585,7 +1594,7 @@ package body Ada.Text_IO is ...@@ -1585,7 +1594,7 @@ package body Ada.Text_IO is
end if; end if;
Terminate_Line (File); Terminate_Line (File);
FIO.Reset (AP (File), To_FCB (Mode)); FIO.Reset (AFCB'Access, To_FCB (Mode));
File.Page := 1; File.Page := 1;
File.Line := 1; File.Line := 1;
File.Col := 1; File.Col := 1;
...@@ -1596,9 +1605,12 @@ package body Ada.Text_IO is ...@@ -1596,9 +1605,12 @@ package body Ada.Text_IO is
end Reset; end Reset;
procedure Reset (File : in out File_Type) is procedure Reset (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
Terminate_Line (File); Terminate_Line (File);
FIO.Reset (AP (File)); FIO.Reset (AFCB'Access);
File.Page := 1; File.Page := 1;
File.Line := 1; File.Line := 1;
File.Col := 1; File.Col := 1;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -301,6 +301,32 @@ package Ada.Text_IO is ...@@ -301,6 +301,32 @@ package Ada.Text_IO is
Layout_Error : exception renames IO_Exceptions.Layout_Error; Layout_Error : exception renames IO_Exceptions.Layout_Error;
private 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 -- -- Handling of Format Characters --
----------------------------------- -----------------------------------
......
...@@ -133,8 +133,11 @@ package body Ada.Wide_Text_IO is ...@@ -133,8 +133,11 @@ package body Ada.Wide_Text_IO is
----------- -----------
procedure Close (File : in out File_Type) is procedure Close (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Close (AP (File)); FIO.Close (AFCB'Access);
end Close; end Close;
--------- ---------
...@@ -232,8 +235,11 @@ package body Ada.Wide_Text_IO is ...@@ -232,8 +235,11 @@ package body Ada.Wide_Text_IO is
------------ ------------
procedure Delete (File : in out File_Type) is procedure Delete (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Delete (AP (File)); FIO.Delete (AFCB'Access);
end Delete; end Delete;
----------------- -----------------
...@@ -1308,6 +1314,9 @@ package body Ada.Wide_Text_IO is ...@@ -1308,6 +1314,9 @@ package body Ada.Wide_Text_IO is
(File : in out File_Type; (File : in out File_Type;
Mode : File_Mode) Mode : File_Mode)
is is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
-- Don't allow change of mode for current file (RM A.10.2(5)) -- 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 ...@@ -1320,7 +1329,7 @@ package body Ada.Wide_Text_IO is
end if; end if;
Terminate_Line (File); Terminate_Line (File);
FIO.Reset (AP (File), To_FCB (Mode)); FIO.Reset (AFCB'Access, To_FCB (Mode));
File.Page := 1; File.Page := 1;
File.Line := 1; File.Line := 1;
File.Col := 1; File.Col := 1;
...@@ -1331,9 +1340,12 @@ package body Ada.Wide_Text_IO is ...@@ -1331,9 +1340,12 @@ package body Ada.Wide_Text_IO is
end Reset; end Reset;
procedure Reset (File : in out File_Type) is procedure Reset (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
Terminate_Line (File); Terminate_Line (File);
FIO.Reset (AP (File)); FIO.Reset (AFCB'Access);
File.Page := 1; File.Page := 1;
File.Line := 1; File.Line := 1;
File.Col := 1; File.Col := 1;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -301,6 +301,32 @@ package Ada.Wide_Text_IO is ...@@ -301,6 +301,32 @@ package Ada.Wide_Text_IO is
Layout_Error : exception renames IO_Exceptions.Layout_Error; Layout_Error : exception renames IO_Exceptions.Layout_Error;
private 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; package WCh_Con renames System.WCh_Con;
----------------------------------- -----------------------------------
......
...@@ -133,8 +133,11 @@ package body Ada.Wide_Wide_Text_IO is ...@@ -133,8 +133,11 @@ package body Ada.Wide_Wide_Text_IO is
----------- -----------
procedure Close (File : in out File_Type) is procedure Close (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Close (AP (File)); FIO.Close (AFCB'Access);
end Close; end Close;
--------- ---------
...@@ -232,8 +235,11 @@ package body Ada.Wide_Wide_Text_IO is ...@@ -232,8 +235,11 @@ package body Ada.Wide_Wide_Text_IO is
------------ ------------
procedure Delete (File : in out File_Type) is procedure Delete (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Delete (AP (File)); FIO.Delete (AFCB'Access);
end Delete; end Delete;
----------------- -----------------
...@@ -1308,6 +1314,9 @@ package body Ada.Wide_Wide_Text_IO is ...@@ -1308,6 +1314,9 @@ package body Ada.Wide_Wide_Text_IO is
(File : in out File_Type; (File : in out File_Type;
Mode : File_Mode) Mode : File_Mode)
is is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
-- Don't allow change of mode for current file (RM A.10.2(5)) -- 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 ...@@ -1320,7 +1329,7 @@ package body Ada.Wide_Wide_Text_IO is
end if; end if;
Terminate_Line (File); Terminate_Line (File);
FIO.Reset (AP (File), To_FCB (Mode)); FIO.Reset (AFCB'Access, To_FCB (Mode));
File.Page := 1; File.Page := 1;
File.Line := 1; File.Line := 1;
File.Col := 1; File.Col := 1;
...@@ -1331,9 +1340,12 @@ package body Ada.Wide_Wide_Text_IO is ...@@ -1331,9 +1340,12 @@ package body Ada.Wide_Wide_Text_IO is
end Reset; end Reset;
procedure Reset (File : in out File_Type) is procedure Reset (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
Terminate_Line (File); Terminate_Line (File);
FIO.Reset (AP (File)); FIO.Reset (AFCB'Access);
File.Page := 1; File.Page := 1;
File.Line := 1; File.Line := 1;
File.Col := 1; File.Col := 1;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -301,6 +301,32 @@ package Ada.Wide_Wide_Text_IO is ...@@ -301,6 +301,32 @@ package Ada.Wide_Wide_Text_IO is
Layout_Error : exception renames IO_Exceptions.Layout_Error; Layout_Error : exception renames IO_Exceptions.Layout_Error;
private 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; package WCh_Con renames System.WCh_Con;
----------------------------------- -----------------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -251,15 +251,21 @@ package body System.Direct_IO is ...@@ -251,15 +251,21 @@ package body System.Direct_IO is
----------- -----------
procedure Reset (File : in out File_Type; Mode : FCB.File_Mode) 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 begin
FIO.Reset (AP (File), Mode); FIO.Reset (AFCB'Access, Mode);
File.Index := 1; File.Index := 1;
File.Last_Op := Op_Read; File.Last_Op := Op_Read;
end Reset; end Reset;
procedure Reset (File : in out File_Type) is procedure Reset (File : in out File_Type) is
AFCB : aliased AP;
for AFCB'Address use File'Address;
pragma Import (Ada, AFCB);
begin begin
FIO.Reset (AP (File)); FIO.Reset (AFCB'Access);
File.Index := 1; File.Index := 1;
File.Last_Op := Op_Read; File.Last_Op := Op_Read;
end Reset; end Reset;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -111,7 +111,6 @@ package System.Direct_IO is ...@@ -111,7 +111,6 @@ package System.Direct_IO is
Size : Interfaces.C_Streams.size_t); Size : Interfaces.C_Streams.size_t);
procedure Reset (File : in out File_Type; Mode : FCB.File_Mode); procedure Reset (File : in out File_Type; Mode : FCB.File_Mode);
procedure Reset (File : in out File_Type); procedure Reset (File : in out File_Type);
procedure Set_Index (File : File_Type; To : Positive_Count); procedure Set_Index (File : File_Type; To : Positive_Count);
...@@ -125,4 +124,21 @@ package System.Direct_IO is ...@@ -125,4 +124,21 @@ package System.Direct_IO is
Zeroes : System.Storage_Elements.Storage_Array); Zeroes : System.Storage_Elements.Storage_Array);
-- Note: Zeroes is the buffer of zeroes used to fill out partial records -- 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; end System.Direct_IO;
...@@ -206,9 +206,10 @@ package body System.File_IO is ...@@ -206,9 +206,10 @@ package body System.File_IO is
-- Close -- -- Close --
----------- -----------
procedure Close (File : in out AFCB_Ptr) is procedure Close (File_Ptr : access AFCB_Ptr) is
Close_Status : int := 0; Close_Status : int := 0;
Dup_Strm : Boolean := False; Dup_Strm : Boolean := False;
File : AFCB_Ptr renames File_Ptr.all;
begin begin
-- Take a task lock, to protect the global data value Open_Files -- Take a task lock, to protect the global data value Open_Files
...@@ -296,7 +297,8 @@ package body System.File_IO is ...@@ -296,7 +297,8 @@ package body System.File_IO is
-- Delete -- -- 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 begin
Check_File_Open (File); Check_File_Open (File);
...@@ -308,7 +310,7 @@ package body System.File_IO is ...@@ -308,7 +310,7 @@ package body System.File_IO is
Filename : aliased constant String := File.Name.all; Filename : aliased constant String := File.Name.all;
begin begin
Close (File); Close (File_Ptr);
-- Now unlink the external file. Note that we use the full name -- Now unlink the external file. Note that we use the full name
-- in this unlink, because the working directory may have changed -- in this unlink, because the working directory may have changed
...@@ -354,7 +356,7 @@ package body System.File_IO is ...@@ -354,7 +356,7 @@ package body System.File_IO is
procedure Finalize (V : in out File_IO_Clean_Up_Type) is procedure Finalize (V : in out File_IO_Clean_Up_Type) is
pragma Warnings (Off, V); pragma Warnings (Off, V);
Fptr1 : AFCB_Ptr; Fptr1 : aliased AFCB_Ptr;
Fptr2 : AFCB_Ptr; Fptr2 : AFCB_Ptr;
Discard : int; Discard : int;
...@@ -371,7 +373,7 @@ package body System.File_IO is ...@@ -371,7 +373,7 @@ package body System.File_IO is
Fptr1 := Open_Files; Fptr1 := Open_Files;
while Fptr1 /= null loop while Fptr1 /= null loop
Fptr2 := Fptr1.Next; Fptr2 := Fptr1.Next;
Close (Fptr1); Close (Fptr1'Access);
Fptr1 := Fptr2; Fptr1 := Fptr2;
end loop; end loop;
...@@ -1058,17 +1060,19 @@ package body System.File_IO is ...@@ -1058,17 +1060,19 @@ package body System.File_IO is
-- The reset which does not change the mode simply does a rewind -- 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 begin
Check_File_Open (File); Check_File_Open (File);
Reset (File, File.Mode); Reset (File_Ptr, File.Mode);
end Reset; end Reset;
-- The reset with a change in mode is done using freopen, and is -- The reset with a change in mode is done using freopen, and is
-- not permitted except for regular files (since otherwise there -- not permitted except for regular files (since otherwise there
-- is no name for the freopen, and in any case it seems meaningless) -- 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; Fopstr : aliased Fopen_String;
begin begin
...@@ -1106,7 +1110,7 @@ package body System.File_IO is ...@@ -1106,7 +1110,7 @@ package body System.File_IO is
(File.Name.all'Address, Fopstr'Address, File.Stream, File.Encoding); (File.Name.all'Address, Fopstr'Address, File.Stream, File.Encoding);
if File.Stream = NULL_Stream then if File.Stream = NULL_Stream then
Close (File); Close (File_Ptr);
raise Use_Error; raise Use_Error;
else else
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -100,20 +100,23 @@ package System.File_IO is ...@@ -100,20 +100,23 @@ package System.File_IO is
-- this allocated file control block. If the open/create fails, then the -- this allocated file control block. If the open/create fails, then the
-- fields of File are undefined, and File_Ptr is unchanged. -- 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 -- 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 -- 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, -- 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 -- 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 -- 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 -- 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 -- The files is reset, and the mode is unchanged
function Mode (File : FCB.AFCB_Ptr) return FCB.File_Mode; function Mode (File : FCB.AFCB_Ptr) return FCB.File_Mode;
......
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