File : s-fileio.adb
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
5 -- S Y S T E M . F I L E _ I O --
-- --
-- B o d y --
-- --
-- $Revision: 1.62 $
10 -- --
-- Copyright (C) 1992-2002 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- --
15 -- 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 --
20 -- 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 --
25 -- 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. --
30 -- --
-- 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). --
-- --
------------------------------------------------------------------------------
35
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;
40 with Unchecked_Deallocation;
package body System.File_IO is
use System.File_Control_Block;
45
package SSL renames System.Soft_Links;
----------------------
-- Global Variables --
50 ----------------------
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
55 -- 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;
60
type Temp_File_Record is record
Name : String (1 .. L_tmpnam + 1);
Next : Temp_File_Record_Ptr;
end record;
65 -- 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.
70
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
75 -- 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.
80
File_IO_Clean_Up_Object : File_IO_Clean_Up_Type;
pragma Warnings (Off, File_IO_Clean_Up_Object);
-- 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
85 -- environment task is finalized.
text_translation_required : Boolean;
pragma Import
(C, text_translation_required, "__gnat_text_translation_required");
90 -- If true, add appropriate suffix to control string for Open.
-----------------------
-- Local Subprograms --
-----------------------
95
procedure Free_String is new Unchecked_Deallocation (String, Pstring);
subtype Fopen_String is String (1 .. 4);
-- Holds open string (longest is "w+b" & nul)
100
procedure Fopen_Mode
(Mode : File_Mode;
Text : Boolean;
Creat : Boolean;
105 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
110 -- 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.
----------------
115 -- Append_Set --
----------------
procedure Append_Set (File : AFCB_Ptr) is
begin
120 if File.Mode = Append_File then
if fseek (File.Stream, 0, SEEK_END) /= 0 then
raise Device_Error;
end if;
end if;
125 end Append_Set;
----------------
-- Chain_File --
----------------
130
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.
135
SSL.Lock_Task.all;
File.Next := Open_Files;
File.Prev := null;
Open_Files := File;
140
if File.Next /= null then
File.Next.Prev := File;
end if;
145 SSL.Unlock_Task.all;
end Chain_File;
---------------------
-- Check_File_Open --
150 ---------------------
procedure Check_File_Open (File : AFCB_Ptr) is
begin
if File = null then
155 raise Status_Error;
end if;
end Check_File_Open;
-----------------------
160 -- Check_Read_Status --
-----------------------
procedure Check_Read_Status (File : AFCB_Ptr) is
begin
165 if File = null then
raise Status_Error;
elsif File.Mode > Inout_File then
raise Mode_Error;
end if;
170 end Check_Read_Status;
------------------------
-- Check_Write_Status --
------------------------
175
procedure Check_Write_Status (File : AFCB_Ptr) is
begin
if File = null then
raise Status_Error;
180 elsif File.Mode = In_File then
raise Mode_Error;
end if;
end Check_Write_Status;
185 -----------
-- Close --
-----------
procedure Close (File : in out AFCB_Ptr) is
190 Close_Status : int := 0;
Dup_Strm : Boolean := False;
begin
Check_File_Open (File);
195 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
200 -- 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
205 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
210 declare
P : AFCB_Ptr;
begin
P := Open_Files;
215 while P /= null loop
if P /= File
and then File.Stream = P.Stream
then
Dup_Strm := True;
220 exit;
end if;
P := P.Next;
end loop;
225 end;
end if;
-- Do the fclose unless this was a duplicate in the shared case
230 if not Dup_Strm then
Close_Status := fclose (File.Stream);
end if;
end if;
235 -- 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
240 -- no exception can occur inside the lock/unlock pair.
begin
SSL.Lock_Task.all;
245 if File.Prev = null then
Open_Files := File.Next;
else
File.Prev.Next := File.Next;
end if;
250
if File.Next /= null then
File.Next.Prev := File.Prev;
end if;
255 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
260 -- 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);
265 AFCB_Free (File);
end if;
File := null;
270 if Close_Status /= 0 then
raise Device_Error;
end if;
end Close;
275 ------------
-- Delete --
------------
procedure Delete (File : in out AFCB_Ptr) is
280 begin
Check_File_Open (File);
if not File.Is_Regular_File then
raise Use_Error;
285 end if;
declare
Filename : aliased constant String := File.Name.all;
290 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
295 -- since we did the open, and we want to unlink the right file!
if unlink (Filename'Address) = -1 then
raise Use_Error;
end if;
300 end;
end Delete;
-----------------
-- End_Of_File --
305 -----------------
function End_Of_File (File : AFCB_Ptr) return Boolean is
begin
Check_File_Open (File);
310
if feof (File.Stream) /= 0 then
return True;
else
315 Check_Read_Status (File);
if ungetc (fgetc (File.Stream), File.Stream) = EOF then
clearerr (File.Stream);
return True;
320 else
return False;
end if;
end if;
end End_Of_File;
325
--------------
-- Finalize --
--------------
330 -- 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
335 pragma Warnings (Off, V);
Discard : int;
Fptr1 : AFCB_Ptr;
Fptr2 : AFCB_Ptr;
340
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)
345 Fptr1 := Open_Files;
while Fptr1 /= null loop
Fptr2 := Fptr1.Next;
Close (Fptr1);
Fptr1 := Fptr2;
350 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.
355
while Temp_Files /= null loop
Discard := unlink (Temp_Files.Name'Address);
Temp_Files := Temp_Files.Next;
end loop;
360
end Finalize;
-----------
-- Flush --
365 -----------
procedure Flush (File : AFCB_Ptr) is
begin
Check_Write_Status (File);
370
if fflush (File.Stream) = 0 then
return;
else
raise Device_Error;
375 end if;
end Flush;
----------------
-- Fopen_Mode --
380 ----------------
-- The fopen mode to be used is shown by the following table:
-- OPEN CREATE
385 -- Append_File "r+" "w+"
-- In_File "r" "w+"
-- Out_File (Direct_IO) "r+" "w"
-- Out_File (all others) "w" "w"
-- Inout_File "r+" "w+"
390
-- 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.
395
-- 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
400 -- 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
405 -- 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.
410
procedure Fopen_Mode
(Mode : File_Mode;
Text : Boolean;
Creat : Boolean;
415 Amethod : Character;
Fopstr : out Fopen_String)
is
Fptr : Positive;
420 begin
case Mode is
when In_File =>
if Creat then
Fopstr (1) := 'w';
425 Fopstr (2) := '+';
Fptr := 3;
else
Fopstr (1) := 'r';
Fptr := 2;
430 end if;
when Out_File =>
if Amethod = 'D' and not Creat then
Fopstr (1) := 'r';
435 Fopstr (2) := '+';
Fptr := 3;
else
Fopstr (1) := 'w';
Fptr := 2;
440 end if;
when Inout_File | Append_File =>
if Creat then
Fopstr (1) := 'w';
445 else
Fopstr (1) := 'r';
end if;
Fopstr (2) := '+';
450 Fptr := 3;
end case;
-- If text_translation_required is true then we need to append
455 -- either a t or b to the string to get the right mode
if text_translation_required then
if Text then
Fopstr (Fptr) := 't';
460 else
Fopstr (Fptr) := 'b';
end if;
Fptr := Fptr + 1;
465 end if;
Fopstr (Fptr) := ASCII.NUL;
end Fopen_Mode;
470 ----------
-- Form --
----------
function Form (File : in AFCB_Ptr) return String is
475 begin
if File = null then
raise Status_Error;
else
return File.Form.all (1 .. File.Form'Length - 1);
480 end if;
end Form;
------------------
-- Form_Boolean --
485 ------------------
function Form_Boolean
(Form : String;
Keyword : String;
490 Default : Boolean)
return Boolean
is
V1, V2 : Natural;
495 begin
Form_Parameter (Form, Keyword, V1, V2);
if V1 = 0 then
return Default;
500
elsif Form (V1) = 'y' then
return True;
elsif Form (V1) = 'n' then
505 return False;
else
raise Use_Error;
end if;
510 end Form_Boolean;
------------------
-- Form_Integer --
------------------
515
function Form_Integer
(Form : String;
Keyword : String;
Default : Integer)
520 return Integer
is
V1, V2 : Natural;
V : Integer;
525 begin
Form_Parameter (Form, Keyword, V1, V2);
if V1 = 0 then
return Default;
530
else
V := 0;
for J in V1 .. V2 loop
535 if Form (J) not in '0' .. '9' then
raise Use_Error;
else
V := V * 10 + Character'Pos (Form (J)) - Character'Pos ('0');
end if;
540
if V > 999_999 then
raise Use_Error;
end if;
end loop;
545
return V;
end if;
end Form_Integer;
550 --------------------
-- Form_Parameter --
--------------------
procedure Form_Parameter
555 (Form : String;
Keyword : String;
Start : out Natural;
Stop : out Natural)
is
560 Klen : constant Integer := Keyword'Length;
-- Start of processing for Form_Parameter
begin
565 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;
570 Stop := Start - 1;
while Form (Stop + 1) /= ASCII.NUL
and then Form (Stop + 1) /= ','
loop
575 Stop := Stop + 1;
end loop;
return;
end if;
580 end loop;
Start := 0;
Stop := 0;
end Form_Parameter;
585
-------------
-- Is_Open --
-------------
590 function Is_Open (File : in AFCB_Ptr) return Boolean is
begin
return (File /= null);
end Is_Open;
595 -------------------
-- Make_Buffered --
-------------------
procedure Make_Buffered
600 (File : AFCB_Ptr;
Buf_Siz : Interfaces.C_Streams.size_t) is
status : Integer;
begin
605 status := setvbuf (File.Stream, Null_Address, IOFBF, Buf_Siz);
end Make_Buffered;
------------------------
-- Make_Line_Buffered --
610 ------------------------
procedure Make_Line_Buffered
(File : AFCB_Ptr;
Line_Siz : Interfaces.C_Streams.size_t) is
615 status : Integer;
begin
status := setvbuf (File.Stream, Null_Address, IOLBF, Line_Siz);
end Make_Line_Buffered;
620
---------------------
-- Make_Unbuffered --
---------------------
625 procedure Make_Unbuffered (File : AFCB_Ptr) is
status : Integer;
begin
status := setvbuf (File.Stream, Null_Address, IONBF, 0);
630 end Make_Unbuffered;
----------
-- Mode --
----------
635
function Mode (File : in AFCB_Ptr) return File_Mode is
begin
if File = null then
raise Status_Error;
640 else
return File.Mode;
end if;
end Mode;
645 ----------
-- Name --
----------
function Name (File : in AFCB_Ptr) return String is
650 begin
if File = null then
raise Status_Error;
else
return File.Name.all (1 .. File.Name'Length - 1);
655 end if;
end Name;
----------
-- Open --
660 ----------
procedure Open
(File_Ptr : in out AFCB_Ptr;
Dummy_FCB : in out AFCB'Class;
665 Mode : File_Mode;
Name : String;
Form : String;
Amethod : Character;
Creat : Boolean;
670 Text : Boolean;
C_Stream : FILEs := NULL_Stream)
is
procedure Tmp_Name (Buffer : Address);
pragma Import (C, Tmp_Name, "__gnat_tmp_name");
675 -- set buffer (a String address) with a temporary filename.
Stream : FILEs := C_Stream;
-- Stream which we open in response to this request
680 Shared : Shared_Status_Type;
-- Setting of Shared_Status field for file
Fopstr : aliased Fopen_String;
-- Mode string used in fopen call
685
Formstr : aliased String (1 .. Form'Length + 1);
-- Form string with ASCII.NUL appended, folded to lower case
Tempfile : constant Boolean := (Name'Length = 0);
690 -- 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
695 -- 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
700 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;
705 -- Length of name actually stored in Fullname
begin
if File_Ptr /= null then
raise Status_Error;
710 end if;
-- Acquire form string, setting required NUL terminator
Formstr (1 .. Form'Length) := Form;
715 Formstr (Formstr'Last) := ASCII.NUL;
-- Convert form string to lower case
for J in Formstr'Range loop
720 if Formstr (J) in 'A' .. 'Z' then
Formstr (J) := Character'Val (Character'Pos (Formstr (J)) + 32);
end if;
end loop;
725 -- Acquire setting of shared parameter
declare
V1, V2 : Natural;
730 begin
Form_Parameter (Formstr, "shared", V1, V2);
if V1 = 0 then
Shared := None;
735
elsif Formstr (V1 .. V2) = "yes" then
Shared := Yes;
elsif Formstr (V1 .. V2) = "no" then
740 Shared := No;
else
raise Use_Error;
end if;
745 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.
750
if Stream /= NULL_Stream then
Fullname (1) := ASCII.Nul;
Full_Name_Len := 1;
755 -- 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.
760
if Tempfile then
if not Creat then
raise Name_Error;
end if;
765
Tmp_Name (Namestr'Address);
if Namestr (1) = ASCII.NUL then
raise Use_Error;
770 end if;
-- Chain to temp file list, ensuring thread safety with a lock
begin
775 SSL.Lock_Task.all;
Temp_Files :=
new Temp_File_Record'(Name => Namestr, Next => Temp_Files);
SSL.Unlock_Task.all;
780 exception
when others =>
SSL.Unlock_Task.all;
raise;
end;
785
-- Normal case of non-null name given
else
Namestr (1 .. Name'Length) := Name;
790 Namestr (Name'Length + 1) := ASCII.NUL;
end if;
-- Get full name in accordance with the advice of RM A.8.2(22).
795 full_name (Namestr'Address, Fullname'Address);
if Fullname (1) = ASCII.NUL then
raise Use_Error;
end if;
800
Full_Name_Len := 1;
while Full_Name_Len < Fullname'Last
and then Fullname (Full_Name_Len) /= ASCII.NUL
loop
805 Full_Name_Len := Full_Name_Len + 1;
end loop;
-- If Shared=None or Shared=Yes, then check for the existence
-- of another file with exactly the same full name.
810
if Shared /= No then
declare
P : AFCB_Ptr;
815 begin
P := Open_Files;
while P /= null loop
if Fullname (1 .. Full_Name_Len) = P.Name.all then
820 -- 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.
825 if Shared = None
or else P.Shared_Status = None
then
raise Use_Error;
830 -- 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
835 then
Stream := P.Stream;
exit;
-- Otherwise one of the files has Shared=Yes and one
840 -- 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
845 -- case we just keep going on the search.
else
null;
end if;
850 end if;
P := P.Next;
end loop;
end;
855 end if;
-- Open specified file if we did not find an existing stream
if Stream = NULL_Stream then
860 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
865 -- Ada semantics.
if Creat = False and then Fopstr (1) /= 'r' then
if file_exists (Namestr'Address) = 0 then
raise Name_Error;
870 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
875 -- 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.
880 -- 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!
885 Stream := fopen (Namestr'Address, Fopstr'Address);
if Stream = NULL_Stream then
if file_exists (Namestr'Address) = 0 then
raise Name_Error;
890 else
raise Use_Error;
end if;
end if;
end if;
895 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.
900
File_Ptr := AFCB_Allocate (Dummy_FCB);
File_Ptr.Is_Regular_File := (is_regular_file
(fileno (Stream)) /= 0);
905 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;
910 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;
915
Chain_File (File_Ptr);
Append_Set (File_Ptr);
end Open;
920 --------------
-- Read_Buf --
--------------
procedure Read_Buf (File : AFCB_Ptr; Buf : Address; Siz : size_t) is
925 Nread : size_t;
begin
Nread := fread (Buf, 1, Siz, File.Stream);
930 if Nread = Siz then
return;
elsif ferror (File.Stream) /= 0 then
raise Device_Error;
935
elsif Nread = 0 then
raise End_Error;
else -- 0 < Nread < Siz
940 raise Data_Error;
end if;
end Read_Buf;
945 procedure Read_Buf
(File : AFCB_Ptr;
Buf : Address;
Siz : in Interfaces.C_Streams.size_t;
Count : out Interfaces.C_Streams.size_t)
950 is
begin
Count := fread (Buf, 1, Siz, File.Stream);
if Count = 0 and then ferror (File.Stream) /= 0 then
955 raise Device_Error;
end if;
end Read_Buf;
-----------
960 -- Reset --
-----------
-- The reset which does not change the mode simply does a rewind.
965 procedure Reset (File : in out AFCB_Ptr) is
begin
Check_File_Open (File);
Reset (File, File.Mode);
end Reset;
970
-- 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)
975 procedure Reset (File : in out AFCB_Ptr; Mode : in File_Mode) is
Fopstr : aliased Fopen_String;
begin
Check_File_Open (File);
980
-- 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
985 or else File.Name'Length <= 1
or else File.Is_System_File
or else (not File.Is_Regular_File)
then
raise Use_Error;
990
-- 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.
995 elsif Mode = File.Mode
and then Mode <= Inout_File
then
rewind (File.Stream);
1000 -- 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
1005 (Mode, File.Is_Text_File, False, File.Access_Method, Fopstr);
File.Stream :=
freopen (File.Name.all'Address, Fopstr'Address, File.Stream);
1010 if File.Stream = NULL_Stream then
Close (File);
raise Use_Error;
else
1015 File.Mode := Mode;
Append_Set (File);
end if;
end if;
end Reset;
1020
---------------
-- Write_Buf --
---------------
1025 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
1030 -- of one byte each.
SSL.Abort_Defer.all;
if fwrite (Buf, Siz, 1, File.Stream) /= 1 then
1035 if Siz /= 0 then
SSL.Abort_Undefer.all;
raise Device_Error;
end if;
end if;
1040
SSL.Abort_Undefer.all;
end Write_Buf;
end System.File_IO;