diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/a-direio.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/a-direio.ads | 26 | ||||
| -rw-r--r-- | gcc/ada/a-sequio.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/a-sequio.ads | 26 | ||||
| -rw-r--r-- | gcc/ada/a-ststio.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/a-ststio.ads | 32 | ||||
| -rw-r--r-- | gcc/ada/a-textio.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/a-textio.ads | 28 | ||||
| -rw-r--r-- | gcc/ada/a-witeio.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/a-witeio.ads | 28 | ||||
| -rw-r--r-- | gcc/ada/a-ztexio.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/a-ztexio.ads | 28 | ||||
| -rw-r--r-- | gcc/ada/s-direio.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/s-direio.ads | 20 | ||||
| -rw-r--r-- | gcc/ada/s-fileio.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/s-fileio.ads | 15 |
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; |