|
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: 16384 (0x4000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Data, package body Destination, package body Error, package body Source, seg_038c15
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Lex;
with Queue_Generic;
package body Error is
-------------------------- Declaration des types --------------------------
---------------------------------------------------------------------------
type Error_Record is
record
Err_No : Natural := 0;
Line_No : Natural := 0;
Column_No : Natural := 0;
end record;
type Check_Mark_List is array (0 .. 20) of Natural;
type Error_List is array (0 .. 20) of Natural;
type Pstring is access String;
-------------------------- Declaration des Paquetages ---------------------
---------------------------------------------------------------------------
package Error_Queue is new Queue_Generic (Error_Record);
package Data is
function Image (Index : Natural) return String;
function Get_Token (Index : Natural) return Lex.Tokens;
end Data;
package Destination is
procedure Open (Destination_File_Name : String);
procedure Close;
procedure Put_Line (S : String);
procedure Put_Check_Marks (The_Check_Marks : Check_Mark_List);
end Destination;
package Source is
procedure Open (Source_File_Name : String);
procedure Close;
procedure Next_Line;
function Image return String;
function Line return Natural;
function End_Of_File return Boolean;
end Source;
-------------------------- Declaration des variables --------------------------
-------------------------------------------------------------------------------
The_Object : Error_Queue.Queue;
The_Iterator : Error_Queue.Iterator;
-------------------------- Iplementation des procedures -----------------------
-------------------------------------------------------------------------------
procedure Initialize is
begin
Error_Queue.Initialize (The_Object);
end Initialize;
procedure Panic (The_Rule : Natural) is
begin
while not Lex.Current_Token_In (Data.Get_Token (The_Rule)) and then
not Lex.At_End loop
Lex.Next;
end loop;
end Panic;
procedure Append (The_Error : Natural) is
Current_Error_Record : Error_Record;
begin
Current_Error_Record.Err_No := The_Error;
Current_Error_Record.Line_No := Lex.Get_Line;
Current_Error_Record.Column_No := Lex.Get_Column;
Error_Queue.Add (The_Object, Current_Error_Record);
end Append;
function Exist return Boolean is
begin
return not Error_Queue.Is_Empty (The_Object);
end Exist;
procedure Init_Iterator is
begin
Error_Queue.Init (The_Iterator, The_Object);
end Init_Iterator;
procedure Next is
begin
Error_Queue.Next (The_Iterator);
end Next;
function Get return Error_Record is
begin
return Error_Queue.Value (The_Iterator);
end Get;
function At_End return Boolean is
begin
return Error_Queue.Done (The_Iterator);
end At_End;
procedure Make_Check_Marks (The_Check_Marks : out Check_Mark_List;
The_Error_List : out Error_List;
The_Line : Natural) is
Current_Error_Record : Error_Record;
Nb_Items : Natural := 0;
begin
Current_Error_Record := Get;
while ((Current_Error_Record.Line_No = The_Line) and (not At_End)) loop
Nb_Items := Nb_Items + 1;
The_Check_Marks (Nb_Items) := Current_Error_Record.Column_No;
The_Error_List (Nb_Items) := Current_Error_Record.Err_No;
Next;
if not At_End then
Current_Error_Record := Get;
end if;
end loop;
The_Check_Marks (0) := Nb_Items;
The_Error_List (0) := Nb_Items;
end Make_Check_Marks;
procedure Display_In_Source (Source_File_Name : String :=
Text_Io.Name (Text_Io.Standard_Input);
Destination_File_Name : String :=
Text_Io.Name (Text_Io.Standard_Output)) is
begin
Init_Iterator;
Source.Open (Source_File_Name);
Destination.Open (Destination_File_Name);
while not Source.End_Of_File loop
Source.Next_Line;
declare
S : constant String := Source.Image;
L : constant Natural := Source.Line;
The_C_M : Check_Mark_List;
The_Error_List : Error_List;
begin
Make_Check_Marks (The_C_M, The_Error_List, L);
Destination.Put_Line (S);
Destination.Put_Check_Marks (The_C_M);
for I in 1 .. The_Error_List (0) loop
Destination.Put_Line (Data.Image (The_Error_List (I)));
end loop;
end;
end loop;
Source.Close;
Destination.Close;
end Display_In_Source;
---------------------------- Corps des Paquetages -------------------------
---------------------------------------------------------------------------
package body Source is separate;
package body Destination is separate;
package body Data is separate;
end Error;
nblk1=f
nid=e
hdr6=e
[0x00] rec0=29 rec1=00 rec2=01 rec3=014
[0x01] rec0=23 rec1=00 rec2=08 rec3=038
[0x02] rec0=29 rec1=00 rec2=04 rec3=000
[0x03] rec0=09 rec1=00 rec2=07 rec3=012
[0x04] rec0=1c rec1=00 rec2=09 rec3=01e
[0x05] rec0=16 rec1=00 rec2=0f rec3=006
[0x06] rec0=12 rec1=00 rec2=03 rec3=000
[0x07] rec0=12 rec1=00 rec2=03 rec3=000
[0x08] rec0=1b rec1=00 rec2=04 rec3=00c
[0x09] rec0=18 rec1=00 rec2=09 rec3=01e
[0x0a] rec0=14 rec1=00 rec2=03 rec3=000
[0x0b] rec0=10 rec1=00 rec2=09 rec3=000
[0x0c] rec0=10 rec1=00 rec2=09 rec3=000
[0x0d] rec0=12 rec1=00 rec2=0f rec3=000
[0x0e] rec0=00 rec1=00 rec2=00 rec3=019
tail 0x217367c3884e8441771bc 0x42a00088462060003
Free Block Chain:
0xe: 0000 00 05 00 04 80 01 72 01 02 03 04 05 06 07 08 65 ┆ r e┆
0x5: 0000 00 06 03 f9 80 48 20 20 20 20 20 20 20 20 20 20 ┆ H ┆
0x6: 0000 00 02 03 fc 80 3b 2a 2a 20 49 6c 20 6d 61 6e 71 ┆ ;** Il manq┆
0x2: 0000 00 0c 03 fc 80 41 20 20 20 28 22 2a 2a 2a 20 49 ┆ A ("*** I┆
0xc: 0000 00 0d 03 fc 80 41 20 20 20 20 20 20 20 20 20 20 ┆ A ┆
0xd: 0000 00 0a 02 12 80 0f 20 65 6e 64 20 4e 65 78 74 5f ┆ end Next_┆
0xa: 0000 00 0b 03 fc 00 03 20 20 20 03 00 00 00 00 1a 20 ┆ ┆
0xb: 0000 00 00 01 33 80 05 74 65 6d 73 3b 05 00 27 20 20 ┆ 3 tems; ' ┆