|
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 - metrics - download
Length: 17408 (0x4400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Qualit_Epsilon_Rule_Bundle, package body Qualit_Frames, package body Qualit_Generic_Agent, package body Qualit_Update_Rule_Bundle, package body Qualit_Working_Memory, seg_04c7f1
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Generic_Kbs;
with Default_User_Operators;
with Display;
with Output_Stream;
with Qualit_Result_File_Maker;
package body Qualit_Generic_Agent is
The_Output_Window : Display.Window (Display.Output_Window);
The_Output_File : Qualit_Result_File_Maker.Object;
-- ****************************** KBS ************************************************
type Class_Names is (Prediction, Delta_Y, Up_Value, Down_Value,
Up_Decrement, Up_Increment, Down_Decrement,
Down_Increment, Actual_Position, Position_To_Reach,
Update, Epsilon, Epsilon_Variation,
Variation_Of_Epsilon_Variation, Nothing);
type Rule_Bundles is (Update_Rule_Bundle, Epsilon_Rule_Bundle);
package Kbs is new Generic_Kbs
(Max_Slots => 50,
Max_Condition_Elements_By_Rule => 10,
Max_Rules => 25,
Class_Names => Class_Names,
Null_Class_Name => Class_Names'Last,
User_Defined_Expression_Operators =>
Default_User_Operators.Expression_Operators,
User_Defined_Unary_Evaluate =>
Default_User_Operators.Unary_Evaluate,
User_Defined_Binary_Evaluate =>
Default_User_Operators.Binary_Evaluate,
User_Defined_Predicate_Operators =>
Default_User_Operators.Predicate_Operators,
User_Defined_Unary_Match =>
Default_User_Operators.Unary_Match,
User_Defined_Binary_Match =>
Default_User_Operators.Binary_Match,
Rule_Bundles => Rule_Bundles);
-- ****************************** FRAMES *********************************************
package Qualit_Frames is
use Slot;
use Kbs;
Null_Value : constant Slot.Object := Value (0);
Epsilon_Near_0 : constant Slot.Object := Value (20);
type Prediction_Names is (Epsilon_Should_Decrease_To_Zero,
Epsilon_Should_Increase_Or_Be_Constant,
Epsilon_Variation_Should_Decrease,
Epsilon_Should_Decrease_Or_Be_Constant);
type Boolean is (True, False);
package Prediction_Name_Facilities is
new Enumeration_Facilities (Prediction_Names);
Epsilon_Should_Decrease_To_Zero_Prediction_Name : constant Object :=
Prediction_Name_Facilities.Value (Epsilon_Should_Decrease_To_Zero);
Epsilon_Should_Increase_Or_Be_Constant_Prediction_Name :
constant Object := Prediction_Name_Facilities.Value
(Epsilon_Should_Increase_Or_Be_Constant);
Epsilon_Variation_Should_Decrease_Prediction_Name : constant Object :=
Prediction_Name_Facilities.Value (Epsilon_Variation_Should_Decrease);
Epsilon_Should_Decrease_Or_Be_Constant_Prediction_Name :
constant Object := Prediction_Name_Facilities.Value
(Epsilon_Should_Decrease_Or_Be_Constant);
package Boolean_Facilities is new Enumeration_Facilities (Boolean);
True_Boolean : constant Object := Boolean_Facilities.Value (True);
False_Boolean : constant Object := Boolean_Facilities.Value (False);
type Prediction_Slots is (Quadrant_Number, Prediction_Name);
package Predictions is
new Fact_Base.Generic_Class (Class_Name => Prediction,
Class_Size => 1,
Slot_Names => Prediction_Slots);
type Epsilon_Slots is (Value);
package Epsilons is
new Fact_Base.Generic_Class (Class_Name => Epsilon,
Class_Size => 1,
Slot_Names => Epsilon_Slots);
type Epsilon_Variation_Slots is (Value);
package Epsilon_Variaions is
new Fact_Base.Generic_Class (Class_Name => Epsilon_Variation,
Class_Size => 1,
Slot_Names => Epsilon_Variation_Slots);
type Variation_Of_Epsilon_Variation_Slots is (Value);
package Variation_Of_Epsilon_Variations is
new Fact_Base.Generic_Class
(Class_Name => Variation_Of_Epsilon_Variation,
Class_Size => 1,
Slot_Names => Variation_Of_Epsilon_Variation_Slots);
type Up_Value_Slots is (Value);
package Up_Values is
new Fact_Base.Generic_Class (Class_Name => Up_Value,
Class_Size => 1,
Slot_Names => Up_Value_Slots);
type Down_Value_Slots is (Value);
package Down_Values is
new Fact_Base.Generic_Class (Class_Name => Down_Value,
Class_Size => 1,
Slot_Names => Down_Value_Slots);
type Up_Decrement_Slots is (Value);
package Up_Decrements is
new Fact_Base.Generic_Class (Class_Name => Up_Decrement,
Class_Size => 1,
Slot_Names => Up_Decrement_Slots);
type Up_Increment_Slots is (Value);
package Up_Increments is
new Fact_Base.Generic_Class (Class_Name => Up_Increment,
Class_Size => 1,
Slot_Names => Up_Increment_Slots);
type Down_Decrement_Slots is (Value);
package Down_Decrements is
new Fact_Base.Generic_Class (Class_Name => Down_Decrement,
Class_Size => 1,
Slot_Names => Down_Decrement_Slots);
type Down_Increment_Slots is (Value);
package Down_Increments is
new Fact_Base.Generic_Class (Class_Name => Down_Increment,
Class_Size => 1,
Slot_Names => Down_Increment_Slots);
type Actual_Position_Slots is (Value);
package Actual_Positions is
new Fact_Base.Generic_Class (Class_Name => Actual_Position,
Class_Size => 1,
Slot_Names => Actual_Position_Slots);
type Position_To_Reach_Slots is (Value);
package Positions_To_Reach is
new Fact_Base.Generic_Class (Class_Name => Position_To_Reach,
Class_Size => 1,
Slot_Names => Position_To_Reach_Slots);
type Update_Slots is (Valid);
package Updates is
new Fact_Base.Generic_Class (Class_Name => Update,
Class_Size => 1,
Slot_Names => Update_Slots);
type Delta_Y_Slots is (Value);
package Delta_Ys is
new Fact_Base.Generic_Class (Class_Name => Delta_Y,
Class_Size => 1,
Slot_Names => Delta_Y_Slots);
procedure Put (The_Fact : Fact_Name; Where : Output_Stream.Object);
end Qualit_Frames;
package body Qualit_Frames is separate;
-- ************************* WORKING MEMORY ******************************************
package Qualit_Working_Memory is
procedure Put_All is
new Kbs.Fact_Base.Working_Memory.Generic_Put (Qualit_Frames.Put);
procedure Default_Put;
procedure Load_Initial (The_Position_To_Reach : Integer);
end Qualit_Working_Memory;
package body Qualit_Working_Memory is separate;
-- ************************ UPDATE RULE BUNDLE ***************************************
package Qualit_Update_Rule_Bundle is
use Kbs;
procedure Update_Do_Action (For_Rule : Rule_Id;
On_Facts : Fact_Collection);
end Qualit_Update_Rule_Bundle;
package body Qualit_Update_Rule_Bundle is separate;
-- ************************ EPSILON RULE BUNDLE **************************************
package Qualit_Epsilon_Rule_Bundle is
use Kbs;
procedure Epsilon_Rules_Do_Action
(For_Rule : Rule_Id; On_Facts : Fact_Collection);
end Qualit_Epsilon_Rule_Bundle;
package body Qualit_Epsilon_Rule_Bundle is separate;
-- ************************** PRINCIPAL **********************************************
procedure Qualit_Do_Action (For_Rule : Kbs.Rule_Id;
On_Facts : Kbs.Fact_Collection) is
begin case Kbs.Rule_Base.Get (For_Rule) is
when Update_Rule_Bundle =>
Qualit_Update_Rule_Bundle.Update_Do_Action (For_Rule, On_Facts);
when Epsilon_Rule_Bundle =>
Qualit_Epsilon_Rule_Bundle.Epsilon_Rules_Do_Action
(For_Rule, On_Facts);
end case;
end Qualit_Do_Action;
task The_Agent is
entry Work;
entry Stop_Working;
end The_Agent;
task body The_Agent is
Inference_Succeded : Boolean := True;
Done : Boolean := False;
function Qualit_Infere is new Kbs.Rule_Base.
One_Inference_With_Conflict_Set
(Retrieve => Kbs.Retrieve,
Do_Action => Qualit_Do_Action);
begin
Qualit_Result_File_Maker.Create (The_Output_File,
"RESULT" & Agent_Ids'Image (Agent_Id));
while not (Done) loop
select
accept Work;
while Inference_Succeded loop
Inference_Succeded := Qualit_Infere;
-- inference has not succeded when actual_pos = pos_to_reach;
end loop;
Qualit_Result_File_Maker.Close (The_Output_File);
Job_Terminated (Agent_Id);
or
accept Stop_Working;
Done := True;
end select;
end loop;
end The_Agent;
procedure Go (Pos_To_Reach : Integer) is
begin
Display.Open_Window (Agent_Ids'Image (Agent_Id),
The_Output_Window, Display.Output_Window);
Qualit_Working_Memory.Load_Initial (Pos_To_Reach);
The_Agent.Work;
end Go;
procedure Stop is
begin
The_Agent.Stop_Working;
end Stop;
end Qualit_Generic_Agent;
nblk1=10
nid=d
hdr6=1e
[0x00] rec0=1b rec1=00 rec2=01 rec3=056
[0x01] rec0=03 rec1=00 rec2=0e rec3=072
[0x02] rec0=14 rec1=00 rec2=0c rec3=05c
[0x03] rec0=04 rec1=00 rec2=0b rec3=00a
[0x04] rec0=12 rec1=00 rec2=07 rec3=04a
[0x05] rec0=18 rec1=00 rec2=06 rec3=03a
[0x06] rec0=00 rec1=00 rec2=0a rec3=002
[0x07] rec0=15 rec1=00 rec2=05 rec3=03a
[0x08] rec0=15 rec1=00 rec2=04 rec3=03e
[0x09] rec0=15 rec1=00 rec2=03 rec3=004
[0x0a] rec0=21 rec1=00 rec2=09 rec3=000
[0x0b] rec0=24 rec1=00 rec2=08 rec3=002
[0x0c] rec0=1b rec1=00 rec2=02 rec3=074
[0x0d] rec0=00 rec1=00 rec2=0f rec3=01c
[0x0e] rec0=23 rec1=00 rec2=10 rec3=001
[0x0f] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x217533ffa86d87711b0b4 0x42a00088462063c03
Free Block Chain:
0xd: 0000 00 00 00 17 80 0e 65 20 28 41 67 65 6e 74 5f 49 ┆ e (Agent_I┆