|
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: 14336 (0x3800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Bgrb1_Fact_Base_Server, seg_04b35f
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
-- version de bgrb_fact_base_server : AVEC ALLOCATION DYNAMIC
with Queue_Generic;
with Output_Stream;
with Bgrb1_Kbs;
with Bgrb1_Frames;
with Slot;
package body Bgrb1_Fact_Base_Server is
type Kinds is (Add, Delete, Change, Unknown);
type Operations_On_Fact_Base (Kind : Kinds := Unknown) is
record
What_Class_Name : Bgrb1_Kbs.Class_Names;
case Kind is
when Add =>
The_Fact : Bgrb1_Frames.Slots;
when Delete =>
The_Deleted_Object : Bgrb1_Kbs.Kbs.Fact_Name;
when Change =>
The_Changed_Fact : Bgrb1_Kbs.Kbs.Fact_Name;
The_Slot : Bgrb1_Frames.Slots;
To_Value : Slot.Object;
when Unknown =>
null;
end case;
end record;
type Operations is access Operations_On_Fact_Base;
package Operations_Queue is new Queue_Generic (Operations);
task Server is
entry Add (What_Class_Name : Bgrb1_Kbs.Class_Names;
The_Fact : Bgrb1_Frames.Slots);
entry Delete (What_Class_Name : Bgrb1_Kbs.Class_Names;
The_User_Object : Bgrb1_Kbs.Kbs.Fact_Name);
entry Change (What_Class_Name : Bgrb1_Kbs.Class_Names;
The_Fact : Bgrb1_Kbs.Kbs.Fact_Name;
The_Slot : Bgrb1_Frames.Slots;
To_Value : Slot.Object);
entry Update;
end Server;
task body Server is
The_Operations_Queue : Operations_Queue.Queue;
Operation : Operations;
begin
Operations_Queue.Initialize (The_Operations_Queue);
loop
select
accept Update do -- bloque l'appelant
while not (Operations_Queue.Is_Empty
(The_Operations_Queue)) loop
Operation := Operations_Queue.First
(The_Operations_Queue);
case Operation.Kind is
when Add =>
-- case Operation.What_Class_Name is
-- when Bgrb_Kbs.Robot =>
-- Bgrb_Frames.Robots.Add
-- ((Operation.all.The_Fact));
-- when Bgrb_Kbs.Brick =>
-- Bgrb_Frames.Bricks.Add
-- (Operation.all.The_Fact);
-- when Bgrb_Kbs.Box =>
-- Bgrb_Frames.Boxes.Add
-- (Operation.all.The_Fact);
-- when Bgrb_Kbs.Nothing =>
-- null;
-- end case;
null;
when Delete =>
case Operation.What_Class_Name is
when Bgrb1_Kbs.Robot =>
Bgrb1_Frames.Robots.Delete
((Operation.all.The_Deleted_Object));
when Bgrb1_Kbs.Brick =>
Bgrb1_Frames.Bricks.Delete
((Operation.all.The_Deleted_Object));
when Bgrb1_Kbs.Box =>
Bgrb1_Frames.Boxes.Delete
((Operation.all.The_Deleted_Object));
when Bgrb1_Kbs.Nothing =>
null;
end case;
when Change =>
case Operation.What_Class_Name is
when Bgrb1_Kbs.Robot =>
Bgrb1_Frames.Robots.Change
(Operation.all.The_Changed_Fact,
Operation.all.The_Slot,
Operation.all.To_Value);
when Bgrb1_Kbs.Brick =>
Bgrb1_Frames.Bricks.Change
(Operation.all.The_Changed_Fact,
Operation.all.The_Slot,
Operation.all.To_Value);
when Bgrb1_Kbs.Box =>
Bgrb1_Frames.Boxes.Change
(Operation.all.The_Changed_Fact,
Operation.all.The_Slot,
Operation.all.To_Value);
when Bgrb1_Kbs.Nothing =>
null;
end case;
when Unknown =>
null;
end case;
Operations_Queue.Delete (The_Operations_Queue);
end loop;
end Update;
or
accept Add (What_Class_Name : Bgrb1_Kbs.Class_Names;
The_Fact : Bgrb1_Frames.Slots) do
Operation := new Operations_On_Fact_Base'
(What_Class_Name => What_Class_Name, Kind => Add,
The_Fact => The_Fact);
null;
end Add;
Operations_Queue.Add (The_Operations_Queue, Operation);
or
accept Delete (What_Class_Name : Bgrb1_Kbs.Class_Names;
The_User_Object : Bgrb1_Kbs.Kbs.Fact_Name) do
Operation := new Operations_On_Fact_Base'
(Kind => Delete,
What_Class_Name => What_Class_Name,
The_Deleted_Object => The_User_Object);
end Delete;
Operations_Queue.Add (The_Operations_Queue, Operation);
or
accept Change (What_Class_Name : Bgrb1_Kbs.Class_Names;
The_Fact : Bgrb1_Kbs.Kbs.Fact_Name;
The_Slot : Bgrb1_Frames.Slots;
To_Value : Slot.Object) do
Operation := new Operations_On_Fact_Base'
(Kind => Change,
What_Class_Name => What_Class_Name,
The_Changed_Fact => The_Fact,
The_Slot => The_Slot,
To_Value => To_Value);
end Change;
Operations_Queue.Add (The_Operations_Queue, Operation);
or
terminate;
end select;
end loop;
end Server;
procedure Add (What_Class_Name : Bgrb1_Kbs.Class_Names;
The_Fact : Bgrb1_Frames.Slots) is
begin
Server.Add (What_Class_Name, The_Fact);
end Add;
procedure Delete (What_Class_Name : Bgrb1_Kbs.Class_Names;
The_User_Object : Bgrb1_Kbs.Kbs.Fact_Name) is
begin
Server.Delete (What_Class_Name, The_User_Object);
end Delete;
procedure Change (What_Class_Name : Bgrb1_Kbs.Class_Names;
The_Fact : Bgrb1_Kbs.Kbs.Fact_Name;
The_Slot : Bgrb1_Frames.Slots;
To_Value : Slot.Object) is
begin
Server.Change (What_Class_Name, The_Fact, The_Slot, To_Value);
end Change;
procedure Update is
begin
Server.Update;
end Update;
end Bgrb1_Fact_Base_Server;
nblk1=d
nid=a
hdr6=14
[0x00] rec0=25 rec1=00 rec2=01 rec3=004
[0x01] rec0=00 rec1=00 rec2=03 rec3=016
[0x02] rec0=1a rec1=00 rec2=02 rec3=022
[0x03] rec0=0e rec1=00 rec2=0c rec3=034
[0x04] rec0=10 rec1=00 rec2=08 rec3=016
[0x05] rec0=10 rec1=00 rec2=07 rec3=06c
[0x06] rec0=14 rec1=00 rec2=0d rec3=002
[0x07] rec0=12 rec1=00 rec2=06 rec3=092
[0x08] rec0=1d rec1=00 rec2=05 rec3=006
[0x09] rec0=16 rec1=00 rec2=04 rec3=000
[0x0a] rec0=1f rec1=00 rec2=04 rec3=050
[0x0b] rec0=0f rec1=00 rec2=03 rec3=000
[0x0c] rec0=24 rec1=00 rec2=14 rec3=4ff
tail 0x217500164867d5a0cf0f8 0x42a00088462063c03
Free Block Chain:
0xa: 0000 00 09 00 26 80 23 20 20 20 20 20 20 20 20 20 20 ┆ & # ┆
0x9: 0000 00 0b 00 19 80 16 20 20 20 20 20 20 20 20 20 20 ┆ ┆
0xb: 0000 00 00 00 14 80 11 20 20 20 20 20 20 4f 75 74 70 ┆ Outp┆