|
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: 36973 (0x906d)
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 Os2000_Io;
with Buffering;
with Primitive_Io;
with Io_Exceptions;
with Io_Exception_Flavors;
with Unchecked_Deallocation;
with Unchecked_Conversion;
package body Os_Dependent_Io is
package Dio renames Device_Independent_Io;
function "=" (X, Y : File_Kind) return Boolean renames Dio."=";
function "=" (X, Y : File_Mode) return Boolean renames Dio."=";
function "=" (X, Y : Os2000_Io.Path_Number) return Boolean
renames Os2000_Io."=";
subtype Byte is System_Types.Byte;
function "=" (X, Y : Byte) return Boolean renames System_Types."=";
subtype User_Kind is File_Kind range Dio.Normal .. Dio.Temporary;
subtype Standard_Kind is File_Kind
range Dio.Standard_Input .. Dio.Standard_Error;
subtype String_Ptr is System_Types.Acc_Str;
function "=" (X, Y : String_Ptr) return Boolean renames System_Types."=";
Ptr_To_Empty : constant String_Ptr := new String'("");
function Cnvt is new Unchecked_Conversion
(Source => String_Ptr, Target => Integer);
type A is array (1 .. 6) of Integer;
type T is access A;
function Revt is new Unchecked_Conversion (Source => Integer, Target => T);
function Convert_Control_Block_To_Address is
new Unchecked_Conversion (Source => Os_Control_Block,
Target => System.Address);
function Convert_Address_To_Control_Block is
new Unchecked_Conversion (Source => System.Address,
Target => Os_Control_Block);
package User is
type Id is private;
function Get_Current_Key return Id;
pragma Suppress (Elaboration_Check, Get_Current_Key);
function Not_Current (Key : Id) return Boolean;
pragma Suppress (Elaboration_Check, Not_Current);
function Less_Than (X, Y : Id) return Boolean;
pragma Suppress (Elaboration_Check, Less_Than);
function "<" (X, Y : Id) return Boolean renames Less_Than;
function Image (Key : Id) return String;
pragma Suppress (Elaboration_Check, Image);
private
type Id is
record
Value1 : Integer;
Value2 : Integer;
Value3 : Integer;
end record;
end User;
function "=" (X, Y : User.Id) return Boolean renames User."=";
type User_Node;
type User_Link is access User_Node;
type User_Node is
record
Key : User.Id;
Path : Os2000_Io.Path_Number;
Next : User_Link;
end record;
type Control_Block (For_Kind : File_Kind := Device_Independent_Io.Normal) is
record
Path : Os2000_Io.Path_Number;
Is_Interactive : Boolean;
Last_Key : User.Id;
Position : Os2000_Io.File_Position;
User_List : User_Link;
case For_Kind is
when User_Kind =>
Name : String_Ptr; -- external name, null terminated
Form : String_Ptr; -- external form
Mode_Bits : Natural;
when Standard_Kind =>
null;
end case;
end record;
-- type Io_Operation is (Create_Op, Open_Op, Close_Op, Delete_Op,
-- Read_Op, Readln_Op, Write_Op, Seek_Op,
-- Get_Pos_Op, Eof_Op, Size_Op, Get_Option_Op);
type Io_Operation is new Integer;
Create_Op : constant Io_Operation := 0;
Open_Op : constant Io_Operation := 1;
Close_Op : constant Io_Operation := 2;
Delete_Op : constant Io_Operation := 3;
Read_Op : constant Io_Operation := 4;
Readln_Op : constant Io_Operation := 5;
Write_Op : constant Io_Operation := 6;
Seek_Op : constant Io_Operation := 7;
Get_Pos_Op : constant Io_Operation := 8;
Eof_Op : constant Io_Operation := 9;
Size_Op : constant Io_Operation := 10;
Get_Option_Op : constant Io_Operation := 11;
subtype Access_Op is Io_Operation range Create_Op .. Open_Op;
Null_Path : constant Os2000_Io.Path_Number := Os2000_Io.Standard_Error;
Interactive_Buffer_Size : constant Natural := 400;
-- large enough to hold max size enum literal plus reasonable formatting
package Unique_Temp_Name is
function Get return String;
pragma Suppress (Elaboration_Check, Get);
end Unique_Temp_Name;
procedure Convert_Error (Status : Os2000_Io.Stratus; In_Op : Io_Operation);
pragma Suppress (Elaboration_Check, Convert_Error);
package Form_Handling is
type Option is (Non_Sharable, Sharable);
-- The only values currently supported for the Form parameter are:
--
-- NON_SHARABLE - Causes the file to be accessed in single-user
-- mode; default for Out and Inout mode.
-- SHARABLE - Causes the file to be accessed for sharable
-- use; default for In mode.
function Sharable (Form : String; Mode : Dio.File_Mode) return Boolean;
function Default_Image
(Form : String; Mode_Bits : Natural) return String;
end Form_Handling;
procedure Free is new Unchecked_Deallocation
(Control_Block, Os_Control_Block);
procedure Free is new Unchecked_Deallocation (User_Node, User_Link);
procedure Free is new Unchecked_Deallocation (String, String_Ptr);
-- procedure Trace
-- (S : String;
-- Absorb_Output : Boolean := Primitive_Io.Global_Absorb_Output)
-- renames Primitive_Io.Put_Line;
Delete_Temp_Files : Boolean renames Primitive_Io.Global_Absorb_Output;
package body User is separate;
package body Unique_Temp_Name is separate;
package body Form_Handling is separate;
procedure Convert_Error (Status : Os2000_Io.Stratus;
In_Op : Io_Operation) is separate;
procedure Release (Tree : in out User_Link) is
Next : User_Link := Tree;
Temp : User_Link;
begin
while Next /= null loop
Temp := Next.Next;
Free (Next);
Next := Temp;
end loop;
end Release;
procedure Release (Cb : in out Os_Control_Block) is
begin
if Cb /= null then
-- Trace ("Odi.Release - release user tree");
Release (Cb.User_List);
case Cb.For_Kind is
when User_Kind =>
-- Trace ("Odi.Release - free name");
Free (Cb.Name);
if Cb.Form /= Ptr_To_Empty then
-- Trace ("Odi.Release - free form");
Free (Cb.Form);
end if;
when Standard_Kind =>
null;
end case;
Free (Cb);
end if;
end Release;
function Compute_Mode_Bits
(Mode : File_Mode; Form : String) return Natural is
Bits : Natural;
begin
case Mode is
when Dio.Closed =>
return 0;
when Dio.In_File =>
Bits := Os2000_Io.Read_Mode;
when Dio.Inout_File =>
Bits := Os2000_Io.Update_Mode;
when Dio.Out_File =>
Bits := Os2000_Io.Write_Mode;
end case;
if Form_Handling.Sharable (Form, Mode) then
return Bits;
else
-- Due to record locking in OS9 2.1, an attempts
-- to use a file when another process has it open
-- for write will hang; so making it Single_User will
-- cause Use_Error when the second process opens it.
return Bits + Os2000_Io.Single_User;
end if;
end Compute_Mode_Bits;
function Compute_Attribute_Bits
(Mode : File_Mode; Form : String) return Natural is
begin
return Os2000_Io.Updatable + Os2000_Io.Public_Updatable;
end Compute_Attribute_Bits;
function Initial_Control_Block
(Name : String;
Form : String;
Kind : File_Kind;
Mode_Bits : Natural) return Os_Control_Block is
New_Cb : Os_Control_Block;
My_Key : User.Id := User.Get_Current_Key;
begin
-- Trace ("Odi.Initial_Control_Block");
New_Cb := new Control_Block (For_Kind => Kind);
New_Cb.Path := Null_Path;
New_Cb.Last_Key := My_Key;
New_Cb.User_List :=
new User_Node'(Key => My_Key, Path => Null_Path, Next => null);
New_Cb.Position := Os2000_Io.Null_Position;
case Kind is
when User_Kind =>
-- Trace ("Odi.Initial_Control_Block - allocating name");
New_Cb.Name := new String'(Name & Ascii.Nul);
if Form'Length > 0 then
New_Cb.Form := new String'(Form);
else
New_Cb.Form := Ptr_To_Empty;
end if;
New_Cb.Mode_Bits := Mode_Bits;
when Dio.Standard_Input =>
New_Cb.Path := Os2000_Io.Standard_In;
when Dio.Standard_Output =>
New_Cb.Path := Os2000_Io.Standard_Out;
when Dio.Standard_Error =>
New_Cb.Path := Os2000_Io.Standard_Error;
end case;
-- Trace ("Odi.Initial_Control_Block - successful");
return New_Cb;
exception
when Storage_Error =>
-- Trace ("Odi.Initial_Control_Block - Storage_Error");
Release (New_Cb);
raise Storage_Error;
end Initial_Control_Block;
function Strip_Nul (S : String) return String is
begin
return S (S'First .. S'Last - 1);
end Strip_Nul;
procedure Set_Initial_Path (Ctrl : Os_Control_Block;
Path : Os2000_Io.Path_Number) is
begin
Ctrl.Path := Path;
Ctrl.User_List.Path := Path;
end Set_Initial_Path;
procedure Set_Interactive (Ctrl : Os_Control_Block) is
Option_Buffer : Byte_String (1 .. 128);
Result : Os2000_Io.Stratus;
Class_Index : constant Natural := 1;
-- device class is first byte of option table
Scf_Class : constant Byte := 0; -- sequential character
Rbf_Class : constant Byte := 1; -- random block
Pip_Class : constant Byte := 2; -- pipes
Sbf_Class : constant Byte := 3; -- sequential block
Net_Class : constant Byte := 4; -- network
begin
-- Trace ("Odi.Set_Interactive");
Os2000_Io.Get_Options (Ctrl.Path, Option_Buffer (1)'Address, Result);
if Result = Os2000_Io.E_Success then
case Option_Buffer (Class_Index) is
when Scf_Class | Pip_Class =>
Ctrl.Is_Interactive := True;
when Rbf_Class | Sbf_Class | Net_Class =>
Ctrl.Is_Interactive := False;
when others =>
-- unknown device type; best to treat as non-interactive
Ctrl.Is_Interactive := False;
end case;
else
Convert_Error (Result, In_Op => Get_Option_Op);
end if;
end Set_Interactive;
procedure Access_File (Name : String;
Form : String;
Mode : File_Mode;
Kind : File_Kind;
For_Op : Access_Op;
Ctrl : out Os_Control_Block) is
New_Cb : Os_Control_Block;
New_Path : Os2000_Io.Path_Number;
Result : Os2000_Io.Stratus;
begin
-- Trace ("Odi.Access_File, name is " & Name);
New_Cb := Initial_Control_Block
(Name => Name,
Form => Form,
Kind => Kind,
Mode_Bits => Compute_Mode_Bits (Mode, Form));
case For_Op is
when Create_Op =>
Os2000_Io.Create
(Name => New_Cb.Name.all (New_Cb.Name.all'First)'Address,
Mode => New_Cb.Mode_Bits,
Attributes => Compute_Attribute_Bits (Mode, Form),
New_Path => New_Path,
Result => Result);
when Open_Op =>
Os2000_Io.Open
(Name => New_Cb.Name.all (New_Cb.Name.all'First)'Address,
Mode => New_Cb.Mode_Bits,
New_Path => New_Path,
Result => Result);
end case;
if Result = Os2000_Io.E_Success then
Set_Initial_Path (New_Cb, New_Path);
Set_Interactive (New_Cb);
Ctrl := New_Cb;
-- Trace ("Odi.Access_File - successful");
else
Release (New_Cb);
Convert_Error (Result, In_Op => For_Op);
-- ^ will raise in Io_Exception
end if;
end Access_File;
procedure Access_File_For_User (Ctrl : Os_Control_Block;
New_Key : User.Id;
User_Path : out Os2000_Io.Path_Number) is
New_Path : Os2000_Io.Path_Number;
Result : Os2000_Io.Stratus;
function To_Int is new Unchecked_Conversion
(Os2000_Io.Path_Number, Integer);
begin
-- Trace ("Odi.Access_File_For_User");
case Ctrl.For_Kind is
when User_Kind =>
Os2000_Io.Open (Name =>
Ctrl.Name.all (Ctrl.Name.all'First)'Address,
Mode => Ctrl.Mode_Bits,
New_Path => New_Path,
Result => Result);
if Result /= Os2000_Io.E_Success then
Convert_Error (Result, In_Op => Open_Op);
-- ^ will raise in Io_Exception
end if;
-- Trace (" Opened file " & Strip_Nul (Ctrl.Name.all));
when Dio.Standard_Input =>
New_Path := Os2000_Io.Standard_In;
when Dio.Standard_Output =>
New_Path := Os2000_Io.Standard_Out;
when Dio.Standard_Error =>
New_Path := Os2000_Io.Standard_Error;
end case;
Ctrl.User_List := new User_Node'(Key => New_Key,
Path => New_Path,
Next => Ctrl.User_List);
-- Trace (" New path is " & Integer'Image (To_Int (New_Path)));
User_Path := New_Path;
end Access_File_For_User;
procedure Open (File : in out File_Type;
Ctrl : in out Os_Control_Block;
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 := Device_Independent_Io.Unknown) is
Result : Os2000_Io.Stratus;
begin
-- Trace ("Odi.Open, kind is " & File_Kind'Image (Kind));
case Kind is
when Dio.Normal =>
Access_File (Name, Form, Mode, Kind, Open_Op, Ctrl);
Dio.Set (File, Buffering.Allocate (Recommended_Buffer_Size));
Actual_Buffer_Size := Recommended_Buffer_Size;
if (Mode = Device_Independent_Io.Out_File) and then
Device_Independent_Io."="
(Client, Device_Independent_Io.Text_Io) then
-- Set file size to zero.
Os2000_Io.Set_File_Size
(Path => Ctrl.Path, New_Size => 0, Result => Result);
if Result /= Os2000_Io.E_Success then
Convert_Error (Status => Result, In_Op => Open_Op);
-- Will raise Constraint_Error or some flavor
-- of Io_Exceptions.
end if;
end if;
when Dio.Temporary =>
-- temporary files must be created, not opened
raise Io_Exception_Flavors.Unsupported_Error;
when Dio.Standard_Input =>
Ctrl := Initial_Control_Block
(Name, Form, Dio.Standard_Input, 0);
Set_Initial_Path (Ctrl, Os2000_Io.Standard_In);
Set_Interactive (Ctrl);
Dio.Set (File, Buffering.Allocate (Interactive_Buffer_Size));
Actual_Buffer_Size := Interactive_Buffer_Size;
when Dio.Standard_Output | Dio.Standard_Error =>
raise Io_Exception_Flavors.Unsupported_Error;
-- Standard_Output/_Error must be created, not opened
end case;
end Open;
procedure Create (File : in out File_Type;
Ctrl : in out Os_Control_Block;
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
-- Trace ("Odi.Create, kind is " & File_Kind'Image (Kind));
case Kind is
when Dio.Normal =>
Access_File (Name, Form, Mode, Kind, Create_Op, Ctrl);
Dio.Set (File, Buffering.Allocate (Recommended_Buffer_Size));
Actual_Buffer_Size := Recommended_Buffer_Size;
when Dio.Temporary =>
loop
begin
Access_File (Unique_Temp_Name.Get, Form,
Mode, Kind, Create_Op, Ctrl);
exit;
exception
when Io_Exceptions.Name_Error |
Io_Exceptions.Use_Error =>
null;
when others =>
Primitive_Io.Global_Absorb_Output := False;
-- Trace
-- ("Odi.Create temporary - unexpected exception",
-- Absorb_Output => False);
raise;
end;
end loop;
Dio.Set (File, Buffering.Allocate (Recommended_Buffer_Size));
Actual_Buffer_Size := Recommended_Buffer_Size;
when Dio.Standard_Input =>
raise Io_Exception_Flavors.Unsupported_Error;
-- Standard_Input must be opened, not created
when Dio.Standard_Output | Dio.Standard_Error =>
Ctrl := Initial_Control_Block (Name, Form, Kind, 0);
if Kind = Dio.Standard_Output then
Set_Initial_Path (Ctrl, Os2000_Io.Standard_Out);
else
Set_Initial_Path (Ctrl, Os2000_Io.Standard_Error);
end if;
Ctrl.Is_Interactive := True;
-- Since standard files are not explicitly closed, it is
-- necessary to treat as interactive in order to flush.
Dio.Set (File, Buffering.Allocate (Interactive_Buffer_Size));
Actual_Buffer_Size := Interactive_Buffer_Size;
end case;
-- exception
-- when others =>
-- Trace ("Odi.Create - got exception");
-- raise;
end Create;
function Current_Position
(Path : Os2000_Io.Path_Number; Is_Interactive : Boolean)
return Os2000_Io.File_Position is
Result : Os2000_Io.Stratus;
Position : Os2000_Io.File_Position;
begin
if not Is_Interactive then
Os2000_Io.Current_Position (Path, Position, Result);
if Result = Os2000_Io.E_Success then
return Position;
else
Convert_Error (Result, In_Op => Get_Pos_Op);
end if;
else
return 1;
end if;
end Current_Position;
procedure Set_Position (Path : Os2000_Io.Path_Number;
To : Os2000_Io.File_Position) is
Result : Os2000_Io.Stratus;
begin
Os2000_Io.Seek (Path => Path,
Position => Natural (To),
Result => Result);
if Result /= Os2000_Io.E_Success then
Convert_Error (Result, In_Op => Seek_Op);
end if;
end Set_Position;
procedure Check_And_Update_User_Data (Ctrl : Os_Control_Block) is
begin
if User.Not_Current (Ctrl.Last_Key) then
-- Trace ("User_Data not current");
declare
Current_Key : User.Id := User.Get_Current_Key;
Next_User : User_Link := Ctrl.User_List;
New_Path : Os2000_Io.Path_Number;
begin
while Next_User /= null and then
Next_User.Key /= Current_Key loop
Next_User := Next_User.Next;
end loop;
if Next_User /= null then
-- Trace (" Found user data on list");
New_Path := Next_User.Path;
else
-- Trace (" Did not find user data on list");
-- Have to open the file for this user.
Access_File_For_User (Ctrl, Current_Key, New_Path);
end if;
-- Trace (" Setting new position " &
-- Integer'Image (Integer (Ctrl.Position)));
Set_Position (New_Path, Ctrl.Position);
Ctrl.Path := New_Path;
Ctrl.Last_Key := Current_Key;
end;
end if;
end Check_And_Update_User_Data;
procedure Read (File : in File_Type;
Ctrl : in Os_Control_Block;
Item : in out Byte_String;
Count : out Natural;
Line_Terminator_Detected : out Boolean;
Line_Last_Data_Index : out Natural;
Line_Terminator_Present : out Boolean) is
Bytes_Read : Natural;
Result : Os2000_Io.Stratus;
begin
-- Trace ("Odi.Read");
Check_And_Update_User_Data (Ctrl);
if Ctrl.Is_Interactive then
Os2000_Io.Readln (Path => Ctrl.Path,
Count => Item'Length,
Buffer => Item (Item'First)'Address,
Bytes_Read => Bytes_Read,
Result => Result);
Line_Terminator_Detected := True;
Line_Terminator_Present := True;
Line_Last_Data_Index := Item'First + Bytes_Read - 1;
else
Os2000_Io.Read (Path => Ctrl.Path,
Count => Item'Length,
Buffer => Item (Item'First)'Address,
Bytes_Read => Bytes_Read,
Result => Result);
Line_Terminator_Detected := False;
Line_Last_Data_Index := Item'First + Bytes_Read - 1;
Line_Terminator_Present := False;
end if;
if Result = Os2000_Io.E_Success then
Ctrl.Position := Current_Position (Ctrl.Path, Ctrl.Is_Interactive);
Count := Bytes_Read;
elsif Ctrl.Is_Interactive then
Convert_Error (Result, In_Op => Readln_Op);
else
Convert_Error (Result, In_Op => Read_Op);
end if;
end Read;
procedure Write (File : in File_Type;
Ctrl : in Os_Control_Block;
Item : in Byte_String;
Line_Terminator_Present : in Boolean) is
Bytes_Written : Natural;
Result : Os2000_Io.Stratus;
-- Data : String (1 .. Item'Length);
Indx : Natural := 1;
begin
if Item'Length <= 0 then
-- Trace ("Odi.Write zero length byte string");
return;
end if;
-- for J in Item'Range loop
-- Trace ("Odi.Write item is " & Integer'Image (Integer (Item (J))));
-- Data (Indx) := Character'Val (Integer (Item (J)));
-- Indx := Indx + 1;
-- end loop;
-- Trace ("Odi.Write " & Data);
Check_And_Update_User_Data (Ctrl);
Os2000_Io.Write (Path => Ctrl.Path,
Count => Item'Length,
Buffer => Item (Item'First)'Address,
Bytes_Written => Bytes_Written,
Result => Result);
if Result /= Os2000_Io.E_Success then
Convert_Error (Result, In_Op => Write_Op);
end if;
if Bytes_Written /= Item'Length then
raise Io_Exceptions.Device_Error;
end if;
-- Trace ("Odi.Write - wrote " & Data);
Ctrl.Position := Current_Position (Ctrl.Path, Ctrl.Is_Interactive);
end Write;
procedure Read_Bytes (Ctrl : in Os_Control_Block;
Bytes_Addr : System.Address;
Byte_Count : Natural;
Bytes_Read : out Natural) is
Result : Os2000_Io.Stratus;
begin
-- Trace ("Odi.Read_Bytes");
Check_And_Update_User_Data (Ctrl);
Os2000_Io.Read (Path => Ctrl.Path,
Count => Byte_Count,
Buffer => Bytes_Addr,
Bytes_Read => Bytes_Read,
Result => Result);
if Result = Os2000_Io.E_Success then
Ctrl.Position := Current_Position (Ctrl.Path, Ctrl.Is_Interactive);
else
Convert_Error (Result, In_Op => Read_Op);
end if;
end Read_Bytes;
procedure Write_Bytes (Ctrl : Os_Control_Block;
Bytes_Addr : System.Address;
Byte_Count : Natural) is
Result : Os2000_Io.Stratus;
Bytes_Written : Natural;
begin
if Byte_Count <= 0 then
-- Trace ("Odi.Write_Bytes - zero bytes to write");
return;
end if;
-- Trace ("Odi.Write_Bytes");
Check_And_Update_User_Data (Ctrl);
Os2000_Io.Write (Path => Ctrl.Path,
Count => Byte_Count,
Buffer => Bytes_Addr,
Bytes_Written => Bytes_Written,
Result => Result);
if Result /= Os2000_Io.E_Success then
Convert_Error (Result, In_Op => Write_Op);
elsif Bytes_Written /= Byte_Count then
raise Io_Exceptions.Device_Error;
else
Ctrl.Position := Current_Position (Ctrl.Path, Ctrl.Is_Interactive);
end if;
end Write_Bytes;
function End_Of_File (File : in File_Type;
Ctrl : in Os_Control_Block) return Boolean is
At_End : Boolean;
Result : Os2000_Io.Stratus;
begin
--Trace ("Odi.End_Of_File");
Check_And_Update_User_Data (Ctrl);
Os2000_Io.End_Of_File
(Path => Ctrl.Path, At_End => At_End, Result => Result);
if Result = Os2000_Io.E_Success or else Result = Os2000_Io.E_Eof then
return At_End;
else
Convert_Error (Result, In_Op => Eof_Op);
end if;
end End_Of_File;
procedure Close (File : in out File_Type;
Ctrl : in out Os_Control_Block) is
Result : Os2000_Io.Stratus;
begin
-- Trace ("Odi.Close");
if Ctrl.For_Kind = Dio.Temporary and then Delete_Temp_Files then
Delete (File, Ctrl);
else
Check_And_Update_User_Data (Ctrl);
Os2000_Io.Close (Path => Ctrl.Path, Result => Result);
if Result = Os2000_Io.E_Success then
Release (Ctrl);
else
Convert_Error (Result, In_Op => Close_Op);
end if;
end if;
end Close;
procedure Reset (File : in out File_Type;
Ctrl : in out Os_Control_Block;
Mode : in File_Mode) is
Current_Mode : File_Mode := Dio.Mode (File, Already_Locked => True);
Result : Os2000_Io.Stratus;
New_Ctrl : Os_Control_Block;
begin
-- Trace ("Odi.Reset");
Check_And_Update_User_Data (Ctrl);
if Mode = Current_Mode then
-- Trace ("Odi.Reset same mode");
Os2000_Io.Seek (Path => Ctrl.Path,
Position => Os2000_Io.Null_Position,
Result => Result);
if Result /= Os2000_Io.E_Success then
Convert_Error (Result, In_Op => Seek_Op);
end if;
elsif Ctrl.For_Kind in User_Kind then
-- Trace ("Odi.Reset new mode");
Os2000_Io.Close (Path => Ctrl.Path, Result => Result);
if Result /= Os2000_Io.E_Success then
Convert_Error (Result, In_Op => Close_Op);
end if;
Access_File (Name => Strip_Nul (Ctrl.Name.all),
Form => Ctrl.Form.all,
Mode => Mode,
Kind => Ctrl.For_Kind,
For_Op => Open_Op,
Ctrl => New_Ctrl);
Release (Ctrl);
Ctrl := New_Ctrl;
-- if Mode = Dio.Out_File and then not Ctrl.Is_Interactive then
-- -- Trace ("Setting file size to 0");
-- Os2000_Io.Set_File_Size (Ctrl.Path, 0, Result);
--
-- if Result /= Os2000_Io.E_Success then
-- Convert_Error (Result, In_Op => Size_Op);
-- end if;
-- end if;
else -- can't change mode for standard_kinds
raise Io_Exception_Flavors.Reset_Error;
end if;
Ctrl.Position := Current_Position (Ctrl.Path, Ctrl.Is_Interactive);
end Reset;
procedure Save (File : in File_Type;
Ctrl : in Os_Control_Block;
Immediate_Effect : in Boolean := True) is
begin
-- Trace ("Odi.Save");
Check_And_Update_User_Data (Ctrl);
null; -- nothing to do???
end Save;
procedure Delete (File : in out File_Type;
Ctrl : in out Os_Control_Block) is
Close_Result, Delete_Result : Os2000_Io.Stratus;
begin
-- Trace ("Odi.Delete");
Check_And_Update_User_Data (Ctrl);
case Ctrl.For_Kind is
when User_Kind =>
Os2000_Io.Close (Path => Ctrl.Path, Result => Close_Result);
-- How should the paths for other tasks be reclaimed???
Os2000_Io.Delete (Name => Ctrl.Name (Ctrl.Name'First)'Address,
Result => Delete_Result);
if Close_Result = Os2000_Io.E_Success and then
Delete_Result = Os2000_Io.E_Success then
Release (Ctrl);
elsif Delete_Result /= Os2000_Io.E_Success then
Convert_Error (Delete_Result, In_Op => Delete_Op);
end if;
when Standard_Kind =>
raise Io_Exceptions.Use_Error;
end case;
end Delete;
function Name (File : in File_Type;
Ctrl : in Os_Control_Block) return String is
begin
-- Trace ("Odi.Name");
case Ctrl.For_Kind is
when Dio.Normal | Dio.Temporary =>
return Strip_Nul (Ctrl.Name.all);
when Dio.Standard_Input | Dio.Standard_Output |
Dio.Standard_Error =>
-- OS9 provides no uniform way of obtaining a string
-- name for the standard paths
raise Io_Exception_Flavors.Unsupported_Error;
end case;
end Name;
function Form (File : in File_Type;
Ctrl : in Os_Control_Block) return String is
begin
-- Trace ("Odi.Form");
case Ctrl.For_Kind is
when Dio.Normal | Dio.Temporary =>
return Form_Handling.Default_Image
(Ctrl.Form.all, Ctrl.Mode_Bits);
when Dio.Standard_Input | Dio.Standard_Output |
Dio.Standard_Error =>
return "";
end case;
end Form;
function Is_Interactive (File : in File_Type;
Ctrl : in Os_Control_Block) return Boolean is
begin
-- Trace ("Odi.Is_Interactive " & Boolean'Image (Ctrl.Is_Interactive));
return Ctrl.Is_Interactive;
end Is_Interactive;
function Size (Ctrl : Os_Control_Block) return Byte_Count is
File_Size : Natural;
Result : Os2000_Io.Stratus;
begin
-- Trace ("Odi.Size");
Check_And_Update_User_Data (Ctrl);
Os2000_Io.File_Size
(Path => Ctrl.Path, Size => File_Size, Result => Result);
if Result = Os2000_Io.E_Success then
return Byte_Count (File_Size);
else
Convert_Error (Result, In_Op => Size_Op);
end if;
end Size;
function Is_Empty (File : in File_Type;
Ctrl : in Os_Control_Block) return Boolean is
begin
-- Trace ("Odi.Is_Empty");
return Size (Ctrl) = 0;
end Is_Empty;
function Index (Ctrl : Os_Control_Block) return Byte_Index is
File_Index : Natural;
begin
-- Trace ("Odi.Index");
Check_And_Update_User_Data (Ctrl);
-- when Check_And_Update_User_Data sets postion for the user, then
-- can just return Ctrl.Position; however, for now
File_Index := Current_Position (Ctrl.Path, Ctrl.Is_Interactive);
return Byte_Index (File_Index);
end Index;
procedure Set_Index (Ctrl : Os_Control_Block; To : Byte_Index) is
begin
-- Trace ("Odi.Set_Index");
Check_And_Update_User_Data (Ctrl);
Set_Position (Ctrl.Path, Os2000_Io.File_Position (To));
end Set_Index;
function Identical_File (File1 : in File_Type;
Ctrl1 : in Os_Control_Block;
File2 : in File_Type;
Ctrl2 : in Os_Control_Block) return Boolean is
begin
-- Trace ("Odi.Identical_File");
if Ctrl1.For_Kind = Ctrl2.For_Kind then
case Ctrl1.For_Kind is
when User_Kind =>
return Ctrl1.Name.all = Ctrl2.Name.all;
when Standard_Kind =>
return Ctrl1.Path = Ctrl2.Path;
end case;
else
return False;
end if;
end Identical_File;
function Address_For_Control
(Ctrl : Os_Control_Block) return System.Address is
begin
return Convert_Control_Block_To_Address (Ctrl);
end Address_For_Control;
function Control_From_Address
(Addr : System.Address) return Os_Control_Block is
begin
return Convert_Address_To_Control_Block (Addr);
end Control_From_Address;
end Os_Dependent_Io;