|
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: 20480 (0x5000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Variable_Table, seg_0473a6
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Tds, Error, Type_Table, Text_Io, Unbounded_String, Stack_Generic;
package body Variable_Table is
package Unlimited_String is new Unbounded_String (10);
type Context is
record
Table : Tds.Object;
Element : Natural;
end record;
package Type_Context_Stack is new Stack_Generic (Element => Context);
package Type_String_Stack is
new Stack_Generic (Element => Unlimited_String.Variable_String);
Master_Table, Current_Table : Tds.Object;
Last_Inserted_Variable_Name : Unlimited_String.Variable_String;
Initialization_Context : Context;
Context_Stack : Type_Context_Stack.Stack;
My_String_Stack : Type_String_Stack.Stack;
procedure Create (Variable_Name, Type_Name : in String;
L, C : in Natural) is
Source_Table, Target_Table : Tds.Object;
begin
Current_Table := Master_Table;
Source_Table := Type_Table.Get_Type (Type_Name);
Tds.Insert_Table_Symbol (Master_Table, Variable_Name, Type_Name, L, C);
Target_Table := Tds.Get_Table (Master_Table, Variable_Name);
Tds.Deep_Copy (Source_Table, Target_Table);
Last_Inserted_Variable_Name := Unlimited_String.Value (Variable_Name);
exception
when Type_Table.Demanded_Type_Does_Not_Exist =>
Error.Set_Type_Error (Error.Inexistant_Type_For_Declaration);
raise Error.Excep_Semantic_Error;
when Tds.Name_Does_Already_Exist =>
Error.Set_Type_Error (Error.Duplicate_Identifier_In_Variable_Table);
raise Error.Excep_Semantic_Error;
end Create;
procedure Create (Variable_Name : in String;
Variable_Type : in Dynamic_Value.Kinds;
L, C : in Natural) is
V : Dynamic_Value.Object;
begin
Current_Table := Master_Table;
case Variable_Type is
when Dynamic_Value.Unknown =>
null;
when Dynamic_Value.Integer_Number =>
Dynamic_Value.Set_Value (V, 0);
when Dynamic_Value.Boolean_Number =>
Dynamic_Value.Set_Value (V, False);
when Dynamic_Value.String_Of_Characters =>
Dynamic_Value.Set_Value (V, "");
when Dynamic_Value.Vocabulary_Word =>
Dynamic_Value.Set_Value (V, "", Dynamic_Value.Voca_Value);
when Dynamic_Value.Set_Of_Words =>
null;
end case;
Tds.Insert_Value_Symbol (Master_Table, Variable_Name, L, C, V);
Last_Inserted_Variable_Name := Unlimited_String.Value (Variable_Name);
exception
when Tds.Name_Does_Already_Exist =>
Error.Set_Type_Error (Error.Duplicate_Identifier_In_Variable_Table);
raise Error.Excep_Semantic_Error;
end Create;
procedure Init_Acces_Path is
begin
Type_String_Stack.Make_Empty (My_String_Stack);
end Init_Acces_Path;
procedure Append_To_Acces_Path (Element : String) is
begin
Type_String_Stack.Push
(Unlimited_String.Value (Element), My_String_Stack);
end Append_To_Acces_Path;
function Get_Access_On (Name : in String) return Dynamic_Value.Object is
V : Dynamic_Value.Object;
begin
V := Tds.Get_Access_On_Value (Current_Table, Name);
return V;
exception
when Tds.Name_Does_Not_Exist_In_This_Table |
Tds.Name_Does_Not_Correspond_To_A_Value =>
Error.Set_Type_Error (Error.Bad_Variable_Name);
raise Error.Excep_Semantic_Error;
end Get_Access_On;
function Get_Access_Through_Path return Dynamic_Value.Object is
V : Dynamic_Value.Object;
My_Stack_Iterator : Type_String_Stack.Iterator;
Current_Element : Unlimited_String.Variable_String;
Temporary_Table : Tds.Object;
begin
Temporary_Table := Current_Table;
Current_Table := Master_Table;
Type_String_Stack.Init (My_Stack_Iterator, My_String_Stack);
Current_Element := Type_String_Stack.Value (My_Stack_Iterator);
Type_String_Stack.Next (My_Stack_Iterator);
while not (Type_String_Stack.Done (My_Stack_Iterator)) loop
Go_In (Unlimited_String.Image (Current_Element));
Current_Element := Type_String_Stack.Value (My_Stack_Iterator);
Type_String_Stack.Next (My_Stack_Iterator);
end loop;
V := Get_Access_On (Unlimited_String.Image (Current_Element));
Current_Table := Temporary_Table;
return V;
end Get_Access_Through_Path;
procedure Go_In (Variable_Name : in String) is
T : Tds.Object;
begin
T := Tds.Get_Table (Current_Table, Variable_Name);
Current_Table := T;
exception
when Tds.Name_Does_Not_Exist_In_This_Table |
Tds.Name_Does_Not_Correspond_To_A_Table =>
Error.Set_Type_Error (Error.Bad_Variable_Name);
raise Error.Excep_Semantic_Error;
end Go_In;
procedure Go_To_Top_Level is
begin
Current_Table := Master_Table;
end Go_To_Top_Level;
procedure Begin_Initialization is
use Tds;
begin
Type_Context_Stack.Make_Empty (Context_Stack);
if (Tds.Get_Kind_Of_Symbol
(Master_Table, Unlimited_String.Image
(Last_Inserted_Variable_Name)) =
Tds.Record_Value) then
Initialization_Context.Table :=
Tds.Get_Table (Master_Table, Unlimited_String.Image
(Last_Inserted_Variable_Name));
if (Tds.Get_Number_Of_Symbols (Initialization_Context.Table) =
0) then
Error.Set_Type_Error (Error.
Too_Many_Parameters_For_Initialization);
raise Error.Excep_Semantic_Error;
end if;
else
Initialization_Context.Table := Master_Table;
end if;
Initialization_Context.Element := 0;
end Begin_Initialization;
procedure Go_In_Inherited is
Name : Unlimited_String.Variable_String;
use Tds;
begin
if (Tds.Get_Number_Of_Symbols (Initialization_Context.Table) <
Initialization_Context.Element) then
Error.Set_Type_Error (Error.Too_Many_Parameters_For_Initialization);
raise Error.Excep_Semantic_Error;
end if;
if (Initialization_Context.Element = 0) then
Initialization_Context.Element := 1;
end if;
Name := Unlimited_String.Value
(Tds.Get_Name (Initialization_Context.Table,
Initialization_Context.Element));
if (Tds.Get_Kind_Of_Symbol
(Initialization_Context.Table, Unlimited_String.Image (Name)) /=
Tds.Record_Value) then
Error.Set_Type_Error (Error.
Inherited_Field_Expected_Instead_Of_Variable);
raise Error.Excep_Semantic_Error;
end if;
Type_Context_Stack.Push (Initialization_Context, Context_Stack);
Initialization_Context.Table :=
Tds.Get_Table (Initialization_Context.Table,
Unlimited_String.Image (Name));
Initialization_Context.Element := 1;
end Go_In_Inherited;
procedure Go_Out_Of_Inherited is
begin
Initialization_Context := Type_Context_Stack.Top (Context_Stack);
Type_Context_Stack.Pop (Context_Stack);
Initialization_Context.Element := Initialization_Context.Element + 1;
exception
when Type_Context_Stack.Underflow =>
Error.Set_Type_Error (Error.Too_Many_Parameters_For_Initialization);
raise Error.Excep_Semantic_Error;
end Go_Out_Of_Inherited;
procedure Initialize_With (V : in Dynamic_Value.Object) is
Value : Dynamic_Value.Object;
Name : Unlimited_String.Variable_String;
use Tds;
begin
if (Tds.Get_Kind_Of_Symbol
(Master_Table, Unlimited_String.Image
(Last_Inserted_Variable_Name)) =
Record_Value) then
if (Initialization_Context.Element = 0) then
Initialization_Context.Element := 1;
Initialization_Context.Table :=
Tds.Get_Table (Master_Table,
Unlimited_String.Image
(Last_Inserted_Variable_Name));
end if;
Name := Unlimited_String.Value
(Tds.Get_Name (Initialization_Context.Table,
Initialization_Context.Element));
Value := Tds.Get_Access_On_Value (Initialization_Context.Table,
Unlimited_String.Image (Name));
Dynamic_Value.Deep_Copy (V, Value);
Initialization_Context.Element :=
Initialization_Context.Element + 1;
else
Name := Unlimited_String.Value (Unlimited_String.Image
(Last_Inserted_Variable_Name));
Value := Tds.Get_Access_On_Value (Initialization_Context.Table,
Unlimited_String.Image (Name));
Dynamic_Value.Deep_Copy (V, Value);
Initialization_Context.Element :=
Initialization_Context.Element + 1;
end if;
exception
when Tds.Name_Does_Not_Correspond_To_A_Value =>
Error.Set_Type_Error (Error.
Inherited_Field_Expected_Instead_Of_Variable);
raise Error.Excep_Semantic_Error;
when Tds.Id_Does_Not_Exist_In_This_Table =>
Error.Set_Type_Error (Error.Too_Many_Parameters_For_Initialization);
raise Error.Excep_Semantic_Error;
when Dynamic_Value.Integer_Expected =>
Error.Set_Type_Error (Error.Integer_Was_Expected);
raise Error.Excep_Semantic_Error;
when Dynamic_Value.Boolean_Expected =>
Error.Set_Type_Error (Error.Boolean_Was_Expected);
raise Error.Excep_Semantic_Error;
when Dynamic_Value.String_Expected =>
Error.Set_Type_Error (Error.String_Was_Expected);
raise Error.Excep_Semantic_Error;
when Dynamic_Value.Set_Expected =>
Error.Set_Type_Error (Error.Set_Was_Expected);
raise Error.Excep_Semantic_Error;
when Dynamic_Value.Word_Expected =>
Error.Set_Type_Error (Error.Word_Was_Expected);
raise Error.Excep_Semantic_Error;
when Dynamic_Value.Word_Or_String_Expected =>
Error.Set_Type_Error (Error.String_Or_Word_Was_Expected);
raise Error.Excep_Semantic_Error;
end Initialize_With;
procedure Print is
begin
Text_Io.Put (" VARIABLES ");
Tds.Print (Master_Table);
end Print;
end Variable_Table;
nblk1=13
nid=b
hdr6=18
[0x00] rec0=20 rec1=00 rec2=01 rec3=044
[0x01] rec0=16 rec1=00 rec2=06 rec3=01a
[0x02] rec0=18 rec1=00 rec2=03 rec3=006
[0x03] rec0=1c rec1=00 rec2=0a rec3=00c
[0x04] rec0=1a rec1=00 rec2=13 rec3=006
[0x05] rec0=1a rec1=00 rec2=0c rec3=036
[0x06] rec0=19 rec1=00 rec2=07 rec3=04a
[0x07] rec0=16 rec1=00 rec2=05 rec3=048
[0x08] rec0=17 rec1=00 rec2=10 rec3=046
[0x09] rec0=12 rec1=00 rec2=12 rec3=02a
[0x0a] rec0=12 rec1=00 rec2=0e rec3=04e
[0x0b] rec0=12 rec1=00 rec2=11 rec3=000
[0x0c] rec0=05 rec1=00 rec2=0b rec3=01a
[0x0d] rec0=19 rec1=00 rec2=0d rec3=022
[0x0e] rec0=02 rec1=00 rec2=0f rec3=000
[0x0f] rec0=15 rec1=00 rec2=0d rec3=000
[0x10] rec0=15 rec1=00 rec2=0d rec3=000
[0x11] rec0=00 rec1=00 rec2=00 rec3=000
[0x12] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21544317286537983531d 0x42a00088462060003
Free Block Chain:
0xb: 0000 00 0d 00 bc 80 0c 69 61 6c 69 7a 65 5f 57 69 74 ┆ ialize_Wit┆
0xd: 0000 00 0f 03 fc 80 23 65 5f 54 61 62 6c 65 2c 20 54 ┆ #e_Table, T┆
0xf: 0000 00 09 00 0b 80 02 65 3b 02 00 00 00 00 00 00 47 ┆ e; G┆
0x9: 0000 00 02 00 76 80 2e 49 6e 69 74 69 61 6c 69 7a 65 ┆ v .Initialize┆
0x2: 0000 00 04 00 09 80 06 6f 5f 41 5f 54 61 06 20 43 72 ┆ o_A_Ta Cr┆
0x4: 0000 00 08 00 f1 80 19 74 5f 43 6f 72 72 65 73 70 6f ┆ t_Correspo┆
0x8: 0000 00 00 00 06 80 03 65 61 6e 03 04 05 06 07 08 09 ┆ ean ┆