|
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 - downloadIndex: ┃ B T ┃
Length: 16729 (0x4159)
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.
--
--
separate (Common_Text_Io)
package body State_Handling is
Nil : File_Type;
-- ^ We cheat because we happen to know that Nil has a
-- default initialization (to null).
Initial_Input_State : Input_State := (File => Nil,
Line_Start => 1,
Eob_Is_Eol => False,
Line_Number => 1,
Page_Number => 1,
Eof_Encountered => False);
Initial_Output_State : Output_State := (File => Nil,
Column_Number => 1,
Line_Number => 1,
Page_Number => 1,
Line_Length => Unbounded_Repr,
Page_Length => Unbounded_Repr,
Line_Terminated => False);
-- A replacement for an instantiation of List_Generic
type Input_State_List_Element;
type Access_Input_State_List_Element is access Input_State_List_Element;
type Input_State_List_Element is
record
Link : Access_Input_State_List_Element;
Data : Access_Input_State;
end record;
Freed_Input_States : Access_Input_State_List_Element := null;
Freed_Input_State_List_Elements : Access_Input_State_List_Element;
type Output_State_List_Element;
type Access_Output_State_List_Element is access Output_State_List_Element;
type Output_State_List_Element is
record
Link : Access_Output_State_List_Element;
Data : Access_Output_State;
end record;
Freed_Output_States : Access_Output_State_List_Element := null;
Freed_Output_State_List_Elements : Access_Output_State_List_Element;
--\f
-- Functions for dealing with the lists of "free" states:
function Is_Empty (Head : Access_Input_State_List_Element) return Boolean;
function First (Head : Access_Input_State_List_Element)
return Access_Input_State;
procedure Rest (Head : in out Access_Input_State_List_Element);
function Make (New_Element : Access_Input_State;
Head : Access_Input_State_List_Element)
return Access_Input_State_List_Element;
function Is_Empty (Head : Access_Output_State_List_Element) return Boolean;
function First (Head : Access_Output_State_List_Element)
return Access_Output_State;
procedure Rest (Head : in out Access_Output_State_List_Element);
function Make (New_Element : Access_Output_State;
Head : Access_Output_State_List_Element)
return Access_Output_State_List_Element;
pragma Suppress (Elaboration_Check, On => Is_Empty);
pragma Suppress (Elaboration_Check, On => First);
pragma Suppress (Elaboration_Check, On => Rest);
pragma Suppress (Elaboration_Check, On => Make);
procedure Initialize (File : File_Type; S : out Input_State) is
Data : Buffering.Data_Buffer;
begin
-- Initialize the input state to correspond to the beginning of the
-- file, and clear the buffer.
S := Initial_Input_State;
S.File := File;
Data := Dio.Get (File);
if Data /= null then
Buffering.Clear (Data);
end if;
end Initialize;
procedure Initialize (File : File_Type; S : out Output_State) is
Data : Buffering.Data_Buffer;
begin
-- Initialize the output state to correspond to the beginning
-- of the file, and clear the buffer.
S := Initial_Output_State;
S.File := File;
Data := Dio.Get (File);
if Data /= null then
Buffering.Clear (Data);
end if;
end Initialize;
--\f
-- The routines Get_Input_State and Get_Output_State are called by every
-- user-visible entry to Text_IO that requires a file argument to be open
-- for a specific mode. These routines check that the file has this state,
-- returning a pointer to the state if it is there, and raising the
-- appropriate exception if not. Both of these routines acquire the
-- file's lock.
--
function Get_Output_State (File : File_Type) return Access_Output_State is
Mode : Dio.File_Mode;
Result : Access_Output_State;
begin
Dio.Acquire (File);
-- Will wait until available, or return immediately if the file
-- is closed.
-- Dio.Mode can raise Status_Error if the file is not open
Mode := Dio.Mode (File);
if Mode = Dio.Closed then
raise Iof.Not_Open_Error;
end if;
Result := Oget (File);
if Result = null then
-- The file was opened by DIO but not by Text_IO.
-- (You see how this assumes that only Text_Io puts something
-- in the protocol state!)
raise Iof.Not_Open_Error;
end if;
if Mode /= Dio.Out_File then
raise Iof.Illegal_Operation_On_Infile;
end if;
return Result;
-- ... leaving file locked
exception
when others =>
Dio.Release (File);
raise;
end Get_Output_State;
--\f
function Get_Input_State (File : File_Type) return Access_Input_State is
Mode : Dio.File_Mode;
Result : Access_Input_State;
begin
Dio.Acquire (File);
-- Will wait until available, or return immediately if the file
-- is closed.
-- Dio.Mode can raise Status_Error if the file is not open
Mode := Dio.Mode (File);
if Mode = Dio.Closed then
raise Iof.Not_Open_Error;
end if;
Result := Iget (File);
if Result = null then
-- The file was opened by DIO but not by Text_IO.
-- (You see how this assumes that only Text_Io puts something
-- in the protocol state!)
raise Iof.Not_Open_Error;
end if;
if Mode /= Dio.In_File then
raise Iof.Illegal_Operation_On_Outfile;
end if;
return Result;
-- ... leaving file locked
exception
when others =>
Dio.Release (File);
raise;
end Get_Input_State;
--\f
-- The routine Get_File_State is called by routines that work with files
-- that are open for input or output. If the file is not open,
-- Status_Error is raised. Otherwise the mode of the file, along with the
-- corresponding Input_State or Output_State is returned. Status_Error is
-- raised if there is no file state in the descriptor.
--
-- The nature of operations that are either input or output makes it
-- unnecessary (or not productive) to lock the handle, so no semaphore
-- operations are performed.
procedure Get_File_State (File : File_Type;
Mode : out File_Mode;
In_State : out Access_Input_State;
Out_State : out Access_Output_State) is
Dio_Mode : Dio.File_Mode;
Local_In_State : Access_Input_State;
Local_Out_State : Access_Output_State;
begin
Dio_Mode := Dio.Mode (File);
-- ^ Can raise Status_Error
case Dio_Mode is
when Dio.Closed =>
raise Iof.Not_Open_Error;
when Dio.In_File =>
Local_In_State := Iget (File);
if Local_In_State = null then
raise Iof.Not_Open_Error;
end if;
Mode := In_File;
when Dio.Out_File =>
Local_Out_State := Oget (File);
if Local_Out_State = null then
raise Iof.Not_Open_Error;
end if;
Mode := Out_File;
when Dio.Inout_File =>
-- Can't be here if opened by Text_Io, therefore consider
-- file closed
raise Iof.Not_Open_Error;
end case;
-- We assign here to make sure both get a value (though only
-- one should ever be read by caller)
In_State := Local_In_State;
Out_State := Local_Out_State;
end Get_File_State;
--\f
procedure Allocate_State (File : File_Type; Mode : File_Mode) is
In_State : Access_Input_State;
Out_State : Access_Output_State;
begin
-- This routine is called with a file that is open as far as DIO is
-- concerned, but has no Text_IO state. The file is given the
-- appropriate state.
case Mode is
when In_File =>
-- Allocate an Input_State from the list of freed Input_States,
-- if possible.
if not Is_Empty (Freed_Input_States) then
In_State := First (Freed_Input_States);
Rest (Freed_Input_States);
else
In_State := new Input_State;
end if;
Initialize (File, In_State.all);
Iset (File, In_State);
when Out_File =>
-- Allocate an Output_State from the list of freed Output_States,
-- if possible.
if not Is_Empty (Freed_Output_States) then
Out_State := First (Freed_Output_States);
Rest (Freed_Output_States);
else
Out_State := new Output_State;
end if;
Initialize (File, Out_State.all);
Oset (File, Out_State);
end case;
end Allocate_State;
procedure Free_State (File : File_Type; Mode : File_Mode) is
In_State : Access_Input_State;
Out_State : Access_Output_State;
begin
case Mode is
when In_File =>
In_State := Iget (File);
-- Add In_State to the list of freed Input_States.
Freed_Input_States := Make (In_State, Freed_Input_States);
Iset (File, null);
when Out_File =>
Out_State := Oget (File);
-- Add Out_State to the list of freed Output_States.
Freed_Output_States := Make (Out_State, Freed_Output_States);
Oset (File, null);
end case;
end Free_State;
procedure Free_State (File : File_Type) is
In_State : Access_Input_State;
Out_State : Access_Output_State;
begin
case Dio.Mode (File) is
when Dio.In_File =>
Free_State (File, In_File);
when Dio.Out_File =>
Free_State (File, Out_File);
when Dio.Closed | Dio.Inout_File =>
-- Can't be here if opened by Text_Io, therefore consider
-- file closed
null;
end case;
end Free_State;
--\f
-----------------------------------------------------------------
-- Replacements for List_Generic:
-----------------------------------------------------------------
function Is_Empty (Head : Access_Input_State_List_Element) return Boolean is
begin
return Head = null;
end Is_Empty;
function First (Head : Access_Input_State_List_Element)
return Access_Input_State is
begin
return Head.Data;
end First;
procedure Rest (Head : in out Access_Input_State_List_Element) is
H : Access_Input_State_List_Element := Head;
begin
Head := Head.Link;
H.Link := Freed_Input_State_List_Elements;
Freed_Input_State_List_Elements := H;
end Rest;
function Make (New_Element : Access_Input_State;
Head : Access_Input_State_List_Element)
return Access_Input_State_List_Element is
begin
if Freed_Input_State_List_Elements /= null then
declare
N : Access_Input_State_List_Element :=
Freed_Input_State_List_Elements;
begin
Freed_Input_State_List_Elements := N.Link;
N.all := (Link => Head, Data => New_Element);
return N;
end;
else
return new Input_State_List_Element'
(Link => Head, Data => New_Element);
end if;
end Make;
function Is_Empty
(Head : Access_Output_State_List_Element) return Boolean is
begin
return Head = null;
end Is_Empty;
function First (Head : Access_Output_State_List_Element)
return Access_Output_State is
begin
return Head.Data;
end First;
procedure Rest (Head : in out Access_Output_State_List_Element) is
H : Access_Output_State_List_Element := Head;
begin
Head := Head.Link;
H.Link := Freed_Output_State_List_Elements;
Freed_Output_State_List_Elements := H;
end Rest;
function Make (New_Element : Access_Output_State;
Head : Access_Output_State_List_Element)
return Access_Output_State_List_Element is
begin
if Freed_Output_State_List_Elements /= null then
declare
N : Access_Output_State_List_Element :=
Freed_Output_State_List_Elements;
begin
Freed_Output_State_List_Elements := N.Link;
N.all := (Link => Head, Data => New_Element);
return N;
end;
else
return new Output_State_List_Element'
(Link => Head, Data => New_Element);
end if;
end Make;
--\f
-----------------------------------------------------------------
-- Routines to store and retrieve the address of the control
-- block in the Device_Independent_Io file descriptor.
-----------------------------------------------------------------
function As_Address is new Unchecked_Conversion
(Access_Input_State, System.Address);
function As_Access_Input_State is
new Unchecked_Conversion (System.Address, Access_Input_State);
procedure Iset (File : File_Type; Ais : Access_Input_State) is
begin
if Ais /= null then
Dio.Set (File, As_Address (Ais));
else
Dio.Set (File, System_Types.Null_Address);
end if;
end Iset;
function Iget (File : File_Type) return Access_Input_State is
A : System.Address;
begin
A := Dio.Get (File);
if A /= System_Types.Null_Address then
return As_Access_Input_State (A);
else
return null;
end if;
end Iget;
function As_Address is new Unchecked_Conversion
(Access_Output_State, System.Address);
function As_Access_Output_State is
new Unchecked_Conversion (System.Address, Access_Output_State);
procedure Oset (File : File_Type; Aos : Access_Output_State) is
begin
if Aos /= null then
Dio.Set (File, As_Address (Aos));
else
Dio.Set (File, System_Types.Null_Address);
end if;
end Oset;
function Oget (File : File_Type) return Access_Output_State is
A : System.Address;
begin
A := Dio.Get (File);
if A /= System_Types.Null_Address then
return As_Access_Output_State (A);
else
return null;
end if;
end Oget;
end State_Handling;