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

⟦7a52fdae1⟧ Ada Source

    Length: 12288 (0x3000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Direct_Io, seg_04ba61

Derivation

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

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

pragma Elaborate (File_Support);

package body Direct_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;
            when Inout_File =>
                return In_Out;
        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 := Inout_File;
                      Name : in String := "";
                      Form : in String := "") is
        Fmode : File_Support.File_Mode := Mode_Of (Mode);
    begin
--Stanford\x09\x09if elem_size > system.MAX_REC_SIZE then
--Stanford\x09\x09\x09raise use_error;
--Stanford\x09\x09end if;
        -- Upon entry/exit: file is unlocked for the following two calls
        File_Open (Name, File_Ptr (File), Fmode, True, Form, Direct, 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
--Stanford\x09\x09if elem_size > system.MAX_REC_SIZE then
--Stanford\x09\x09\x09raise use_error;
--Stanford\x09\x09end if;
        -- Upon entry/exit: file is unlocked for the following two calls
        File_Open (Name, File_Ptr (File), Fmode,
                   False, Form, Direct, Elem_Size);
        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 In_Out =>
                return Inout_File;
        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

    -- Upon entry/exit: file is locked
    --   -- This routine is called by the overloaded read() routines
    procedure Do_Read (File : in File_Type;
                       Item : out Element_Type;
                       From : in Positive_Count) is
        Actual : Integer;
    begin
        Reject_Null_File (File);
        if File.Mode = Output then
            raise Mode_Error;
        end if;
        Position_File (File.Fd, Integer (From), Elem_Size);
        Actual := Read (File.Fd, Item'Long_Address, Item'Size / Bits_Per_Byte);
        if Actual /= Item'Size / Bits_Per_Byte then
            File.Pagelength := Actual;
            raise End_Error;
        end if;
        File.Index := Natural (From + 1);
    end Do_Read;

    procedure Read (File : in File_Type;
                    Item : out Element_Type;
                    From : in Positive_Count) is
    begin
        Safe_Support.File_Lock (File_Ptr (File));
        Do_Read (File, Item, From);
        Safe_Support.File_Unlock (File_Ptr (File));
    exception
        when others =>
            Safe_Support.File_Unlock (File_Ptr (File));
            raise;
    end Read;

    procedure Read (File : in File_Type; Item : out Element_Type) is
    begin
        Safe_Support.File_Lock (File_Ptr (File));
        Reject_Null_File (File);
        Do_Read (File, Item, Positive_Count (File.Index));
        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;

    -- Upon entry/exit: file is locked
    --
    -- This routine is called by the overloaded write() routines
    procedure Do_Write (File : in File_Type;
                        Item : in Element_Type;
                        To : in Positive_Count) is
        This_Elem_Size : Integer := Item'Size / Bits_Per_Byte;
        Item_Addr : System.Long_Address;
    begin
        Reject_Null_File (File);
        if File.Mode = Input then
            raise Mode_Error;
        end if;
        Position_File (File.Fd, Integer (To), Elem_Size);
        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);
        elsif This_Elem_Size = Elem_Size then
            Item_Addr := Item'Long_Address;
        else
            raise Device_Error;  -- must be greater than MAX_REC_SIZE
        end if;
        Write (File.Fd, Item_Addr, Elem_Size);
        File.Index := Natural (To + 1);
    end Do_Write;

    procedure Write (File : in File_Type;
                     Item : in Element_Type;
                     To : in Positive_Count) is
    begin
        Safe_Support.File_Lock (File_Ptr (File));
        Do_Write (File, Item, To);
        Safe_Support.File_Unlock (File_Ptr (File));
    exception
        when others =>
            Safe_Support.File_Unlock (File_Ptr (File));
            raise;
    end Write;

    procedure Write (File : in File_Type; Item : in Element_Type) is
    begin
        Safe_Support.File_Lock (File_Ptr (File));
        Reject_Null_File (File);
        Do_Write (File, Item, Positive_Count (File.Index));
        Safe_Support.File_Unlock (File_Ptr (File));
    exception
        when others =>
            Safe_Support.File_Unlock (File_Ptr (File));
            raise;
    end Write;

    procedure Set_Index (File : in File_Type; To : in Positive_Count) is
    begin
        Safe_Support.File_Lock (File_Ptr (File));
        Reject_Null_File (File);
        Position_File (File.Fd, Integer (To), Elem_Size);
        File.Index := Natural (To);
        Safe_Support.File_Unlock (File_Ptr (File));
    exception
        when others =>
            Safe_Support.File_Unlock (File_Ptr (File));
            raise;
    end Set_Index;

    function Index (File : in File_Type) return Positive_Count is
    begin
        Reject_Null_File (File);
        return Positive_Count (File.Index);
    end Index;

    function Size (File : in File_Type) return Count is
        Cnt : Count;
    begin
        Safe_Support.File_Lock (File_Ptr (File));
        Reject_Null_File (File);
        Cnt := Count (File_Size (File.Fd, Elem_Size));
        Safe_Support.File_Unlock (File_Ptr (File));
        return Cnt;
    exception
        when others =>
            Safe_Support.File_Unlock (File_Ptr (File));
            raise;
    end Size;
    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;
        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;
--Stanford\x09if not element_type'constrained then
--Stanford\x09\x09if elem_size > system.max_rec_size or else elem_size <= 0 then
--Stanford\x09\x09\x09elem_size := system.max_rec_size;
--Stanford\x09\x09end if;
--Stanford\x09end if;
exception
    when Numeric_Error | Constraint_Error =>
        Elem_Size := System.Max_Rec_Size;
end Direct_Io;

    nblk1=b
    nid=0
    hdr6=16
        [0x00] rec0=28 rec1=00 rec2=01 rec3=01e
        [0x01] rec0=19 rec1=00 rec2=02 rec3=012
        [0x02] rec0=19 rec1=00 rec2=03 rec3=08e
        [0x03] rec0=1f rec1=00 rec2=04 rec3=03e
        [0x04] rec0=29 rec1=00 rec2=05 rec3=002
        [0x05] rec0=19 rec1=00 rec2=06 rec3=056
        [0x06] rec0=1d rec1=00 rec2=07 rec3=036
        [0x07] rec0=17 rec1=00 rec2=08 rec3=054
        [0x08] rec0=1e rec1=00 rec2=09 rec3=010
        [0x09] rec0=1f rec1=00 rec2=0a rec3=000
        [0x0a] rec0=1d rec1=00 rec2=0b rec3=000
    tail 0x21548d50086843b8e7229 0x42a00088462060003