|
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 Symbol_Table, seg_0375f5, seg_037bd8, seg_038ad7
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Boolean_Class;
with Bounded_String;
with Msg_Report;
with Object;
with Pen_Class;
with Scanner;
with Turtle_Class;
package body Symbol_Table is
Global_Symbols_Name : constant String := "Global_Symbols";
Void_Name : constant String := "Void";
Default_Name : constant String := "No_Name_";
subtype Symbol_Table_Reference is The_Symbol_Table.Map;
Symbol_Table_Id : Symbol_Table_Reference;
Current_Block_Name : Scanner.B_String;
Current_Block_Number : Natural;
-- initialiser la table des symboles
-- =================================
procedure Create is
Value : Table_Reference;
Ident : Scanner.B_String;
begin
The_Symbol_Table.Initialize (Symbol_Table_Id);
-- inserer le bloc contenant les symboles globaux
Bounded_String.Copy (Current_Block_Name, Global_Symbols_Name);
Bounded_String.Copy (Value.Father_Name, Void_Name);
Block_Table.Initialize (Value.Block_Access);
The_Symbol_Table.Define
(Symbol_Table_Id, Bounded_String.Image (Current_Block_Name), Value);
-- inserer les identificateurs predefinis: Tortue, Stylo, Vrai, Faux, Vide
Bounded_String.Copy (Ident, Turtle_Class.Predefined_Turtle);
Insert (Ident, Turtle_Class.Create);
Bounded_String.Copy (Ident, Pen_Class.Predefined_Pen);
Insert (Ident, Pen_Class.Create);
Bounded_String.Copy (Ident, Boolean_Class.Predefined_True);
Insert (Ident, Boolean_Class.Create (True));
Bounded_String.Copy (Ident, Boolean_Class.Predefined_False);
Insert (Ident, Boolean_Class.Create (False));
Bounded_String.Copy (Ident, Object.Predefined_Void);
Insert (Ident, Object.Void_Reference);
-- initialiser le nombre de blocs "sans nom" existants
Current_Block_Number := 0;
end Create;
-- entrer dans un bloc nomme de la table des symboles
-- ==================================================
procedure Enter (Block_Name : in Scanner.B_String) is
Value : Table_Reference;
Found : Boolean;
begin
-- recherche du bloc dans la table des symboles
The_Symbol_Table.Find (Symbol_Table_Id,
Bounded_String.Image (Block_Name), Value, Found);
if (not Found) then
-- inserer un nouveau bloc dans la table des symboles
Bounded_String.Copy (Value.Father_Name, Current_Block_Name);
Block_Table.Initialize (Value.Block_Access);
The_Symbol_Table.Define (Symbol_Table_Id,
Bounded_String.Image (Block_Name), Value);
end if;
-- mise a jour du nom du nouveau bloc courant
Bounded_String.Copy (Current_Block_Name, Block_Name);
Msg_Report.Information ("Current block: " &
Bounded_String.Image (Current_Block_Name));
end Enter;
-- entrer dans un bloc "sans nom" de la table des symboles
-- =======================================================
procedure New_Enter (Block_Name : in out Scanner.B_String) is
Value : Table_Reference;
Block_Number : Scanner.B_String;
begin
-- incrementer le nombre de blocs "sans nom" existants
Current_Block_Number := Current_Block_Number + 1;
-- conversion numero de bloc entier -> chaine
Bounded_String.Copy (Block_Number,
Positive'Image (Current_Block_Number));
Bounded_String.Delete (Block_Number, 1);
-- donner au bloc un nom par defaut
Bounded_String.Copy (Block_Name, Default_Name);
Bounded_String.Append (Block_Name, Block_Number);
-- inserer le nouveau bloc "sans nom" dans la table des symboles
Bounded_String.Copy (Value.Father_Name, Current_Block_Name);
Block_Table.Initialize (Value.Block_Access);
The_Symbol_Table.Define (Symbol_Table_Id,
Bounded_String.Image (Block_Name), Value);
-- mise a jour du nom du nouveau bloc courant
Bounded_String.Copy (Current_Block_Name, Block_Name);
Msg_Report.Information ("Current block: " &
Bounded_String.Image (Current_Block_Name));
end New_Enter;
-- quitter le bloc courant de la table des symboles
-- ================================================
procedure Leave is
Value : Table_Reference;
begin
-- recherche du bloc courant
Value := The_Symbol_Table.Eval
(Symbol_Table_Id, Bounded_String.Image
(Current_Block_Name));
if Bounded_String.Image (Value.Father_Name) /= Void_Name then
-- mise a jour du nom du nouveau bloc courant
Bounded_String.Copy (Current_Block_Name, Value.Father_Name);
end if;
Msg_Report.Information ("Current block: " &
Bounded_String.Image (Current_Block_Name));
end Leave;
-- retourne le bloc courant
-- ========================
function Current_Block return Scanner.B_String is
begin
return Current_Block_Name;
end Current_Block;
-- inserer un element dans le bloc courant
-- =======================================
procedure Insert (Identifier : Scanner.B_String;
Content : Object.Reference) is
Value : Table_Reference;
begin
-- rechercher le bloc courant
Value := The_Symbol_Table.Eval
(Symbol_Table_Id, Bounded_String.Image
(Current_Block_Name));
-- inserer l'element
Block_Table.Define (Value.Block_Access,
Bounded_String.Image (Identifier), Content);
end Insert;
-- rechercher si un identificateur existe dans le bloc courant
-- ===========================================================
function Is_Found_In_Block (Identifier : Scanner.B_String) return Boolean is
Value : Table_Reference;
Content : Object.Reference;
Success : Boolean;
begin
-- rechercher le bloc courant
Value := The_Symbol_Table.Eval
(Symbol_Table_Id, Bounded_String.Image
(Current_Block_Name));
-- rechercher l'identificateur
Block_Table.Find (Value.Block_Access,
Bounded_String.Image (Identifier), Content, Success);
return Success;
end Is_Found_In_Block;
-- detruire un identificateur dans le bloc courant
-- ===============================================
procedure Remove (Identifier : Scanner.B_String) is
Value : Table_Reference;
begin
-- rechercher le bloc courant
Value := The_Symbol_Table.Eval
(Symbol_Table_Id, Bounded_String.Image
(Current_Block_Name));
-- retrait de l'identificateur
Block_Table.Undefine (Value.Block_Access,
Bounded_String.Image (Identifier));
end Remove;
-- recherche ascendante d'un identificateur dans la table
-- ======================================================
procedure Search (Identifier : Scanner.B_String;
Search_Block : Table_Reference;
Success_Block : out Table_Reference;
Success : out Boolean) is
Father_Block : Table_Reference;
Cont : Object.Reference;
Found : Boolean;
begin
-- recherche de l'identificateur dans le bloc courant
Block_Table.Find (Search_Block.Block_Access,
Bounded_String.Image (Identifier), Cont, Found);
if Found then
-- identificateur trouve
Success_Block := Search_Block;
Success := True;
else
if Bounded_String.Image (Search_Block.Father_Name) = Void_Name then
-- fin de recherche, identificateur non trouve
Success := False;
else
-- recherche de l'identificateur dans le bloc pere
Father_Block := The_Symbol_Table.Eval
(Symbol_Table_Id,
Bounded_String.Image
(Search_Block.Father_Name));
Search (Identifier, Father_Block, Success_Block, Success);
end if;
end if;
end Search;
-- rechercher si un identificateur existe dans la table des symboles
-- =================================================================
function Is_Found (Identifier : Scanner.B_String) return Boolean is
Current_Block, Found_Block : Table_Reference;
Success : Boolean;
begin
-- recherche du bloc courant
Current_Block := The_Symbol_Table.Eval
(Symbol_Table_Id, Bounded_String.Image
(Current_Block_Name));
-- recherche de l'identificateur dans le bloc courant ou dans un bloc pere
Search (Identifier, Current_Block, Found_Block, Success);
return Success;
end Is_Found;
-- mise a jour du contenu de l'identificateur dans la table des symboles
-- =====================================================================
procedure Set_Info (Identifier : Scanner.B_String;
Content : Object.Reference) is
Current_Block, Found_Block : Table_Reference;
Found : Boolean;
begin
-- recherche du bloc courant
Current_Block := The_Symbol_Table.Eval
(Symbol_Table_Id, Bounded_String.Image
(Current_Block_Name));
-- recherche de l'identificateur dans le bloc courant ou dans un bloc pere
Search (Identifier, Current_Block, Found_Block, Found);
if Found then
-- mise a jour du contenu
Block_Table.Define (Found_Block.Block_Access,
Bounded_String.Image (Identifier), Content);
end if;
end Set_Info;
-- lecture du contenu de l'identificateur dans la table des symboles
-- =================================================================
function Get_Info (Identifier : Scanner.B_String) return Object.Reference is
Current_Block, Found_Block : Table_Reference;
Found : Boolean;
begin
-- recherche du bloc courant
Current_Block := The_Symbol_Table.Eval
(Symbol_Table_Id, Bounded_String.Image
(Current_Block_Name));
-- recherche de l'identificateur dans le bloc courant ou dans un bloc pere
Search (Identifier, Current_Block, Found_Block, Found);
if Found then
return Block_Table.Eval (Found_Block.Block_Access,
Bounded_String.Image (Identifier));
end if;
end Get_Info;
-- affichage du contenu de la table des symboles
-- =============================================
procedure Image_Table is
Iter : The_Symbol_Table.Iterator;
Block_Name : Scanner.B_String;
Value : Table_Reference;
begin
-- initialiser l'iterateur
The_Symbol_Table.Init (Iter, Symbol_Table_Id);
while not The_Symbol_Table.Done (Iter) loop
Bounded_String.Copy (Block_Name,
Bounded_String.Value
(The_Symbol_Table.Value (Iter)));
-- lire le contenu
Value := The_Symbol_Table.Eval (Symbol_Table_Id,
Bounded_String.Image (Block_Name));
Msg_Report.Information ("Symbol Table contents");
Msg_Report.Continue
("Block name: " & Bounded_String.Image (Block_Name) &
", Father name: " & Bounded_String.Image (Value.Father_Name));
-- afficher le contenu du bloc
Image_Block (Block_Name);
The_Symbol_Table.Next (Iter);
end loop;
end Image_Table;
-- affichage du contenu du bloc courant
-- ====================================
procedure Image_Block (Block_Name : Scanner.B_String) is
Iter : Block_Table.Iterator;
Name : Scanner.B_String;
Value : Table_Reference;
Content : Object.Reference;
begin
-- rechercher le bloc courant
Value := The_Symbol_Table.Eval (Symbol_Table_Id,
Bounded_String.Image (Block_Name));
-- initialiser l'iterateur
Block_Table.Init (Iter, Value.Block_Access);
Msg_Report.Information ("Block Table contents");
while not Block_Table.Done (Iter) loop
Bounded_String.Copy (Name, Bounded_String.Value
(Block_Table.Value (Iter)));
-- lire le contenu
Content := Block_Table.Eval (Value.Block_Access,
Bounded_String.Image (Name));
Msg_Report.Continue
("Identifier: " & Bounded_String.Image (Name) & ", Class: " &
Object.Class'Image (Object.The_Class (Content)) &
", Value: " & Integer'Image (Object.Identificator (Content)));
Block_Table.Next (Iter);
end loop;
end Image_Block;
end Symbol_Table;
nblk1=13
nid=10
hdr6=1e
[0x00] rec0=24 rec1=00 rec2=01 rec3=084
[0x01] rec0=19 rec1=00 rec2=06 rec3=018
[0x02] rec0=1d rec1=00 rec2=07 rec3=06e
[0x03] rec0=1d rec1=00 rec2=04 rec3=03a
[0x04] rec0=1e rec1=00 rec2=09 rec3=01c
[0x05] rec0=24 rec1=00 rec2=12 rec3=028
[0x06] rec0=1e rec1=00 rec2=0b rec3=000
[0x07] rec0=1d rec1=00 rec2=0d rec3=044
[0x08] rec0=1a rec1=00 rec2=08 rec3=076
[0x09] rec0=0e rec1=00 rec2=05 rec3=004
[0x0a] rec0=1c rec1=00 rec2=0c rec3=084
[0x0b] rec0=1b rec1=00 rec2=03 rec3=054
[0x0c] rec0=1f rec1=00 rec2=0f rec3=00c
[0x0d] rec0=1f rec1=00 rec2=02 rec3=04e
[0x0e] rec0=1a rec1=00 rec2=0e rec3=000
[0x0f] rec0=1a rec1=00 rec2=0e rec3=000
[0x10] rec0=1a rec1=00 rec2=0e rec3=000
[0x11] rec0=19 rec1=00 rec2=0e rec3=000
[0x12] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21530ac3884e47b5b3976 0x42a00088462060003
Free Block Chain:
0x10: 0000 00 0a 00 05 00 02 20 20 02 53 79 6d 62 6f 6c 5f ┆ Symbol_┆
0xa: 0000 00 11 00 fb 00 48 20 20 20 20 20 20 20 20 20 20 ┆ H ┆
0x11: 0000 00 13 00 93 80 2c 6f 70 79 20 28 43 75 72 72 65 ┆ ,opy (Curre┆
0x13: 0000 00 00 00 19 80 16 20 20 20 20 20 20 20 20 20 42 ┆ B┆