|
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: 11786 (0x2e0a)
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«
└─⟦3894e7f0f⟧
└─⟦this⟧
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