|
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: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_Class, seg_02cf0d, separate Generic_Fact_Base
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
separate (Generic_Fact_Base)
package body Generic_Class is
The_Class_Object : Class.Object;
function Slot_Count return Natural is
First : Natural := Slot_Names'Pos (Slot_Names'First);
Last : Natural := Slot_Names'Pos (Slot_Names'Last);
begin
return Last - First + 1;
end Slot_Count;
function As_Query_Slot_Name
(Slot_Name : Slot_Names) return Query.Slot_Names is
begin
return Slot_Names'Pos (Slot_Name) -
Slot_Names'Pos (Slot_Names'First) + 1;
end As_Query_Slot_Name;
function As_Class_Slot_Name
(Slot_Name : Slot_Names) return Class.Slot_Names is
begin
return Slot_Names'Pos (Slot_Name) -
Slot_Names'Pos (Slot_Names'First) + 1;
end As_Class_Slot_Name;
function As_Anonymous (What : Patterns) return Query.Patterns is
Result : Query.Patterns (1 .. Slot_Count);
begin
for Slot_Name in What'Range loop
Result (As_Query_Slot_Name (Slot_Name)) := What (Slot_Name);
end loop;
return Result;
end As_Anonymous;
function As_Anonymous (What : Slots) return Class.Slots is
Result : Class.Slots (1 .. Slot_Count);
begin
for Slot_Name in What'Range loop
Result (As_Class_Slot_Name (Slot_Name)) := What (Slot_Name);
end loop;
return Result;
end As_Anonymous;
function Get_Slot_Names_Images return Class.Slot_Names_Images is
Result : Class.Slot_Names_Images (1 .. Slot_Count);
begin
for I in Slot_Names loop
Result (As_Class_Slot_Name (I)) :=
Constant_String.Make (Slot_Names'Image (I));
end loop;
return Result;
end Get_Slot_Names_Images;
function Class_Object return Class.Object is
begin
return The_Class_Object;
end Class_Object;
function Exist (What : Patterns) return Query.Object is
begin
return Query.Object'(Kind => Query.Find,
Class => Class.Class_Name_Of (The_Class_Object),
Size => Slot_Count,
Value => As_Anonymous (What));
end Exist;
function Not_Any (What : Patterns) return Query.Object is
begin
return Query.Object'(Kind => Query.Check_No,
Class => Class.Class_Name_Of (The_Class_Object),
Size => Slot_Count,
Value => As_Anonymous (What));
end Not_Any;
procedure Check_Class_Membership (For_Object : Class.User_Object) is
begin
if Class."/=" (Class.Class_Of (For_Object), The_Class_Object) then
raise Illegal_Access;
end if;
end Check_Class_Membership;
function Get (The_Fact : Class.User_Object; Slot : Slot_Names)
return Integer is
begin
Check_Class_Membership (For_Object => The_Fact);
return Class.Get (The_Fact, Slot => As_Class_Slot_Name (Slot));
end Get;
function Get (The_Fact : Class.User_Object) return Slots is
Result : Slots;
begin
Check_Class_Membership (For_Object => The_Fact);
for Slot in Slot_Names loop
Result (Slot) := Class.Get (The_Object => The_Fact,
Slot => As_Class_Slot_Name (Slot));
end loop;
return Result;
end Get;
procedure Add (The_Fact : Slots) is
begin
Class.Add (To_Class => The_Class_Object,
The_Instance => As_Anonymous (The_Fact));
end Add;
procedure Delete (The_Fact : Class.User_Object) is
begin
Check_Class_Membership (For_Object => The_Fact);
Class.Delete (The_Fact);
end Delete;
procedure Change (The_Fact : Class.User_Object; Value : Slots) is
begin
Check_Class_Membership (For_Object => The_Fact);
Class.Change (The_Fact, To_Value => As_Anonymous (Value));
end Change;
procedure Change (The_Fact : Class.User_Object;
The_Slot : Slot_Names;
To_Value : Integer) is
begin
Check_Class_Membership (For_Object => The_Fact);
Class.Change (The_Object => The_Fact,
Slot => As_Class_Slot_Name (The_Slot),
To_Value => To_Value);
end Change;
procedure Generic_Put (The_Fact : Class.User_Object;
Where : Output_Stream.Object) is
First : Boolean := True;
Class_Name : constant String :=
Class_Names'Image (Class.Class_Name_Of (The_Class_Object));
use Output_Stream;
begin
Check_Class_Membership (For_Object => The_Fact);
Put (Class_Name & "'(", Where);
Indent_Right (Where);
New_Line (Where);
for I in Slot_Names loop
if not First then
Put_Line (", ", Where);
else
First := False;
end if;
Put (Slot_Names'Image (I) & " =>", Where);
Put (Image (I, Get (The_Fact, Slot => I)), Where);
end loop;
Indent_Left (Where);
Put_Line (")", Where);
end Generic_Put;
begin
The_Class_Object := Class.Make (Name => Class_Name,
Class_Size => Class_Size,
Names => Get_Slot_Names_Images);
Working_Memory.Register (The_Class_Object);
end Generic_Class;
nblk1=b
nid=3
hdr6=e
[0x00] rec0=21 rec1=00 rec2=01 rec3=016
[0x01] rec0=1f rec1=00 rec2=05 rec3=026
[0x02] rec0=1b rec1=00 rec2=04 rec3=01e
[0x03] rec0=00 rec1=00 rec2=06 rec3=00c
[0x04] rec0=21 rec1=00 rec2=09 rec3=058
[0x05] rec0=19 rec1=00 rec2=0b rec3=040
[0x06] rec0=16 rec1=00 rec2=08 rec3=000
[0x07] rec0=13 rec1=00 rec2=04 rec3=000
[0x08] rec0=33 rec1=00 rec2=05 rec3=026
[0x09] rec0=14 rec1=00 rec2=08 rec3=000
[0x0a] rec0=14 rec1=00 rec2=08 rec3=000
tail 0x21525a8da840f8282ab93 0x42a00088462063c03
Free Block Chain:
0x3: 0000 00 07 01 9b 80 35 20 20 20 20 20 43 68 65 63 6b ┆ 5 Check┆
0x7: 0000 00 02 00 7b 80 0f 3d 3e 20 49 29 29 2c 20 57 68 ┆ { => I)), Wh┆
0x2: 0000 00 0a 00 15 80 08 20 4f 62 6a 65 63 74 3b 08 00 ┆ Object; ┆
0xa: 0000 00 00 00 21 80 1e 20 20 20 20 20 20 20 20 20 20 ┆ ! ┆