|
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: 14911 (0x3a3f)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦f8bc794bc⟧
└─⟦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;