⟦99f27fb7f⟧

TextFile

with Log;
with Profile;
with Byte_Defs;

package body Record_Stream_Generic is

    -- Each record in the stream is represented as a sequence
    -- of one or more blocks.  Each block is a two-byte count,
    -- followed by count bytes of data.  The last block of
    -- each record has a zero block count and no data.  Block
    -- counts are represented most significant byte first.
    --
    -- Because block counts are two bytes, a block may be no
    -- longer than 2**16-1 bytes.  However, a record may have
    -- any number of blocks, and thus can be arbitrarily long.
    --
    -- A zero length record is represented as a single block
    -- with a zero block count and no data.

    End_Of_Record_Mark : constant Block_Count := 0;
    Radix : constant Block_Count := 256;

    function "&" (X, Y : Byte_String) return Byte_String renames Byte_Defs."&";

    procedure Noop (State : in out State_Type) is
    begin
        null;
    end Noop;

    -- The following skins are used to update State.Total.

    procedure Put (Into : in out State_Type; Data : Byte_String) is
    begin
        Put (Into.File, Data);
        Into.Total := Into.Total + Data'Length;
    end Put;

    procedure Get (From : in out State_Type; Data : out Byte_String) is
    begin
        Get (From.File, Data);
        From.Total := From.Total + Data'Length;
    end Get;

    function Interchange_Form (Data : Block_Count) return Byte_String is
        Bytes : Byte_String (1 .. 2);
        subtype Byte is Byte_Defs.Byte;
    begin
        Bytes := (Byte (Data / Radix), Byte (Data mod Radix));
        return Bytes;
    end Interchange_Form;

    procedure Put (Into : in out State_Type; Data : Block_Count) is
    begin
        Put (Into, Interchange_Form (Data));
    end Put;

    procedure Get (From : in out State_Type; Data : out Block_Count) is
        Bytes : Byte_String (1 .. 2);
    begin
        Get (From, Bytes);
        Data := (Block_Count (Bytes (1)) * Radix) + Block_Count (Bytes (2));
    end Get;

    procedure Open (Stream : out Id; Mode : Mode_Type; File : File_Type) is
        The_Stream : Id; -- local copy
    begin
        Log.Put_Line ("Record_Stream.Open" & ", mode = " &
                      Mode_Type'Image (Mode), Profile.Debug_Msg);
        Pool.Open (Pool.Object_Id (The_Stream));
        declare
            State : State_Type
                renames Pool.Value (Pool.Object_Id (The_Stream)).Object;
        begin
            State := (Mode, File,
                      Total => 0,
                      Recnum => 0,
                      Block => 0,
                      First => 0,
                      Count => 0,
                      Buffer => (others => 0));
            case Mode is
                when Get_Only =>
                    Get_End_Of_Record (The_Stream); -- first block
                when Put_Only =>
                    State.Block := 1; -- End_Of_Record := False.
            end case;
        end;
        Stream := The_Stream;
    end Open;

    procedure Close (Stream : Id) is
        State : State_Type renames Pool.Value (Pool.Object_Id (Stream)).Object;
    begin
        Log.Put_Line ("Record_Stream.Close", Profile.Debug_Msg);
        if not End_Of_Record (Stream) then
            begin
                case State.Mode is
                    when Put_Only =>
                        Put_End_Of_Record (Stream);
                    when Get_Only =>
                        Get_End_Of_Record (Stream);
                end case;
            exception
                when others =>
                    null;
            end;
        end if;
        Pool.Close (Pool.Object_Id (Stream));
    end Close;

    function End_Of_Record (State : State_Type) return Boolean is
    begin
        return State.Count = 0 and then State.Block = End_Of_Record_Mark;
        -- Same predicate for Get and Put.  Slick, eh?
    end End_Of_Record;
    pragma Inline (End_Of_Record);

    function End_Of_Record (Stream : Id) return Boolean is
    begin
        return End_Of_Record (Pool.Value (Pool.Object_Id (Stream)).Object);
    end End_Of_Record;

    procedure Check_Mode_Put (State : State_Type) is
    begin
        if State.Mode = Get_Only then
            raise Mode_Error;
        end if;
        pragma Assert (State.First = 0);
    end Check_Mode_Put;
    pragma Inline (Check_Mode_Put);

    procedure Check_Mode_Get (State : State_Type) is
    begin
        if State.Mode = Put_Only then
            raise Mode_Error;
        end if;
    end Check_Mode_Get;
    pragma Inline (Check_Mode_Get);

    procedure Put_End_Of_Record (Stream : Id) is
        State : State_Type renames Pool.Value (Pool.Object_Id (Stream)).Object;
    begin
        Check_Mode_Put (State);
        if State.Count > 0 then
            Put (State, Interchange_Form (State.Count) &
                           State.Buffer (0 .. State.Count - 1) &
                           Interchange_Form (End_Of_Record_Mark));
        else
            Put (State, End_Of_Record_Mark);
        end if;
        State.Count := 0;
        State.Block := End_Of_Record_Mark;
        State.Recnum := State.Recnum + 1;
        Log.Put_Line ("end record" & Natural'Image (State.Recnum),
                      Profile.Debug_Msg);
    end Put_End_Of_Record;

    procedure Get_End_Of_Record (Stream : Id) is
        State : State_Type renames Pool.Value (Pool.Object_Id (Stream)).Object;
    begin
        Check_Mode_Get (State);
        if not End_Of_Record (State) then
            -- Skip over the rest of the current record.
            State.Count := 0;
            loop
                if State.Block > 0 then
                    declare
                        Buffer : Byte_String (1 .. State.Block);
                    begin
                        Get (State, Buffer);
                    end;
                end if;
                Get (State, State.Block); -- next block
                exit when State.Block = End_Of_Record_Mark;
            end loop;
        end if;
        Get (State, State.Block); -- first block in next record
        State.Recnum := State.Recnum + 1;
        Log.Put_Line ("begin record" & Natural'Image (State.Recnum),
                      Profile.Debug_Msg);
    end Get_End_Of_Record;

    procedure Put (Stream : Id; Data : Byte_String; Count : out Natural) is
        State : State_Type renames Pool.Value (Pool.Object_Id (Stream)).Object;
        The_Count : Natural := Buffer_Size - State.Count;
    begin
        Check_Mode_Put (State);
        if The_Count > Block_Count'Last then
            The_Count := Block_Count'Last;
        end if;
        -- This code has been optimized for speed.
        -- If you simplify it, you may slow it down.
        if The_Count > Data'Length then
            -- Store the Data in the buffer, but don't Put anything.
            The_Count := Data'Length;
            if The_Count > 0 then
                State.Buffer (State.Count .. State.Count + The_Count - 1) :=
                   Data;
                State.Count := State.Count + The_Count;
            end if;
        elsif State.Count = 0 then
            -- Put the Data, bypassing the buffer.
            pragma Assert (Data'Length > 0);
            if Data'Length <= Block_Count'Last then
                The_Count := Data'Length;
                Put (State, Interchange_Form (The_Count) & Data);
            else
                The_Count := Block_Count'Last;
                Put (State, Interchange_Form (The_Count) &
                               Data (Data'First .. Data'First + The_Count - 1));
            end if;
            State.Block := The_Count;
        else
            -- Append the Data to the buffer, and Put the result.
            if State.Count + Data'Length <= Block_Count'Last then
                The_Count := Data'Length;
                Put (State, Interchange_Form (State.Count + The_Count) &
                               State.Buffer (0 .. State.Count - 1) & Data);
            else
                The_Count := Block_Count'Last - State.Count;
                Put (State, Interchange_Form (State.Count + The_Count) &
                               State.Buffer (0 .. State.Count - 1) &
                               Data (Data'First .. Data'First + The_Count - 1));
            end if;
            State.Block := State.Count + The_Count;
            State.Count := 0;
        end if;
        Count := The_Count;
    end Put;

    procedure Get (Stream : Id; Data : out Byte_String; Count : out Natural) is
        State : State_Type renames Pool.Value (Pool.Object_Id (Stream)).Object;
        The_Count : Natural := State.Count;
    begin
        Check_Mode_Get (State);
        -- This code has been optimized for speed.
        -- If you simplify it, you may slow it down.
        if not End_Of_Record (State) then
            if The_Count > 0 then
                if The_Count > Data'Length then
                    -- Return a piece of the buffer.
                    The_Count := Data'Length;
                    Data := State.Buffer (State.First ..
                                             State.First + The_Count - 1);
                    State.First := State.First + The_Count;
                    State.Count := State.Count - The_Count;
                elsif The_Count = Data'Length then
                    -- Return the entire buffer.
                    Data := State.Buffer (State.First ..
                                             State.First + The_Count - 1);
                    State.First := 0;
                    State.Count := 0;
                else
                    -- Return the entire buffer (but less than Data'length).
                    Data (Data'First .. Data'First + The_Count - 1) :=
                       State.Buffer (State.First ..
                                        State.First + The_Count - 1);
                    State.First := 0;
                    State.Count := 0;
                end if;
            else
                The_Count := State.Block;
                if The_Count = Data'Length then
                    -- Get the rest of the block.
                    Get (State, Data);
                    State.Block := 0;
                elsif The_Count < Data'Length then
                    -- Get the rest of the block (but less than Data'length).
                    Get (State, Data (Data'First ..
                                         Data'First + The_Count - 1));
                    State.Block := 0;
                else
                    The_Count := Data'Length;
                    if The_Count >= Buffer_Size then
                        -- Get Data without copying through buffer.
                        Get (State, Data);
                        State.Block := State.Block - Data'Length;
                    else
                        if State.Block >= Buffer_Size then
                            -- Get one buffer's worth of the block.
                            Get (State, State.Buffer);
                            State.Count := Buffer_Size - The_Count;
                            State.Block := State.Block - Buffer_Size;
                        else
                            -- Get the rest of the block into the buffer.
                            Get (State, State.Buffer (0 .. State.Block - 1));
                            State.Count := State.Block - The_Count;
                            State.Block := 0;
                        end if;
                        State.First := The_Count;
                        Data := State.Buffer (0 .. The_Count - 1);
                    end if;
                end if;
            end if;
            if State.Count = 0 and then State.Block = 0 then
                begin
                    Get (State, State.Block); -- length of next block
                exception
                    when End_Error =>
                        State.Block := End_Of_Record_Mark;
                end;
            end if;
        end if;
        Count := The_Count;
    end Get;

    procedure Put (Stream : Id; Data : Byte_String) is
        Total : Natural;
        Count : Natural;
    begin
        Put (Stream, Data, Total);
        if Total = 0 then
            raise End_Error; -- ???
        end if;
        while Total < Data'Length loop
            Put (Stream, Data (Data'First + Total .. Data'Last), Count);
            if Count = 0 then
                raise End_Error; -- ???
            end if;
            Total := Total + Count;
        end loop;
    end Put;

    procedure Get (Stream : Id; Data : out Byte_String) is
        Total : Natural;
        Count : Natural;
    begin
        Get (Stream, Data, Total);
        if Total = 0 then
            raise End_Error;
        end if;
        while Total < Data'Length loop
            Get (Stream, Data (Data'First + Total .. Data'Last), Count);
            if Count = 0 then
                raise End_Error;
            end if;
            Total := Total + Count;
        end loop;
    end Get;

end Record_Stream_Generic;
DataMuseum.dk

Rational R1000/400 Tapes

⟦99f27fb7f⟧ TextFile

Derivation

TextFile
