|
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: 29696 (0x7400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Database, seg_026cce, seg_027f4b
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
-------------------------------------------------------------------------------
with Direct_Io;
with Text_Io;
with Request;
with Notice;
package body Database is
File_Request_Name : constant String := "requests";
File_Notice_Name : constant String := "notices";
Request_File : Request_Io.File_Type;
Notice_File : Notice_Io.File_Type;
--------------------------------------------------------------------------
procedure Succ (Count : in out Request_Io.Count) is
begin
if (Natural (Count) < Natural (Request_Io.Count'Last)) then
Count := Request_Io.Count'Succ (Count);
end if;
end Succ;
--------------------------------------------------------------------------
procedure Pred (Count : in out Request_Io.Count) is
begin
if (Natural (Count) > Natural (Request_Io.Count'First)) then
Count := Request_Io.Count'Pred (Count);
end if;
end Pred;
--------------------------------------------------------------------------
procedure Succ (Count : in out Notice_Io.Count) is
begin
if (Natural (Count) < Natural (Notice_Io.Count'Last)) then
Count := Notice_Io.Count'Succ (Count);
end if;
end Succ;
--------------------------------------------------------------------------
procedure Pred (Count : in out Notice_Io.Count) is
begin
if (Natural (Count) > Natural (Notice_Io.Count'First)) then
Count := Notice_Io.Count'Pred (Count);
end if;
end Pred;
--------------------------------------------------------------------------
procedure Put (The_Element : Request.Element;
Action : Actions := Performed;
Status : States := Unlock) is
Count : Request_Io.Count;
R_Data : Request_Data;
begin
R_Data.The_Element := The_Element; Request.Add_Handler (Umps_Defs.Any_Behaviors, R_Data.The_Element);
R_Data.State := Status;
R_Data.Action := Action;
Count := Request_Io.Size (Request_File);
Succ (Count);
Request_Io.Write (Request_File, R_Data, Count);
exception
when Request_Io.Use_Error =>
raise Too_Many_Requests_Error;
when Request_Io.Mode_Error =>
raise Internal_Error;
when Request_Io.Device_Error =>
raise Device_Error;
end Put;
--------------------------------------------------------------------------
procedure Put (The_Element : Notice.Element) is
Count : Notice_Io.Count;
N_Data : Notice_Data;
begin
N_Data.The_Element := The_Element;
Notice.Add_Handler (Umps_Defs.Any_Behaviors, N_Data.The_Element);
Count := Notice_Io.Size (Notice_File);
Succ (Count);
Notice_Io.Write (Notice_File, N_Data, Count);
exception
when Notice_Io.Use_Error =>
raise Too_Many_Requests_Error;
when Notice_Io.Mode_Error =>
raise Internal_Error;
when Notice_Io.Device_Error =>
raise Device_Error;
end Put;
--------------------------------------------------------------------------
procedure Next (Iter : in out Iter_Request) is
Element : Request.Element;
R_Data : Request_Data;
function Is_Field_Equal is new Request.Is_Equal (Field => Iter.Field);
begin
Succ (Iter.Count);
Request_Io.Set_Index (Request_File, Iter.Count);
Search_Next_Element:
while (not Request_Io.End_Of_File (Request_File)) loop
Request_Io.Read (Request_File, R_Data);
if ((Iter.State = States'(Both) or else
R_Data.State = Iter.State) and then
(Iter.Action = Actions'(Both) or else
R_Data.Action = Iter.Action)) then
Element := Iter.Condition_Data;
if (Request.Sender (Element) = Umps_Defs.Any_Behaviors) then
Request.Add_Sender
(Request.Sender (R_Data.The_Element), Element);
end if;
exit Search_Next_Element when
Is_Field_Equal (R_Data.The_Element, Element);
end if;
Succ (Iter.Count);
end loop Search_Next_Element;
exception
when Notice_Io.End_Error =>
raise Internal_Error;
when Notice_Io.Data_Error =>
raise Integrity_Error;
when Notice_Io.Mode_Error =>
raise Internal_Error;
when Notice_Io.Device_Error =>
raise Device_Error;
end Next;
--------------------------------------------------------------------------
procedure Next (Iter : in out Iter_Notice) is
Element : Notice.Element;
N_Data : Notice_Data;
function Is_Field_Equal is new Notice.Is_Equal (Field => Iter.Field);
begin
Succ (Iter.Count);
Notice_Io.Set_Index (Notice_File, Iter.Count);
Search_Next_Element:
while (not Notice_Io.End_Of_File (Notice_File)) loop
Notice_Io.Read (Notice_File, N_Data);
Element := Iter.Condition_Data;
if (Notice.Sender (Element) = Umps_Defs.Any_Behaviors) then
Notice.Add_Sender
(Notice.Sender (N_Data.The_Element), Element);
end if; -- They must have the same behavior number
exit Search_Next_Element when Is_Field_Equal
(N_Data.The_Element, Element);
Succ (Iter.Count);
end loop Search_Next_Element;
exception
when Notice_Io.End_Error =>
raise Internal_Error;
when Notice_Io.Data_Error =>
raise Integrity_Error;
when Notice_Io.Mode_Error =>
raise Internal_Error;
when Notice_Io.Device_Error =>
raise Device_Error;
end Next;
--------------------------------------------------------------------------
procedure Init (Iter : in out Iter_Request;
On : Request.Element;
Field : Slot.Fields := Slot.On_Value;
Action : Actions := Interested;
State : States := Unlock;
Behavior : Umps_Defs.Behavior_Number :=
Umps_Defs.Any_Behaviors) is
begin
Iter.Condition_Data := On;
Request.Add_Sender (Behavior, Into => Iter.Condition_Data);
Request.Add_Handler (Umps_Defs.Any_Behaviors,
Into => Iter.Condition_Data);
Iter.Count := Request_Io.Count'First;
Iter.Field := Field;
Iter.State := State;
Iter.Action := Action;
Next (Iter);
end Init;
--------------------------------------------------------------------------
procedure Init (Iter : in out Iter_Notice;
On : Notice.Element;
Field : Slot.Fields := Slot.On_Value;
Behavior : Umps_Defs.Behavior_Number :=
Umps_Defs.Any_Behaviors
) is
begin
Iter.Condition_Data := On;
Notice.Add_Sender (Behavior, Into => Iter.Condition_Data);
Notice.Add_Handler (Umps_Defs.Any_Behaviors,
Into => Iter.Condition_Data);
Iter.Count := Notice_Io.Count'First;
Iter.Field := Field;
Next (Iter);
end Init;
--------------------------------------------------------------------------
function Done (Iter : Iter_Request) return Boolean is
begin
return (Natural (Iter.Count) > Natural
(Request_Io.Size (Request_File)));
end Done;
--------------------------------------------------------------------------
function Done (Iter : Iter_Notice) return Boolean is
begin
return (Natural (Iter.Count) > Natural (Notice_Io.Size (Notice_File)));
end Done;
--------------------------------------------------------------------------
procedure Value (Iter : Iter_Request;
The_Element : out Request.Element;
Action : out Actions;
State : out States) is
R_Data : Request_Data;
begin
if (not Done (Iter)) then
Request_Io.Read (Request_File, R_Data, Iter.Count);
The_Element := R_Data.The_Element;
Action := R_Data.Action;
State := R_Data.State;
else
raise Iterator_Error;
end if;
exception
when Request_Io.End_Error =>
raise Internal_Error;
when Request_Io.Data_Error =>
raise Integrity_Error;
when Request_Io.Mode_Error =>
raise Internal_Error;
when Request_Io.Device_Error =>
raise Device_Error;
end Value;
--------------------------------------------------------------------------
procedure Value (Iter : Iter_Notice; The_Element : out Notice.Element) is
N_Data : Notice_Data;
begin
if (not Done (Iter)) then
Notice_Io.Read (Notice_File, N_Data, Iter.Count);
The_Element := N_Data.The_Element;
else
raise Iterator_Error;
end if;
exception
when Notice_Io.End_Error =>
raise Internal_Error;
when Notice_Io.Data_Error =>
raise Integrity_Error;
when Notice_Io.Mode_Error =>
raise Internal_Error;
when Notice_Io.Device_Error =>
raise Device_Error;
end Value;
--------------------------------------------------------------------------
procedure Replace (Iter : Iter_Request;
The_Element : Request.Element;
With_Action : Actions := Performed;
With_State : States := Unlock) is
R_Data : Request_Data;
begin
R_Data.The_Element := The_Element;
R_Data.Action := With_Action;
R_Data.State := With_State;
Request_Io.Write (Request_File, R_Data, Iter.Count);
exception
when Request_Io.Use_Error =>
raise Internal_Error;
-- It's a rewrite
when Request_Io.Mode_Error =>
raise Internal_Error;
when Request_Io.Device_Error =>
raise Device_Error;
end Replace;
--------------------------------------------------------------------------
procedure Replace (Iter : Iter_Notice; The_Element : Notice.Element) is
N_Data : Notice_Data;
begin
N_Data.The_Element := The_Element;
Notice_Io.Write (File => Notice_File, Item => N_Data, To => Iter.Count);
exception
when Notice_Io.Use_Error =>
raise Internal_Error;
-- It's a rewrite
when Notice_Io.Mode_Error =>
raise Internal_Error;
when Notice_Io.Device_Error =>
raise Device_Error;
end Replace;
--------------------------------------------------------------------------
procedure Display (R_Data : Request_Data; String_Before : String := "") is
begin
Text_Io.Put_Line (String_Before & "State => " &
States'Image (R_Data.State));
Text_Io.Put_Line (String_Before & "Action => " &
Actions'Image (R_Data.Action));
Request.Display (R_Data.The_Element, String_Before & " ");
end Display;
--------------------------------------------------------------------------
procedure Display (N_Data : Notice_Data; String_Before : String := "") is
begin
Notice.Display (N_Data.The_Element, String_Before);
end Display;
--------------------------------------------------------------------------
procedure Display_Requests (String_Before : String := "") is
begin
if (Natural (Request_Io.Size (Request_File)) = 0) then
Text_Io.Put_Line (String_Before & "<empty>");
return;
end if;
Display_All:
declare
R_Data : Request_Data;
begin
Request_Io.Set_Index (Request_File,
Request_Io.Positive_Count'First);
Read_And_Display_All:
while (not Request_Io.End_Of_File (Request_File)) loop
Request_Io.Read (Request_File, R_Data);
Display (R_Data, String_Before);
end loop Read_And_Display_All;
exception
when Request_Io.End_Error =>
raise Internal_Error;
when Request_Io.Data_Error =>
raise Integrity_Error;
when Request_Io.Mode_Error =>
raise Internal_Error;
when Request_Io.Device_Error =>
raise Device_Error;
end Display_All;
end Display_Requests;
--------------------------------------------------------------------------
procedure Display_Notices (String_Before : String := "") is
begin
if (Natural (Notice_Io.Size (Notice_File)) = 0) then
Text_Io.Put_Line (String_Before & "<empty>");
return;
end if;
Display_All:
declare
Element : Notice_Data;
begin
Notice_Io.Set_Index (Notice_File,
Notice_Io.Positive_Count'First);
Read_And_Display_All:
while (not Notice_Io.End_Of_File (Notice_File)) loop
Notice_Io.Read (Notice_File, Element);
Display (Element, String_Before);
end loop Read_And_Display_All;
exception
when Notice_Io.End_Error =>
raise Internal_Error;
when Notice_Io.Data_Error =>
raise Integrity_Error;
when Notice_Io.Mode_Error =>
raise Internal_Error;
when Notice_Io.Device_Error =>
raise Device_Error;
end Display_All;
end Display_Notices;
--------------------------------------------------------------------------
procedure Display is
begin
Text_Io.New_Line;
Text_Io.New_Line;
Text_Io.Put_Line ("-- Requests :");
Display_Requests (" ");
Text_Io.Put_Line ("-- End Requests");
Text_Io.New_Line;
Text_Io.New_Line;
Text_Io.Put_Line ("-- Notices : ");
Display_Notices (" ");
Text_Io.Put_Line ("-- End Notices");
end Display;
--------------------------------------------------------------------------
procedure Open_Anyway_Request_File is
begin
Request_Io.Open (File => Request_File,
Mode => Request_Io.Inout_File,
Name => File_Request_Name);
exception
when Request_Io.Name_Error =>
Creating_Files:
declare
begin
Request_Io.Create (File => Request_File,
Mode => Request_Io.Inout_File,
Name => File_Request_Name);
exception
when Request_Io.Status_Error =>
raise Already_Open_Error;
when Request_Io.Name_Error | Request_Io.Use_Error =>
raise Internal_Error;
end Creating_Files;
when Request_Io.Status_Error =>
raise Already_Open_Error;
when Request_Io.Use_Error =>
raise Internal_Error;
end Open_Anyway_Request_File;
--------------------------------------------------------------------------
procedure Open_Anyway_Notice_File is
begin
Notice_Io.Open (File => Notice_File,
Mode => Notice_Io.Inout_File,
Name => File_Notice_Name);
exception
when Notice_Io.Name_Error =>
Creating_Files:
declare
begin
Notice_Io.Create (File => Notice_File,
Mode => Notice_Io.Inout_File,
Name => File_Notice_Name);
exception
when Notice_Io.Status_Error =>
raise Already_Open_Error;
when Notice_Io.Name_Error | Notice_Io.Use_Error =>
raise Internal_Error;
end Creating_Files;
when Notice_Io.Status_Error =>
raise Already_Open_Error;
when Notice_Io.Use_Error =>
raise Internal_Error;
end Open_Anyway_Notice_File;
--------------------------------------------------------------------------
procedure Destroy is
begin
Request_Io.Open (File => Request_File,
Mode => Request_Io.Inout_File,
Name => File_Request_Name);
Notice_Io.Open (File => Notice_File,
Mode => Notice_Io.Inout_File,
Name => File_Notice_Name);
raise Already_Open_Error;
exception
when Already_Open_Error | Request_Io.Status_Error =>
Deleting_Files:
declare
begin
Request_Io.Delete (Request_File);
Notice_Io.Delete (Notice_File);
exception
when Request_Io.Status_Error =>
null;
when Request_Io.Use_Error =>
raise Internal_Error;
end Deleting_Files;
when Request_Io.Device_Error =>
raise Device_Error;
when Request_Io.Name_Error | Request_Io.Use_Error =>
null;
end Destroy;
--------------------------------------------------------------------------
procedure Open is
begin
Open_Anyway_Request_File;
Open_Anyway_Notice_File;
end Open;
--------------------------------------------------------------------------
procedure Close is
begin
Open_Anyway_Request_File;
Open_Anyway_Notice_File;
raise Already_Open_Error;
exception
when Already_Open_Error =>
Request_Io.Close (Request_File);
Notice_Io.Close (Notice_File);
end Close;
end Database;
------------------------------------------------------------------------------
nblk1=1c
nid=18
hdr6=2e
[0x00] rec0=21 rec1=00 rec2=01 rec3=012
[0x01] rec0=00 rec1=00 rec2=1c rec3=004
[0x02] rec0=1d rec1=00 rec2=0e rec3=002
[0x03] rec0=00 rec1=00 rec2=03 rec3=002
[0x04] rec0=1a rec1=00 rec2=05 rec3=04c
[0x05] rec0=00 rec1=00 rec2=17 rec3=014
[0x06] rec0=1c rec1=00 rec2=11 rec3=00a
[0x07] rec0=1c rec1=00 rec2=0d rec3=018
[0x08] rec0=16 rec1=00 rec2=02 rec3=03a
[0x09] rec0=19 rec1=00 rec2=08 rec3=086
[0x0a] rec0=18 rec1=00 rec2=0a rec3=028
[0x0b] rec0=1c rec1=00 rec2=14 rec3=02e
[0x0c] rec0=1d rec1=00 rec2=15 rec3=01c
[0x0d] rec0=1c rec1=00 rec2=16 rec3=040
[0x0e] rec0=1d rec1=00 rec2=04 rec3=012
[0x0f] rec0=1a rec1=00 rec2=19 rec3=00a
[0x10] rec0=16 rec1=00 rec2=06 rec3=052
[0x11] rec0=1a rec1=00 rec2=0f rec3=040
[0x12] rec0=1f rec1=00 rec2=07 rec3=008
[0x13] rec0=18 rec1=00 rec2=1b rec3=028
[0x14] rec0=19 rec1=00 rec2=10 rec3=02e
[0x15] rec0=1a rec1=00 rec2=1a rec3=05a
[0x16] rec0=1e rec1=00 rec2=12 rec3=000
[0x17] rec0=19 rec1=00 rec2=10 rec3=02e
[0x18] rec0=1a rec1=00 rec2=1a rec3=05a
[0x19] rec0=1e rec1=00 rec2=12 rec3=000
[0x1a] rec0=1e rec1=00 rec2=12 rec3=000
[0x1b] rec0=1e rec1=00 rec2=12 rec3=000
tail 0x21520431883aa67618714 0x42a00088462063c03
Free Block Chain:
0x18: 0000 00 0b 00 0e 80 0b 65 72 6e 61 6c 5f 45 72 72 6f ┆ ernal_Erro┆
0xb: 0000 00 09 00 0e 80 0b 20 20 20 20 20 20 20 20 20 72 ┆ r┆
0x9: 0000 00 0c 03 f9 80 05 69 65 6c 64 3b 05 00 14 20 20 ┆ ield; ┆
0xc: 0000 00 13 00 04 80 01 6f 01 44 61 74 61 2c 20 43 6f ┆ o Data, Co┆
0x13: 0000 00 00 03 fc 80 31 20 20 20 20 20 20 20 20 20 20 ┆ 1 ┆