|
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: 18432 (0x4800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Tds, seg_045532
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Error, Unbounded_String, Text_Io;
package body Tds is
package Unlimited_String is new Unbounded_String (5);
type Symbol_Content (What : Kinds := Unknown) is
record
Name, Type_Name : Unlimited_String.Variable_String;
Line, Column, Insertion_Order : Natural;
case What is
when Unknown =>
null;
when Basic_Value =>
The_Value : Dynamic_Value.Object;
when Record_Value =>
The_Table : Object;
end case;
end record;
function Get_Name (S : in Symbol) return String is
begin
return Unlimited_String.Image (S.all.Name);
end Get_Name;
procedure Deep_Copy (Source : in Object; Target : in out Object) is
begin
if (Target = null) then
Target := new Object_Content;
end if;
Target.Number_Of_Symbols := Source.all.Number_Of_Symbols;
Tree.Deep_Copy (Source.all.Table, Target.all.Table);
end Deep_Copy;
procedure Deep_Copy (Source : in Symbol; Target : in out Symbol) is
St : Object;
V : Dynamic_Value.Object;
begin
-- si s2<>NULL c'est pas grave, le ramasse miette s'en occupe
case Source.What is
when Record_Value =>
Deep_Copy (Source.all.The_Table, St);
Target := new Symbol_Content'
(What => Record_Value,
Name => Source.all.Name,
Type_Name => Source.all.Type_Name,
Line => Source.all.Line,
Column => Source.all.Column,
Insertion_Order => Source.all.Insertion_Order,
The_Table => St);
when Basic_Value =>
Dynamic_Value.Deep_Copy (Source.all.The_Value, V);
Target := new Symbol_Content'(What => Basic_Value,
The_Value => V,
Name => Source.all.Name,
Type_Name => Source.all.Type_Name,
Line => Source.all.Line,
Column => Source.all.Column,
Insertion_Order =>
Source.all.Insertion_Order);
when Unknown =>
Target := new Symbol_Content'(What => Unknown,
Name => Source.all.Name,
Type_Name => Source.all.Type_Name,
Line => Source.all.Line,
Column => Source.all.Column,
Insertion_Order =>
Source.all.Insertion_Order);
end case;
end Deep_Copy;
function Get_Name (Where : in Object; Id : in Natural) return String is
It : Tree.Iterator;
Stop : Boolean := False;
S : Symbol;
begin
if ((Where.all.Number_Of_Symbols < Id) or (Id < 1)) then
raise Id_Does_Not_Exist_In_This_Table;
end if;
Tree.Open (It, Where.all.Table);
while (not Stop) loop
S := Tree.Consult (It);
-- on sait que le numero recherche existe => pas besoin de verifier at_end
Stop := (S.all.Insertion_Order = Id);
Tree.Next (It);
end loop;
return Unlimited_String.Image (S.all.Name);
end Get_Name;
function Get_Table (Where : in Object; Name : in String) return Object is
S_Seek : Symbol;
N : Unlimited_String.Variable_String;
begin
N := Unlimited_String.Value (Name);
S_Seek := new Symbol_Content'(What => Unknown,
Name => N,
Type_Name => N,
Line => 0,
Column => 0,
Insertion_Order => 0);
if Tree.Exists (Where.all.Table, S_Seek) then
Tree.Get_Value (Where.all.Table, S_Seek);
if (S_Seek.What = Record_Value) then
return S_Seek.The_Table;
else
raise Name_Does_Not_Correspond_To_A_Table;
end if;
else
raise Name_Does_Not_Exist_In_This_Table;
end if;
end Get_Table;
function Get_Access_On_Value (Where : in Object; Name : in String)
return Dynamic_Value.Object is
S_Seek : Symbol;
N : Unlimited_String.Variable_String;
begin
N := Unlimited_String.Value (Name);
S_Seek := new Symbol_Content'(What => Unknown,
Name => N,
Type_Name => N,
Line => 0,
Column => 0,
Insertion_Order => 0);
if Tree.Exists (Where.all.Table, S_Seek) then
Tree.Get_Value (Where.all.Table, S_Seek);
if (S_Seek.What = Basic_Value) then
return S_Seek.The_Value;
else
raise Name_Does_Not_Correspond_To_A_Value;
end if;
else
raise Name_Does_Not_Exist_In_This_Table;
end if;
end Get_Access_On_Value;
function Get_Kind_Of_Symbol
(Where : in Object; Name : in String) return Kinds is
S_Seek : Symbol;
N : Unlimited_String.Variable_String;
begin
N := Unlimited_String.Value (Name);
S_Seek := new Symbol_Content'(What => Unknown,
Name => N,
Type_Name => N,
Line => 0,
Column => 0,
Insertion_Order => 0);
if Tree.Exists (Where.all.Table, S_Seek) then
Tree.Get_Value (Where.all.Table, S_Seek);
return S_Seek.What;
else
raise Name_Does_Not_Exist_In_This_Table;
end if;
end Get_Kind_Of_Symbol;
function Get_Number_Of_Symbols (Where : in Object) return Natural is
begin
return Where.all.Number_Of_Symbols;
end Get_Number_Of_Symbols;
function Get_Type_Name
(Where : in Object; Name : in String) return String is
S_Seek : Symbol;
N : Unlimited_String.Variable_String;
begin
N := Unlimited_String.Value (Name);
S_Seek := new Symbol_Content'(What => Unknown,
Name => N,
Type_Name => N,
Line => 0,
Column => 0,
Insertion_Order => 0);
if Tree.Exists (Where.all.Table, S_Seek) then
Tree.Get_Value (Where.all.Table, S_Seek);
return Unlimited_String.Image (S_Seek.Type_Name);
else
raise Name_Does_Not_Exist_In_This_Table;
end if;
end Get_Type_Name;
procedure Print (S : in Symbol);
procedure Print (T : Tree.Object) is
It : Tree.Iterator;
begin
if not Tree.Is_Empty (T) then
Tree.Open (It, T);
while not (Tree.At_End (It)) loop
Print (Tree.Consult (It));
Tree.Next (It);
end loop;
end if;
end Print;
procedure Print (What : in Object) is
begin
Text_Io.Put_Line (" TABLE ");
Text_Io.Put_Line
("_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_");
Text_Io.New_Line;
Print (What.all.Table);
Text_Io.New_Line;
Text_Io.Put_Line (" FIN DE LA TABLE ");
end Print;
procedure Print (S : in Symbol) is
begin
Text_Io.Put (" symbol ");
Text_Io.Put (Kinds'Image (S.all.What));
Text_Io.Put (" nom: " & Unlimited_String.Image (S.all.Name) &
" type: " & Unlimited_String.Image (S.all.Type_Name));
Text_Io.Put (" l: " & Natural'Image (S.all.Line) &
" c: " & Natural'Image (S.all.Column));
Text_Io.Put (" N# : " & Natural'Image (S.all.Insertion_Order));
case S.all.What is
when Unknown =>
null;
when Basic_Value =>
Text_Io.Put (" valeur: ");
Dynamic_Value.Print (S.all.The_Value);
Text_Io.New_Line;
when Record_Value =>
Text_Io.New_Line;
if not Tree.Is_Empty (S.all.The_Table.all.Table) then
Text_Io.Put_Line ("-------------- Contenu du Record ----");
Print (S.all.The_Table.all.Table);
Text_Io.Put_Line ("--------------- Fin du record ------");
Text_Io.New_Line;
end if;
end case;
end Print;
procedure Insert_Value_Symbol (Where : in out Object;
N : in String;
L, C : in Natural;
Initial_Value : Dynamic_Value.Object) is
Sn, Tn : Unlimited_String.Variable_String;
S : Symbol;
begin
if (Where = null) then
Where := new Object_Content;
end if;
Where.all.Number_Of_Symbols := Where.Number_Of_Symbols + 1;
Sn := Unlimited_String.Value (N);
Tn := Unlimited_String.Value
(Dynamic_Value.Kinds'Image
(Dynamic_Value.Get_Kind (Initial_Value)));
S := new Symbol_Content'
(What => Basic_Value,
The_Value => Initial_Value,
Name => Sn,
Type_Name => Tn,
Line => L,
Column => C,
Insertion_Order => Where.all.Number_Of_Symbols);
Tree.Insert (Where.all.Table, S);
exception
when Tree.Value_Already_Exists =>
Error.Set_Type_Error (Error.Field_Already_Exists);
raise Error.Excep_Semantic_Error;
end Insert_Value_Symbol;
procedure Insert_Table_Symbol
(Where : in out Object; N, T : in String; L, C : in Natural) is
Empty_Table : Object;
S : Symbol;
Sn : Unlimited_String.Variable_String;
Tn : Unlimited_String.Variable_String;
begin
if (Where = null) then
Where := new Object_Content;
end if;
Where.all.Number_Of_Symbols := Where.all.Number_Of_Symbols + 1;
Sn := Unlimited_String.Value (N);
Tn := Unlimited_String.Value (T);
Empty_Table := new Object_Content;
S := new Symbol_Content'(What => Record_Value,
Name => Sn,
Type_Name => Tn,
Line => L,
Column => C,
Insertion_Order => Where.all.Number_Of_Symbols,
The_Table => Empty_Table);
Tree.Insert (Where.all.Table, S);
exception
when Tree.Value_Already_Exists =>
Error.Set_Type_Error (Error.Field_Already_Exists);
raise Error.Excep_Semantic_Error;
end Insert_Table_Symbol;
function Are_Equal (S1, S2 : Symbol) return Boolean is
begin
return (Get_Name (S1) = Get_Name (S2));
end Are_Equal;
function "<" (S1, S2 : Symbol) return Boolean is
begin
return (Get_Name (S1) < Get_Name (S2));
end "<";
end Tds;
nblk1=11
nid=b
hdr6=1c
[0x00] rec0=22 rec1=00 rec2=01 rec3=050
[0x01] rec0=16 rec1=00 rec2=03 rec3=034
[0x02] rec0=0e rec1=00 rec2=04 rec3=080
[0x03] rec0=1b rec1=00 rec2=0e rec3=030
[0x04] rec0=19 rec1=00 rec2=11 rec3=00c
[0x05] rec0=18 rec1=00 rec2=09 rec3=028
[0x06] rec0=1b rec1=00 rec2=05 rec3=030
[0x07] rec0=1b rec1=00 rec2=0c rec3=04a
[0x08] rec0=00 rec1=00 rec2=08 rec3=00a
[0x09] rec0=1d rec1=00 rec2=07 rec3=032
[0x0a] rec0=18 rec1=00 rec2=0d rec3=016
[0x0b] rec0=18 rec1=00 rec2=02 rec3=042
[0x0c] rec0=16 rec1=00 rec2=0a rec3=052
[0x0d] rec0=11 rec1=00 rec2=0f rec3=000
[0x0e] rec0=02 rec1=00 rec2=0b rec3=000
[0x0f] rec0=02 rec1=00 rec2=0b rec3=000
[0x10] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21541a05a864a816400b0 0x42a00088462060003
Free Block Chain:
0xb: 0000 00 10 00 12 80 01 3b 01 00 08 65 6e 64 20 54 64 ┆ ; end Td┆
0x10: 0000 00 06 00 04 80 01 20 01 02 03 04 05 06 07 08 09 ┆ ┆
0x6: 0000 00 00 00 0a 00 07 20 20 20 20 65 6e 64 07 3a 3d ┆ end :=┆