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

⟦5937ebd0c⟧ Ada Source

    Length: 11264 (0x2c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Condition, seg_02955e

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 => 0, 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 : Condition_Element) 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 : Condition_Element) 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 : Condition_Element) 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 : Condition_Element)
                   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;

end Condition;

    nblk1=a
    nid=5
    hdr6=10
        [0x00] rec0=24 rec1=00 rec2=01 rec3=054
        [0x01] rec0=22 rec1=00 rec2=06 rec3=01a
        [0x02] rec0=21 rec1=00 rec2=04 rec3=006
        [0x03] rec0=1b rec1=00 rec2=07 rec3=00e
        [0x04] rec0=04 rec1=00 rec2=08 rec3=016
        [0x05] rec0=1d rec1=00 rec2=03 rec3=010
        [0x06] rec0=1b rec1=00 rec2=02 rec3=002
        [0x07] rec0=0f rec1=00 rec2=0a rec3=001
        [0x08] rec0=54 rec1=28 rec2=00 rec3=000
        [0x09] rec0=41 rec1=07 rec2=8f rec3=09d
    tail 0x21722d08083cd8794c618 0x42a00088462063c03
Free Block Chain:
  0x5: 0000  00 09 00 a4 80 1a 68 65 6e 20 49 73 5f 47 72 65  ┆      hen Is_Gre┆
  0x9: 0000  00 00 00 06 80 03 20 20 20 03 00 00 00 00 00 00  ┆                ┆