DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦597a75b32⟧ Ada Source

    Length: 9216 (0x2400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Sequential_Io, seg_04ba70

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

with File_Support;
use File_Support;
with Safe_Support;
with System;
with A_Strings;
with Memory;
with Unchecked_Conversion;

package body Sequential_Io is

    pragma Suppress (Access_Check);
    pragma Suppress (Discriminant_Check);
    pragma Suppress (Index_Check);
    pragma Suppress (Length_Check);
    pragma Suppress (Range_Check);
    pragma Suppress (Division_Check);
    pragma Suppress (Elaboration_Check);

    Elem_Size : Integer;
    Bits_Per_Byte : constant := 8;

    function Mode_Of (Mode : File_Mode) return File_Support.File_Mode is
    begin
        case Mode is
            when In_File =>
                return Input;
            when Out_File =>
                return Output;
        end case;
    end Mode_Of;

    procedure Reject_Null_File (File : File_Type) is
    begin
        if File = null then
            raise Status_Error;
        end if;
    end Reject_Null_File;
    -- pragma inline(reject_null_file);

    -- file management

    -- No file locking. file can't be referenced until create() returns.
    procedure Create (File : in out File_Type;
                      Mode : in File_Mode := Out_File;
                      Name : in String := "";
                      Form : in String := "") is
        Fmode : File_Support.File_Mode := Mode_Of (Mode);
    begin
        -- Upon entry/exit: file is unlocked for the following two calls
        File_Open (Name, File_Ptr (File), Fmode, True,
                   Form, Sequential, Elem_Size);
        File_Support.Setup_Buffer (File_Ptr (File), Elem_Size);
    end Create;

    -- No file locking. file can't be referenced until open() returns.
    procedure Open (File : in out File_Type;
                    Mode : in File_Mode;
                    Name : in String;
                    Form : in String := "") is
        Fmode : File_Support.File_Mode := Mode_Of (Mode);
    begin
        -- Upon entry/exit: file is unlocked for the following two calls
        File_Open (Name, File_Ptr (File), Fmode, False, Form, Sequential);
        File_Support.Setup_Buffer (File_Ptr (File), Elem_Size);
    end Open;

    procedure Close (File : in out File_Type) is
    begin
        Reject_Null_File (File);
        Safe_Support.File_Lock (File_Ptr (File));
        File_Close (File_Ptr (File)); -- upon return, file is unlocked
        File := null;
    end Close;

    procedure Delete (File : in out File_Type) is
    begin
        Reject_Null_File (File);
        Safe_Support.File_Lock (File_Ptr (File));
        File_Delete (File_Ptr (File)); -- upon return, file is unlocked
        File := null;
    end Delete;

    procedure Reset (File : in out File_Type; Mode : in File_Mode) is
        Fmode : File_Support.File_Mode := Mode_Of (Mode);
    begin
        Safe_Support.File_Lock (File_Ptr (File));
        Reject_Null_File (File);
        File_Reset (File_Ptr (File), Fmode);
        Safe_Support.File_Unlock (File_Ptr (File));
    exception
        when others =>
            Safe_Support.File_Unlock (File_Ptr (File));
            raise;
    end Reset;

    procedure Reset (File : in out File_Type) is
    begin
        Safe_Support.File_Lock (File_Ptr (File));
        Reject_Null_File (File);
        File_Reset (File_Ptr (File), File.Mode);
        Safe_Support.File_Unlock (File_Ptr (File));
    exception
        when others =>
            Safe_Support.File_Unlock (File_Ptr (File));
            raise;
    end Reset;

    function Mode (File : in File_Type) return File_Mode is
    begin
        Reject_Null_File (File);
        case File.Mode is
            when Input =>
                return In_File;
            when Output =>
                return Out_File;
            when others =>
                null;
        end case;
    end Mode;

    function Name (File : in File_Type) return String is
        use A_Strings;
    begin
        Reject_Null_File (File);
        if File.Name = null then
            return "";
        else
            return File.Name.S;
        end if;
    end Name;

    function Form (File : in File_Type) return String is
        use A_Strings;
    begin
        Reject_Null_File (File);
        if File.Form = null then
            return "";
        end if;
        return File.Form.S;
    end Form;

    function Is_Open (File : in File_Type) return Boolean is
    begin
        return File /= null;
    end Is_Open;

    -- input and output operations

    procedure Read (File : in File_Type; Item : out Element_Type) is
        Actual, Desired : Integer;
    begin
        Safe_Support.File_Lock (File_Ptr (File));
        Reject_Null_File (File);
        if File.Mode = Output then
            raise Mode_Error;
        end if;
        Desired := Item'Size / Bits_Per_Byte;
        Actual := Read (File.Fd, Item'Long_Address, Desired);
        if Actual /= Item'Size / Bits_Per_Byte then
            File.Pagelength := Actual;
            raise End_Error;
        end if;
        if not Element_Type'Constrained then
            Skip_In_File (File.Fd, Elem_Size - Desired);
        end if;
        Safe_Support.File_Unlock (File_Ptr (File));
    exception
        when others =>
            Safe_Support.File_Unlock (File_Ptr (File));
            raise;
    end Read;

    procedure Copy (From, To : System.Long_Address; Bytes : Integer) is
        type Buffer is array (1 .. Bytes) of Character;
        type Acc_Buf is access Buffer;
        pragma Remote_Access (Acc_Buf);
        function To_Acc is new Unchecked_Conversion
                                  (System.Long_Address, Acc_Buf);
    begin
        To_Acc (To).all := To_Acc (From).all;
    end Copy;

    procedure Write (File : in File_Type; Item : in Element_Type) is
        This_Elem_Size : Integer := Item'Size / Bits_Per_Byte;
        Item_Addr : System.Long_Address;
    begin
        Safe_Support.File_Lock (File_Ptr (File));
        Reject_Null_File (File);
        if File.Mode = Input then
            raise Mode_Error;
        end if;
        if This_Elem_Size < Elem_Size then
            -- copy item into buffer, to fill out waste space.
            Item_Addr := File.Buffer.Elem'Long_Address;
            Copy (Item'Long_Address, Item_Addr, This_Elem_Size);
        else
            Item_Addr := Item'Long_Address;
        end if;
        Write (File.Fd, Item_Addr, Elem_Size);
        Safe_Support.File_Unlock (File_Ptr (File));
    exception
        when others =>
            Safe_Support.File_Unlock (File_Ptr (File));
            raise;
    end Write;

    function End_Of_File (File : in File_Type) return Boolean is
        Result : Boolean;
    begin
        Safe_Support.File_Lock (File_Ptr (File));
        Reject_Null_File (File);
        if File.Mode = Output then
            raise Mode_Error;
        end if;
        -- check for end of file
        Result := File_Eof (File_Ptr (File));
        Safe_Support.File_Unlock (File_Ptr (File));
        return Result;
    exception
        when others =>
            Safe_Support.File_Unlock (File_Ptr (File));
            raise;
    end End_Of_File;

begin
    Elem_Size := Element_Type'Size / Bits_Per_Byte;
    if not Element_Type'Constrained then
        if Elem_Size > System.Max_Rec_Size or else Elem_Size <= 0 then
            Elem_Size := System.Max_Rec_Size;
        end if;
    end if;
exception
    when Numeric_Error | Constraint_Error =>
        Elem_Size := System.Max_Rec_Size;
end Sequential_Io;

    nblk1=8
    nid=0
    hdr6=10
        [0x00] rec0=27 rec1=00 rec2=01 rec3=046
        [0x01] rec0=18 rec1=00 rec2=02 rec3=042
        [0x02] rec0=1a rec1=00 rec2=03 rec3=058
        [0x03] rec0=22 rec1=00 rec2=04 rec3=01c
        [0x04] rec0=24 rec1=00 rec2=05 rec3=05a
        [0x05] rec0=1a rec1=00 rec2=06 rec3=064
        [0x06] rec0=1c rec1=00 rec2=07 rec3=02e
        [0x07] rec0=18 rec1=00 rec2=08 rec3=000
    tail 0x21750c0fe86843ba18fc3 0x42a00088462060003