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

⟦c67e7d9d4⟧ Ada Source

    Length: 4096 (0x1000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Parameter_Parser_Defs, seg_01420f

Derivation

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

package body Parameter_Parser_Defs is

    function Deslash (S : String) return String is
        P : Integer := Su.Locate ('\', S);
    begin
        if P in 1 .. S'Last - 1 then
            return S (S'First .. P - 1) & S (P + 1) &
                      Deslash (S (P + 2 .. S'Last));
        else
            return S;
        end if;
    end Deslash;

    function Clean (S : String) return String is
    begin
        if S'Length = 0 then
            return S;
        elsif S (S'First) = '(' then
            if S (S'Last) = ')' then
                return Deslash (S (S'First + 1 .. S'Last - 1));
            else
                return Deslash (S (S'First + 1 .. S'Last));
            end if;
        else
            return Deslash (S);
        end if;
    end Clean;

    function Normal (S : String) return String is
        Ns : String (1 .. S'Length) := Su.Upper_Case (S);
    begin
        return Ns;
    end Normal;
    -- Allow abbreviations within <..>

    function May_Be (Arg, Val : String) return Boolean is

    begin
        return Arg'Length <= Val'Length and then
                  (Val (1 .. Arg'Length) = Arg or else
                   (Arg /= "" and then Arg (Arg'Last) = '>' and then
                    Arg (Arg'First .. Arg'Last - 1) =
                       Val (1 .. Arg'Length - 1)));
    end May_Be;

    procedure Unique_Prefix (S : String;
                             Result : out Enumeration;
                             Prefix : out Boolean;
                             Unique : out Boolean) is
        Already_Matched : Boolean := False;
        Exact : Boolean;
        Match : Boolean;
        Up_S : constant String := String_Utilities.Upper_Case (S);
        -- determines if S is a prefix of Is_In,  Case sensitive
        procedure Check_Prefix (S, Is_In : String;
                                Prefix : in out Boolean;
                                Exact : out Boolean) is
            Bound : constant Integer := Is_In'First + S'Length - 1;
        begin
            Prefix := S'Length <= Is_In'Length and then
                         S = Is_In (Is_In'First .. Bound);
            Exact := Prefix and then (S'Length = Is_In'Length);
        end Check_Prefix;
    begin
        Prefix := False;
        Unique := False;
        Result := Enumeration'Last;
        for Enum in Enumeration loop
            Check_Prefix (Up_S, Enumeration'Image (Enum), Match, Exact);
            if Exact then
                Result := Enum;
                Unique := True;
                Prefix := False;
                return;
            elsif Match then
                Unique := not Already_Matched;
                Already_Matched := True;
                Prefix := True;
                Result := Enum;
            end if;
        end loop;
    end Unique_Prefix;

end Parameter_Parser_Defs;

    nblk1=3
    nid=0
    hdr6=6
        [0x00] rec0=23 rec1=00 rec2=01 rec3=022
        [0x01] rec0=17 rec1=00 rec2=02 rec3=060
        [0x02] rec0=1c rec1=00 rec2=03 rec3=000
    tail 0x2170fc0b283127f63f708 0x42a00088462060003