New Language: Ada

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@45957 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 1041 insertions, 0 deletions

diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb
new file mode 100644
index 00000000000..21548568a33
--- /dev/null
+++ b/gcc/ada/s-fileio.adb
@@ -0,0 +1,1041 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                       S Y S T E M . F I L E _ I O                        --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision: 1.59 $
+--                                                                          --
+--          Copyright (C) 1992-2001 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- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Finalization;            use Ada.Finalization;
+with Ada.IO_Exceptions;           use Ada.IO_Exceptions;
+with Interfaces.C_Streams;        use Interfaces.C_Streams;
+with System.Soft_Links;
+with Unchecked_Deallocation;
+
+package body System.File_IO is
+
+   use System.File_Control_Block;
+
+   package SSL renames System.Soft_Links;
+
+   ----------------------
+   -- Global Variables --
+   ----------------------
+
+   Open_Files : AFCB_Ptr;
+   --  This points to a list of AFCB's for all open files. This is a doubly
+   --  linked list, with the Prev pointer of the first entry, and the Next
+   --  pointer of the last entry containing null. Note that this global
+   --  variable must be properly protected to provide thread safety.
+
+   type Temp_File_Record;
+   type Temp_File_Record_Ptr is access all Temp_File_Record;
+
+   type Temp_File_Record is record
+      Name : String (1 .. L_tmpnam + 1);
+      Next : Temp_File_Record_Ptr;
+   end record;
+   --  One of these is allocated for each temporary file created
+
+   Temp_Files : Temp_File_Record_Ptr;
+   --  Points to list of names of temporary files. Note that this global
+   --  variable must be properly protected to provide thread safety.
+
+   type File_IO_Clean_Up_Type is new Controlled with null record;
+   --  The closing of all open files and deletion of temporary files is an
+   --  action which takes place at the end of execution of the main program.
+   --  This action can be implemented using a library level object which
+   --  gets finalized at the end of the main program execution. The above is
+   --  a controlled type introduced for this purpose.
+
+   procedure Finalize (V : in out File_IO_Clean_Up_Type);
+   --  This is the finalize operation that is used to do the cleanup.
+
+   File_IO_Clean_Up_Object : File_IO_Clean_Up_Type;
+   --  This is the single object of the type that triggers the finalization
+   --  call. Since it is at the library level, this happens just before the
+   --  environment task is finalized.
+
+   text_translation_required : Boolean;
+   pragma Import
+     (C, text_translation_required, "__gnat_text_translation_required");
+   --  If true, add appropriate suffix to control string for Open.
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   procedure Free_String is new Unchecked_Deallocation (String, Pstring);
+
+   subtype Fopen_String is String (1 .. 4);
+   --  Holds open string (longest is "w+b" & nul)
+
+   procedure Fopen_Mode
+     (Mode    : File_Mode;
+      Text    : Boolean;
+      Creat   : Boolean;
+      Amethod : Character;
+      Fopstr  : out Fopen_String);
+   --  Determines proper open mode for a file to be opened in the given
+   --  Ada mode. Text is true for a text file and false otherwise, and
+   --  Creat is true for a create call, and False for an open call. The
+   --  value stored in Fopstr is a nul-terminated string suitable for a
+   --  call to fopen or freopen. Amethod is the character designating
+   --  the access method from the Access_Method field of the FCB.
+
+   ----------------
+   -- Append_Set --
+   ----------------
+
+   procedure Append_Set (File : AFCB_Ptr) is
+   begin
+      if File.Mode = Append_File then
+         if fseek (File.Stream, 0, SEEK_END) /= 0 then
+            raise Device_Error;
+         end if;
+      end if;
+   end Append_Set;
+
+   ----------------
+   -- Chain_File --
+   ----------------
+
+   procedure Chain_File (File : AFCB_Ptr) is
+   begin
+      --  Take a task lock, to protect the global data value Open_Files
+      --  No exception handler needed, since we cannot get an exception.
+
+      SSL.Lock_Task.all;
+      File.Next := Open_Files;
+      File.Prev := null;
+      Open_Files := File;
+
+      if File.Next /= null then
+         File.Next.Prev := File;
+      end if;
+
+      SSL.Unlock_Task.all;
+   end Chain_File;
+
+   ---------------------
+   -- Check_File_Open --
+   ---------------------
+
+   procedure Check_File_Open (File : AFCB_Ptr) is
+   begin
+      if File = null then
+         raise Status_Error;
+      end if;
+   end Check_File_Open;
+
+   -----------------------
+   -- Check_Read_Status --
+   -----------------------
+
+   procedure Check_Read_Status (File : AFCB_Ptr) is
+   begin
+      if File = null then
+         raise Status_Error;
+      elsif File.Mode > Inout_File then
+         raise Mode_Error;
+      end if;
+   end Check_Read_Status;
+
+   ------------------------
+   -- Check_Write_Status --
+   ------------------------
+
+   procedure Check_Write_Status (File : AFCB_Ptr) is
+   begin
+      if File = null then
+         raise Status_Error;
+      elsif File.Mode = In_File then
+         raise Mode_Error;
+      end if;
+   end Check_Write_Status;
+
+   -----------
+   -- Close --
+   -----------
+
+   procedure Close (File : in out AFCB_Ptr) is
+      Close_Status : int := 0;
+      Dup_Strm     : Boolean := False;
+
+   begin
+      Check_File_Open (File);
+      AFCB_Close (File);
+
+      --  Sever the association between the given file and its associated
+      --  external file. The given file is left closed. Do not perform system
+      --  closes on the standard input, output and error files and also do
+      --  not attempt to close a stream that does not exist (signalled by a
+      --  null stream value -- happens in some error situations).
+
+      if not File.Is_System_File
+        and then File.Stream /= NULL_Stream
+      then
+         --  Do not do an fclose if this is a shared file and there is
+         --  at least one other instance of the stream that is open.
+
+         if File.Shared_Status = Yes then
+            declare
+               P   : AFCB_Ptr;
+
+            begin
+               P := Open_Files;
+               while P /= null loop
+                  if P /= File
+                    and then File.Stream = P.Stream
+                  then
+                     Dup_Strm := True;
+                     exit;
+                  end if;
+
+                  P := P.Next;
+               end loop;
+            end;
+         end if;
+
+         --  Do the fclose unless this was a duplicate in the shared case
+
+         if not Dup_Strm then
+            Close_Status := fclose (File.Stream);
+         end if;
+      end if;
+
+      --  Dechain file from list of open files and then free the storage
+      --  Since this is a global data structure, we have to protect against
+      --  multiple tasks attempting to access this list.
+
+      --  Note that we do not use an exception handler to unlock here since
+      --  no exception can occur inside the lock/unlock pair.
+
+      begin
+         SSL.Lock_Task.all;
+
+         if File.Prev = null then
+            Open_Files := File.Next;
+         else
+            File.Prev.Next := File.Next;
+         end if;
+
+         if File.Next /= null then
+            File.Next.Prev := File.Prev;
+         end if;
+
+         SSL.Unlock_Task.all;
+      end;
+
+      --  Deallocate some parts of the file structure that were kept in heap
+      --  storage with the exception of system files (standard input, output
+      --  and error) since they had some information allocated in the stack.
+
+      if not File.Is_System_File then
+         Free_String (File.Name);
+         Free_String (File.Form);
+         AFCB_Free (File);
+      end if;
+
+      File := null;
+
+      if Close_Status /= 0 then
+         raise Device_Error;
+      end if;
+   end Close;
+
+   ------------
+   -- Delete --
+   ------------
+
+   procedure Delete (File : in out AFCB_Ptr) is
+   begin
+      Check_File_Open (File);
+
+      if not File.Is_Regular_File then
+         raise Use_Error;
+      end if;
+
+      declare
+         Filename : aliased constant String := File.Name.all;
+
+      begin
+         Close (File);
+
+         --  Now unlink the external file. Note that we use the full name
+         --  in this unlink, because the working directory may have changed
+         --  since we did the open, and we want to unlink the right file!
+
+         if unlink (Filename'Address) = -1 then
+            raise Use_Error;
+         end if;
+      end;
+   end Delete;
+
+   -----------------
+   -- End_Of_File --
+   -----------------
+
+   function End_Of_File (File : AFCB_Ptr) return Boolean is
+   begin
+      Check_File_Open (File);
+
+      if feof (File.Stream) /= 0 then
+         return True;
+
+      else
+         Check_Read_Status (File);
+
+         if ungetc (fgetc (File.Stream), File.Stream) = EOF then
+            clearerr (File.Stream);
+            return True;
+         else
+            return False;
+         end if;
+      end if;
+   end End_Of_File;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   --  Note: we do not need to worry about locking against multiple task
+   --  access in this routine, since it is called only from the environment
+   --  task just before terminating execution.
+
+   procedure Finalize (V : in out File_IO_Clean_Up_Type) is
+      Discard : int;
+      Fptr1   : AFCB_Ptr;
+      Fptr2   : AFCB_Ptr;
+
+   begin
+      --  First close all open files (the slightly complex form of this loop
+      --  is required because Close as a side effect nulls out its argument)
+
+      Fptr1 := Open_Files;
+      while Fptr1 /= null loop
+         Fptr2 := Fptr1.Next;
+         Close (Fptr1);
+         Fptr1 := Fptr2;
+      end loop;
+
+      --  Now unlink all temporary files. We do not bother to free the
+      --  blocks because we are just about to terminate the program. We
+      --  also ignore any errors while attempting these unlink operations.
+
+      while Temp_Files /= null loop
+         Discard := unlink (Temp_Files.Name'Address);
+         Temp_Files := Temp_Files.Next;
+      end loop;
+
+   end Finalize;
+
+   -----------
+   -- Flush --
+   -----------
+
+   procedure Flush (File : AFCB_Ptr) is
+   begin
+      Check_Write_Status (File);
+
+      if fflush (File.Stream) = 0 then
+         return;
+      else
+         raise Device_Error;
+      end if;
+   end Flush;
+
+   ----------------
+   -- Fopen_Mode --
+   ----------------
+
+   --  The fopen mode to be used is shown by the following table:
+
+   --                                     OPEN         CREATE
+   --     Append_File                     "r+"           "w+"
+   --     In_File                         "r"            "w+"
+   --     Out_File (Direct_IO)            "r+"           "w"
+   --     Out_File (all others)           "w"            "w"
+   --     Inout_File                      "r+"           "w+"
+
+   --  Note: we do not use "a" or "a+" for Append_File, since this would not
+   --  work in the case of stream files, where even if in append file mode,
+   --  you can reset to earlier points in the file. The caller must use the
+   --  Append_Set routine to deal with the necessary positioning.
+
+   --  Note: in several cases, the fopen mode used allows reading and
+   --  writing, but the setting of the Ada mode is more restrictive. For
+   --  instance, Create in In_File mode uses "w+" which allows writing,
+   --  but the Ada mode In_File will cause any write operations to be
+   --  rejected with Mode_Error in any case.
+
+   --  Note: for the Out_File/Open cases for other than the Direct_IO case,
+   --  an initial call will be made by the caller to first open the file in
+   --  "r" mode to be sure that it exists. The real open, in "w" mode, will
+   --  then destroy this file. This is peculiar, but that's what Ada semantics
+   --  require and the ACVT tests insist on!
+
+   --  If text file translation is required, then either b or t is
+   --  added to the mode, depending on the setting of Text.
+
+   procedure Fopen_Mode
+     (Mode    : File_Mode;
+      Text    : Boolean;
+      Creat   : Boolean;
+      Amethod : Character;
+      Fopstr  : out Fopen_String)
+   is
+      Fptr  : Positive;
+
+   begin
+      case Mode is
+         when In_File =>
+            if Creat then
+               Fopstr (1) := 'w';
+               Fopstr (2) := '+';
+               Fptr := 3;
+            else
+               Fopstr (1) := 'r';
+               Fptr := 2;
+            end if;
+
+         when Out_File =>
+            if Amethod = 'D' and not Creat then
+               Fopstr (1) := 'r';
+               Fopstr (2) := '+';
+               Fptr := 3;
+            else
+               Fopstr (1) := 'w';
+               Fptr := 2;
+            end if;
+
+         when Inout_File | Append_File =>
+            if Creat then
+               Fopstr (1) := 'w';
+            else
+               Fopstr (1) := 'r';
+            end if;
+
+            Fopstr (2) := '+';
+            Fptr := 3;
+
+      end case;
+
+      --  If text_translation_required is true then we need to append
+      --  either a t or b to the string to get the right mode
+
+      if text_translation_required then
+         if Text then
+            Fopstr (Fptr) := 't';
+         else
+            Fopstr (Fptr) := 'b';
+         end if;
+
+         Fptr := Fptr + 1;
+      end if;
+
+      Fopstr (Fptr) := ASCII.NUL;
+   end Fopen_Mode;
+
+   ----------
+   -- Form --
+   ----------
+
+   function Form (File : in AFCB_Ptr) return String is
+   begin
+      if File = null then
+         raise Status_Error;
+      else
+         return File.Form.all (1 .. File.Form'Length - 1);
+      end if;
+   end Form;
+
+   ------------------
+   -- Form_Boolean --
+   ------------------
+
+   function Form_Boolean
+     (Form    : String;
+      Keyword : String;
+      Default : Boolean)
+      return    Boolean
+   is
+      V1, V2 : Natural;
+
+   begin
+      Form_Parameter (Form, Keyword, V1, V2);
+
+      if V1 = 0 then
+         return Default;
+
+      elsif Form (V1) = 'y' then
+         return True;
+
+      elsif Form (V1) = 'n' then
+         return False;
+
+      else
+         raise Use_Error;
+      end if;
+   end Form_Boolean;
+
+   ------------------
+   -- Form_Integer --
+   ------------------
+
+   function Form_Integer
+     (Form    : String;
+      Keyword : String;
+      Default : Integer)
+      return    Integer
+   is
+      V1, V2 : Natural;
+      V      : Integer;
+
+   begin
+      Form_Parameter (Form, Keyword, V1, V2);
+
+      if V1 = 0 then
+         return Default;
+
+      else
+         V := 0;
+
+         for J in V1 .. V2 loop
+            if Form (J) not in '0' .. '9' then
+               raise Use_Error;
+            else
+               V := V * 10 + Character'Pos (Form (J)) - Character'Pos ('0');
+            end if;
+
+            if V > 999_999 then
+               raise Use_Error;
+            end if;
+         end loop;
+
+         return V;
+      end if;
+   end Form_Integer;
+
+   --------------------
+   -- Form_Parameter --
+   --------------------
+
+   procedure Form_Parameter
+     (Form    : String;
+      Keyword : String;
+      Start   : out Natural;
+      Stop    : out Natural)
+  is
+      Klen : constant Integer := Keyword'Length;
+
+   --  Start of processing for Form_Parameter
+
+   begin
+      for J in Form'First + Klen .. Form'Last - 1 loop
+         if Form (J) = '='
+           and then Form (J - Klen .. J - 1) = Keyword
+         then
+            Start := J + 1;
+            Stop := Start - 1;
+
+            while Form (Stop + 1) /= ASCII.NUL
+              and then Form (Stop + 1) /= ','
+            loop
+               Stop := Stop + 1;
+            end loop;
+
+            return;
+         end if;
+      end loop;
+
+      Start := 0;
+      Stop  := 0;
+   end Form_Parameter;
+
+   -------------
+   -- Is_Open --
+   -------------
+
+   function Is_Open (File : in AFCB_Ptr) return Boolean is
+   begin
+      return (File /= null);
+   end Is_Open;
+
+   -------------------
+   -- Make_Buffered --
+   -------------------
+
+   procedure Make_Buffered
+     (File     : AFCB_Ptr;
+      Buf_Siz  : Interfaces.C_Streams.size_t) is
+      status   : Integer;
+
+   begin
+      status := setvbuf (File.Stream, Null_Address, IOFBF, Buf_Siz);
+   end Make_Buffered;
+
+   ------------------------
+   -- Make_Line_Buffered --
+   ------------------------
+
+   procedure Make_Line_Buffered
+     (File     : AFCB_Ptr;
+      Line_Siz : Interfaces.C_Streams.size_t) is
+      status   : Integer;
+
+   begin
+      status := setvbuf (File.Stream, Null_Address, IOLBF, Line_Siz);
+   end Make_Line_Buffered;
+
+   ---------------------
+   -- Make_Unbuffered --
+   ---------------------
+
+   procedure Make_Unbuffered (File : AFCB_Ptr) is
+      status : Integer;
+
+   begin
+      status := setvbuf (File.Stream, Null_Address, IONBF, 0);
+   end Make_Unbuffered;
+
+   ----------
+   -- Mode --
+   ----------
+
+   function Mode (File : in AFCB_Ptr) return File_Mode is
+   begin
+      if File = null then
+         raise Status_Error;
+      else
+         return File.Mode;
+      end if;
+   end Mode;
+
+   ----------
+   -- Name --
+   ----------
+
+   function Name (File : in AFCB_Ptr) return String is
+   begin
+      if File = null then
+         raise Status_Error;
+      else
+         return File.Name.all (1 .. File.Name'Length - 1);
+      end if;
+   end Name;
+
+   ----------
+   -- Open --
+   ----------
+
+   procedure Open
+     (File_Ptr  : in out AFCB_Ptr;
+      Dummy_FCB : in out AFCB'Class;
+      Mode      : File_Mode;
+      Name      : String;
+      Form      : String;
+      Amethod   : Character;
+      Creat     : Boolean;
+      Text      : Boolean;
+      C_Stream  : FILEs := NULL_Stream)
+   is
+      procedure Tmp_Name (Buffer : Address);
+      pragma Import (C, Tmp_Name, "__gnat_tmp_name");
+      --  set buffer (a String address) with a temporary filename.
+
+      Stream : FILEs := C_Stream;
+      --  Stream which we open in response to this request
+
+      Shared : Shared_Status_Type;
+      --  Setting of Shared_Status field for file
+
+      Fopstr : aliased Fopen_String;
+      --  Mode string used in fopen call
+
+      Formstr : aliased String (1 .. Form'Length + 1);
+      --  Form string with ASCII.NUL appended, folded to lower case
+
+      Tempfile : constant Boolean := (Name'Length = 0);
+      --  Indicates temporary file case
+
+      Namelen : constant Integer := max_path_len;
+      --  Length required for file name, not including final ASCII.NUL
+      --  Note that we used to reference L_tmpnam here, which is not
+      --  reliable since __gnat_tmp_name does not always use tmpnam.
+
+      Namestr : aliased String (1 .. Namelen + 1);
+      --  Name as given or temporary file name with ASCII.NUL appended
+
+      Fullname : aliased String (1 .. max_path_len + 1);
+      --  Full name (as required for Name function, and as stored in the
+      --  control block in the Name field) with ASCII.NUL appended.
+
+      Full_Name_Len : Integer;
+      --  Length of name actually stored in Fullname
+
+   begin
+      if File_Ptr /= null then
+         raise Status_Error;
+      end if;
+
+      --  Acquire form string, setting required NUL terminator
+
+      Formstr (1 .. Form'Length) := Form;
+      Formstr (Formstr'Last) := ASCII.NUL;
+
+      --  Convert form string to lower case
+
+      for J in Formstr'Range loop
+         if Formstr (J) in 'A' .. 'Z' then
+            Formstr (J) := Character'Val (Character'Pos (Formstr (J)) + 32);
+         end if;
+      end loop;
+
+      --  Acquire setting of shared parameter
+
+      declare
+         V1, V2 : Natural;
+
+      begin
+         Form_Parameter (Formstr, "shared", V1, V2);
+
+         if V1 = 0 then
+            Shared := None;
+
+         elsif Formstr (V1 .. V2) = "yes" then
+            Shared := Yes;
+
+         elsif Formstr (V1 .. V2) = "no" then
+            Shared := No;
+
+         else
+            raise Use_Error;
+         end if;
+      end;
+
+      --  If we were given a stream (call from xxx.C_Streams.Open), then set
+      --  full name to null and that is all we have to do in this case so
+      --  skip to end of processing.
+
+      if Stream /= NULL_Stream then
+         Fullname (1) := ASCII.Nul;
+         Full_Name_Len := 1;
+
+      --  Normal case of Open or Create
+
+      else
+         --  If temporary file case, get temporary file name and add
+         --  to the list of temporary files to be deleted on exit.
+
+         if Tempfile then
+            if not Creat then
+               raise Name_Error;
+            end if;
+
+            Tmp_Name (Namestr'Address);
+
+            if Namestr (1) = ASCII.NUL then
+               raise Use_Error;
+            end if;
+
+            --  Chain to temp file list, ensuring thread safety with a lock
+
+            begin
+               SSL.Lock_Task.all;
+               Temp_Files :=
+                 new Temp_File_Record'(Name => Namestr, Next => Temp_Files);
+               SSL.Unlock_Task.all;
+
+            exception
+               when others =>
+                  SSL.Unlock_Task.all;
+                  raise;
+            end;
+
+         --  Normal case of non-null name given
+
+         else
+            Namestr (1 .. Name'Length) := Name;
+            Namestr (Name'Length + 1)  := ASCII.NUL;
+         end if;
+
+         --  Get full name in accordance with the advice of RM A.8.2(22).
+
+         full_name (Namestr'Address, Fullname'Address);
+
+         if Fullname (1) = ASCII.NUL then
+            raise Use_Error;
+         end if;
+
+         for J in Fullname'Range loop
+            if Fullname (J) = ASCII.NUL then
+               Full_Name_Len := J;
+               exit;
+            end if;
+         end loop;
+
+         --  If Shared=None or Shared=Yes, then check for the existence
+         --  of another file with exactly the same full name.
+
+         if Shared /= No then
+            declare
+               P : AFCB_Ptr;
+
+            begin
+               P := Open_Files;
+               while P /= null loop
+                  if Fullname (1 .. Full_Name_Len) = P.Name.all then
+
+                     --  If we get a match, and either file has Shared=None,
+                     --  then raise Use_Error, since we don't allow two
+                     --  files of the same name to be opened unless they
+                     --  specify the required sharing mode.
+
+                     if Shared = None
+                       or else P.Shared_Status = None
+                     then
+                        raise Use_Error;
+
+                     --  If both files have Shared=Yes, then we acquire the
+                     --  stream from the located file to use as our stream.
+
+                     elsif Shared = Yes
+                       and then P.Shared_Status = Yes
+                     then
+                        Stream := P.Stream;
+                        exit;
+
+                     --  Otherwise one of the files has Shared=Yes and one
+                     --  has Shared=No. If the current file has Shared=No
+                     --  then all is well but we don't want to share any
+                     --  other file's stream. If the current file has
+                     --  Shared=Yes, we would like to share a stream, but
+                     --  not from a file that has Shared=No, so in either
+                     --  case we just keep going on the search.
+
+                     else
+                        null;
+                     end if;
+                  end if;
+
+                  P := P.Next;
+               end loop;
+            end;
+         end if;
+
+         --  Open specified file if we did not find an existing stream
+
+         if Stream = NULL_Stream then
+            Fopen_Mode (Mode, Text, Creat, Amethod, Fopstr);
+
+            --  A special case, if we are opening (OPEN case) a file and
+            --  the mode returned by Fopen_Mode is not "r" or "r+", then
+            --  we first make sure that the file exists as required by
+            --  Ada semantics.
+
+            if Creat = False and then Fopstr (1) /= 'r' then
+               if file_exists (Namestr'Address) = 0 then
+                  raise Name_Error;
+               end if;
+            end if;
+
+            --  Now open the file. Note that we use the name as given
+            --  in the original Open call for this purpose, since that
+            --  seems the clearest implementation of the intent. It
+            --  would presumably work to use the full name here, but
+            --  if there is any difference, then we should use the
+            --  name used in the call.
+
+            --  Note: for a corresponding delete, we will use the
+            --  full name, since by the time of the delete, the
+            --  current working directory may have changed and
+            --  we do not want to delete a different file!
+
+            Stream := fopen (Namestr'Address, Fopstr'Address);
+
+            if Stream = NULL_Stream then
+               if file_exists (Namestr'Address) = 0 then
+                  raise Name_Error;
+               else
+                  raise Use_Error;
+               end if;
+            end if;
+         end if;
+      end if;
+
+      --  Stream has been successfully located or opened, so now we are
+      --  committed to completing the opening of the file. Allocate block
+      --  on heap and fill in its fields.
+
+      File_Ptr := AFCB_Allocate (Dummy_FCB);
+
+      File_Ptr.Is_Regular_File   := (is_regular_file
+                                      (fileno (Stream)) /= 0);
+      File_Ptr.Is_System_File    := False;
+      File_Ptr.Is_Text_File      := Text;
+      File_Ptr.Shared_Status     := Shared;
+      File_Ptr.Access_Method     := Amethod;
+      File_Ptr.Stream            := Stream;
+      File_Ptr.Form              := new String'(Formstr);
+      File_Ptr.Name              := new String'(Fullname
+                                                 (1 .. Full_Name_Len));
+      File_Ptr.Mode              := Mode;
+      File_Ptr.Is_Temporary_File := Tempfile;
+
+      Chain_File (File_Ptr);
+      Append_Set (File_Ptr);
+   end Open;
+
+   --------------
+   -- Read_Buf --
+   --------------
+
+   procedure Read_Buf (File : AFCB_Ptr; Buf : Address; Siz : size_t) is
+      Nread : size_t;
+
+   begin
+      Nread := fread (Buf, 1, Siz, File.Stream);
+
+      if Nread = Siz then
+         return;
+
+      elsif ferror (File.Stream) /= 0 then
+         raise Device_Error;
+
+      elsif Nread = 0 then
+         raise End_Error;
+
+      else -- 0 < Nread < Siz
+         raise Data_Error;
+      end if;
+
+   end Read_Buf;
+
+   procedure Read_Buf
+     (File  : AFCB_Ptr;
+      Buf   : Address;
+      Siz   : in Interfaces.C_Streams.size_t;
+      Count : out Interfaces.C_Streams.size_t)
+   is
+   begin
+      Count := fread (Buf, 1, Siz, File.Stream);
+
+      if Count = 0 and then ferror (File.Stream) /= 0 then
+         raise Device_Error;
+      end if;
+   end Read_Buf;
+
+   -----------
+   -- Reset --
+   -----------
+
+   --  The reset which does not change the mode simply does a rewind.
+
+   procedure Reset (File : in out AFCB_Ptr) is
+   begin
+      Check_File_Open (File);
+      Reset (File, 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 : in File_Mode) is
+      Fopstr : aliased Fopen_String;
+
+   begin
+      Check_File_Open (File);
+
+      --  Change of mode not allowed for shared file or file with no name
+      --  or file that is not a regular file, or for a system file.
+
+      if File.Shared_Status = Yes
+        or else File.Name'Length <= 1
+        or else File.Is_System_File
+        or else (not File.Is_Regular_File)
+      then
+         raise Use_Error;
+
+      --  For In_File or Inout_File for a regular file, we can just do a
+      --  rewind if the mode is unchanged, which is more efficient than
+      --  doing a full reopen.
+
+      elsif Mode = File.Mode
+        and then Mode <= Inout_File
+      then
+         rewind (File.Stream);
+
+      --  Here the change of mode is permitted, we do it by reopening the
+      --  file in the new mode and replacing the stream with a new stream.
+
+      else
+         Fopen_Mode
+           (Mode, File.Is_Text_File, False, File.Access_Method, Fopstr);
+
+         File.Stream :=
+           freopen (File.Name.all'Address, Fopstr'Address, File.Stream);
+
+         if File.Stream = NULL_Stream then
+            Close (File);
+            raise Use_Error;
+
+         else
+            File.Mode := Mode;
+            Append_Set (File);
+         end if;
+      end if;
+   end Reset;
+
+   ---------------
+   -- Write_Buf --
+   ---------------
+
+   procedure Write_Buf (File : AFCB_Ptr; Buf : Address; Siz : size_t) is
+   begin
+      --  Note: for most purposes, the Siz and 1 parameters in the fwrite
+      --  call could be reversed, but on VMS, this is a better choice, since
+      --  for some file formats, reversing the parameters results in records
+      --  of one byte each.
+
+      SSL.Abort_Defer.all;
+
+      if fwrite (Buf, Siz, 1, File.Stream) /= 1 then
+         if Siz /= 0 then
+            SSL.Abort_Undefer.all;
+            raise Device_Error;
+         end if;
+      end if;
+
+      SSL.Abort_Undefer.all;
+   end Write_Buf;
+
+end System.File_IO;