|
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: 17408 (0x4400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Maps, seg_0046e4
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Io;
with Files;
with String_Utilities;
with Low_Level_File_Operations;
package body Maps is
Key_Field : constant Positive := 1;
function Create (From_String : in String) return Mapping is
New_Mapping : Mapping;
begin
if From_String = "" then
-- No fields in string, so no key field.
raise Parse_Failure;
end if;
New_Mapping := Mapping (Mappings.Iterator'
(Mappings.Create (From_String)));
if Mappings.Current
(Mappings.Iterator (New_Mapping)) = "" then
-- Key field is null.
raise Parse_Failure;
end if;
return New_Mapping;
exception
when others =>
raise;
end Create;
function Image (Of_Fields : in Mapping) return String is
begin
return Mappings.Image (Mappings.Iterator (Of_Fields));
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when others =>
raise;
end Image;
function Done (This_Mapping : in Mapping) return Boolean is
begin
return Mappings.Done (Mappings.Iterator (This_Mapping));
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when others =>
raise;
end Done;
procedure Reset (This_Mapping : in out Mapping) is
begin
Mappings.Reset (Mappings.Iterator (This_Mapping));
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when others =>
raise;
end Reset;
function Current (This_Mapping : in Mapping) return Field is
begin
return Mappings.Current (Mappings.Iterator (This_Mapping));
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when Mappings.No_Current_Field =>
raise No_Current_Field;
when others =>
raise;
end Current;
procedure Modify (This_Mapping : in out Mapping; New_Field : in Field) is
begin
if Mappings.Position (Mappings.Iterator (This_Mapping)) = Key_Field then
-- Attempt to modify key field.
raise Out_Of_Range;
end if;
Mappings.Modify (Mappings.Iterator (This_Mapping), New_Field);
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when Mappings.No_Current_Field =>
raise No_Current_Field;
when Mappings.Parse_Failure =>
raise Parse_Failure;
when others =>
raise;
end Modify;
procedure Next (This_Mapping : in out Mapping) is
begin
Mappings.Next (Mappings.Iterator (This_Mapping));
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when Mappings.No_Next_Field =>
raise No_Next_Field;
when others =>
raise;
end Next;
function Position (In_Mapping : in Mapping) return Field_Number is
begin
return Mappings.Position (Mappings.Iterator (In_Mapping));
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when Mappings.No_Current_Field =>
raise No_Current_Field;
when others =>
raise;
end Position;
procedure Set (This_Mapping : in out Mapping; To_Field : in Field_Number) is
begin
Mappings.Set (Mappings.Iterator (This_Mapping), To_Field);
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when Mappings.Out_Of_Range =>
raise Out_Of_Range;
when others =>
raise;
end Set;
function Field_At (This_Position : in Field_Number; In_Mapping : in Mapping)
return Field is
begin
return Mappings.Field_At (This_Position,
Mappings.Iterator (In_Mapping));
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when Mappings.Out_Of_Range =>
raise Out_Of_Range;
when others =>
raise;
end Field_At;
function Fields_In (This_Mapping : in Mapping) return Positive is
begin
return Mappings.Fields_In (Mappings.Iterator (This_Mapping));
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when others =>
raise;
end Fields_In;
procedure Add (This_Field : in Field;
To_Mapping : in out Mapping;
Using_Separator : in Character) is
begin
Mappings.Add (This_Field, Mappings.Iterator (To_Mapping),
Using_Separator);
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when Mappings.Parse_Failure =>
raise Parse_Failure;
when others =>
raise;
end Add;
function Key_For (This_Mapping : in Mapping) return String is
begin
return Mappings.Field_At (Key_Field, Mappings.Iterator (This_Mapping));
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when others =>
raise Bad_Mapping;
end Key_For;
function Create
(From_Map_File : in String; Ignore_Case : in Boolean := True)
return Map is
New_Map : Map;
Input : Io.File_Type;
begin
New_Map.Contents := Lines.Create;
New_Map.Ignore_Case := Ignore_Case;
Low_Level_File_Operations.Create (From_Map_File);
Low_Level_File_Operations.Open_To_Read (From_Map_File, Input);
while not Io.End_Of_File (Input) loop
declare
Current_Line : constant String := Io.Get_Line (Input);
Current_Mapping : Mapping := Create (Current_Line);
begin
declare
Current_Key : constant String := Key_For (Current_Mapping);
begin
if Is_Mapped (Current_Key, New_Map) then
-- Duplicate entry.
raise Parse_Failure;
end if;
Lines.Add (New_Map.Contents, Lines.Create (Current_Line));
end;
end;
end loop;
Low_Level_File_Operations.Close (Input);
Lines.Reset_To_First (New_Map.Contents);
return New_Map;
exception
when Low_Level_File_Operations.Io_Failure =>
Low_Level_File_Operations.Close (Input);
raise Io_Failure;
when others =>
Low_Level_File_Operations.Close (Input);
raise Parse_Failure;
end Create;
procedure Save (To_Map_File : in String; This_Map : in out Map) is
begin
Files.Save (To_Map_File, This_Map.Contents);
exception
when Files.Not_Initialized =>
raise Not_Initialized;
when Files.Io_Failure =>
raise Io_Failure;
when others =>
raise;
end Save;
function Is_Mapped (This_Key : in String; In_Map : in Map) return Boolean is
The_Mapping : Mapping;
begin
The_Mapping := Mapping_For (This_Key, In_Map);
return True;
exception
when Not_Initialized =>
raise Not_Initialized;
when Bad_Mapping =>
raise Bad_Mapping;
when others =>
return False;
end Is_Mapped;
procedure Locate (This_Key : in String;
In_Map : in out Map;
The_Mapping : in out Mapping) is
-- Looks for the specified key in the specified map. If
-- finds it, the map will be left with Current pointing
-- to the entry matching the key, and the mapping itself
-- will be passed to the caller. If not found, raises
-- "No_Mapping".
This_Key_Normalized : constant String :=
String_Utilities.Upper_Case (This_Key);
begin
Lines.Reset_To_First (In_Map.Contents);
while not Lines.Done (In_Map.Contents) loop
declare
Current_Line : constant String :=
Lines.Image (Lines.Current (In_Map.Contents));
Current_Mapping : Mapping := Create (Current_Line);
Key_Field : constant String := Key_For (Current_Mapping);
Key_Field_Normalized : constant String :=
String_Utilities.Upper_Case (Key_Field);
begin
The_Mapping := Current_Mapping;
if In_Map.Ignore_Case then
if Key_Field_Normalized = This_Key_Normalized then
-- Found match ignoring casing.
exit;
end if;
else
if Key_Field = This_Key then
-- Found match including casing.
exit;
end if;
end if;
-- Didn't find match on this pass.
end;
Lines.Next (In_Map.Contents);
end loop;
if Lines.Done (In_Map.Contents) then
-- Never found match.
raise No_Mapping;
end if;
exception
when Lines.Not_Initialized =>
raise Not_Initialized;
when Bad_Mapping | Parse_Failure =>
raise Bad_Mapping;
when No_Mapping =>
raise No_Mapping;
when others =>
raise;
end Locate;
function Mapping_For
(This_Key : in String; In_Map : in Map) return Mapping is
The_Mapping : Mapping;
The_Map : Map := In_Map;
begin
Locate (This_Key, The_Map, The_Mapping);
return The_Mapping;
end Mapping_For;
procedure Add (This_Mapping : in Mapping; To_Map : in out Map) is
Old_Mapping : Mapping;
begin
Locate (This_Key => Key_For (This_Mapping),
In_Map => To_Map,
The_Mapping => Old_Mapping);
-- Found existing mapping with same key: need to overwrite.
Lines.Modify (To_Map.Contents, Lines.Create (Image (This_Mapping)));
exception
when No_Mapping =>
-- No mapping with the given key exists: need to add.
Lines.Add (To_Map.Contents, Lines.Create (Image (This_Mapping)));
when others =>
raise;
end Add;
procedure Add (This_Mapping : in String; To_Map : in out Map) is
begin
Add (Create (This_Mapping), To_Map);
end Add;
procedure Delete (From_Map : in out Map) is
begin
Lines.Delete (From_Map.Contents);
exception
when Lines.No_Current_Line =>
raise No_Current_Mapping;
when others =>
raise;
end Delete;
function Done (This_Map : in Map) return Boolean is
begin
return Lines.Done (This_Map.Contents);
exception
when Lines.Not_Initialized =>
raise Not_Initialized;
when others =>
raise;
end Done;
procedure Reset (This_Map : in out Map) is
begin
Lines.Reset_To_First (This_Map.Contents);
exception
when Lines.Not_Initialized =>
raise Not_Initialized;
when others =>
raise;
end Reset;
function Current (This_Map : in Map) return Mapping is
begin
return Create (Lines.Image (Lines.Current (This_Map.Contents)));
exception
when Lines.Not_Initialized =>
raise Not_Initialized;
when Lines.No_Current_Line =>
raise No_Current_Mapping;
when Parse_Failure | Bad_Mapping =>
raise Bad_Mapping;
when others =>
raise;
end Current;
procedure Next (This_Map : in out Map) is
begin
Lines.Next (This_Map.Contents);
exception
when Lines.Not_Initialized =>
raise Not_Initialized;
when Lines.No_Next_Line =>
raise No_Next_Mapping;
when others =>
raise;
end Next;
function Is_Empty (This_Map : in Map) return Boolean is
begin
return Lines.Is_Empty (This_Map.Contents);
exception
when Lines.Not_Initialized =>
raise Not_Initialized;
when others =>
raise;
end Is_Empty;
function Mappings_In (This_Map : in Map) return Natural is
begin
return Lines.Lines_In (This_Map.Contents);
exception
when Mappings.Not_Initialized =>
raise Not_Initialized;
when others =>
raise;
end Mappings_In;
procedure Dispose (Of_This_Map : in out Map) is
begin
Lines.Dispose (Of_This_Map.Contents);
end Dispose;
end Maps;
nblk1=10
nid=0
hdr6=20
[0x00] rec0=27 rec1=00 rec2=01 rec3=026
[0x01] rec0=26 rec1=00 rec2=02 rec3=03a
[0x02] rec0=21 rec1=00 rec2=03 rec3=03c
[0x03] rec0=24 rec1=00 rec2=04 rec3=06e
[0x04] rec0=1f rec1=00 rec2=05 rec3=082
[0x05] rec0=23 rec1=00 rec2=06 rec3=038
[0x06] rec0=00 rec1=00 rec2=10 rec3=006
[0x07] rec0=18 rec1=00 rec2=07 rec3=00e
[0x08] rec0=00 rec1=00 rec2=0f rec3=016
[0x09] rec0=27 rec1=00 rec2=08 rec3=054
[0x0a] rec0=16 rec1=00 rec2=09 rec3=03c
[0x0b] rec0=1c rec1=00 rec2=0a rec3=010
[0x0c] rec0=21 rec1=00 rec2=0b rec3=078
[0x0d] rec0=2a rec1=00 rec2=0c rec3=01a
[0x0e] rec0=27 rec1=00 rec2=0d rec3=01a
[0x0f] rec0=1a rec1=00 rec2=0e rec3=000
tail 0x217002a4c815c67496af4 0x42a00088462061e03