|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 25478 (0x6386)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦4c85d69e2⟧
└─⟦this⟧
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1988 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054-3197
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1988. ALL RIGHTS RESERVED.
--
--
with Buffering;
with Os_Dependent_Io;
with Semaphore;
with Unchecked_Conversion;
with Unchecked_Deallocation;
-- with Primitive_Io; -- For debugging only (e.g., List_All_Open_Files)
package body Device_Independent_Io is
type Double_Link is
record
Prev : File_Type := null;
Next : File_Type := null;
end record;
type File_Descriptor is
record
The_Mode : File_Mode := Closed;
The_Kind : File_Kind := Normal;
Exclusive_Access : Semaphore.Lock_State :=
Semaphore.Initial_Lock_State;
Os_Block : Os_Dependent_Io.Os_Control_Block;
Protocol_Block : System.Address := System_Types.Null_Address;
Data_Buffer : Buffering.Data_Buffer := Buffering.No_Buffer;
Connections : Double_Link;
end record;
-- All open files are threaded on this list:
All_Open_Files : File_Type := null;
-- These three objects are logically constants, but we want all fields
-- to take the implicit default values and Ada requires that if an
-- object is declared constant it must have an explicit initialization.
A_Closed_Input_File : File_Descriptor;
A_Closed_Output_File : File_Descriptor;
A_Closed_Error_File : File_Descriptor;
function To_File_Type is new Unchecked_Conversion
(System.Address, File_Type);
-- Dio_Absorb_Output : constant Boolean := Primitive_Io.Global_Absorb_Output;
-- procedure Pput (S : in String;
-- Absorb_Output : Boolean := Dio_Absorb_Output)
-- renames Primitive_Io.Put_Line;
procedure Free is new Unchecked_Deallocation (File_Descriptor, File_Type);
function Is_Open (File : File_Type) return Boolean is
begin
return File /= null and then File.The_Mode /= Closed;
end Is_Open;
procedure Check_Open (File : File_Type) is
begin
-- if not Is_Open (File) then
-- raise Status_Error;
-- end if;
if File = null or else File.The_Mode = Closed then
raise Status_Error;
end if;
end Check_Open;
pragma Inline (Check_Open);
procedure Acquire (File : File_Type) is
begin
if File /= null then
Semaphore.Acquire (File.Exclusive_Access);
end if;
-- exception
-- when Constraint_Error =>
-- -- If file was already closed, for example
-- null;
end Acquire;
procedure Release (File : File_Type) is
begin
if File /= null then
Semaphore.Release (File.Exclusive_Access);
end if;
-- exception
-- when Constraint_Error =>
-- -- If file was already closed, for example
-- null;
end Release;
procedure Acquire_If_Needed (File : File_Type; Already_Locked : Boolean) is
begin
if not Already_Locked then
begin
Semaphore.Acquire (File.Exclusive_Access);
exception
when Constraint_Error =>
-- If file was already closed, for example
null;
end;
end if;
end Acquire_If_Needed;
procedure Release_If_Grabbed (File : File_Type; Already_Locked : Boolean) is
begin
if not Already_Locked then
begin
Semaphore.Release (File.Exclusive_Access);
exception
when Constraint_Error =>
-- If file was already closed, for example
null;
end;
end if;
end Release_If_Grabbed;
pragma Inline (Acquire_If_Needed, Release_If_Grabbed);
-- Used to implement program termination
procedure Add_To_Open_Files (File : File_Type) is
begin
File.Connections.Next := All_Open_Files;
if All_Open_Files /= null then
All_Open_Files.Connections.Prev := File;
end if;
All_Open_Files := File;
end Add_To_Open_Files;
procedure Remove_From_Open_Files (File : File_Type) is
begin
if File.Connections.Prev /= null then
File.Connections.Prev.Connections.Next := File.Connections.Next;
if File.Connections.Next /= null then
File.Connections.Next.Connections.Prev := File.Connections.Prev;
end if;
end if;
if All_Open_Files = File then
All_Open_Files := File.Connections.Next;
end if;
end Remove_From_Open_Files;
-- File is known to be null or Closed.
procedure Real_Open (File : in out File_Type;
Mode : in File_Mode;
Kind : in File_Kind;
Name : in String;
Form : in String;
Recommended_Buffer_Size : in Natural;
Actual_Buffer_Size : out Natural;
Client : in Client_Kind := Unknown) is
begin
File := new File_Descriptor;
begin
Os_Dependent_Io.Open (File, File.Os_Block, Mode, Kind,
Name, Form, Recommended_Buffer_Size,
Actual_Buffer_Size, Client);
exception
when others =>
Free (File);
raise;
end;
File.The_Mode := Mode;
File.The_Kind := Kind;
Add_To_Open_Files (File);
end Real_Open;
procedure Open (File : in out File_Type;
Mode : in File_Mode;
Kind : in File_Kind;
Name : in String := "";
Form : in String := "";
Recommended_Buffer_Size : in Natural;
Actual_Buffer_Size : out Natural;
Client : in Client_Kind := Unknown) is
begin
if Is_Open (File) then
raise Status_Error;
end if;
if Kind = Temporary then
-- Can't Open a temporary file, must Create it
raise Name_Error;
end if;
Real_Open (File, Mode, Kind, Name, Form,
Recommended_Buffer_Size, Actual_Buffer_Size, Client);
end Open;
procedure Append (File : in out File_Type;
Mode : in File_Mode;
Kind : in File_Kind;
Name : in String := "";
Form : in String := "";
Recommended_Buffer_Size : in Natural;
Actual_Buffer_Size : out Natural) is
begin
if Is_Open (File) then
raise Status_Error;
end if;
if Kind = Temporary then
-- Can't Append to a temporary file, must Create it
raise Name_Error;
end if;
Real_Open (File, Mode, Kind, Name, Form, Recommended_Buffer_Size,
Actual_Buffer_Size, Unknown);
-- ??? Ok wiseguy, now position to the end
-- ??? When is check made that OS permits append on files
-- ??? of this Mode and Kind?
raise Program_Error;
end Append;
procedure Create (File : in out File_Type;
Mode : in File_Mode;
Kind : in File_Kind;
Name : in String := "";
Form : in String := "";
Recommended_Buffer_Size : in Natural;
Actual_Buffer_Size : out Natural) is
begin
if Is_Open (File) then
raise Status_Error;
end if;
File := new File_Descriptor;
begin
Os_Dependent_Io.Create
(File, File.Os_Block, Mode, Kind, Name, Form,
Recommended_Buffer_Size, Actual_Buffer_Size);
exception
when others =>
Free (File);
raise;
end;
File.The_Mode := Mode;
File.The_Kind := Kind;
Add_To_Open_Files (File);
end Create;
procedure Close (File : in out File_Type;
Already_Locked : Boolean := True) is
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
begin
Os_Dependent_Io.Close (File, File.Os_Block);
Buffering.Free (File.Data_Buffer);
File.The_Mode := Closed;
Remove_From_Open_Files (File);
-- When closing the file we release the lock unconditionally
Release (File);
Free (File); -- File := null;
exception
when others =>
-- When closing the file we release the lock unconditionally
Release (File);
raise;
end;
end if;
end Close;
procedure Save (File : File_Type;
Immediate_Effect : Boolean := True;
Already_Locked : Boolean := True) is
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
begin
Os_Dependent_Io.Save (File, File.Os_Block, Immediate_Effect);
Release_If_Grabbed (File, Already_Locked);
exception
when others =>
Release_If_Grabbed (File, Already_Locked);
raise;
end;
end if;
end Save;
procedure Delete (File : in out File_Type;
Already_Locked : Boolean := True) is
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
begin
Os_Dependent_Io.Delete (File, File.Os_Block);
Buffering.Free (File.Data_Buffer);
File.The_Mode := Closed;
Remove_From_Open_Files (File);
-- When deleting the file, we release the lock unconditionally
Release (File);
Free (File); -- File := null;
exception
when others =>
-- ??? Should the file be closed ???
-- Since here the file is not deleted, and not
-- closed, we release the lock conditionally.
Release_If_Grabbed (File, Already_Locked);
raise;
end;
else
Release_If_Grabbed (File, Already_Locked);
raise Status_Error;
end if;
end Delete;
procedure Reset (File : in out File_Type;
Mode : File_Mode;
Already_Locked : Boolean := True) is
begin
if Mode = Closed then
raise Status_Error;
end if;
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
begin
Os_Dependent_Io.Reset (File, File.Os_Block, Mode);
File.The_Mode := Mode;
Release_If_Grabbed (File, Already_Locked);
exception
when others =>
Release_If_Grabbed (File, Already_Locked);
raise;
end;
else
Release_If_Grabbed (File, Already_Locked);
raise Status_Error;
end if;
end Reset;
procedure Reset (File : in out File_Type;
Already_Locked : Boolean := True) is
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
begin
Os_Dependent_Io.Reset (File, File.Os_Block, File.The_Mode);
Release_If_Grabbed (File, Already_Locked);
exception
when others =>
Release_If_Grabbed (File, Already_Locked);
raise;
end;
else
Release_If_Grabbed (File, Already_Locked);
raise Status_Error;
end if;
end Reset;
function Mode (File : File_Type; Already_Locked : Boolean := True)
return File_Mode is
Mode : File_Mode;
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
Mode := File.The_Mode;
Release_If_Grabbed (File, Already_Locked);
return Mode;
else
Release_If_Grabbed (File, Already_Locked);
raise Status_Error;
end if;
end Mode;
function Kind (File : File_Type; Already_Locked : Boolean := True)
return File_Kind is
Kind : File_Kind;
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
Kind := File.The_Kind;
Release_If_Grabbed (File, Already_Locked);
return Kind;
else
Release_If_Grabbed (File, Already_Locked);
raise Status_Error;
end if;
end Kind;
function Name (File : File_Type; Already_Locked : Boolean := True)
return String is
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
declare
Name : constant String :=
Os_Dependent_Io.Name (File, File.Os_Block);
begin
Release_If_Grabbed (File, Already_Locked);
return Name;
end;
else
Release_If_Grabbed (File, Already_Locked);
raise Status_Error;
end if;
end Name;
function Form (File : File_Type; Already_Locked : Boolean := True)
return String is
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
declare
Form : constant String :=
Os_Dependent_Io.Form (File, File.Os_Block);
begin
Release_If_Grabbed (File, Already_Locked);
return Form;
end;
else
Release_If_Grabbed (File, Already_Locked);
raise Status_Error;
end if;
end Form;
procedure Set (File : File_Type; Buffer : Buffering.Data_Buffer) is
begin
File.Data_Buffer := Buffer;
end Set;
function Get (File : File_Type) return Buffering.Data_Buffer is
begin
return File.Data_Buffer;
end Get;
function Buffer_Size (File : File_Type; Already_Locked : Boolean := True)
return Natural is
N : Natural := 0;
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
if Buffering.Is_Allocated (File.Data_Buffer) then
N := Buffering.Max_Length (File.Data_Buffer);
else
N := 0;
end if;
Release_If_Grabbed (File, Already_Locked);
return N;
else
Release_If_Grabbed (File, Already_Locked);
raise Status_Error;
end if;
end Buffer_Size;
function End_Of_File (File : File_Type; Already_Locked : Boolean := True)
return Boolean is
Eof : Boolean;
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
Eof := Os_Dependent_Io.End_Of_File (File, File.Os_Block);
Release_If_Grabbed (File, Already_Locked);
return Eof;
else
Release_If_Grabbed (File, Already_Locked);
raise Status_Error;
end if;
end End_Of_File;
function Is_Interactive (File : File_Type; Already_Locked : Boolean := True)
return Boolean is
Ii : Boolean;
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
Ii := Os_Dependent_Io.Is_Interactive (File, File.Os_Block);
Release_If_Grabbed (File, Already_Locked);
return Ii;
else
Release_If_Grabbed (File, Already_Locked);
raise Status_Error;
end if;
end Is_Interactive;
procedure Read (File : in File_Type;
Item : in out Byte_String;
Count : out Natural;
Line_Terminator_Detected : out Boolean;
Line_Last_Data_Index : out Natural;
Line_Terminator_Present : out Boolean;
Already_Locked : Boolean := True) is
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
if File.The_Mode = In_File then
-- Data is always read into the user's buffer directly. In case
-- of error his buffer could be trashed. This seems reasonable.
Os_Dependent_Io.Read (File,
File.Os_Block,
Item, Count, Line_Terminator_Detected,
Line_Last_Data_Index,
Line_Terminator_Present);
Release_If_Grabbed (File, Already_Locked);
else
raise Mode_Error;
end if;
else
raise Status_Error;
end if;
exception
when others =>
Release_If_Grabbed (File, Already_Locked);
raise;
end Read;
procedure Read (File : File_Type;
Item : in out Byte_String;
Count : out Natural;
Already_Locked : Boolean := True) is
Db, Dc : Boolean;
Dn : Natural;
begin
Read (File, Item, Count, Db, Dn, Dc, Already_Locked);
end Read;
procedure Write (File : in File_Type;
Item : in Byte_String;
Line_Terminator_Present : in Boolean;
Already_Locked : Boolean := True) is
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
if File.The_Mode = Out_File then
-- With this call, which writes a record at a time, we
-- don't go through the file's buffer. (In fact, maybe
-- we shouldn't allocate the buffer?) Because even with
-- asynchronous I/O the task which has the data can't
-- continue until the I/O is complete.
begin
Os_Dependent_Io.Write (File, File.Os_Block, Item,
Line_Terminator_Present);
Release_If_Grabbed (File, Already_Locked);
end;
else
raise Mode_Error;
end if;
else
raise Status_Error;
end if;
exception
when others =>
Release_If_Grabbed (File, Already_Locked);
raise;
end Write;
function Is_Empty (File : File_Type; Already_Locked : Boolean := True)
return Boolean is
Ie : Boolean;
begin
Acquire_If_Needed (File, Already_Locked);
if Is_Open (File) then
Ie := Os_Dependent_Io.Is_Empty (File, File.Os_Block);
Release_If_Grabbed (File, Already_Locked);
return Ie;
else
Release_If_Grabbed (File, Already_Locked);
raise Status_Error;
end if;
end Is_Empty;
function Closed_Input_File return File_Type is
begin
return To_File_Type (A_Closed_Input_File'Address);
end Closed_Input_File;
function Closed_Output_File return File_Type is
begin
return To_File_Type (A_Closed_Output_File'Address);
end Closed_Output_File;
function Closed_Error_File return File_Type is
begin
return To_File_Type (A_Closed_Error_File'Address);
end Closed_Error_File;
procedure Close_All_Open_Files is
begin
-- The big problem, of course, is how (in Ada) to call the
-- protocol-level Close ?!??!
-- One way: The protocol routine will provide the 'Address
-- of the routine to call to be put in the file control
-- block to be called through a special assembly language
-- routine.
raise Program_Error;
end Close_All_Open_Files;
procedure Identical_Files (File : in File_Type;
Open_In : out Natural;
Open_Out : out Natural;
Open_In_Out : out Natural) is
Files : File_Type;
O_In, O_Out, O_In_Out : Natural := 0;
begin
Files := All_Open_Files;
loop
exit when Files = null;
if Os_Dependent_Io.Identical_File
(File, File.Os_Block, Files, Files.Os_Block) then
case Files.The_Mode is
when In_File =>
O_In := O_In + 1;
when Out_File =>
O_Out := O_Out + 1;
when Inout_File =>
O_In_Out := O_In_Out + 1;
when Closed =>
null;
end case;
end if;
Files := Files.Connections.Next;
end loop;
Open_In := O_In;
Open_Out := O_Out;
Open_In_Out := O_In_Out;
end Identical_Files;
procedure List_All_Open_Files is
-- Files : File_Type;
-- Debugging : constant Boolean := not Dio_Absorb_Output;
begin
-- if not Debugging then
return;
-- end if;
-- if All_Open_Files = null then
-- Pput ("Device_Independent_Io: No open files");
-- else
-- Pput ("Device_Independent_Io: Currently open files:");
-- Files := All_Open_Files;
-- loop
-- begin
-- Pput (" " & Name (Files));
-- exception
-- when others =>
-- Pput
-- (" << File open but name can't be determined >>");
-- end;
-- Files := Files.Connections.Next;
-- exit when Files = null;
-- end loop;
-- end if;
end List_All_Open_Files;
package body Client_Specific is
procedure Set (File : File_Type; Control : Pointer) is
begin
raise Program_Error;
end Set;
function Get (File : File_Type) return Pointer is
begin
raise Program_Error;
return null;
end Get;
end Client_Specific;
procedure Set (File : File_Type; Control : System.Address) is
begin
File.Protocol_Block := Control;
end Set;
function Get (File : File_Type) return System.Address is
begin
return File.Protocol_Block;
end Get;
function Get_Os_Dependent_Control
(File : File_Type) return System.Address is
begin
if File /= null then
return Os_Dependent_Io.Address_For_Control (File.Os_Block);
else
return System.Address_Zero;
end if;
end Get_Os_Dependent_Control;
package body File_Type_Conversions is
function To_Derived is new Unchecked_Conversion
(File_Type, Derived_File_Type);
function From_Derived is new Unchecked_Conversion
(Derived_File_Type, File_Type);
function From_Standard (File : File_Type) return Derived_File_Type is
begin
return To_Derived (File);
end From_Standard;
function To_Standard (File : Derived_File_Type) return File_Type is
begin
return From_Derived (File);
end To_Standard;
end File_Type_Conversions;
end Device_Independent_Io;