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 - metrics - download

⟦50e39a765⟧ Ada Source

    Length: 7168 (0x1c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Signature, seg_052277

Derivation

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

with Message_Interchange;
with Text_Io;

use Text_Io;
package body Signature is

    Sep : Character renames Message_Interchange.Separator;

    First : Boolean;
    -- used to build images like  blah#blah#blah
    -- instead of                #blah#blah#blah

    Prototyping_Stub : exception;

    function Create return Signature.Object is
    begin
        return Object'(others => Parameter.Null_Parameter);
    end Create;


    procedure Add (To_Signature : in out Signature.Object;
                   The_Parameter : Parameter.Object;
                   At_Position : Position) is
    begin
        To_Signature (At_Position) := The_Parameter;
    end Add;


    function I (Sig : Object; Pos : Iterator_Range) return String is
    begin  
        if Pos = Iterator_Range'Last then
            return ""; -- fin de la recursivite
        elsif Parameter.Is_Null (Sig (Position (Pos))) then
            --return I (Sig, Pos + 1);
            return ""; -- fin de la recursivite
        elsif First then  
            First := False;
            return (Parameter.Image (Sig (Position (Pos))) & I (Sig, Pos + 1));
        else
            return (Sep & Parameter.Image (Sig (Position (Pos))) &
                    I (Sig, Pos + 1));
        end if;
    end I;


    function Image (Of_Signature : Signature.Object) return String is
    begin
        First := True;
        return I (Of_Signature, Iterator_Range (Position'First));
    end Image;


    function Value (Of_String : String) return Signature.Object is
        S : String renames Of_String;

        Name : Positive := S'First;
        Next_Name : Positive := S'First;
        Class : Positive := S'First;
        Value : Positive := S'First;
        Current : Positive := S'First;

        Param_Pos : Positive := 1;

        Sig : Signature.Object := Signature.Create;
    begin
        while Current <= S'Last loop

            Locate_Name:
                loop
                    exit when S (Class) = Sep;
                    Class := Class + 1;
                    Current := Current + 1;
                end loop Locate_Name;
            Current := Current + 1; -- to point after the sep
            Value := Current;

            Locate_Class:
                loop
                    exit when S (Value) = Sep;
                    Value := Value + 1;
                    Current := Current + 1;
                end loop Locate_Class;
            Current := Current + 1; -- to point after the sep
            Next_Name := Current;

            Locate_Value:
                loop
                    exit when S (Next_Name) = Sep or Next_Name = S'Last;
                    Next_Name := Next_Name + 1;
                    Current := Current + 1;
                end loop Locate_Value;
            Current := Current + 1; -- to point after the sep

            if S (Next_Name) = Sep then
                Next_Name := Next_Name - 1;
                --[cheat]
                -- a parameter is always in the range name .. next_name
                -- this is required because there is no sep at the
                -- end of the signature
            end if;


            Signature.Add (To_Signature => Sig,
                           The_Parameter => Parameter.Value
                                               (S (Name .. Next_Name)),
                           At_Position => Param_Pos);


            Param_Pos := Param_Pos + 1;
            Name := Next_Name + 1 + 1;
            -- name is incremented twice see [cheat]

            Class := Name;
            Value := Name;
            Next_Name := Name;

        end loop;

        return Sig;

    end Value;


    procedure Init (Iter : in out Iterator;
                    Signature : Standard.Signature.Object) is
    begin
        Iter.Position := Iterator_Range (Signature'First);
        Iter.Signature := Signature;
    end Init;


    procedure Next (Iter : in out Iterator) is
    begin
        Iter.Position := Iter.Position + 1;
    end Next;


    function Is_Done (Iter : Iterator) return Boolean is
    begin
        return Iter.Position = Iterator_Range'Last;
    end Is_Done;


    function Value (Iter : Iterator) return Parameter.Object is
    begin
        return Iter.Signature (Positive (Iter.Position));
    end Value;


    procedure Reset (Signature : in out Standard.Signature.Object) is
    begin
        for I in Signature'Range loop
            Signature (I) := Parameter.Null_Parameter;
        end loop;
    end Reset;


    function Is_Equal (Left, Right : Signature.Object) return Boolean is
    begin
        for I in Left'Range loop
            if not Parameter.Is_Equal (Left (I), Right (I)) then
                return False;
            end if;  
        end loop;
        return True;
    end Is_Equal;


    function Is_Compatible (Left, Right : Signature.Object) return Boolean is
    begin
        for I in Left'Range loop
            if not Parameter.Is_Compatible (Left (I), Right (I)) then
                return False;
            end if;  
        end loop;
        return True;
    end Is_Compatible;
    procedure Strip_Values (Signature : in out Standard.Signature.Object) is
    begin
        for I in Signature'Range loop
            Parameter.Strip_Value (Signature (I));
        end loop;
    end Strip_Values;


end Signature;

    nblk1=6
    nid=0
    hdr6=c
        [0x00] rec0=24 rec1=00 rec2=01 rec3=012
        [0x01] rec0=19 rec1=00 rec2=02 rec3=022
        [0x02] rec0=1e rec1=00 rec2=03 rec3=010
        [0x03] rec0=1f rec1=00 rec2=04 rec3=010
        [0x04] rec0=27 rec1=00 rec2=05 rec3=00e
        [0x05] rec0=1b rec1=00 rec2=06 rec3=000
    tail 0x21759a4c687a063399f47 0x42a00088462060003