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

⟦977b3bf36⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Unary, seg_02904e

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;
procedure Unary is
    Result : Boolean;

    Dummy : constant := -1;

    Robot : constant := 1;
    Ball  : constant := 2;
    Box   : constant := 3;

    Busy : constant := 1;
    Free : constant := 2;
    Heap : constant := 3;

    Red   : constant := 1;
    Blue  : constant := 2;
    Green : constant := 3;

    type Slot_Name is (Class, Size, Colour, State);

    type Object is array (Slot_Name) of Integer;

    The_Object : Object;

    type Object_Collection is array (Positive range <>) of Object;

    Objects : Object_Collection (1 .. 6) :=
       (Object'(Class => Robot, Size => Dummy, Colour => Green, State => Free),
        Object'(Class => Robot, Size => Dummy, Colour => Red, State => Busy),
        Object'(Class => Ball, Size => 50, Colour => Green, State => Heap),
        Object'(Class => Ball, Size => 100, Colour => Blue, State => Heap),
        Object'(Class => Box, Size => 75, Colour => Green, State => Free),
        Object'(Class => Box, Size => 25, Colour => Blue, State => Busy));

    type Operators is (Is_Equal, Is_Less, Is_Less_Or_Equal, Is_Greater,
                       Is_Greater_Or_Equal, Is_Different, Is_Any);  
    type Condition is
        record
            Operator : Operators;
            Operand  : Integer;
        end record;

    type Query is array (Slot_Name) of Condition;

    Filter : Query;

    No_Matter : constant Condition := (Is_Any, 0);

    type Conditions is array (Positive range <>) of Condition;

    function Is_Equal (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Equal, Operand => Value);
    end Is_Equal;

    function Is_Less (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Less, Operand => Value);
    end Is_Less;

    function Is_Less_Or_Equal (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Less_Or_Equal, Operand => Value);
    end Is_Less_Or_Equal;

    function Is_Greater (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Greater, Operand => Value);
    end Is_Greater;

    function Is_Greater_Or_Equal (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Greater_Or_Equal, Operand => Value);
    end Is_Greater_Or_Equal;

    function Is_Different (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Different, Operand => Value);
    end Is_Different;

    function Match (Value : Integer; Against : Condition) return Boolean is
        Operator : Operators renames Against.Operator;
        Operand  : Integer   renames Against.Operand;
    begin
        case 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;
            when Is_Any =>
                return True;
        end case;
    end Match;

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

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

begin
    Filter := (Class          => Is_Different (Robot),
               Size           => Is_Less (100),
               Colour | State => No_Matter);

    for I in Objects'Range loop

        Result := Match (Objects (I),
                         Against => (Class          => Is_Different (Robot),
                                     Size           => Is_Less (100),
                                     Colour | State => No_Matter));

        Text_Io.Put_Line (Integer'Image (I) & " => " & Boolean'Image (Result));
    end loop;
end Unary;

    nblk1=7
    nid=7
    hdr6=a
        [0x00] rec0=21 rec1=00 rec2=01 rec3=092
        [0x01] rec0=1d rec1=00 rec2=02 rec3=086
        [0x02] rec0=1c rec1=00 rec2=03 rec3=01e
        [0x03] rec0=1f rec1=00 rec2=05 rec3=026
        [0x04] rec0=12 rec1=00 rec2=04 rec3=000
        [0x05] rec0=1f rec1=00 rec2=04 rec3=078
        [0x06] rec0=08 rec1=00 rec2=06 rec3=000
    tail 0x2172275b083c775aa0cec 0x42a00088462063c03
Free Block Chain:
  0x7: 0000  00 06 00 17 80 14 20 72 65 74 75 72 6e 20 43 6f  ┆       return Co┆
  0x6: 0000  00 00 00 17 80 14 3d 3e 20 47 72 65 65 6e 2c 20  ┆      => Green, ┆