-- --
-- B o d y --
-- --
--- --
--- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2003 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- --
with Ada.Finalization; use Ada.Finalization;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Interfaces.C_Streams; use Interfaces.C_Streams;
+with System.CRTL;
with System.Soft_Links;
with Unchecked_Deallocation;
package SSL renames System.Soft_Links;
+ use type System.CRTL.size_t;
+
----------------------
-- Global Variables --
----------------------
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;
+
+ -- Do the chaining operation locked
+
File.Next := Open_Files;
File.Prev := null;
Open_Files := File;
end if;
SSL.Unlock_Task.all;
+
+ exception
+ when others =>
+ SSL.Unlock_Task.all;
+ raise;
end Chain_File;
---------------------
Check_File_Open (File);
AFCB_Close (File);
+ -- Take a task lock, to protect the global data value Open_Files
+
+ SSL.Lock_Task.all;
+
-- 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
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;
+ if File.Prev = null then
+ Open_Files := File.Next;
+ else
+ File.Prev.Next := File.Next;
+ end if;
- SSL.Unlock_Task.all;
- end;
+ if File.Next /= null then
+ File.Next.Prev := File.Prev;
+ end if;
-- Deallocate some parts of the file structure that were kept in heap
-- storage with the exception of system files (standard input, output
if Close_Status /= 0 then
raise Device_Error;
end if;
+
+ SSL.Unlock_Task.all;
+
+ exception
+ when others =>
+ SSL.Unlock_Task.all;
+ raise;
end Close;
------------
procedure Finalize (V : in out File_IO_Clean_Up_Type) is
pragma Warnings (Off, V);
- Discard : int;
Fptr1 : AFCB_Ptr;
Fptr2 : AFCB_Ptr;
+ Discard : int;
+ pragma Unreferenced (Discard);
+
begin
+ -- Take a lock to protect global Open_Files data structure
+
+ SSL.Lock_Task.all;
+
-- First close all open files (the slightly complex form of this loop
-- is required because Close as a side effect nulls out its argument)
Temp_Files := Temp_Files.Next;
end loop;
+ SSL.Unlock_Task.all;
+
+ exception
+ when others =>
+ SSL.Unlock_Task.all;
+ raise;
end Finalize;
-----------
-------------------
procedure Make_Buffered
- (File : AFCB_Ptr;
- Buf_Siz : Interfaces.C_Streams.size_t) is
- status : Integer;
+ (File : AFCB_Ptr;
+ Buf_Siz : Interfaces.C_Streams.size_t)
+ is
+ status : Integer;
+ pragma Unreferenced (status);
begin
status := setvbuf (File.Stream, Null_Address, IOFBF, Buf_Siz);
procedure Make_Line_Buffered
(File : AFCB_Ptr;
- Line_Siz : Interfaces.C_Streams.size_t) is
- status : Integer;
+ Line_Siz : Interfaces.C_Streams.size_t)
+ is
+ status : Integer;
+ pragma Unreferenced (status);
begin
status := setvbuf (File.Stream, Null_Address, IOLBF, Line_Siz);
procedure Make_Unbuffered (File : AFCB_Ptr) is
status : Integer;
+ pragma Unreferenced (status);
begin
status := setvbuf (File.Stream, Null_Address, IONBF, 0);
procedure Open
(File_Ptr : in out AFCB_Ptr;
- Dummy_FCB : in out AFCB'Class;
+ Dummy_FCB : in AFCB'Class;
Mode : File_Mode;
Name : String;
Form : String;
Text : Boolean;
C_Stream : FILEs := NULL_Stream)
is
+ pragma Warnings (Off, Dummy_FCB);
+ -- Yes we know this is never assigned a value. That's intended, since
+ -- all we ever use of this value is the tag for dispatching purposes.
+
procedure Tmp_Name (Buffer : Address);
pragma Import (C, Tmp_Name, "__gnat_tmp_name");
-- set buffer (a String address) with a temporary filename.
-- Normal case of non-null name given
else
+ if Name'Length > Namelen then
+ raise Name_Error;
+ end if;
+
Namestr (1 .. Name'Length) := Name;
Namestr (Name'Length + 1) := ASCII.NUL;
end if;
P : AFCB_Ptr;
begin
+ -- Take a task lock to protect Open_Files
+
+ SSL.Lock_Task.all;
+
+ -- Search list of open files
+
P := Open_Files;
while P /= null loop
if Fullname (1 .. Full_Name_Len) = P.Name.all then
P := P.Next;
end loop;
+
+ SSL.Unlock_Task.all;
+
+ exception
+ when others =>
+ SSL.Unlock_Task.all;
+ raise;
end;
end if;