|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 22528 (0x5800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package body Engine, seg_00c7d3, separate Expertsystem
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Instancecounter;
separate (Expertsystem)
package body Engine is
Maxrule : constant Positive := 30;
Maxlru : constant Positive := 30;
type Sorted_Rule is array (1 .. Maxlru) of Natural;
type Lru_Resolution is
record
Rule_Array : Sorted_Rule := (others => 0);
Count : Natural := 0;
end record;
Lru_Strategy : Lru_Resolution;
Cst : Tuple.Object;
Cstsort : Tuple.Object;
Csrule : Natural := 0;
Tc : Tuplecollection.Object;
T : Tuple.Object;
The_Tuple : Tuple.Object;
Localid : Contextid;
function "<" (Left, Right : Reference) return Boolean is
begin
return Left.Date < Right.Date;
end "<";
procedure Sortdate is new Tuple.Sort ("<");
procedure Evaluatetuplecollection (Rule : Positive) is
begin
if not Rulemanager.Ismasked (Context_Name, Rule) then
case Rule is
when 1 =>
Tc := Condition_1;
when 2 =>
Tc := Condition_2;
when 3 =>
Tc := Condition_3;
when 4 =>
Tc := Condition_4;
when 5 =>
Tc := Condition_5;
when 6 =>
Tc := Condition_6;
when 7 =>
Tc := Condition_7;
when 8 =>
Tc := Condition_8;
when 9 =>
Tc := Condition_9;
when 10 =>
Tc := Condition_10;
when 11 =>
Tc := Condition_11;
when 12 =>
Tc := Condition_12;
when 13 =>
Tc := Condition_13;
when 14 =>
Tc := Condition_14;
when 15 =>
Tc := Condition_15;
when 16 =>
Tc := Condition_16;
when 17 =>
Tc := Condition_17;
when 18 =>
Tc := Condition_18;
when 19 =>
Tc := Condition_19;
when 20 =>
Tc := Condition_20;
when 21 =>
Tc := Condition_21;
when 22 =>
Tc := Condition_22;
when 23 =>
Tc := Condition_23;
when 24 =>
Tc := Condition_24;
when 25 =>
Tc := Condition_25;
when 26 =>
Tc := Condition_26;
when 27 =>
Tc := Condition_27;
when 28 =>
Tc := Condition_28;
when 29 =>
Tc := Condition_29;
when 30 =>
Tc := Condition_30;
when others =>
null;
end case;
else
declare
Tc1 : Tuplecollection.Object;
begin
Tc := Tc1;
end;
end if;
if Debugger.Isdebugged (Debugger.Conditionevalued) then
case Rule is
when 1 =>
Debugger.Sendconditionevalued
(Name_1, 1, Tuplecollection.Isnotnull (Tc), Tc);
when 2 =>
Debugger.Sendconditionevalued
(Name_2, 2, Tuplecollection.Isnotnull (Tc), Tc);
when 3 =>
Debugger.Sendconditionevalued
(Name_3, 3, Tuplecollection.Isnotnull (Tc), Tc);
when 4 =>
Debugger.Sendconditionevalued
(Name_4, 4, Tuplecollection.Isnotnull (Tc), Tc);
when 5 =>
Debugger.Sendconditionevalued
(Name_5, 5, Tuplecollection.Isnotnull (Tc), Tc);
when 6 =>
Debugger.Sendconditionevalued
(Name_6, 6, Tuplecollection.Isnotnull (Tc), Tc);
when 7 =>
Debugger.Sendconditionevalued
(Name_7, 7, Tuplecollection.Isnotnull (Tc), Tc);
when 8 =>
Debugger.Sendconditionevalued
(Name_8, 8, Tuplecollection.Isnotnull (Tc), Tc);
when 9 =>
Debugger.Sendconditionevalued
(Name_9, 9, Tuplecollection.Isnotnull (Tc), Tc);
when 10 =>
Debugger.Sendconditionevalued
(Name_10, 10, Tuplecollection.Isnotnull (Tc), Tc);
when 11 =>
Debugger.Sendconditionevalued
(Name_11, 11, Tuplecollection.Isnotnull (Tc), Tc);
when 12 =>
Debugger.Sendconditionevalued
(Name_12, 12, Tuplecollection.Isnotnull (Tc), Tc);
when 13 =>
Debugger.Sendconditionevalued
(Name_13, 13, Tuplecollection.Isnotnull (Tc), Tc);
when 14 =>
Debugger.Sendconditionevalued
(Name_14, 14, Tuplecollection.Isnotnull (Tc), Tc);
when 15 =>
Debugger.Sendconditionevalued
(Name_15, 15, Tuplecollection.Isnotnull (Tc), Tc);
when 16 =>
Debugger.Sendconditionevalued
(Name_16, 16, Tuplecollection.Isnotnull (Tc), Tc);
when 17 =>
Debugger.Sendconditionevalued
(Name_17, 17, Tuplecollection.Isnotnull (Tc), Tc);
when 18 =>
Debugger.Sendconditionevalued
(Name_18, 18, Tuplecollection.Isnotnull (Tc), Tc);
when 19 =>
Debugger.Sendconditionevalued
(Name_19, 19, Tuplecollection.Isnotnull (Tc), Tc);
when 20 =>
Debugger.Sendconditionevalued
(Name_20, 20, Tuplecollection.Isnotnull (Tc), Tc);
when 21 =>
Debugger.Sendconditionevalued
(Name_21, 21, Tuplecollection.Isnotnull (Tc), Tc);
when 22 =>
Debugger.Sendconditionevalued
(Name_22, 22, Tuplecollection.Isnotnull (Tc), Tc);
when 23 =>
Debugger.Sendconditionevalued
(Name_23, 23, Tuplecollection.Isnotnull (Tc), Tc);
when 24 =>
Debugger.Sendconditionevalued
(Name_24, 24, Tuplecollection.Isnotnull (Tc), Tc);
when 25 =>
Debugger.Sendconditionevalued
(Name_25, 25, Tuplecollection.Isnotnull (Tc), Tc);
when 26 =>
Debugger.Sendconditionevalued
(Name_26, 26, Tuplecollection.Isnotnull (Tc), Tc);
when 27 =>
Debugger.Sendconditionevalued
(Name_27, 27, Tuplecollection.Isnotnull (Tc), Tc);
when 28 =>
Debugger.Sendconditionevalued
(Name_28, 28, Tuplecollection.Isnotnull (Tc), Tc);
when 29 =>
Debugger.Sendconditionevalued
(Name_29, 29, Tuplecollection.Isnotnull (Tc), Tc);
when 30 =>
Debugger.Sendconditionevalued
(Name_30, 30, Tuplecollection.Isnotnull (Tc), Tc);
when others =>
null;
end case;
end if;
end Evaluatetuplecollection;
procedure Executetuple (Rule : Natural) is
begin
case Rule is
when 1 =>
Action_1 (Cst);
when 2 =>
Action_2 (Cst);
when 3 =>
Action_3 (Cst);
when 4 =>
Action_4 (Cst);
when 5 =>
Action_5 (Cst);
when 6 =>
Action_6 (Cst);
when 7 =>
Action_7 (Cst);
when 8 =>
Action_8 (Cst);
when 9 =>
Action_9 (Cst);
when 10 =>
Action_10 (Cst);
when 11 =>
Action_11 (Cst);
when 12 =>
Action_12 (Cst);
when 13 =>
Action_13 (Cst);
when 14 =>
Action_14 (Cst);
when 15 =>
Action_15 (Cst);
when 16 =>
Action_16 (Cst);
when 17 =>
Action_17 (Cst);
when 18 =>
Action_18 (Cst);
when 19 =>
Action_19 (Cst);
when 20 =>
Action_20 (Cst);
when 21 =>
Action_21 (Cst);
when 22 =>
Action_22 (Cst);
when 23 =>
Action_23 (Cst);
when 24 =>
Action_24 (Cst);
when 25 =>
Action_25 (Cst);
when 26 =>
Action_26 (Cst);
when 27 =>
Action_27 (Cst);
when 28 =>
Action_28 (Cst);
when 29 =>
Action_29 (Cst);
when 30 =>
Action_30 (Cst);
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 Executetuple;
procedure Lrureset is
begin
for I in 1 .. Maxlru loop
Lru_Strategy.Rule_Array (I) := 0;
end loop;
Lru_Strategy.Count := 0;
end Lrureset;
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
Evaluatetuplecollection (I);
if Tuplecollection.Isnotnull (Tc) then
Pos := 0;
for J in 1 .. Lru_Strategy.Count loop
if Lru_Strategy.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 := Lru_Strategy.Rule_Array (Last_Pos);
end if;
end if;
end loop;
Debugger.Sendconflictsetfinished;
if The_Rule = 0 then
Lrureset;
Debugger.Sendnewstep;
Debugger.Sendfailed;
return False;
end if;
Lru_Strategy.Count := Lru_Strategy.Count + 1;
if Lru_Strategy.Count > Maxlru then
Lru_Strategy.Count := Maxlru;
for I in 1 .. Maxlru - 1 loop
Lru_Strategy.Rule_Array (I) := Lru_Strategy.Rule_Array (I + 1);
end loop;
end if;
Lru_Strategy.Rule_Array (Lru_Strategy.Count) := The_Rule;
Evaluatetuplecollection (The_Rule);
Cst := Tuplecollection.First (Tc);
if Debugger.Isdebugged (Debugger.Choosedrule) or
Debugger.Isdebugged (Debugger.Rulefacts) then
Debugger.Sendchoosedrule (The_Rule, Cst);
end if;
Executetuple (The_Rule);
return True;
end Lruinfer;
function Lexormeainfer return Boolean is
First_Tuple : Boolean := True;
begin
Csrule := 0;
Debugger.Sendconflictsetstarted;
for I in 1 .. Used_Rules loop
Evaluatetuplecollection (I);
for J in 1 .. Tuplecollection.Cardinality (Tc) loop
T := Tuplecollection.Get (Tc, J);
if First_Tuple then
Cst := T;
Sortdate (T);
Cstsort := T;
Csrule := I;
First_Tuple := False;
else
if Resolution = Mea and Tuple.First (T).Date >
Tuple.First (Cst).Date then
Csrule := I;
Cst := T;
else
The_Tuple := T;
Sortdate (T);
for K in 1 .. Tuple.Cardinality (T) loop
if Tuple.Get (T, K).Date >
Tuple.Get (Cstsort, K).Date then
Csrule := I;
Cst := The_Tuple;
Cstsort := T;
exit;
elsif Tuple.Get (T, K).Date <
Tuple.Get (Cstsort, K).Date then
exit;
end if;
if K = Tuple.Cardinality (Cst) then
exit;
end if;
end loop;
end if;
end if;
end loop;
end loop;
Debugger.Sendconflictsetfinished;
if Csrule /= 0 and then (Debugger.Isdebugged (Debugger.Choosedrule) or
Debugger.Isdebugged (Debugger.Rulefacts)) then
Debugger.Sendchoosedrule (Csrule, Cst);
end if;
Executetuple (Csrule);
return Csrule /= 0;
end Lexormeainfer;
function Firstinfer return Boolean is
begin
Debugger.Sendconflictsetstarted;
for I in 1 .. Used_Rules loop
Evaluatetuplecollection (I);
if Tuplecollection.Isnotnull (Tc) then
Debugger.Sendconflictsetfinished;
Cst := Tuplecollection.First (Tc);
if Debugger.Isdebugged (Debugger.Choosedrule) or
Debugger.Isdebugged (Debugger.Rulefacts) then
Debugger.Sendchoosedrule (I, Cst);
end if;
Executetuple (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
if Resolution = Lex then
Debugger.Sendstrategyused (" LEX ");
elsif Resolution = Mea then
Debugger.Sendstrategyused (" MEA ");
else
Debugger.Sendstrategyused (Strategynam);
end if;
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 Lexormeastrategy is new Stepnumber (Lexormeainfer, " /// ");
function Lrustrategy is new Stepnumber (Lruinfer, " LRU ");
function Firststrategy is new Stepnumber (Firstinfer, "FIRST");
function Inference (Step : Natural := 1) return Boolean is
begin
Debugger.Sendcontextentered (Context_Name, Localid);
if Resolution = Lex or Resolution = Mea then
return Lexormeastrategy (Step);
elsif 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 Engine;
nblk1=15
nid=0
hdr6=2a
[0x00] rec0=28 rec1=00 rec2=01 rec3=030
[0x01] rec0=1d rec1=00 rec2=02 rec3=048
[0x02] rec0=1d rec1=00 rec2=03 rec3=022
[0x03] rec0=1a rec1=00 rec2=04 rec3=08a
[0x04] rec0=15 rec1=00 rec2=05 rec3=008
[0x05] rec0=13 rec1=00 rec2=06 rec3=006
[0x06] rec0=13 rec1=00 rec2=07 rec3=062
[0x07] rec0=13 rec1=00 rec2=08 rec3=092
[0x08] rec0=26 rec1=00 rec2=09 rec3=004
[0x09] rec0=21 rec1=00 rec2=0a rec3=030
[0x0a] rec0=17 rec1=00 rec2=0b rec3=020
[0x0b] rec0=16 rec1=00 rec2=0c rec3=030
[0x0c] rec0=14 rec1=00 rec2=0d rec3=07a
[0x0d] rec0=21 rec1=00 rec2=0e rec3=04e
[0x0e] rec0=1f rec1=00 rec2=0f rec3=02a
[0x0f] rec0=1d rec1=00 rec2=10 rec3=022
[0x10] rec0=15 rec1=00 rec2=11 rec3=064
[0x11] rec0=23 rec1=00 rec2=12 rec3=05e
[0x12] rec0=24 rec1=00 rec2=13 rec3=024
[0x13] rec0=21 rec1=00 rec2=14 rec3=064
[0x14] rec0=0b rec1=00 rec2=15 rec3=000
tail 0x2170982ba820748fd3957 0x42a00088462060003