-- --
-- 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- --
-----------
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;
------------
------------
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;
-----------------
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 :=
-- --
-- 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- --
-----------
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;
------------
------------
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;
-----------------
-----------
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;
-----------
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
-- --
-- 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- --
-----------
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;
------------
------------
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;
-----------------
--------------
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));
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;
-- --
-- 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 --
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;
-----------------------------
-----------
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;
---------
------------
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;
-----------------
(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))
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;
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;
-- --
-- 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 --
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 --
-----------------------------------
-----------
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;
---------
------------
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;
-----------------
(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))
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;
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;
-- --
-- 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 --
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;
-----------------------------------
-----------
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;
---------
------------
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;
-----------------
(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))
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;
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;
-- --
-- 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 --
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;
-----------------------------------
-- --
-- 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- --
-----------
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;
-- --
-- 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- --
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);
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;
-- 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
-- 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);
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
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;
Fptr1 := Open_Files;
while Fptr1 /= null loop
Fptr2 := Fptr1.Next;
- Close (Fptr1);
+ Close (Fptr1'Access);
Fptr1 := Fptr2;
end loop;
-- 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
(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
-- --
-- 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- --
-- 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;
projects / platform / upstream / linaro-gcc.git / commitdiff