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

⟦c80ff5910⟧ Ada Source

    Length: 14336 (0x3800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Condition, seg_02ad8e

Derivation

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

with Text_Io;
package body Condition is

    type Alias_Storage is array (Alias) of Integer;
    The_Aliases : Alias_Storage := (others => 0);

    function Is_Any return Condition.Object is
    begin
        return (Count => 1, Value => (others => (Is_Any, 0)));
    end Is_Any;


    -- value condition

    function Is_Equal (Value : Integer) return Condition.Object is
    begin
        return (Count => 1, Value => (others => (Is_Equal, Value)));
    end Is_Equal;


    function Is_Less (Value : Integer) return Condition.Object is
    begin
        return (Count => 1, Value => (others => (Is_Less, Value)));
    end Is_Less;


    function Is_Less_Or_Equal (Value : Integer) return Condition.Object is
    begin
        return (Count => 1, Value => (others => (Is_Less_Or_Equal, Value)));
    end Is_Less_Or_Equal;


    function Is_Greater (Value : Integer) return Condition.Object is
    begin
        return (Count => 1, Value => (others => (Is_Greater, Value)));
    end Is_Greater;


    function Is_Greater_Or_Equal (Value : Integer) return Condition.Object is
    begin
        return (Count => 1, Value => (others => (Is_Greater_Or_Equal, Value)));
    end Is_Greater_Or_Equal;


    function Is_Different (Value : Integer) return Condition.Object is
    begin
        return (Count => 1, Value => (others => (Is_Different, Value)));
    end Is_Different;


    -- alias condition

    function Is_Equal (Value : Alias) return Condition.Object is
    begin
        return (Count => 1,
                Value => (others => (Is_Equal_To_Alias, Alias'Pos (Value))));
    end Is_Equal;


    function Is_Less (Value : Alias) return Condition.Object is
    begin
        return (Count => 1,
                Value => (others => (Is_Less_Than_Alias, Alias'Pos (Value))));
    end Is_Less;


    function Is_Less_Or_Equal (Value : Alias) return Condition.Object is
    begin
        return (Count => 1,
                Value => (others =>
                             (Is_Less_Or_Equal_Than_Alias, Alias'Pos (Value))));
    end Is_Less_Or_Equal;


    function Is_Greater (Value : Alias) return Condition.Object is
    begin
        return (Count => 1,
                Value => (others =>
                             (Is_Greater_Than_Alias, Alias'Pos (Value))));
    end Is_Greater;


    function Is_Greater_Or_Equal (Value : Alias) return Condition.Object is
    begin
        return (Count => 1,
                Value => (others => (Is_Greater_Or_Equal_Than_Alias,
                                     Alias'Pos (Value))));
    end Is_Greater_Or_Equal;


    function Is_Different (Value : Alias) return Condition.Object is
    begin
        return (Count => 1,
                Value => (others =>
                             (Is_Different_Than_Alias, Alias'Pos (Value))));
    end Is_Different;


    -- miscellaneous condition


    function Say_It_Is (Object : Alias) return Condition.Object is
    begin
        return (Count => 1,
                Value => (others => (Say_It_Is, Alias'Pos (Object))));
    end Say_It_Is;

    function "and" (Left, Right : Condition.Object) return Condition.Object is
    begin
        return (Count => Left.Count + Right.Count,
                Value => Left.Value & Right.Value);
    end "and";


    function Value_Match (Value : Integer; Against : Term) return Boolean is
        Operator : Operators renames Against.Operator;
        Operand  : Integer   renames Against.Operand;
    begin
        case Value_Operators'(Operator) is
            when Is_Equal =>
                return Value = Operand;
            when Is_Less =>
                return Value < Operand;
            when Is_Less_Or_Equal =>
                return Value <= Operand;
            when Is_Greater =>
                return Value > Operand;
            when Is_Greater_Or_Equal =
                return Value >= Operand;
            when Is_Different =>
                return Value /= Operand;
        end case;
    end Value_Match;


    function Alias_Match (Value : Integer; Against : Term) return Boolean is
        Operator : Operators renames Against.Operator;
        Alias_Id : constant Alias := Alias'Val (Against.Operand);
        Operand  : Integer   renames The_Aliases (Alias_Id);
    begin
        case Alias_Operators'(Operator) is
            when Is_Equal_To_Alias =>
                return Value = Operand;
            when Is_Less_Than_Alias =>
                return Value < Operand;
            when Is_Less_Or_Equal_Than_Alias =>
                return Value <= Operand;
            when Is_Greater_Than_Alias =>
                return Value > Operand;
            when Is_Greater_Or_Equal_Than_Alias =>
                return Value >= Operand;
            when Is_Different_Than_Alias =>
                return Value /= Operand;
        end case;
    end Alias_Match;



    function Miscellaneous_Match
                (Value : Integer; Against : Term) return Boolean is
        Operator : Operators renames Against.Operator;
        Operand  : Integer   renames Against.Operand;
    begin
        case Miscellaneous_Operators'(Operator) is
            when Is_Any =>
                return True;
            when Say_It_Is =>
                The_Aliases (Alias'Val (Operand)) := Value;
                return True;
        end case;
    end Miscellaneous_Match;



    function Match (Value : Integer; Against : Term) return Boolean is
        Operator : Operators renames Against.Operator;
    begin
        case Operator is
            when Value_Operators =>
                return Value_Match (Value, Against);
            when Alias_Operators =>
                return Alias_Match (Value, Against);
            when Miscellaneous_Operators =>
                return Miscellaneous_Match (Value, Against);
        end case;
    end Match;


    function Match (Value : Integer; Against : Condition.Object)
                   return Boolean is
    begin
        for I in Against.Value'Range loop
            if not Match (Value, Against.Value (I)) then
                return False;
            end if;
        end loop;
        return True;
    end Match;

    procedure Put (The_Term : Term; Where : Output_Stream.Object) is
        use Output_Stream;
    begin
        Put (Operators'Image (The_Term.Operator), Where);
        case The_Term.Operator is
            when Value_Operators =>
                Put (" (" & Integer'Image (The_Term.Operand) & ")", Where);
            when Alias_Operators | Say_It_Is =>
                Put (" (Alias'", Where);
                Put (Alias'Image (Alias'Val (The_Term.Operand)), Where);
                Put (")", Where);
            when Is_Any =>
                null;
        end case;
    end Put;

    procedure Put (The_Condition : Object; Where : Output_Stream.Object) is
        First : Boolean := True;
        use Output_Stream;
    begin
        if The_Condition.Count = 0 then
            Put ("Any", Where);
        else
            for I in The_Condition.Value'Range loop  
                if not First then
                    New_Line (Where);
                    Put ("  & ", Where);
                else
                    First := False;
                end if;
                Put (The_Condition.Value (I), Where);
            end loop;
        end if;
    end Put;
end Condition;

    nblk1=d
    nid=3
    hdr6=14
        [0x00] rec0=24 rec1=00 rec2=01 rec3=054
        [0x01] rec0=22 rec1=00 rec2=0d rec3=01a
        [0x02] rec0=21 rec1=00 rec2=04 rec3=006
        [0x03] rec0=1a rec1=00 rec2=07 rec3=04c
        [0x04] rec0=00 rec1=00 rec2=02 rec3=002
        [0x05] rec0=19 rec1=00 rec2=08 rec3=04a
        [0x06] rec0=00 rec1=00 rec2=0b rec3=006
        [0x07] rec0=1f rec1=00 rec2=0a rec3=048
        [0x08] rec0=1e rec1=00 rec2=09 rec3=010
        [0x09] rec0=15 rec1=00 rec2=06 rec3=000
        [0x0a] rec0=1b rec1=00 rec2=05 rec3=016
        [0x0b] rec0=19 rec1=00 rec2=03 rec3=000
        [0x0c] rec0=04 rec1=00 rec2=09 rec3=000
    tail 0x21723f3c083e57b6b0513 0x42a00088462063c03
Free Block Chain:
  0x3: 0000  00 05 03 18 80 3e 20 20 20 20 20 20 50 75 74 20  ┆     >      Put ┆
  0x5: 0000  00 0c 03 fc 80 1d 20 20 20 77 68 65 6e 20 49 73  ┆         when Is┆
  0xc: 0000  00 00 00 06 80 03 20 20 20 03 3e 20 28 49 73 5f  ┆          > (Is_┆