|
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: 23552 (0x5c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Symbols, seg_046520
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with T_Value, Dynamic_Object, Text_Io, Bounded_String, Binary_Trees_Pkg;
with Models, Erreur;
package body Symbols is
use Symbols_Tree;
Inf : constant Integer := -1;
Equ : constant Integer := 0;
Sup : constant Integer := 1;
Current_Symbol : Symbol;
Lookahead : Boolean;
function Create_Symbol
(N : String; T : String; F : Dynamic_Object.Dynamic_Object)
return Symbol is
A : Symbol;
begin
Bounded_String.Free (A.Symbol_Name);
Bounded_String.Copy (A.Symbol_Name, N);
Bounded_String.Free (A.Symbol_Type);
Bounded_String.Copy (A.Symbol_Type, T);
Dynamic_Object.Surface_Copy (A.Symbol_Value, F);
return A;
end Create_Symbol;
function Compare (A, B : Symbol) return Integer is
begin
declare
use Bounded_String;
begin
if Image (A.Symbol_Name) < Image (B.Symbol_Name) then
return Inf;
elsif Image (A.Symbol_Name) = Image (B.Symbol_Name) then
return Equ;
else
return Sup;
end if;
end;
end Compare;
procedure Dispose_Symbol (The_Symbol : in out Symbol) is
begin
Dynamic_Object.Dispose_Object (The_Symbol.Symbol_Value);
Bounded_String.Free (The_Symbol.Symbol_Name);
Bounded_String.Free (The_Symbol.Symbol_Type);
end Dispose_Symbol;
procedure Destroy_Object is new Destroy_Deep (Free_Value => Dispose_Symbol);
procedure Dump_An_Symbol (A : Symbol) is
begin
Text_Io.Put_Line ("........................................");
Text_Io.Put_Line (Bounded_String.Image (A.Symbol_Name) & " " &
Bounded_String.Image (A.Symbol_Type) &
" With Object: ");
Dynamic_Object.Dump_Object_Attributes (A.Symbol_Value);
end Dump_An_Symbol;
procedure Dump is new Visit (Process => Dump_An_Symbol);
--Creation
procedure Create (D : in out Object) is
begin
D.Node := Symbols_Tree.Create;
end Create;
--Access
procedure Dump_Number_Of_Symbol (D : in Object) is
begin
Text_Io.Put_Line ("Number of Symbol:" &
Natural'Image (Symbols_Tree.Size (D.Node)));
end Dump_Number_Of_Symbol;
function Has_Symbol (D : in Object; Name : in String) return Boolean is
A : Symbol;
F : Dynamic_Object.Dynamic_Object;
begin
Dynamic_Object.New_Object (F);
A := Create_Symbol (Name, Name,
F); -- Only the first param. is important
return Symbols_Tree.Is_Found (A, D.Node);
end Has_Symbol;
function Get_Symbol_Type_By_Name
(D : Object; Name : String) return String is
Found : Boolean := False;
A : Symbol;
B : Dynamic_Object.Dynamic_Object;
begin
Dynamic_Object.New_Object (B);
A := Create_Symbol (Name, Name,
B); -- Only the first param. is important
Symbols_Tree.Find (A, D.Node, Found, A);
if Found then
return Bounded_String.Image (A.Symbol_Type);
else
return "";
end if;
exception
when others =>
raise Error_Symbol_Search;
end Get_Symbol_Type_By_Name;
procedure Get_Symbol_Object_By_Name
(D : Object;
Name : String;
F : in out Dynamic_Object.Dynamic_Object) is
Found : Boolean := False;
A : Symbol;
B : Dynamic_Object.Dynamic_Object;
begin
Dynamic_Object.New_Object (B);
A := Create_Symbol (Name, Name,
B); -- Only the first param. is important
Symbols_Tree.Find (A, D.Node, Found, A);
if Found then
Dynamic_Object.Copy_Object (F, A.Symbol_Value);
end if;
exception
when others =>
raise Error_Symbol_Search;
end Get_Symbol_Object_By_Name;
function Is_Pointer (D : Object; Symbol_Name : String) return Boolean is
begin
if Has_Symbol (D, Symbol_Name) then
if (Get_Symbol_Type_By_Name (D, Symbol_Name) = "POINTEUR") then
return True;
else
return False;
end if;
else
Erreur.Alerte (Symbol_Name & " est inconnue du scenario =>");
return False;
end if;
end Is_Pointer;
function Get_Pointer_Reference
(D : Object; Symbol_Name : String) return String is
A : Dynamic_Object.Dynamic_Object;
V : T_Value.Object;
S : Bounded_String.Variable_String (Max_Symbol_String);
begin
if Has_Symbol (D, Symbol_Name) then
Bounded_String.Free (S);
T_Value.New_Value (V);
Dynamic_Object.New_Object (A);
Get_Symbol_Object_By_Name (D, Symbol_Name, A);
Dynamic_Object.Get_Attribute_By_Name (A, "POINTEUR", V);
Dynamic_Object.Dispose_Object (A);
Bounded_String.Copy (S, T_Value.Get (V));
T_Value.Dispose (V);
return Bounded_String.Image (S);
else
Erreur.Execution (Symbol_Name & " est inconnue du scenario =>");
end if;
end Get_Pointer_Reference;
function Get_Symbol_Type (D : Object;
M : Models.Object;
Symbol_Name : String;
Attribute_Name : String) return String is
S : Bounded_String.Variable_String (Max_Symbol_String);
begin
if Has_Symbol (D, Symbol_Name) then
Bounded_String.Free (S);
if (Get_Symbol_Type_By_Name (D, Symbol_Name) = "POINTEUR") then
if Models.Has_Field_In_Model
(M, Get_Symbol_Type_By_Name
(D, Get_Pointer_Reference (D, Symbol_Name)),
Attribute_Name) then
Bounded_String.Copy
(S, Models.Get_Field_Type_By_Name
(M, Get_Symbol_Type_By_Name
(D, Get_Pointer_Reference
(D, Symbol_Name)), Attribute_Name));
else
Erreur.Alerte (Attribute_Name &
" est inconnue du scenario =>");
return "ENTIER";
end if;
else
if Models.Has_Field_In_Model
(M, Get_Symbol_Type_By_Name (D, Symbol_Name),
Attribute_Name) then
Bounded_String.Copy
(S, Models.Get_Field_Type_By_Name
(M, Get_Symbol_Type_By_Name (D, Symbol_Name),
Attribute_Name));
else
Erreur.Alerte (Attribute_Name &
" est inconnue du scenario =>");
return "ENTIER";
end if;
end if;
if not (Bounded_String.Image (S) = "ENTIER" or
Bounded_String.Image (S) = "CHAINE" or
Bounded_String.Image (S) = "BOOLEEN") then
return "ENUMERE";
else
return Bounded_String.Image (S);
end if;
else
Erreur.Alerte (Symbol_Name & " est inconnue du scenario =>");
return "ENTIER";
end if;
end Get_Symbol_Type;
function Get_Symbol_Type
(D : Object; M : Models.Object; Symbol_Name : String)
return String is
begin
if Has_Symbol (D, Symbol_Name) then
if (Get_Symbol_Type_By_Name (D, Symbol_Name) = "POINTEUR") then
return Models.Get_Model_Type_By_Name
(M, Get_Symbol_Type_By_Name
(D, Get_Pointer_Reference (D, Symbol_Name)));
else
return Models.Get_Model_Type_By_Name
(M, Get_Symbol_Type_By_Name (D, Symbol_Name));
end if;
else
Erreur.Alerte (Symbol_Name & " est inconnue du scenario =>");
return "STRUCTURE";
end if;
end Get_Symbol_Type;
function Get_Symbol_Value (D : Object;
M : Models.Object;
Symbol_Name : String;
Attribute_Name : String) return Integer is
A : Dynamic_Object.Dynamic_Object;
V : T_Value.Object;
I : Integer;
begin
if Has_Symbol (D, Symbol_Name) then
T_Value.New_Value (V);
Dynamic_Object.New_Object (A);
if (Get_Symbol_Type_By_Name (D, Symbol_Name) = "POINTEUR") then
if Models.Has_Field_In_Model
(M, Get_Symbol_Type_By_Name
(D, Get_Pointer_Reference (D, Symbol_Name)),
Attribute_Name) then
Get_Symbol_Object_By_Name
(D, Get_Pointer_Reference (D, Symbol_Name), A);
else
Erreur.Execution (Attribute_Name &
" est inconnue du scenario =>");
return 0;
end if;
else
if Models.Has_Field_In_Model
(M, Get_Symbol_Type_By_Name (D, Symbol_Name),
Attribute_Name) then
Get_Symbol_Object_By_Name (D, Symbol_Name, A);
else
Erreur.Execution (Attribute_Name &
" est inconnue du scenario =>");
return 0;
end if;
end if;
Dynamic_Object.Get_Attribute_By_Name (A, Attribute_Name, V);
Dynamic_Object.Dispose_Object (A);
I := T_Value.Get (V);
T_Value.Dispose (V);
return I;
else
Erreur.Execution (Symbol_Name & " est inconnue du scenario =>");
end if;
end Get_Symbol_Value;
function Get_Symbol_Value (D : Object;
M : Models.Object;
Symbol_Name : String;
Attribute_Name : String) return Boolean is
A : Dynamic_Object.Dynamic_Object;
V : T_Value.Object;
B : Boolean;
begin
if Has_Symbol (D, Symbol_Name) then
T_Value.New_Value (V);
Dynamic_Object.New_Object (A);
if (Get_Symbol_Type_By_Name (D, Symbol_Name) = "POINTEUR") then
if Models.Has_Field_In_Model
(M, Get_Symbol_Type_By_Name
(D, Get_Pointer_Reference (D, Symbol_Name)),
Attribute_Name) then
Get_Symbol_Object_By_Name
(D, Get_Pointer_Reference (D, Symbol_Name), A);
else
Erreur.Execution (Attribute_Name &
" est inconnue du scenario =>");
return False;
end if;
else
if Models.Has_Field_In_Model
(M, Get_Symbol_Type_By_Name (D, Symbol_Name),
Attribute_Name) then
Get_Symbol_Object_By_Name (D, Symbol_Name, A);
else
Erreur.Execution (Attribute_Name &
" est inconnue du scenario =>");
return False;
end if;
end if;
Dynamic_Object.Get_Attribute_By_Name (A, Attribute_Name, V);
Dynamic_Object.Dispose_Object (A);
B := T_Value.Get (V);
T_Value.Dispose (V);
return B;
else
Erreur.Execution (Symbol_Name & " est inconnue du scenario =>");
end if;
end Get_Symbol_Value;
function Get_Symbol_Value (D : Object;
M : Models.Object;
Symbol_Name : String;
Attribute_Name : String) return String is
A : Dynamic_Object.Dynamic_Object;
V : T_Value.Object;
S : Bounded_String.Variable_String (Max_Symbol_String);
begin
if Has_Symbol (D, Symbol_Name) then
Bounded_String.Free (S);
T_Value.New_Value (V);
Dynamic_Object.New_Object (A);
if (Get_Symbol_Type_By_Name (D, Symbol_Name) = "POINTEUR") then
if Models.Has_Field_In_Model
(M, Get_Symbol_Type_By_Name
(D, Get_Pointer_Reference (D, Symbol_Name)),
Attribute_Name) then
Get_Symbol_Object_By_Name
(D, Get_Pointer_Reference (D, Symbol_Name), A);
else
Erreur.Execution (Attribute_Name &
" est inconnue du scenario =>");
return "";
end if;
else
if Models.Has_Field_In_Model
(M, Get_Symbol_Type_By_Name (D, Symbol_Name),
Attribute_Name) then
Get_Symbol_Object_By_Name (D, Symbol_Name, A);
else
Erreur.Execution (Attribute_Name &
" est inconnue du scenario =>");
return "";
end if;
end if;
Dynamic_Object.Get_Attribute_By_Name (A, Attribute_Name, V);
Dynamic_Object.Dispose_Object (A);
Bounded_String.Copy (S, T_Value.Get (V));
T_Value.Dispose (V);
return Bounded_String.Image (S);
else
Erreur.Execution (Symbol_Name & " est inconnue du scenario =>");
end if;
end Get_Symbol_Value;
procedure Dump_Symbols (D : in Object) is
begin
Dump (D.Node, Symbols_Tree.Inorder);
end Dump_Symbols;
--Modification
procedure Store_Symbol (D : in out Object;
Aname : String;
Atype : String;
F : Dynamic_Object.Dynamic_Object) is
Found : Boolean := False;
A : Symbol;
B : Dynamic_Object.Dynamic_Object;
begin
Dynamic_Object.New_Object (B);
Dynamic_Object.Copy_Object (B, F);
Symbols_Tree.Replace_If_Found
(Create_Symbol (Aname, Atype, B), D.Node, Found, A);
if Found then
Dispose_Symbol (A);
end if;
exception
when others =>
raise Error_Symbol_Store;
end Store_Symbol;
--Liberation
procedure Dispose_Object (D : in out Object) is
begin
Destroy_Object (D.Node);
end Dispose_Object;
--Iteration
procedure Open_Symbol_Indexation (D : Object; I : in out Symbol_Index) is
begin
I.Node := Symbols_Tree.Make_Iter (D.Node);
Lookahead := False;
Next_Symbol_Index (I);
end Open_Symbol_Indexation;
procedure Next_Symbol_Index (I : in out Symbol_Index) is
begin
if not Lookahead then
if Symbols_Tree.More (I.Node) then
Symbols_Tree.Next (I.Node, Current_Symbol); else
raise Error_Symbol_Index;
end if;
end if;
end Next_Symbol_Index;
function Get_Indexed_Symbol_Name (I : Symbol_Index) return String is
begin
return Bounded_String.Image (Current_Symbol.Symbol_Name);
exception
when others =>
raise Error_Symbol_Index;
end Get_Indexed_Symbol_Name;
function Get_Indexed_Symbol_Type (I : Symbol_Index) return String is
begin
return Bounded_String.Image (Current_Symbol.Symbol_Type);
exception
when others =>
raise Error_Symbol_Index;
end Get_Indexed_Symbol_Type;
procedure Get_Indexed_Symbol_Value
(I : Symbol_Index; F : in out Dynamic_Object.Dynamic_Object) is
begin
Dynamic_Object.Copy_Object (F, Current_Symbol.Symbol_Value);
exception
when others =>
raise Error_Symbol_Index;
raise Error_Symbol_Index;
end Get_Indexed_Symbol_Value;
function No_More_Symbols (I : Symbol_Index) return Boolean is
More : Boolean := True;
begin
More := Symbols_Tree.More (I.Node);
if More then
return (False);
end if;
if (not More and not Lookahead) then
Lookahead := True;
return (False);
elsif (not More and Lookahead) then
return (True);
end if;
end No_More_Symbols;
end Symbols;
nblk1=16
nid=0
hdr6=2c
[0x00] rec0=23 rec1=00 rec2=01 rec3=00a
[0x01] rec0=00 rec1=00 rec2=07 rec3=010
[0x02] rec0=1c rec1=00 rec2=0a rec3=00a
[0x03] rec0=23 rec1=00 rec2=09 rec3=020
[0x04] rec0=1c rec1=00 rec2=08 rec3=018
[0x05] rec0=21 rec1=00 rec2=0e rec3=008
[0x06] rec0=19 rec1=00 rec2=12 rec3=048
[0x07] rec0=19 rec1=00 rec2=0d rec3=042
[0x08] rec0=1d rec1=00 rec2=11 rec3=06e
[0x09] rec0=20 rec1=00 rec2=10 rec3=046
[0x0a] rec0=1b rec1=00 rec2=02 rec3=03c
[0x0b] rec0=1e rec1=00 rec2=0c rec3=020
[0x0c] rec0=03 rec1=00 rec2=15 rec3=044
[0x0d] rec0=1c rec1=00 rec2=14 rec3=01a
[0x0e] rec0=1e rec1=00 rec2=06 rec3=042
[0x0f] rec0=02 rec1=00 rec2=16 rec3=03c
[0x10] rec0=1b rec1=00 rec2=13 rec3=04c
[0x11] rec0=21 rec1=00 rec2=03 rec3=026
[0x12] rec0=02 rec1=00 rec2=0b rec3=006
[0x13] rec0=23 rec1=00 rec2=0f rec3=002
[0x14] rec0=20 rec1=00 rec2=05 rec3=04a
[0x15] rec0=16 rec1=00 rec2=04 rec3=000
tail 0x21748b278865044c6150e 0x42a00088462060003