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: ┃ M T

⟦a08882dd7⟧ TextFile

    Length: 11787 (0x2e0b)
    Types: TextFile
    Names: »MOTOR_ADA«

Derivation

└─⟦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;