DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦e3939d76a⟧ TextFile

    Length: 15499 (0x3c8b)
    Types: TextFile
    Names: »B«

Derivation

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Instancecounter;

separate (Expertsystem)

package body Motor is

    Maxrule : constant Positive := 30;
    Maxstrategy : constant Positive := 30;

    type Condition is array (1 .. Maxrule) of Boolean;
    type Ordered_Rule is array (1 .. Maxstrategy) of Natural;
    type Strategic is
        record
            Rule_Array : Ordered_Rule := (others => 0);
            Count : Natural := 0;
        end record;

    The_Strategie : Strategic;
    Rule_Condition : Condition;

    Localid : Contextid;

    Cst : Tuple.Object;
    Cstc : Tuplecollection.Object;

    procedure Reset is
    begin
        for I in 1 .. Maxstrategy loop
            The_Strategie.Rule_Array (I) := 0;
        end loop;
        The_Strategie.Count := 0;
    end Reset;

    function Evaluate (Rule : Natural) return Boolean is
        Result : Boolean;
    begin
        if not Rulemanager.Ismasked (Context_Name, Rule) then
            case Rule is
                when 1 =>
                    Result := Condition_1;
                when 2 =>
                    Result := Condition_2;
                when 3 =>
                    Result := Condition_3;
                when 4 =>
                    Result := Condition_4;
                when 5 =>
                    Result := Condition_5;
                when 6 =>
                    Result := Condition_6;
                when 7 =>
                    Result := Condition_7;
                when 8 =>
                    Result := Condition_8;
                when 9 =>
                    Result := Condition_9;
                when 10 =>
                    Result := Condition_10;
                when 11 =>
                    Result := Condition_11;
                when 12 =>
                    Result := Condition_12;
                when 13 =>
                    Result := Condition_13;
                when 14 =>
                    Result := Condition_14;
                when 15 =>
                    Result := Condition_15;
                when 16 =>
                    Result := Condition_16;
                when 17 =>
                    Result := Condition_17;
                when 18 =>
                    Result := Condition_18;
                when 19 =>
                    Result := Condition_19;
                when 20 =>
                    Result := Condition_20;
                when 21 =>
                    Result := Condition_21;
                when 22 =>
                    Result := Condition_22;
                when 23 =>
                    Result := Condition_23;
                when 24 =>
                    Result := Condition_24;
                when 25 =>
                    Result := Condition_25;
                when 26 =>
                    Result := Condition_26;
                when 27 =>
                    Result := Condition_27;
                when 28 =>
                    Result := Condition_28;
                when 29 =>
                    Result := Condition_29;
                when 30 =>
                    Result := Condition_30;
                when others =>
                    Result := False;
            end case;
        else
            Result := False;
        end if;

        if Debugger.Isdebugged (Debugger.Conditionevalued) then
            case Rule is
                when 1 =>
                    Debugger.Sendconditionevalued (Name_1, 1, Result, Cstc);
                when 2 =>
                    Debugger.Sendconditionevalued (Name_2, 2, Result, Cstc);
                when 3 =>
                    Debugger.Sendconditionevalued (Name_3, 3, Result, Cstc);
                when 4 =>
                    Debugger.Sendconditionevalued (Name_4, 4, Result, Cstc);
                when 5 =>
                    Debugger.Sendconditionevalued (Name_5, 5, Result, Cstc);
                when 6 =>
                    Debugger.Sendconditionevalued (Name_6, 6, Result, Cstc);
                when 7 =>
                    Debugger.Sendconditionevalued (Name_7, 7, Result, Cstc);
                when 8 =>
                    Debugger.Sendconditionevalued (Name_8, 8, Result, Cstc);
                when 9 =>
                    Debugger.Sendconditionevalued (Name_9, 9, Result, Cstc);
                when 10 =>
                    Debugger.Sendconditionevalued (Name_10, 10, Result, Cstc);
                when 11 =>
                    Debugger.Sendconditionevalued (Name_11, 11, Result, Cstc);
                when 12 =>
                    Debugger.Sendconditionevalued (Name_12, 12, Result, Cstc);
                when 13 =>
                    Debugger.Sendconditionevalued (Name_13, 13, Result, Cstc);
                when 14 =>
                    Debugger.Sendconditionevalued (Name_14, 14, Result, Cstc);
                when 15 =>
                    Debugger.Sendconditionevalued (Name_15, 15, Result, Cstc);
                when 16 =>
                    Debugger.Sendconditionevalued (Name_16, 16, Result, Cstc);
                when 17 =>
                    Debugger.Sendconditionevalued (Name_17, 17, Result, Cstc);
                when 18 =>
                    Debugger.Sendconditionevalued (Name_18, 18, Result, Cstc);
                when 19 =>
                    Debugger.Sendconditionevalued (Name_19, 19, Result, Cstc);
                when 20 =>
                    Debugger.Sendconditionevalued (Name_20, 20, Result, Cstc);
                when 21 =>
                    Debugger.Sendconditionevalued (Name_21, 21, Result, Cstc);
                when 22 =>
                    Debugger.Sendconditionevalued (Name_22, 22, Result, Cstc);
                when 23 =>
                    Debugger.Sendconditionevalued (Name_23, 23, Result, Cstc);
                when 24 =>
                    Debugger.Sendconditionevalued (Name_24, 24, Result, Cstc);
                when 25 =>
                    Debugger.Sendconditionevalued (Name_25, 25, Result, Cstc);
                when 26 =>
                    Debugger.Sendconditionevalued (Name_26, 26, Result, Cstc);
                when 27 =>
                    Debugger.Sendconditionevalued (Name_27, 27, Result, Cstc);
                when 28 =>
                    Debugger.Sendconditionevalued (Name_28, 28, Result, Cstc);
                when 29 =>
                    Debugger.Sendconditionevalued (Name_29, 29, Result, Cstc);
                when 30 =>
                    Debugger.Sendconditionevalued (Name_30, 30, Result, Cstc);
                when others =>
                    null;
            end case;
        end if;
        return Result;
    end Evaluate;

    procedure Execute (Rule : Natural) is
    begin
        case Rule is
            when 1 =>
                Action_1;
            when 2 =>
                Action_2;
            when 3 =>
                Action_3;
            when 4 =>
                Action_4;
            when 5 =>
                Action_5;
            when 6 =>
                Action_6;
            when 7 =>
                Action_7;
            when 8 =>
                Action_8;
            when 9 =>
                Action_9;
            when 10 =>
                Action_10;
            when 11 =>
                Action_11;
            when 12 =>
                Action_12;
            when 13 =>
                Action_13;
            when 14 =>
                Action_14;
            when 15 =>
                Action_15;
            when 16 =>
                Action_16;
            when 17 =>
                Action_17;
            when 18 =>
                Action_18;
            when 19 =>
                Action_19;
            when 20 =>
                Action_20;
            when 21 =>
                Action_21;
            when 22 =>
                Action_22;
            when 23 =>
                Action_23;
            when 24 =>
                Action_24;
            when 25 =>
                Action_25;
            when 26 =>
                Action_26;
            when 27 =>
                Action_27;
            when 28 =>
                Action_28;
            when 29 =>
                Action_29;
            when 30 =>
                Action_30;
            when others =>
                null;
        end case;

        if Rule /= 0 and then (Debugger.Isdebugged (Debugger.Choosedaction) or
                               Debugger.Isdebugged (Debugger.Actionfact)) then
            case Rule is
                when 1 =>
                    Debugger.Sendchoosedaction (Name_1, 1, Cst);
                when 2 =>
                    Debugger.Sendchoosedaction (Name_2, 2, Cst);
                when 3 =>
                    Debugger.Sendchoosedaction (Name_3, 3, Cst);
                when 4 =>
                    Debugger.Sendchoosedaction (Name_4, 4, Cst);
                when 5 =>
                    Debugger.Sendchoosedaction (Name_5, 5, Cst);
                when 6 =>
                    Debugger.Sendchoosedaction (Name_6, 6, Cst);
                when 7 =>
                    Debugger.Sendchoosedaction (Name_7, 7, Cst);
                when 8 =>
                    Debugger.Sendchoosedaction (Name_8, 8, Cst);
                when 9 =>
                    Debugger.Sendchoosedaction (Name_9, 9, Cst);
                when 10 =>
                    Debugger.Sendchoosedaction (Name_10, 10, Cst);
                when 11 =>
                    Debugger.Sendchoosedaction (Name_11, 11, Cst);
                when 12 =>
                    Debugger.Sendchoosedaction (Name_12, 12, Cst);
                when 13 =>
                    Debugger.Sendchoosedaction (Name_13, 13, Cst);
                when 14 =>
                    Debugger.Sendchoosedaction (Name_14, 14, Cst);
                when 15 =>
                    Debugger.Sendchoosedaction (Name_15, 15, Cst);
                when 16 =>
                    Debugger.Sendchoosedaction (Name_16, 16, Cst);
                when 17 =>
                    Debugger.Sendchoosedaction (Name_17, 17, Cst);
                when 18 =>
                    Debugger.Sendchoosedaction (Name_18, 18, Cst);
                when 19 =>
                    Debugger.Sendchoosedaction (Name_19, 19, Cst);
                when 20 =>
                    Debugger.Sendchoosedaction (Name_20, 20, Cst);
                when 21 =>
                    Debugger.Sendchoosedaction (Name_21, 21, Cst);
                when 22 =>
                    Debugger.Sendchoosedaction (Name_22, 22, Cst);
                when 23 =>
                    Debugger.Sendchoosedaction (Name_23, 23, Cst);
                when 24 =>
                    Debugger.Sendchoosedaction (Name_24, 24, Cst);
                when 25 =>
                    Debugger.Sendchoosedaction (Name_25, 25, Cst);
                when 26 =>
                    Debugger.Sendchoosedaction (Name_26, 26, Cst);
                when 27 =>
                    Debugger.Sendchoosedaction (Name_27, 27, Cst);
                when 28 =>
                    Debugger.Sendchoosedaction (Name_28, 28, Cst);
                when 29 =>
                    Debugger.Sendchoosedaction (Name_29, 29, Cst);
                when 30 =>
                    Debugger.Sendchoosedaction (Name_30, 30, Cst);
                when others =>
                    Debugger.Sendchoosedaction ("NO OPERATION ! ", 0, Cst);
            end case;
        end if;

        Debugger.Sendnewstep;
        if Rule = 0 then
            Debugger.Sendfailed;
        end if;

    end Execute;


    function Lruinfer return Boolean is
        The_Rule : Natural := 0;
        Pos : Natural := 0;
        Last_Pos : Natural := Integer'Last;
    begin
        Debugger.Sendconflictsetstarted;
        for I in 1 .. Used_Rules loop
            Rule_Condition (I) := Evaluate (I);

            if Rule_Condition (I) then
                Pos := 0;
                for J in 1 .. The_Strategie.Count loop
                    if The_Strategie.Rule_Array (J) = I then
                        Pos := J;
                    end if;
                end loop;
                if Pos = 0 then
                    The_Rule := I;
                    exit;
                elsif Pos < Last_Pos then
                    Last_Pos := Pos;
                    The_Rule := The_Strategie.Rule_Array (Last_Pos);
                end if;
            end if;
        end loop;

        Debugger.Sendconflictsetfinished;

        if The_Rule = 0 then
            Reset;
            Debugger.Sendnewstep;
            Debugger.Sendfailed;
            return False;
        end if;

        The_Strategie.Count := The_Strategie.Count + 1;
        if The_Strategie.Count >= Maxstrategy then
            The_Strategie.Count := Maxstrategy;
            for I in 1 .. Maxstrategy - 1 loop
                The_Strategie.Rule_Array (I) :=
                   The_Strategie.Rule_Array (I + 1);
            end loop;
        end if;
        The_Strategie.Rule_Array (The_Strategie.Count) := The_Rule;

        if Debugger.Isdebugged (Debugger.Choosedrule) or
           Debugger.Isdebugged (Debugger.Rulefacts) then
            Debugger.Sendchoosedrule (The_Rule, Cst);
        end if;

        Execute (The_Rule);

        return True;
    end Lruinfer;

    function Firstinfer return Boolean is
    begin
        Debugger.Sendconflictsetstarted;
        for I in 1 .. Used_Rules loop
            Rule_Condition (I) := Evaluate (I);

            if Rule_Condition (I) then
                Debugger.Sendconflictsetfinished;
                if Debugger.Isdebugged (Debugger.Choosedrule) or
                   Debugger.Isdebugged (Debugger.Rulefacts) then
                    Debugger.Sendchoosedrule (I, Cst);
                end if;

                Execute (I);
                return True;
            end if;
        end loop;
        Debugger.Sendnewstep;
        Debugger.Sendfailed;
        return False;
    end Firstinfer;

    generic
        with function Inferstrategy return Boolean;
        Strategynam : Strategyname := " ??? ";
    function Stepnumber (Step : Natural) return Boolean;

    function Stepnumber (Step : Natural) return Boolean is
        Astep : Boolean;
    begin
        Debugger.Sendcontextentered (Context_Name, Localid);
        Debugger.Sendstrategyused (Strategynam);
        if Step = Any then
            loop
                Astep := Inferstrategy;
                exit when not Astep;
            end loop;
        else
            for I in 1 .. Step loop
                Astep := Inferstrategy;
                exit when not Astep;
            end loop;
        end if;
        return Astep;
    end Stepnumber;


    function Lrustrategy is new Stepnumber (Lruinfer, " LRU ");

    function Firststrategy is new Stepnumber (Firstinfer, "FIRST");

    function Inference (Step : Natural := 1) return Boolean is
    begin
        if Resolution = Lru then
            return Lrustrategy (Step);
        else
            return Firststrategy (Step);
        end if;
    end Inference;

begin
    Localid := Instancecounter.Newcontext (Context_Name);
    Debugger.Sendrulesnames (Localid, Context_Name, Name_1, Name_2,
                             Name_3, Name_4, Name_5, Name_6, Name_7,
                             Name_8, Name_9, Name_10, Name_11, Name_12,
                             Name_13, Name_14, Name_15, Name_16, Name_17,
                             Name_18, Name_19, Name_20, Name_21, Name_22,
                             Name_23, Name_24, Name_25, Name_26,
                             Name_27, Name_28, Name_29, Name_30);

end Motor;