DataMuseum.dk

top - metrics - download

    Length: 5716 (0x1654)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Tape_Specific;

separate (Tar)
package body Block_Buffer is

    procedure Do_Byte_Swap (Buffer : in out Buffer_Type) is
        procedure Do_Byte_Swap (Buffer : in out System.Byte_String) is
            Temp : System.Byte;
        begin
            for I in 1 .. Integer (Buffer'Length) / 2 loop
                Temp := Buffer (Buffer'First + 2 * (I - 1));
                Buffer (Buffer'First + 2 * (I - 1)) :=
                   Buffer (Buffer'First + 2 * (I - 1) + 1);
                Buffer (Buffer'First + 2 * (I - 1) + 1) := Temp;
            end loop;
        end Do_Byte_Swap;
    begin
        if Buffer.Swap then
            Do_Byte_Swap (Buffer.Data (1 .. Buffer.Count));
        end if;
    end Do_Byte_Swap;

    function Block_Size (Record_Size, Records_Per_Block : Positive)
                        return Tape_Specific.Byte_Range is
        Max : constant Positive := Max_Block_Size / Record_Size;
    begin
        if Max >= Records_Per_Block then
            return Record_Size * Records_Per_Block;
        else
            Put_Line ("Maximum block size is" &
                      Positive'Image (Max_Block_Size) & " bytes.");
            Put_Line ("Records_Per_Block => " & Positive'Image (Max) & ".");
            return Record_Size * Max;
        end if;
    end Block_Size;

    procedure Open (Buffer : in out Buffer_Type;
                    Mode : Dio.File_Mode;
                    Name : String;
                    Record_Size : Positive;
                    Records_Per_Block : Positive;
                    Swap_Bytes : Boolean) is
    begin
        case Mode is
            when Dio.In_File =>
                Dio.Open (Buffer.File, Mode, Name);
            when Dio.Out_File =>
                Open_Out_File (Buffer.File, Name);
        end case;
        Buffer.Block := Block_Size (Record_Size, Records_Per_Block);
        Buffer.Swap := Swap_Bytes;
        Buffer.Count := 0;
        begin
            Tape_Specific.Set_Block_Size (Buffer.File, Buffer.Block);
        exception
            when others =>
                null;
        end;
    end Open;

    procedure Flush (Buffer : in out Buffer_Type) is
    begin
        if Buffer.Count > 0 then
            Do_Byte_Swap (Buffer);
            for I in Buffer.Count + 1 .. Buffer.Block loop
                Buffer.Data (I) := 0;
            end loop;
            Dio.Write (Buffer.File, Buffer.Data (1 .. Buffer.Block));
            Buffer.Count := 0;
        end if;
    end Flush;

    procedure Close (Buffer : in out Buffer_Type) is
    begin
        case Dio.Mode (Buffer.File) is
            when Dio.Out_File =>
                Flush (Buffer);
                begin
                    Tape_Specific.Unload (Buffer.File);
                exception
                    when others =>
                        null;
                end;
            when Dio.In_File =>
                begin
                    Tape_Specific.Rewind (Buffer.File);
                exception
                    when others =>
                        null;
                end;
        end case;
        begin
            Dio.Close (Buffer.File);
        exception
            when others =>
                null;
        end;
    end Close;

    procedure Read (File : Dio.File_Type;
                    Buffer : out System.Byte_String;
                    Count : out Natural) is
    begin
        Count := 0;
        Dio.Read (File, Buffer, Count);
    exception
        when Constraint_Error =>
            Put_Line ("Dio.Read raised Constraint_Error.");
            raise;
        when Io_Exceptions.Data_Error =>
            Put_Line ("Dio.Read raised Io_Exceptions.Data_Error.");
            raise;
        when others =>
            Put_Line ("Dio.Read raised an unexpected exception.");
            raise;
    end Read;

    procedure Read (Buffer : in out Buffer_Type;
                    Data : out System.Byte_String) is
        Buffr : System.Byte_String renames Buffer.Data;
        Count : Natural renames Buffer.Count;
        Total : Natural := 0;
        Slice : Natural;
    begin
        while Total < Data'Length loop
            if Count > Total then
                Slice := Data'Length - Total;
                Data (Data'First + Total .. Data'Last) := Buffr (1 .. Slice);
                Count := Count - Slice;
                Buffr (1 .. Count) := Buffr (Slice + 1 .. Slice + Count);
                Total := Total + Slice;
            elsif Count > 0 then
                Data (Data'First + Total .. Data'First + Total + Count - 1) :=
                   Buffr (1 .. Count);
                Count := 0;
            else
                Read (Buffer.File, Buffr (1 .. Buffer.Block), Count);
                Do_Byte_Swap (Buffer);
            end if;
        end loop;
    end Read;

    procedure Write (Buffer : in out Buffer_Type; Data : System.Byte_String) is
        Buffr : System.Byte_String renames Buffer.Data (1 .. Buffer.Block);
        Count : Natural renames Buffer.Count;
        Total : Natural := 0;
        Slice : Natural;
    begin
        while Total < Data'Length loop
            Slice := Data'Length - Total;
            if Count + Slice < Buffer.Block then
                Buffr (Count + 1 .. Count + Slice) :=
                   Data (Data'First + Total .. Data'Last);
                Count := Count + Slice;
            else
                Slice := Buffer.Block - Count;
                Buffr (Count + 1 .. Count + Slice) :=
                   Data (Data'First + Total .. Data'First + Total + Slice - 1);
                Count := Count + Slice;
                Flush (Buffer);
            end if;
            Total := Total + Slice;
        end loop;
    end Write;

end Block_Buffer;