|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 19334 (0x4b86)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Binary_Tree;
with Bounded_String;
with Text_Io;
with String_Map_Generic;
with String_Utilities;
package body Symbol is
------------------ structure de donnees ----------------------------------
--------------------------------------------------------------------------
type Second_Level_Item is
record
The_Type : Symbol_Type := No_Type;
The_Value : Natural := 0;
Parameter_Number : Natural := 0;
end record;
package Second_Level_Map is new String_Map_Generic (17, Second_Level_Item);
type First_Level_Item is
record
The_Node : Binary_Tree.Node := null;
The_Type : Symbol_Type := No_Type;
The_Value : Natural := 0;
The_Table : Second_Level_Map.Map := Second_Level_Map.Nil;
end record;
package First_Level_Map is new String_Map_Generic (127, First_Level_Item);
------------------ declaration des variables -----------------------------
--------------------------------------------------------------------------
The_Table : First_Level_Map.Map := First_Level_Map.Nil;
Current_Second_Level_Map : Second_Level_Map.Map := Second_Level_Map.Nil;
Current_First_Level_Item : First_Level_Item;
Current_Second_Level_Item : Second_Level_Item;
Current_Level : Natural := 1;
Nb_Of_Tmp_Var : Integer := 0;
Current_Actor_Id : Natural := 0;
The_Parameter_Number : Natural := 1;
------------------ implementation des procedures -------------------------
--------------------------------------------------------------------------
procedure Initialize is
begin
First_Level_Map.Initialize (The_Table);
end Initialize;
function Tmp_Var_Name return String is
begin
Nb_Of_Tmp_Var := Nb_Of_Tmp_Var + 1;
return ("_tmp" & String_Utilities.Number_To_String (Nb_Of_Tmp_Var));
end Tmp_Var_Name;
procedure Add_Material (Material_Name : String) is
begin
Current_Actor_Id := 0;
Current_First_Level_Item.The_Type := Material;
Current_First_Level_Item.The_Value := 0;
Second_Level_Map.Initialize (Current_First_Level_Item.The_Table);
Current_Second_Level_Map := Current_First_Level_Item.The_Table;
First_Level_Map.Define (The_Table, Material_Name,
Current_First_Level_Item, True);
exception
when First_Level_Map.Multiply_Defined =>
Text_Io.Put
("*** Erreur *** Il existe deja un type de materiel nomme ");
Text_Io.Put (Material_Name);
Text_Io.Put_Line (" ...");
end Add_Material;
procedure Add_Actor (Actor_Name : String; T : Symbol_Type) is
begin
Current_Second_Level_Item.The_Value := Current_Actor_Id;
Current_Actor_Id := Current_Actor_Id + 1;
Current_Second_Level_Item.The_Type := T;
Second_Level_Map.Define (Current_Second_Level_Map, Actor_Name,
Current_Second_Level_Item, True);
exception
when Second_Level_Map.Multiply_Defined =>
Text_Io.Put ("*** Erreur *** Il existe deja un acteur nomme ");
Text_Io.Put (Actor_Name);
Text_Io.Put_Line (" ...");
end Add_Actor;
function Get_Actor_Value
(Theatre_Name : String; Actor_Name : String) return Natural is
The_First_Level_Item : First_Level_Item;
The_Second_Level_Item : Second_Level_Item;
Ok : Boolean := False;
begin
First_Level_Map.Find (The_Table, Theatre_Name,
The_First_Level_Item, Ok);
if Ok then
Second_Level_Map.Find (The_First_Level_Item.The_Table,
Actor_Name, The_Second_Level_Item, Ok);
if Ok then
return The_Second_Level_Item.The_Value;
else
Text_Io.Put_Line
("*** Il n'y a pas un tel acteur pour cette station");
end if;
else
Text_Io.Put_Line ("*** Il n'y a pas de station de ce nom");
end if;
return 0;
end Get_Actor_Value;
function Get_Theatre_Adress (Theatre_Name : String) return Natural is
The_First_Level_Item : First_Level_Item;
Ok : Boolean := False;
begin
First_Level_Map.Find (The_Table, Theatre_Name,
The_First_Level_Item, Ok);
if Ok then
return The_First_Level_Item.The_Value;
else
Text_Io.Put_Line ("*** Erreur *** La station n'existe pas");
end if;
end Get_Theatre_Adress;
procedure Add_Theatre
(Theatre_Name, Material_Name : String; Adress : Natural) is
Ok : Boolean := False;
begin
First_Level_Map.Find (The_Table, Material_Name,
Current_First_Level_Item, Ok);
if Ok then
Current_First_Level_Item.The_Type := Theatre;
Current_First_Level_Item.The_Value := Adress;
First_Level_Map.Define (The_Table, Theatre_Name,
Current_First_Level_Item, True);
else
Text_Io.Put ("*** Error *** Le type de materiel ");
Text_Io.Put (Material_Name);
Text_Io.Put_Line (" n'existe pas ...");
end if;
exception
when First_Level_Map.Multiply_Defined =>
Text_Io.Put ("*** Erreur *** Il y a deja un ");
Text_Io.Put (Theatre_Name);
Text_Io.Put_Line (" ...");
end Add_Theatre;
procedure Add_Function (Function_Name : String) is
begin
Current_First_Level_Item.The_Type := Sub_Prog;
Current_First_Level_Item.The_Value := 0;
Second_Level_Map.Initialize (Current_First_Level_Item.The_Table);
Current_Second_Level_Map := Current_First_Level_Item.The_Table;
First_Level_Map.Define (The_Table, Function_Name,
Current_First_Level_Item, True);
exception
when First_Level_Map.Multiply_Defined =>
Text_Io.Put ("*** Erreur *** Il y a deja une fonction ");
Text_Io.Put (Function_Name);
Text_Io.Put_Line (" ...");
end Add_Function;
procedure Set_Current_Level (To : Natural; Function_Name : String) is
The_First_Level_Item : First_Level_Item;
Success : Boolean := False;
begin
The_Parameter_Number := 1;
if To in 1 .. 2 then
Current_Level := To;
if Current_Level = 2 then
First_Level_Map.Find (The_Table, Function_Name,
The_First_Level_Item, Success);
if Success then
Current_Second_Level_Map := The_First_Level_Item.The_Table;
else
Text_Io.Put ("*** Error *** La fonction ");
Text_Io.Put (Function_Name);
Text_Io.Put_Line (" n'existe pas ...");
end if;
end if;
else
Text_Io.Put_Line ("*** Error *** Niveau non autorise ...");
end if;
end Set_Current_Level;
function Get_Current_Level return Natural is
begin
return Current_Level;
end Get_Current_Level;
procedure Add_Variable (Variable_Name : String;
The_Type : Symbol_Type := No_Type;
The_Value : Natural := 0) is
The_First_Level_Item : First_Level_Item;
The_Second_Level_Item : Second_Level_Item;
begin
if Current_Level = 1 then
The_First_Level_Item.The_Type := The_Type;
The_First_Level_Item.The_Value := The_Value;
First_Level_Map.Define (The_Table, Variable_Name,
The_First_Level_Item, True);
else
The_Second_Level_Item.The_Type := The_Type;
The_Second_Level_Item.The_Value := The_Value;
The_Second_Level_Item.Parameter_Number := The_Parameter_Number;
Second_Level_Map.Define (Current_Second_Level_Map, Variable_Name,
The_Second_Level_Item, True);
end if;
exception
when First_Level_Map.Multiply_Defined |
Second_Level_Map.Multiply_Defined =>
Text_Io.Put ("*** Erreur *** Il existe deja une variable nommee ");
Text_Io.Put (Variable_Name);
Text_Io.Put_Line (" ...");
end Add_Variable;
procedure Add_Parameter (Variable_Name : String;
The_Type : Symbol_Type := No_Type;
The_Value : Natural := 0) is
begin
Add_Variable (Variable_Name, The_Type, The_Value);
The_Parameter_Number := The_Parameter_Number + 1;
end Add_Parameter;
procedure Get_Variable (Variable_Name : String;
The_Type : out Symbol_Type;
The_Value : out Natural;
Success : out Boolean) is
The_First_Level_Item : First_Level_Item;
The_Second_Level_Item : Second_Level_Item;
Ok : Boolean := False;
T : Symbol_Type;
V : Natural;
begin
if Current_Level = 2 then
Get_Variable_From_2 (Variable_Name, T, V, Ok);
if not Ok then
Get_Variable_From_1 (Variable_Name, T, V, Ok);
end if;
else
Get_Variable_From_1 (Variable_Name, T, V, Ok);
end if;
The_Type := T;
The_Value := V;
Success := Ok;
end Get_Variable;
procedure Get_Variable_From_1 (Variable_Name : String;
The_Type : out Symbol_Type;
The_Value : out Natural;
Success : out Boolean) is
The_First_Level_Item : First_Level_Item;
Ok : Boolean := False;
begin
First_Level_Map.Find (The_Table, Variable_Name,
The_First_Level_Item, Ok);
The_Type := The_First_Level_Item.The_Type;
The_Value := The_First_Level_Item.The_Value;
Success := Ok;
end Get_Variable_From_1;
procedure Get_Variable_From_2 (Variable_Name : String;
The_Type : out Symbol_Type;
The_Value : out Natural;
Success : out Boolean) is
The_Second_Level_Item : Second_Level_Item;
Ok : Boolean := False;
begin
Second_Level_Map.Find (Current_Second_Level_Map, Variable_Name,
The_Second_Level_Item, Ok);
The_Type := The_Second_Level_Item.The_Type;
The_Value := The_Second_Level_Item.The_Value;
Success := Ok;
end Get_Variable_From_2;
procedure Set_Var_Type (Variable_Name : String; The_Type : Symbol_Type) is
The_First_Level_Item : First_Level_Item;
The_Second_Level_Item : Second_Level_Item;
Ok : Boolean := False;
begin
if Current_Level = 1 then
First_Level_Map.Find (The_Table, Variable_Name,
The_First_Level_Item, Ok);
if Ok then
The_First_Level_Item.The_Type := The_Type;
First_Level_Map.Define
(The_Table, Variable_Name, The_First_Level_Item);
else
Text_Io.Put_Line ("*** Erreur *** La Var n'existe pas");
end if;
else
Second_Level_Map.Find (Current_Second_Level_Map, Variable_Name,
The_Second_Level_Item, Ok);
if Ok then
The_Second_Level_Item.The_Type := The_Type;
Second_Level_Map.Define (Current_Second_Level_Map,
Variable_Name, The_Second_Level_Item);
else
Text_Io.Put_Line ("*** Erreur *** La Var n'existe pas");
end if;
end if;
end Set_Var_Type;
procedure Set_Parameter_Value
(Parameter_Number : Natural; The_Value : Natural := 0) is
The_Second_Level_Item : Second_Level_Item;
Iter : Second_Level_Map.Iterator;
Ok, Success : Boolean := False;
S : String (1 .. 255);
L : Natural;
begin
Second_Level_Map.Init (Iter, Current_Second_Level_Map);
while not (Second_Level_Map.Done (Iter) or Ok) loop
declare
Var_Name : constant String := Second_Level_Map.Value (Iter);
begin
L := Var_Name'Last;
S (1 .. L) := Var_Name;
Second_Level_Map.Find (Current_Second_Level_Map, Var_Name,
The_Second_Level_Item, Success);
if (The_Second_Level_Item.Parameter_Number =
Parameter_Number) then
Ok := True;
else
Ok := False;
end if;
Second_Level_Map.Next (Iter);
end;
end loop;
The_Second_Level_Item.The_Value := The_Value;
Second_Level_Map.Define (Current_Second_Level_Map,
S (1 .. L), The_Second_Level_Item);
end Set_Parameter_Value;
procedure Set_Var_Value (Variable_Name : String;
The_Value : Natural := 0) is
The_First_Level_Item : First_Level_Item;
The_Second_Level_Item : Second_Level_Item;
Ok : Boolean := False;
begin
if Current_Level = 1 then
First_Level_Map.Find (The_Table, Variable_Name,
The_First_Level_Item, Ok);
if Ok then
The_First_Level_Item.The_Value := The_Value;
First_Level_Map.Define
(The_Table, Variable_Name, The_First_Level_Item);
else
Text_Io.Put_Line ("*** Erreur *** La Var n'existe pas");
end if;
else
Second_Level_Map.Find (Current_Second_Level_Map, Variable_Name,
The_Second_Level_Item, Ok);
if Ok then
The_Second_Level_Item.The_Value := The_Value;
Second_Level_Map.Define (Current_Second_Level_Map,
Variable_Name, The_Second_Level_Item);
else
Text_Io.Put_Line ("*** Erreur *** La Var n'existe pas");
end if;
end if;
end Set_Var_Value;
procedure Set_Function_Value
(Function_Name : String; The_Value : Natural := 0) is
The_First_Level_Item : First_Level_Item;
Ok : Boolean := False;
begin
First_Level_Map.Find (The_Table, Function_Name,
The_First_Level_Item, Ok);
if Ok then
The_First_Level_Item.The_Value := The_Value;
First_Level_Map.Define
(The_Table, Function_Name, The_First_Level_Item);
else
Text_Io.Put_Line ("*** Erreur *** La fonction n'existe pas");
end if;
end Set_Function_Value;
procedure Set_Start_Point (Function_Name : String;
The_Node : Binary_Tree.Node) is
The_First_Level_Item : First_Level_Item;
Ok : Boolean := False;
begin
First_Level_Map.Find (The_Table, Function_Name,
The_First_Level_Item, Ok);
if Ok then
The_First_Level_Item.The_Node := The_Node;
First_Level_Map.Define
(The_Table, Function_Name, The_First_Level_Item);
else
Text_Io.Put_Line ("*** Erreur *** La fonction n'existe pas");
end if;
end Set_Start_Point;
function Get_Function_Value (Function_Name : String) return Natural is
The_First_Level_Item : First_Level_Item;
Ok : Boolean := False;
begin
First_Level_Map.Find (The_Table, Function_Name,
The_First_Level_Item, Ok);
if Ok then
return The_First_Level_Item.The_Value;
else
Text_Io.Put_Line ("*** Erreur *** La fonction n'existe pas");
end if;
end Get_Function_Value;
function Get_Start_Point (Function_Name : String) return Binary_Tree.Node is
The_First_Level_Item : First_Level_Item;
Ok : Boolean := False;
begin
First_Level_Map.Find (The_Table, Function_Name,
The_First_Level_Item, Ok);
if Ok then
return The_First_Level_Item.The_Node;
else
Text_Io.Put_Line ("*** Erreur *** La fonction n'existe pas");
end if;
end Get_Start_Point;
procedure Put (The_Item : Second_Level_Item) is
begin
Text_Io.Put (Symbol_Type'Image (The_Item.The_Type));
Text_Io.Put (" ");
Text_Io.Put (Natural'Image (The_Item.The_Value));
Text_Io.Put (" ");
Text_Io.Put (Natural'Image (The_Item.Parameter_Number));
end Put;
procedure Put (The_Item : First_Level_Item) is
Second_Level_Iterator : Second_Level_Map.Iterator;
The_Second_Level_Item : Second_Level_Item;
Ok : Boolean;
begin
Text_Io.Put (Symbol_Type'Image (The_Item.The_Type));
Text_Io.Put (" ");
Text_Io.Put (Natural'Image (The_Item.The_Value));
Text_Io.Put_Line ("");
if not (Second_Level_Map.Is_Nil (The_Item.The_Table)) then
Second_Level_Map.Init (Second_Level_Iterator, The_Item.The_Table);
while not Second_Level_Map.Done (Second_Level_Iterator) loop
Second_Level_Map.Find (The_Item.The_Table,
Second_Level_Map.Value
(Second_Level_Iterator),
The_Second_Level_Item, Ok);
Text_Io.Put (" ");
Text_Io.Put (Second_Level_Map.Value (Second_Level_Iterator));
Text_Io.Put (" ");
Put (The_Second_Level_Item);
Text_Io.Put_Line ("");
Second_Level_Map.Next (Second_Level_Iterator);
end loop;
end if;
end Put;
procedure Put is
First_Level_Iterator : First_Level_Map.Iterator;
The_First_Level_Item : First_Level_Item;
Ok : Boolean;
begin
Text_Io.Put_Line
("----------------- Debut de la Table des Symboles --------------------");
First_Level_Map.Init (First_Level_Iterator, The_Table);
while not First_Level_Map.Done (First_Level_Iterator) loop
First_Level_Map.Find (The_Table,
First_Level_Map.Value (First_Level_Iterator),
The_First_Level_Item, Ok);
Text_Io.Put (First_Level_Map.Value (First_Level_Iterator));
Text_Io.Put (" ");
Put (The_First_Level_Item);
Text_Io.Put_Line ("");
First_Level_Map.Next (First_Level_Iterator);
end loop;
Text_Io.Put_Line
("----------------- Fin de la Table des Symboles ----------------------");
end Put;
end Symbol;